Merge branch 'w182'

3 files changed, 197 insertions, 2 deletions

diff --git a/challenge-182/bob-lied/README b/challenge-182/bob-lied/README
index c231e3a589..6fb1b537d5 100644
--- a/challenge-182/bob-lied/README
+++ b/challenge-182/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 182 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-182/
diff --git a/challenge-182/bob-lied/perl/ch-1.pl b/challenge-182/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..425f8dcebc
--- /dev/null
+++ b/challenge-182/bob-lied/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 182 Task 1 Max Index
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of integers.
+# Write a script to find the index of the first biggest number in the list.
+# Example 1: Input: @n = (5, 2, 9, 1, 7, 6)
+#           Output: 2 (as 3rd element in the list is the biggest number)
+# Example 2: Input: @n = (4, 2, 3, 1, 5, 0)
+#           Output: 4 (as 5th element in the list is the biggest number)
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+use Scalar::Util qw/looks_like_number/;
+
+my @list = grep { looks_like_number($_) }  @ARGV;
+
+my $mi = maxIndex(@list);
+print "maxIndex(@list) = " if $Verbose;
+print $mi;
+print " (list[$mi]=$list[$mi])" if $Verbose;
+print "\n";
+
+sub maxIndex(@list)
+{
+    my $max = $list[0];
+    my $indexOfMax = 0;
+    for ( my $i = 1; $i < @list ; $i++ )
+    {
+        if ( $list[$i] > $max )
+        {
+            $max = $list[$i];
+            $indexOfMax = $i
+        }
+    }
+    return $indexOfMax;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( maxIndex(5,2,9,1,7,6), 2, "Example 1");
+    is( maxIndex(4,2,3,1,5,0), 4, "Example 1");
+    is( maxIndex(9,2,5,1,7,6), 0, "At 0");
+    is( maxIndex(6,2,5,1,7,9), 5, "At end");
+    is( maxIndex(7,7,7,7,7,7), 0, "Multiple");
+
+    done_testing;
+}
+
diff --git a/challenge-182/bob-lied/perl/ch-2.pl b/challenge-182/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..fe2549009c
--- /dev/null
+++ b/challenge-182/bob-lied/perl/ch-2.pl
@@ -0,0 +1,133 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 182 Task 2 Common Path
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# Given a list of absolute Linux file paths, determine the deepest path
+# to the directory that contains all of them.
+# Example Input: /a/b/c/1/x.pl
+#                /a/b/c/d/e/2/x.pl
+#                /a/b/c/d/3/x.pl
+#                /a/b/c/4/x.pl
+#                /a/b/c/d/5/x.pl
+#         Ouput: /a/b/c
+#
+# We are going to infer that "absolute" means that the paths are
+# always full paths, starting from "/". That implies that "/" will
+# always be common to all the paths.
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+# Allow a file name as an argument, or read standard input.
+my $fh = *STDIN;
+if ( @ARGV )
+{
+    open($fh, '<', $ARGV[0]) || die "can't open $ARGV[0], $!";
+}
+
+say commonPath( parseInput($fh) );
+
+# Open a string as a file handle, to allow testing without depending
+# on extra files.
+sub parseInputFromString($s)
+{
+    open(my $fh, "<", \$s) || die "open input string failed, $!";
+    return parseInput($fh);
+}
+
+# Read the list of inputs and return an array of path segments,
+# Example:
+#   /a/b/d      [ [ 'a', 'b', 'd' ],
+#   /a/b/f        [ 'a', 'b', 'f' ] ]
+sub parseInput($fh)
+{
+    # String input has some extra white space around it.
+    # Opportunity to use a v5.36 feature.
+    use builtin qw/trim/; no warnings 'experimental::builtin';
+
+    my @pathList = ();  # Don't trip over undef
+    while ( <$fh> )
+    {
+        push @pathList, [ split '/', trim($_) ];
+    }
+    return \@pathList;
+}
+
+sub commonPath($pathList)
+{
+    use List::Util qw/all min/;
+
+    return '' if scalar(@$pathList) == 0;
+
+    my $depth = 0;
+
+    # We only have to go as deep as the shortest path.
+    my $maxDepth = (min map { scalar(@$_) } $pathList->@* );
+
+    # We go deeper as long as all paths are the same at this depth.
+    # The map takes a vertical column slice out of the pathList array.
+    $depth++ while ( $depth < $maxDepth &&
+                     all { $_ eq $pathList->[0][$depth] }
+                        map { $_->[$depth] } $pathList->@* );
+
+    return "/".join("/", $pathList->[0]->@[1..$depth-1]);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    my @TestCase = (
+        { in => '/a/b/c/1/x.pl
+                 /a/b/c/d/e/2/x.pl
+                 /a/b/c/d/3/x.pl
+                 /a/b/c/4/x.pl
+                 /a/b/c/d/5/x.pl ',
+          out => '/a/b/c',
+          desc => "Example"
+        },
+        { in => '/a/b/c
+                 /b/c/d
+                 /d/e/f ',
+          out => '/',
+          desc => "Root only"
+        },
+        { in => '/a/b
+                 /a/b',
+          out => '/a/b',
+          desc => 'Identical'
+        },
+        { in => '/a a/b/c
+                 /a a/b c/d',
+          out => '/a a',
+          desc => 'White space'
+        },
+        { in => '/a/b/c',
+          out => '/a/b/c',
+          desc => "Singleton"
+        },
+        { in => '',
+          out => '',
+          desc => "Empty list"
+        },
+    );
+
+    for my $t ( 0 .. $#TestCase )
+    {
+        my $test = $TestCase[$t];
+        is( commonPath( parseInputFromString($test->{in}) ), $test->{out}, $test->{desc} );
+    }
+
+    done_testing;
+}
+