Merge pull request #7962 from boblied/w213

W213

3 files changed, 233 insertions, 3 deletions

diff --git a/challenge-213/bob-lied/README b/challenge-213/bob-lied/README
index dd9d61c433..ca4d14b3b4 100644
--- a/challenge-213/bob-lied/README
+++ b/challenge-213/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 212 by Bob Lied
+Solutions to weekly challenge 213 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-212/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-212/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-213/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-213/bob-lied
diff --git a/challenge-213/bob-lied/perl/ch-1.pl b/challenge-213/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..943607a940
--- /dev/null
+++ b/challenge-213/bob-lied/perl/ch-1.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 213 Task 1 Fun Sort 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of positive integers.
+# Write a script to sort the all even integers first then all odds in
+# ascending order.
+# Example 1 Input: @list = (1,2,3,4,5,6) Output: (2,4,6,1,3,5)
+# Example 2 Input: @list = (1,2)         Output: (2,1)
+# Example 3 Input: @list = (1)           Output: (1)
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest);
+exit(!runTest()) if $DoTest;
+
+say "(", join(",", funSort(@ARGV)->@*), ")";
+
+# Single sort with separation in sort function
+sub funSort(@list)
+{
+    return [ sort { (($a & 1) <=> ($b & 1)) || ($a <=> $b) } @list ];
+}
+
+# Sort, then partition
+sub funSort_part(@list)
+{
+    use List::MoreUtils qw/part/;
+    use List::Flatten qw/flat/;
+
+    return [ grep { defined } flat part { $_ % 2 } sort { $a <=> $b} @list ];
+}
+
+# Partition, then sort each piece
+sub funSort_partB(@list)
+{
+    use List::MoreUtils qw/part/;
+    my @sorted;
+    for my $sub ( part { $_ % 2} @list )
+    {
+        next unless defined $sub;
+        push @sorted, sort { $a <=> $b } $sub->@*;
+    }
+    return \@sorted;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( funSort(1,2,3,4,5,6), [2,4,6,1,3,5], "Example 1");
+    is( funSort(1,2        ), [2,1],         "Example 2");
+    is( funSort(1          ), [1  ],         "Example 3");
+    is( funSort(3,7,5,9,1  ), [1,3,5,7,9],   "Odds");
+    is( funSort(2          ), [2  ],         "Evens 1");
+    is( funSort(2,8,4,6    ), [2,4,6,8],     "Evens 2");
+
+    is( funSort_part(1,2,3,4,5,6), [2,4,6,1,3,5], "Example 1");
+    is( funSort_part(1,2        ), [2,1],         "Example 2");
+    is( funSort_part(1          ), [1  ],         "Example 3");
+    is( funSort_part(3,7,5,9,1  ), [1,3,5,7,9],   "Odds");
+    is( funSort_part(2          ), [2  ],         "Evens 1");
+    is( funSort_part(2,8,4,6    ), [2,4,6,8],     "Evens 2");
+
+    is( funSort_partB(1,2,3,4,5,6), [2,4,6,1,3,5], "Example 1");
+    is( funSort_partB(1,2        ), [2,1],         "Example 2");
+    is( funSort_partB(1          ), [1  ],         "Example 3");
+    is( funSort_partB(3,7,5,9,1  ), [1,3,5,7,9],   "Odds");
+    is( funSort_partB(2          ), [2  ],         "Evens 1");
+    is( funSort_partB(2,8,4,6    ), [2,4,6,8],     "Evens 2");
+
+    done_testing;
+}
diff --git a/challenge-213/bob-lied/perl/ch-2.pl b/challenge-213/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..5b2544f5cb
--- /dev/null
+++ b/challenge-213/bob-lied/perl/ch-2.pl
@@ -0,0 +1,150 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 213 Task 2 Shortest Route 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of bidirectional routes defining a network of nodes,
+# as well as source and destination node numbers.
+# Write a script to find the route from source to destination that passes
+# through fewest nodes.
+# Example 1: Input: @routes = ([1,2,6], [5,6,7]) $source = 1 $destination = 7
+#           Output: (1,2,6,7)
+#   Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6
+#   then jump to route [5,6,7] and takes the route 6 -> 7.
+#   So the final route is (1,2,6,7)
+# Example 2: Input: @routes = ([1,2,3], [4,5,6]) $source = 2 $destination = 5
+#           Output: -1
+# Example 3: Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8]) $source = 1 $destination = 7
+#           Output: (1,2,3,8,7)
+#   Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3
+#   then jump to route [3,8,9] and takes the route 3 -> 8
+#   then jump to route [7,8] and takes the route 8 -> 7
+#   So the final route is (1,2,3,8,7)
+# -----------------------------------
+# Flatten the set of routes to form the entire graph, then do a path
+# search in the total graph.
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+my $Source;
+my $Destination;
+
+package Graph;
+{
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+    use Moo;
+    use Carp qw/confess/;
+
+    has adj => ( is => 'rw', default => sub{ {} } );
+
+    sub show($self)
+    {
+        for my $node ( sort keys %{$self->{adj}} )
+        {
+            say "$node --> [ ", join(",", sort $self->{adj}{$node}->@*), " ]";;
+        }
+    }
+
+    sub addNode($self, $n)
+    {
+        $self->{adj}{$n} //= [];
+    }
+
+    sub addEdge($self, $v1, $v2)
+    {
+        $self->addNode($v1);
+        my $neighbors = $self->{adj}{$v1};
+        push @{$neighbors}, $v2 unless grep { $_ == $v2 } $neighbors->@*;
+        return $self;
+    }
+
+    sub hasNode($self, $n)
+    {
+        return exists $self->{adj}{$n};
+    }
+
+    sub route($self, $source, $destination)
+    {
+        no warnings "experimental::builtin";
+        use List::Util qw/uniq/;
+        return [ $source] if ( $source == $destination );
+
+        # Breadth-first search
+        my @path;
+        my @queue = ( $source );
+        my %seen;
+
+        while ( @queue )
+        {
+            my $node = shift @queue;
+            push @path, $node;
+
+            my $neighbors = $self->{adj}{$node};
+            for my $neighbor ( grep { !$seen{$_} } $neighbors->@* )
+            {
+                say "Q:[@queue] P:[@path] n:$neighbor" if $Verbose;
+                if ( $neighbor == $destination )
+                {
+                    return [ @path, $neighbor ];
+                }
+                push @queue, $neighbor;
+            }
+
+            $seen{$node} = true;
+        }
+        return [];
+    }
+}
+
+package main;
+
+use Graph;
+
+sub shortestRoute($segments, $source, $destination)
+{
+    my $g = Graph->new;
+    for my $route ( $segments->@* )
+    {
+        my $v1 = shift @$route;
+        $g->addNode($v1);
+        while ( @$route )
+        {
+            my $v2 = shift @$route;
+            $g->addEdge($v1,$v2)->addEdge($v2,$v1);
+            $v1 = $v2;
+        }
+    }
+    $g->show if $Verbose;
+    return [] unless $g->hasNode($source) && $g->hasNode($destination);
+    return $g->route($source, $destination);
+}
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose,
+           "source:i" => \$Source, "dest:i" => \$Destination);
+exit(!runTest()) if $DoTest;
+
+my @routeList;
+push @routeList, [ split(",", $_) ] for @ARGV;
+
+say "(", join(",", shortestRoute(\@routeList, $Source, $Destination)->@*), ")";
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( shortestRoute( [[1,2,6],[5,6,7]],               1, 7), [1,2,6,7],   "Example 1");
+    is( shortestRoute( [[1,2,3],[4,5,6]],               3, 6), [],          "Example 2");
+    is( shortestRoute( [[1,2,3],[4,5,6],[3,8,9],[7,8]], 1, 7), [1,2,3,8,7], "Example 3");
+    is( shortestRoute( [[1,2,6,7],[5,6,7],[1,2,6,7]],   1, 7), [1,2,6,7],   "Redundant edges");
+    is( shortestRoute( [[1,2,3]], 2, 2), [2], "Going nowhere");
+    is( shortestRoute( [[2]], 2, 2), [2], "Going nowhere faster");
+
+    done_testing;
+}