Merge branch 'w184'

3 files changed, 202 insertions, 2 deletions

diff --git a/challenge-184/bob-lied/README b/challenge-184/bob-lied/README
index c231e3a589..4dbe332297 100644
--- a/challenge-184/bob-lied/README
+++ b/challenge-184/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 184 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-184/
diff --git a/challenge-184/bob-lied/perl/ch-1.pl b/challenge-184/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..5aa155e8a8
--- /dev/null
+++ b/challenge-184/bob-lied/perl/ch-1.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 184 Task 1 Sequence Number
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given list of strings in the format aa9999 i.e. first 2 characters
+# can be anything 'a-z' followed by 4 digits '0-9'.
+# Write a script to replace the first two characters with sequence starting
+# with '00', '01', '02' etc.
+# Example 1 Input: @list = ('ab1234', 'cd5678', 'ef1342')
+#          Output:         ('001234', '015678', '021342')
+# Example 2 Input: @list =  'pq1122', 'rs3334')
+#          Output:         ('001122', '013334')
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+my $format = qr/[a-z]{2}\d{4}/;
+
+for ( @ARGV )
+{
+    warn "Expect format aa9999, got $_" unless m/$format/;
+}
+
+say showArray( seqNum( grep /$format/, @ARGV ) );
+
+sub showArray(@array)
+{
+    return '()' unless @array;
+    return "('" . join("', '", @array) . "')";
+}
+
+sub seqNum(@list)
+{
+    # There's quite a lot of subtle Perl going on in one line here.
+    #
+    # Within the map, The return value of s/// is the number of
+    # substitutions,  not the string. To get a list of substituted
+    # strings, we need to return it explicitly.
+    #
+    # If we do the substitution to the $_ variable in the map, then we are
+    # modifying the original list.  If we want to keep the original list
+    # intact, we need to copy to a temporary variable and return that. The
+    # copy is done 'en passant' to be able to use the s/// operator in the
+    # same assignment statement; the idiom is: (my $copy=$orig) =~ s///.
+    #
+    # s///e evaluates the second part of s/// as Perl code and uses the
+    # result to substitue for what matched in the first part.
+    # Here we are using /e to incorporate the sequence number increment as a
+    # side effect of formatting the number before replacement in the string.
+    #
+    # $seq is post-incremented, so that the counter starts at 0.
+    #
+    # Increment the $seq variable, using sprintf(%02d) to get a two-digit
+    # number with leading zero.  If it overflows past 99, wrap around to 00.
+    my $seq = 0;
+    return map { (my $n = $_) =~ s/^../sprintf("%02d", $seq++ % 100)/e; $n } @list;
+    # return map { $_ =~ s/^../sprintf("%02d", $seq++ % 100)/e; $_ } @list;
+
+    # Alternative in two steps, remove the prefix and insert the sequence
+    # Does not modify the original list.
+    # return map { sprintf("%02d$_", ($seq++ % 100)) } map { substr($_, 2) } @list;
+
+    # Using Perl to write C. This modifies the original list.
+    # for ( my $i = 0 ; $i <= $#list ; $i++ )
+    # {
+    #     my $seq = sprintf("%02d", $i%100);
+    #     $list[$i] = $seq . substr($list[$i], 2);
+    # }
+    # return @list;
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    my @output;
+    @output = seqNum('ab1234', 'cd5678', 'ef1342');
+    is( \@output,  [ '001234', '015678', '021342' ], "Example 1");
+    @output = seqNum('pq1122', 'rs3334');
+    is( \@output,  [ '001122', '013334' ],           "Example 2");
+
+    done_testing;
+}
diff --git a/challenge-184/bob-lied/perl/ch-2.pl b/challenge-184/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..bccc237400
--- /dev/null
+++ b/challenge-184/bob-lied/perl/ch-2.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 184 Task 2 Split Array
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given list of strings containing 0-9 and a-z separated by space only.
+# Write a script to split the data into two arrays, one for integers and one
+# for alphabets only.
+# Example 1 Input: @list = ( 'a 1 2 b 0', '3 c 4 d')
+#          Output: [[1,2,0], [3,4]] and [['a','b'], ['c','d']]
+# Example 2 Input: @list = ( '1 2', 'p q r', 's 3', '4 5 t')
+#          Output: [[1,2], [3], [4,5]] and [['p','q','r'], ['s'], ['t']]
+#=============================================================================
+
+use v5.36;
+
+use constant NUMBER => 0;
+use constant LETTER => 1;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+# Use this module to show output of nested array references.
+# Doesn't exactly match the spec because it quotes numbers
+# and has no white space.
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+$Data::Dumper::Terse = 1;
+
+my $numLet = splitArray(@ARGV);
+say Dumper($numLet->[NUMBER]), ' and ', Dumper($numLet->[LETTER]);
+
+# Input is an array of strings.
+sub splitArray(@array)
+{
+    # Split each string into an array of digits and letters.
+    # Use _splitList to turn each string in the array into a pair of lists.
+    # The result is an array of pairs, where each pair contains two
+    # array references, [NUMBER] for numbers and [LETTER] for letters.
+    my @nlListPair = map { _splitList( split(' ', $_) ) } @array;
+
+    # This array will be our result.
+    my @numberLetter = ( [], [] );
+
+    for my $p ( @nlListPair )
+    {
+        # Notice that Example 2 implies that an empty list should be removed
+        # from the output. [1,2] has no letters and [p q r] has no numbers,
+        # but there are no corresponding empty lists in the output.
+        for my $type ( NUMBER, LETTER )
+        {
+            my $list = $p->[$type];
+            push @{$numberLetter[$type]}, $list if scalar(@$list);
+        }
+    }
+    return \@numberLetter;
+}
+
+# Given a list of digits and letters, partition the list into
+# an array of numbers and an array of letters.  Returns a reference
+# to a pair of arrays where the first element is a list of numbers
+# and the second element is a list of letters.
+# Example: ('a', 1, 'x', 3) ==> [ [1,3], ['a','x'] ]
+sub _splitList(@list)
+{
+    my @numberLetter = ( [], [] );
+
+    for ( @list )
+    {
+        my $which = (m/\d/ ? NUMBER : LETTER);
+        push @{$numberLetter[$which]}, $_;
+    }
+
+    return \@numberLetter;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( _splitList( qw(a 1 2 b 0) ), [[1,2,0], ['a','b'    ]], 'Split a 1 2 b 0');
+    is( _splitList( qw(3 c 4 d  ) ), [[3,4  ], ['c','d'    ]], 'Split 3 c 4 d');
+    is( _splitList( qw(1 2      ) ), [[1,2  ], [           ]], 'Split 1 2');
+    is( _splitList( qw(p q r    ) ), [[     ], ['p','q','r']], 'Split p q r');
+    is( _splitList( qw(s 3      ) ), [[3    ], ['s'        ]], 'Split s 3');
+    is( _splitList( qw(4 5 t    ) ), [[4,5  ], ['t'        ]], 'Split 3 c 4 d');
+
+    is( splitArray( 'a 1 2 b 0', '3 c 4 d' ),
+                    [ [[1,2,0], [3,4]], [['a','b'], ['c','d']] ], 'Example 1');
+    is( splitArray( '1 2', 'p q r', 's 3', '4 5 t' ),
+                    [ [[1,2], [3], [4,5]], [['p','q','r'], ['s'], ['t']] ], 'Example 2');
+
+    is( splitArray( '1 2', '3 4', '5 6' ),
+                    [ [[1,2], [3,4], [5,6]], [] ], 'No letters');
+    is( splitArray( 'a b', 'c d' ),
+                    [ [] , [['a','b'], ['c','d']] ], 'No numbers');
+
+    done_testing;
+}
+