Merge pull request #8422 from PerlMonk-Athanasius/branch-for-challenge-226

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

4 files changed, 757 insertions, 0 deletions

diff --git a/challenge-226/athanasius/perl/ch-1.pl b/challenge-226/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..5cc029cb0b
--- /dev/null
+++ b/challenge-226/athanasius/perl/ch-1.pl
@@ -0,0 +1,184 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 226
+=========================
+
+TASK #1
+-------
+*Shuffle String*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string and an array of indices of same length as string.
+
+Write a script to return the string after re-arranging the indices in the
+correct order.
+
+Example 1
+
+  Input: $string = 'lacelengh', @indices = (3,2,0,5,4,8,6,7,1)
+  Output: 'challenge'
+
+Example 2
+
+  Input: $string = 'rulepark', @indices = (4,7,3,1,0,5,2,6)
+  Output: 'perlraku'
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Assumption
+----------
+The indices must be unique and valid, i.e., there must be exactly one index for
+each letter in $string.
+
+=cut
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <string> [<indices> ...]
+  perl $0
+
+    <string>           A non-empty string
+    [<indices> ...]    A list of indices, one for each letter in the string\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 226, Task #1: Shuffle String (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($string, $indices) = parse_command_line();
+
+        printf "Input:  \$string = '%s', \@indices = (%s)\n",
+                $string, join ',', @$indices;
+
+        my $new_str = shuffle( $string, $indices );
+
+        print "Output: '$new_str'\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub shuffle
+#-------------------------------------------------------------------------------
+{
+    my ($string, $indices) = @_;
+
+    my  @orig = split '', $string; 
+    my  @new;
+
+    for my $i (0 .. $#$indices)
+    {
+        $new[ $indices->[ $i ] ] = $orig[ $i ];
+    }
+
+    return join '', @new;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $string  = shift @ARGV;
+    my $length  = length $string;
+
+    $length > 0                or  error( 'Empty string' );
+
+    my @indices = @ARGV;
+
+    for (@indices)
+    {
+        / ^ $RE{num}{int} $ /x or  error( qq["$_" is not a valid integer] );
+        $_ >= 0                or  error( qq["$_" is negative] );
+    }
+
+    scalar @indices < $length  and error( 'Not enough indices' );
+    scalar @indices > $length  and error( 'Too many indices' );
+
+    my @actual = sort { $a <=> $b } @indices;
+
+    for my $i (0 .. $length - 1)
+    {
+        $actual[ $i ] == $i    or  error( 'The indices are invalid' );
+    }
+
+    return ($string, \@indices);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $string, $idx_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $string, $idx_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @indices = split / \s+ /x, $idx_str;
+        my $new_str = shuffle( $string, \@indices );
+
+        is $new_str, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  |lacelengh    | 3 2 0 5 4  8 6 7 1         |challenge
+Example 2  |rulepark     | 4 7 3 1 0  5 2 6           |perlraku
+Wikipedia 1|elevenplustwo|12 3 5 4 2 11 6 7 8 9 0 1 10|twelveplusone
+Wikipedia 2|radiumcame   | 7 1 2 8 6  0 5 3 4 9       |madamcurie
diff --git a/challenge-226/athanasius/perl/ch-2.pl b/challenge-226/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..731ab108c2
--- /dev/null
+++ b/challenge-226/athanasius/perl/ch-2.pl
@@ -0,0 +1,203 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 226
+=========================
+
+TASK #2
+-------
+*Zero Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of non-negative integers, @ints.
+
+Write a script to return the minimum number of operations to make every element
+equal zero.
+
+    In each operation, you are required to pick a positive number less than or
+    equal to the smallest element in the array, then subtract that from each
+    positive element in the array.
+
+Example 1:
+
+  Input: @ints = (1, 5, 0, 3, 5)
+  Output: 3
+
+  operation 1: pick 1 => (0, 4, 0, 2, 4)
+  operation 2: pick 2 => (0, 2, 0, 0, 2)
+  operation 3: pick 2 => (0, 0, 0, 0, 0)
+
+Example 2:
+
+  Input: @ints = (0)
+  Output: 0
+
+Example 3:
+
+  Input: @ints = (2, 1, 4, 0, 3)
+  Output: 4
+
+  operation 1: pick 1 => (1, 0, 3, 0, 2)
+  operation 2: pick 1 => (0, 0, 2, 0, 1)
+  operation 3: pick 1 => (0, 0, 1, 0, 0)
+  operation 4: pick 1 => (0, 0, 0, 0, 0)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. It $VERBOSE is set to a true value, the operations (pick values) are
+   described, as per Examples 1 and 3.
+
+Assumption
+----------
+A "positive element" is an array value greater than zero.
+
+=cut
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Util     qw( uniqnum );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A list of one or more non-negative integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 226, Task #2: Zero Array (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( qq["$_" is negative] );
+        }
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @ints;
+
+        my $ops = find_min_ops( \@ints );
+
+        printf "Output: %d\n", scalar @$ops;
+
+        if ($VERBOSE && scalar @$ops > 0)
+        {
+            print "\n";
+
+            my @list = @ints;
+
+            for my $i (0 .. $#$ops)
+            {
+                my $pick = $ops->[ $i ];
+
+                @list = map { $_ > 0 ? $_ - $pick : $_ } @list;
+
+                printf "Operation %d: pick %d => (%s)\n",
+                        $i + 1, $pick, join ', ', @list;
+            }
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_min_ops
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+    my  @ops;
+    my  @steps = sort { $a <=> $b } uniqnum @$ints;
+
+    shift @steps while scalar @steps > 0 && $steps[ 0 ] == 0;
+
+    if (scalar @steps > 0)
+    {
+        push @ops, $steps[ 0 ];
+
+        for my $i (1 .. $#steps)
+        {
+            push @ops, $steps[ $i ] - $steps[ $i - 1 ];
+        }
+    }
+
+    return \@ops;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints, $min_ops, $picks) = split / \| /x, $line;
+
+        for ($test_name, $ints, $min_ops, $picks)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints  = split / \s+ /x, $ints;
+        my @picks = split / \s+ /x, $picks;
+        my $ops   = find_min_ops( \@ints );
+
+        is scalar @$ops,  $min_ops, "$test_name: min ops";
+        is_deeply  $ops, \@picks,   "$test_name: picks";
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 5 0 3 5|3|1 2 2
+Example 2|0        |0|
+Example 3|2 1 4 0 3|4|1 1 1 1
diff --git a/challenge-226/athanasius/raku/ch-1.raku b/challenge-226/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..b7a2ef2028
--- /dev/null
+++ b/challenge-226/athanasius/raku/ch-1.raku
@@ -0,0 +1,175 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 226
+=========================
+
+TASK #1
+-------
+*Shuffle String*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string and an array of indices of same length as string.
+
+Write a script to return the string after re-arranging the indices in the
+correct order.
+
+Example 1
+
+  Input: $string = 'lacelengh', @indices = (3,2,0,5,4,8,6,7,1)
+  Output: 'challenge'
+
+Example 2
+
+  Input: $string = 'rulepark', @indices = (4,7,3,1,0,5,2,6)
+  Output: 'perlraku'
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Assumption
+----------
+The indices must be unique and valid, i.e., there must be exactly one index for
+each letter in $string.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 226, Task #1: Shuffle String (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $string where { .chars > 0 },                    #= A non-empty string
+
+    #| A list of indices, one for each letter in the string
+
+    *@indices where { .all ~~ UInt:D && indices-are-valid( $string, @indices ) }
+)
+#===============================================================================
+{
+    "Input:  \$string = '%s', \@indices = (%s)\n".printf:
+        $string, @indices.join: ',';
+
+    my Str $new-str = shuffle( $string, @indices );
+
+    "Output: '$new-str'".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub shuffle( Str:D $string, List:D[UInt:D] $indices --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @orig = $string.split: '', :skip-empty; 
+    my Str @new;
+
+    for 0 .. $indices.end -> UInt $i
+    {
+        @new[ $indices[ $i ] ] = @orig[ $i ];
+    }
+
+    return @new.join: '';
+}
+
+#-------------------------------------------------------------------------------
+sub indices-are-valid( Str:D $string, List:D[UInt:D] $indices --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $length   = $string.chars;
+
+    return False if $indices.elems ≠ $length;
+
+    my UInt @required = 0 .. $length - 1;
+    my UInt @actual   = $indices.sort;
+
+    return @actual ~~ @required;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $string, $idx-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $string, $idx-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @indices = $idx-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Str  $new-str = shuffle( $string, @indices );
+
+        is $new-str, $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  |lacelengh    | 3 2 0 5 4  8 6 7 1         |challenge
+        Example 2  |rulepark     | 4 7 3 1 0  5 2 6           |perlraku
+        Wikipedia 1|elevenplustwo|12 3 5 4 2 11 6 7 8 9 0 1 10|twelveplusone
+        Wikipedia 2|radiumcame   | 7 1 2 8 6  0 5 3 4 9       |madamcurie
+        END
+}
+
+################################################################################
diff --git a/challenge-226/athanasius/raku/ch-2.raku b/challenge-226/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..b6a6dfd88c
--- /dev/null
+++ b/challenge-226/athanasius/raku/ch-2.raku
@@ -0,0 +1,195 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 226
+=========================
+
+TASK #2
+-------
+*Zero Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of non-negative integers, @ints.
+
+Write a script to return the minimum number of operations to make every element
+equal zero.
+
+    In each operation, you are required to pick a positive number less than or
+    equal to the smallest element in the array, then subtract that from each
+    positive element in the array.
+
+Example 1:
+
+  Input: @ints = (1, 5, 0, 3, 5)
+  Output: 3
+
+  operation 1: pick 1 => (0, 4, 0, 2, 4)
+  operation 2: pick 2 => (0, 2, 0, 0, 2)
+  operation 3: pick 2 => (0, 0, 0, 0, 0)
+
+Example 2:
+
+  Input: @ints = (0)
+  Output: 0
+
+Example 3:
+
+  Input: @ints = (2, 1, 4, 0, 3)
+  Output: 4
+
+  operation 1: pick 1 => (1, 0, 3, 0, 2)
+  operation 2: pick 1 => (0, 0, 2, 0, 1)
+  operation 3: pick 1 => (0, 0, 1, 0, 0)
+  operation 4: pick 1 => (0, 0, 0, 0, 0)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. It $VERBOSE is set to True, the operations (pick values) are described, as
+   per Examples 1 and 3.
+
+Assumption
+----------
+A "positive element" is an array value greater than zero.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+my Bool constant $VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 226, Task #2: Zero Array (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A list of one or more non-negative integers
+
+    *@ints where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my Pos @ops = find-min-ops( @ints );
+
+    "Output: %d\n".printf: @ops.elems;
+
+    if $VERBOSE && @ops.elems > 0
+    {
+        put();
+
+        my UInt @list = @ints;
+
+        for 0 .. @ops.end -> UInt $i
+        {
+            my Pos $pick = @ops[ $i ];
+
+            @list .= map: { $_ > 0 ?? $_ - $pick !! $_ };
+
+            "Operation %d: pick %d => (%s)\n".printf:
+                $i + 1, $pick, @list.join: ', ';
+        }
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-min-ops( List:D[UInt:D] $ints --> List:D[Pos:D] )
+#-------------------------------------------------------------------------------
+{
+    my Pos  @ops;
+    my UInt @steps = $ints.unique.sort;
+
+    @steps.shift while @steps.elems > 0 && @steps[ 0 ] == 0;
+
+    if @steps.elems > 0
+    {
+        @ops.push: @steps[ 0 ];
+
+        for 1 .. @steps.end -> Pos $i
+        {
+            @ops.push: @steps[ $i ] - @steps[ $i - 1 ];
+        }
+    }
+
+    return @ops;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints, $min-ops, $picks) = $line.split: / \| /;
+
+        for     $test-name, $ints, $min-ops, $picks
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt @ints  = $ints\.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Pos  @picks = $picks.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Pos  @ops   = find-min-ops( @ints );
+
+        is        @ops.elems, $min-ops.Int, "$test-name: min ops";
+        is-deeply @ops,       @picks,       "$test-name: picks";
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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 5 0 3 5|3|1 2 2
+        Example 2|0        |0|
+        Example 3|2 1 4 0 3|4|1 1 1 1
+        END
+}
+
+################################################################################