Week 212

2 files changed, 146 insertions, 0 deletions

diff --git a/challenge-212/bob-lied/perl/ch-1.pl b/challenge-212/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..fb0edd9ce2
--- /dev/null
+++ b/challenge-212/bob-lied/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 212 Task 1 Jumping Letters 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a word having alphabetic characters only, and a list of
+# positive integers of the same length.
+# Write a script to print the new word generated after jumping forward each
+# letter in the given word by the integer in the list. The given list would have
+# exactly the number as the total alphabets in the given word.
+# Example 1 Input: $word = 'Perl' and @jump = (2,22,19,9)
+#           Output: Raku
+#   'P' jumps 2 place forward and becomes 'R'.
+#   'e' jumps 22 place forward and becomes 'a'.
+#       (jump is cyclic i.e. after 'z' you go back to 'a')
+#   'r' jumps 19 place forward and becomes 'k'.
+#   'l' jumps 9 place forward and becomes 'u'.
+# Example 2 Input: $word = 'Raku' and @jump = (24,4,7,17)
+#           Output: 'Perl'
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub jumpLetter($c, $n)
+{
+    my $v = ord($c);
+    my $lc_a = ord('a');
+    my $uc_A = ord('A');
+    if ( $lc_a <= $v <= ord('z') )
+    {
+        return chr($lc_a+(($v - $lc_a) + $n) % 26);
+    }
+    elsif ( $uc_A <= $v <= ord('Z') )
+    {
+        return chr($uc_A+(($v - $uc_A) + $n) % 26);
+    }
+    else
+    {
+        return $c;
+    }
+}
+
+sub jumpWord($word, $jumps)
+{
+    # return join "", map { jumpLetter(substr($word, $_, 1), $jumps->[$_]) } 0 .. $jumps->$#*;
+    substr($word, $_, 1, jumpLetter(substr($word, $_, 1), $jumps->[$_]) ) for 0 .. $jumps->$#*;
+    return $word;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( jumpWord("Perl", [2,22,19,9]), "Raku", "Example 1");
+    is( jumpWord("Raku", [24,4,7,17]), "Perl", "Example 2");
+
+    done_testing;
+}
+
diff --git a/challenge-212/bob-lied/perl/ch-2.pl b/challenge-212/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..713cf29754
--- /dev/null
+++ b/challenge-212/bob-lied/perl/ch-2.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 212 Task 2 Rearrange Groups 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of integers and group size greater than zero.
+# Write a script to split the list into equal groups of the given size where
+# integers are in sequential order. If it can’t be done then print -1.
+# Example 1: Input: @list = (1,2,3,5,1,2,7,6,3) and $size = 3
+#           Output: (1,2,3), (1,2,3), (5,6,7)
+# Example 2: Input: @list = (1,2,3) and $size = 2
+#           Output: -1
+# Example 3: Input: @list = (1,2,4,3,5,3) and $size = 3
+#           Output: (1,2,3), (3,4,5)
+# Example 4: Input: @list = (1,5,2,6,4,7) and $size = 3
+#           Output: -1
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw(min);
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub rearrange($list, $grpsize)
+{
+    return [] if ( (scalar(@$list) % $grpsize) != 0 );
+
+    my %available;
+    $available{$_}++ for $list->@*;
+    my @output;
+    
+    for ( 0 .. ($list->$#* / $grpsize ) )
+    {
+        my @group;
+        my $start = min grep { $available{$_} > 0 } keys %available;
+        for my $seq ( $start .. ($start + $grpsize - 1) )
+        {
+            if ( $available{$seq} )
+            {
+                push @group, $seq;
+                $available{$seq}--;
+            }
+        }
+        if ( @group == $grpsize )
+        {
+            push @output, [ @group ];
+        }
+        else
+        {
+            return []
+        }
+    }
+
+    return \@output;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( rearrange([1,1,1,2,2,2],       2), [[1,2],[1,2],[1,2]], "Example 0");
+    is( rearrange([1,2,3,5,1,2,7,6,3], 3), [ [1,2,3],[1,2,3],[5,6,7]], "Example 1");
+    is( rearrange([1,2,3],             2), [],                  "Example 2");
+    is( rearrange([1,2,4,3,5,3],       3), [[1,2,3],[3,4,5]],   "Example 3");
+    is( rearrange([1,5,2,6,4,7],       3), [],                  "Example 4");
+    is( rearrange([1,2,3,6,7,8],       3), [[1,2,3],[6,7,8]],   "No overlap");
+
+    done_testing;
+}
+