Week 213 solutions for Avery Adams

3 files changed, 94 insertions, 0 deletions

diff --git a/challenge-213/avery-adams/blogs.txt b/challenge-213/avery-adams/blogs.txt
new file mode 100644
index 0000000000..e5c6818478
--- /dev/null
+++ b/challenge-213/avery-adams/blogs.txt
@@ -0,0 +1,2 @@
+https://blogs.perl.org/users/oldtechaa/2023/04/perl-weekly-challenge-213---the-simple-and-the-hard.html
+https://dev.to/oldtechaa/perl-weekly-challenge-213-the-simple-and-the-hard-17o3
diff --git a/challenge-213/avery-adams/perl/ch-1.pl b/challenge-213/avery-adams/perl/ch-1.pl
new file mode 100644
index 0000000000..e9c401fa54
--- /dev/null
+++ b/challenge-213/avery-adams/perl/ch-1.pl
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+use strict;
+use v5.24;
+
+my (@even, @odd);
+$_ % 2 ? push @odd, $_ : push @even, $_ for sort @ARGV;
+say @even, @odd;
diff --git a/challenge-213/avery-adams/perl/ch-2.pl b/challenge-213/avery-adams/perl/ch-2.pl
new file mode 100644
index 0000000000..a851601f25
--- /dev/null
+++ b/challenge-213/avery-adams/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/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;
+}
\ No newline at end of file