Perl & Raku solutions to Tasks 1 & 2 for Week 238

4 files changed, 709 insertions, 0 deletions

diff --git a/challenge-238/athanasius/perl/ch-1.pl b/challenge-238/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..9f879288fb
--- /dev/null
+++ b/challenge-238/athanasius/perl/ch-1.pl
@@ -0,0 +1,165 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 238
+=========================
+
+TASK #1
+-------
+*Running Sum*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to return the running sum of the given array. The running sum can
+be calculated as sum[i] = num[0] + num[1] + …. + num[i].
+
+Example 1
+
+  Input: @int = (1, 2, 3, 4, 5)
+  Output: (1, 3, 6, 10, 15)
+
+Example 2
+
+  Input: @int = (1, 1, 1, 1, 1)
+  Output: (1, 2, 3, 4, 5)
+
+Example 3
+
+  Input: @int = (0, -1, 1, 2)
+  Output: (0, -1, 0, 2)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<int> ...]
+  perl $0
+
+    [<int> ...]    A non-empty list of integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 238, Task #1: Running Sum (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $int = \@ARGV;
+
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+            for @$int;
+
+        my $sum = find_running_sum( $int );
+
+        my (@int_str, @sum_str);
+
+        for my $i (0 .. $#$int)
+        {
+            my $width = length $int->[ $i ];
+            my $len_s = length $sum->[ $i ];
+               $width = $len_s if $len_s > $width; 
+
+            push @int_str, sprintf '%*s', $width, $int->[ $i ];
+            push @sum_str, sprintf '%*s', $width, $sum->[ $i ];
+        }
+
+        printf "Input: \@int = (%s)\n", join ', ', @int_str;
+        printf "Output:       (%s)\n",  join ', ', @sum_str;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_running_sum
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  @sum   = $ints->[ 0 ];
+
+    for my $i (1 .. $#$ints)
+    {
+        push @sum, $ints->[ $i ] + $sum[ -1 ];
+    }
+
+    return \@sum;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $int_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @int = split / \s+ /x, $int_str;
+        my @exp = split / \s+ /x, $exp_str;
+        my $sum = find_running_sum( \@int );
+
+        is_deeply $sum, \@exp, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1| 1  2 3  4 5| 1  3 6 10 15
+Example 2| 1  1 1  1 1| 1  2 3  4  5
+Example 3| 0 -1 1  2  | 0 -1 0  2
+Negatives|-3 -2 6 -1 4|-3 -5 1  0  4
diff --git a/challenge-238/athanasius/perl/ch-2.pl b/challenge-238/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..6ffeba71e4
--- /dev/null
+++ b/challenge-238/athanasius/perl/ch-2.pl
@@ -0,0 +1,191 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 238
+=========================
+
+TASK #2
+-------
+*Persistence Sort*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers.
+
+Write a script to sort the given array in increasing order with respect to the
+count of steps required to obtain a single-digit number by multiplying its
+digits recursively for each array element. If any two numbers have the same
+count of steps, then print the smaller number first.
+
+Example 1
+
+  Input: @int = (15, 99, 1, 34)
+  Output: (1, 15, 34, 99)
+
+  15 => 1 x 5 => 5 (1 step)
+  99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
+  1  => 0 step
+  34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)
+
+Example 2
+
+  Input: @int = (50, 25, 33, 22)
+  Output: (22, 33, 50, 25)
+
+  50 => 5 x 0 => 0 (1 step)
+  25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
+  33 => 3 x 3 => 9 (1 step)
+  22 => 2 x 2 => 4 (1 step)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+A "positive" integer is an unsigned integer (i.e., an integer >= 0).
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of positive integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 238, Task #2: Persistence Sort (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $ints = \@ARGV;
+
+        for (@$ints)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+            $_ >= 0                or error( "$_ is negative" );
+        }
+
+        my  $sorted = persistence_sort( $ints );
+        my (@ints_str, @sort_str);
+
+        for my $i (0 .. $#$ints)
+        {
+            my $width = length $ints  ->[ $i ];
+            my $len_s = length $sorted->[ $i ];
+               $width = $len_s if $len_s > $width; 
+
+            push @ints_str, sprintf '%*s', $width, $ints  ->[ $i ];
+            push @sort_str, sprintf '%*s', $width, $sorted->[ $i ];
+        }
+
+        printf "Input: \@int = (%s)\n", join ', ', @ints_str;
+        printf "Output:       (%s)\n",  join ', ', @sort_str;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub persistence_sort
+#-------------------------------------------------------------------------------
+{
+    my ($ints)  = @_;
+    my  @sorted = sort { count_steps( $a ) <=> count_steps( $b )
+                                     || $a <=> $b } @$ints;
+
+    return \@sorted;
+}
+
+#-------------------------------------------------------------------------------
+sub count_steps
+#-------------------------------------------------------------------------------
+{
+    my ($num)    = @_;
+    my  $steps   = 0;
+    my  $product = $num;
+
+    while (length $product > 1)
+    {
+        my @digits = split //, $product;
+        $product   = $digits[ 0  ];
+        $product  *= $digits[ $_ ] for 1 .. $#digits;
+        ++$steps;
+    }
+
+    return $steps;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $int_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints     = split / \s+ /x, $int_str;
+        my @expected = split / \s+ /x, $exp_str;
+        my $sorted   = persistence_sort( \@ints );
+
+        is_deeply $sorted, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|15 99  1 34| 1 15 34 99
+Example 2|50 25 33 22|22 33 50 25
diff --git a/challenge-238/athanasius/raku/ch-1.raku b/challenge-238/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..614570d333
--- /dev/null
+++ b/challenge-238/athanasius/raku/ch-1.raku
@@ -0,0 +1,166 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 238
+=========================
+
+TASK #1
+-------
+*Running Sum*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to return the running sum of the given array. The running sum can
+be calculated as sum[i] = num[0] + num[1] + …. + num[i].
+
+Example 1
+
+  Input: @int = (1, 2, 3, 4, 5)
+  Output: (1, 3, 6, 10, 15)
+
+Example 2
+
+  Input: @int = (1, 1, 1, 1, 1)
+  Output: (1, 2, 3, 4, 5)
+
+Example 3
+
+  Input: @int = (0, -1, 1, 2)
+  Output: (0, -1, 0, 2)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first element in the input list is negative, it must be preceded by
+   "--" to distinguish it from a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 238, Task #1: Running Sum (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@int where { .elems > 0 && .all ~~ Int:D }  #= A non-empty list of integers
+)
+#===============================================================================
+{
+    my Int  @sum = find-running-sum( @int );
+    my Str (@int-str, @sum-str);
+
+    for 0 .. @int.end -> UInt $i
+    {
+        my UInt $width = max( @int[ $i ].chars, @sum[ $i ].chars );
+
+        @int-str.push: '%*s'.sprintf: $width, @int[ $i ];
+        @sum-str.push: '%*s'.sprintf: $width, @sum[ $i ];
+    }
+
+    "Input: \@int = (%s)\n".printf: @int-str.join: ', ';
+    "Output:       (%s)\n"\.printf: @sum-str.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-running-sum( List:D[Int:D] $ints --> List:D[Int:D] )
+#-------------------------------------------------------------------------------
+{
+    my Int @sum = $ints[ 0 ];
+
+    for 1 .. $ints.end -> UInt $i
+    {
+        @sum.push: $ints[ $i ] + @sum[ *-1 ];
+    }
+
+    return @sum;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $int-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @int = $int-str.split( / \s+ / ).map: { .Int };
+        my Int @exp = $exp-str.split( / \s+ / ).map: { .Int };
+        my Int @sum = find-running-sum( @int );
+
+        is-deeply @sum, @exp, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1| 1  2 3  4 5| 1  3 6 10 15
+        Example 2| 1  1 1  1 1| 1  2 3  4  5
+        Example 3| 0 -1 1  2  | 0 -1 0  2
+        Negatives|-3 -2 6 -1 4|-3 -5 1  0  4
+        END
+}
+
+################################################################################
diff --git a/challenge-238/athanasius/raku/ch-2.raku b/challenge-238/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..74a2553ec7
--- /dev/null
+++ b/challenge-238/athanasius/raku/ch-2.raku
@@ -0,0 +1,187 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 238
+=========================
+
+TASK #2
+-------
+*Persistence Sort*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers.
+
+Write a script to sort the given array in increasing order with respect to the
+count of steps required to obtain a single-digit number by multiplying its
+digits recursively for each array element. If any two numbers have the same
+count of steps, then print the smaller number first.
+
+Example 1
+
+  Input: @int = (15, 99, 1, 34)
+  Output: (1, 15, 34, 99)
+
+  15 => 1 x 5 => 5 (1 step)
+  99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
+  1  => 0 step
+  34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)
+
+Example 2
+
+  Input: @int = (50, 25, 33, 22)
+  Output: (22, 33, 50, 25)
+
+  50 => 5 x 0 => 0 (1 step)
+  25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
+  33 => 3 x 3 => 9 (1 step)
+  22 => 2 x 2 => 4 (1 step)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+A "positive" integer is an unsigned integer (i.e., an integer >= 0).
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 238, Task #2: Persistence Sort (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of positive integers
+
+    *@ints where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+    my UInt @sorted = persistence-sort( @ints );
+    my Str (@ints-str, @sort-str);
+
+    for 0 .. @ints.end -> UInt $i
+    {
+        my UInt $width = max( @ints[ $i ].chars, @sorted[ $i ].chars );
+
+        @ints-str.push: '%*s'.sprintf: $width, @ints\ [ $i ];
+        @sort-str.push: '%*s'.sprintf: $width, @sorted[ $i ];
+    }
+
+    "Input: \@int = (%s)\n".printf: @ints-str.join: ', ';
+    "Output:       (%s)\n"\.printf: @sort-str.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub persistence-sort( List:D[UInt:D] $ints --> Seq:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    return $ints.sort: { count-steps( $^a ) <=> count-steps( $^b ) ||
+                                      $^a   <=>   $^b };
+}
+
+#-------------------------------------------------------------------------------
+sub count-steps( UInt:D $num --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $steps   = 0;
+    my UInt $product = $num;
+
+    while $product.chars > 1
+    {
+        my UInt @digits = $product.split( '', :skip-empty ).map: { .Int };
+
+        $product = [*] @digits;
+        ++$steps;
+    }
+
+    return $steps;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $int-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @ints     = $int-str.split( / \s+ / ).map: { .Int };
+        my UInt @expected = $exp-str.split( / \s+ / ).map: { .Int };
+        my UInt @sorted   = persistence-sort( @ints );
+
+        is-deeply @sorted, @expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error( Str:D $message )
+#-------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1|15 99  1 34| 1 15 34 99
+        Example 2|50 25 33 22|22 33 50 25
+        END
+}
+
+################################################################################