Perl Weekly Challenge #213 - The Simple and the Hard
Tags: perl, perlweeklychallenge, dijkstra, chatgpt
Published: 2023-04-23 03:10:35

Hey everybody, back this week with a couple really interesting weekly challenge tasks. The first one is extremely simple, like one-liner simple, and the second one is quite complex and nearly 90 lines long.

#### Challenge #1 - Fun Sort

This was fun, it's in the name. This challenge took me about 5 minutes. Sort the input, split into even and odd arrays and put them together to print out. Pretty self-explanatory.

    #!/usr/bin/perl
    use strict;
    use v5.24;

    my (@even, @odd);
    $_ % 2 ? push @odd, $_ : push @even, $_ for sort @ARGV;
    say @even, @odd;

#### Challenge #2 - Not Fun Dijkstra

I still don't know how Dijkstra came up with his algorithm after 20 minutes of thinking and it took me hours to understand it, but I'm glad he did. I had never heard of Dijkstra's algorithm, so originally I had no idea how to solve this challenge. To give me a starting point, I asked ChatGPT what it thought, and it said "Use Dijkstra's algorithm" and gave me an implementation to play with. As before, I wrote this code by hand, but it helped me a lot with the algorithmic design. Also, the AI seemed to fail badly when I asked it for additional error-checking if there was no route, so I designed and wrote that part entirely on my own.

If you haven't checked out the ways AI can assist your workflow and productivity, I highly recommend it. There are valid concerns about it, obviously, and I would never recommend copying and pasting code from it without understanding what it's doing, but it can help you understand a complex algorithm and how you would implement it.

Essentially, the theory behind Dijkstra's algorithm is not to traverse recursively, but to always follow whatever the shortest untraveled route attached to the source is. If you're always following whatever the shortest route is, the first route that reaches the destination will be the shortest route to the destination. Then you maintain a list of arrows (a hash of each node in our case) pointing backwards to the source node along that shortest route.

Here's the code:

    #!/usr/bin/perl

    use strict;
    use v5.24;
    use List::Util 'min';

    my @routes = ([1, 2, 6], [5, 6, 7]);
    my $source = 1;
    my $destination = 7;

    print_dijkstra(\@routes, $source, $destination);

    @routes = ([1, 2, 3], [4, 5, 6]);
    $source = 2;
    $destination = 5;
    
    print_dijkstra(\@routes, $source, $destination);

    @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8]);
    $source = 1;
    $destination = 7;

    print_dijkstra(\@routes, $source, $destination);

    sub print_dijkstra {
        my $result = dijkstra(@_);
        if ($result == -1) {
            say -1;
        } else {
            my @route = @{$result};
            for (@route) {
                $_ != $route[$#route] ? print "$_, " : print "$_\n"
            }
        }
    }

    sub dijkstra {
        my ($routeref, $source, $destination) = @_;
        my @routes = @{$routeref};

        my %adjacency;
        for my $route (@routes) {
            my @nodes = @$route;
            for my $i (0 .. $#nodes - 1) {
                push @{$adjacency{$nodes[$i]}}, $nodes[$i + 1];
                push @{$adjacency{$nodes[$i + 1]}}, $nodes[$i];
            }
        }

        my %distance;
        my %visited;
        my %previous;
        $distance{$source} = 0;

        my %new_visits;
        while (keys %visited != keys %adjacency) {
            my $node = min(grep {!defined $visited{$_}} keys %distance);
            $visited{$node} = 1;

            for my $adjacent (@{$adjacency{$node}}) {
                my $total_distance = $distance{$node} + 1;
                if (!defined $distance{$adjacent} || $total_distance < $distance{$adjacent}) {
                    $distance{$adjacent} = $total_distance;
                    $previous{$adjacent} = $node;
                }
            }

            if (%visited == %new_visits && !$visited{$destination}) {
                return -1;
            } elsif ($visited{$destination}) {
                last;
            }
            %new_visits = %visited;
        }

        my @route;
        my $node = $destination;
        while ($node != $source) {
            unshift @route, $node;
            $node = $previous{$node};
        }
        unshift @route, $source;
    
        return \@route;
    }

The first iteration through, the second example ended up in an endless loop because it kept trying to reach the separate set of nodes and couldn't. Because of that, I had to write the no route code properly, which essentially checks whether we're making any progress through the route or not. If not and we've reached a dead-end, we return a -1 and leave. However, the third example shows that we also need to handle the case where there are nodes that can't be reached but we have visited the destination, so that's included in the no route code.

#### Conclusion

This week we had a very simple challenge and a tough one. I had fun with the first one (albeit briefly) and I learned a lot from the second one, including the power of AI. It's a very powerful tool to have on hand. Have a good week and if I have time next week I'll see you then with the next challenge!