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

4 files changed, 859 insertions, 0 deletions

diff --git a/challenge-193/athanasius/perl/ch-1.pl b/challenge-193/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f0525c16a4
--- /dev/null
+++ b/challenge-193/athanasius/perl/ch-1.pl
@@ -0,0 +1,143 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 193
+=========================
+
+TASK #1
+-------
+*Binary String*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer, $n > 0.
+
+Write a script to find all possible binary numbers of size $n.
+
+Example 1
+
+  Input: $n = 2
+  Output: 00, 11, 01, 10
+
+Example 2
+
+  Input: $n = 3
+  Output: 000, 001, 010, 100, 111, 110, 101, 011
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TEST_FLDS => 3;
+const my $USAGE     =>
+"Usage:
+  perl $0 <n>
+  perl $0
+
+    <n>    An integer greater than zero\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 193, Task #1: Binary String (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args == 1)
+    {
+        my $n = $ARGV[ 0 ];
+
+        $n =~ / ^ $RE{num}{int} $ /x
+                or error( qq["$n" is not a valid integer] );
+
+        $n > 0  or error( qq["$n" is not positive] );
+
+        print  "Input:  \$n = $n\n";
+        printf "Output: %s\n", join ', ', @{ find_binary_numbers( $n ) };
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_binary_numbers
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+    my  @binaries;
+
+    for my $i (0 .. 2 ** $n - 1)
+    {
+        push @binaries, sprintf '%0*b', $n, $i;
+    }
+
+    return \@binaries;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $n, $expected) = split / , \s* /x, $line, $TEST_FLDS;
+        my  @expected = sort split / \s+ /x, $expected;
+
+        is_deeply( find_binary_numbers( $n ), \@expected, $test_name );
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1, 2, 00 11 01 10
+Example 2, 3, 000 001 010 100 111 110 101 011
diff --git a/challenge-193/athanasius/perl/ch-2.pl b/challenge-193/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..0396ac5bd2
--- /dev/null
+++ b/challenge-193/athanasius/perl/ch-2.pl
@@ -0,0 +1,291 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 193
+=========================
+
+TASK #2
+-------
+*Odd String*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of strings of same length, @s.
+
+Write a script to find the odd string in the given list. Use positional value
+of alphabet starting with 0, i.e. a = 0, b = 1, ... z = 25.
+
+    Find the difference array for each string as shown in the example. Then
+    pick the odd one out.
+
+Example 1:
+
+  Input: @s = ("adc", "wzy", "abc")
+  Output: "abc"
+
+  Difference array for "adc" => [ d - a, c - d ]
+                             => [ 3 - 0, 2 - 3 ]
+                             => [ 3, -1 ]
+
+  Difference array for "wzy" => [ z - w, y - z ]
+                             => [ 25 - 22, 24 - 25 ]
+                             => [ 3, -1 ]
+
+  Difference array for "abc" => [ b - a, c - b ]
+                             => [ 1 - 0, 2 - 1 ]
+                             => [ 1, 1 ]
+
+  The difference array for "abc" is the odd one.
+
+Example 2:
+
+  Input: @s = ("aaa", "bob", "ccc", "ddd")
+  Output: "bob"
+
+  Difference array for "aaa" => [ a - a, a - a ]
+                             => [ 0 - 0, 0 - 0 ]
+                             => [ 0, 0 ]
+
+  Difference array for "bob" => [ o - b, b - o ]
+                             => [ 14 - 1, 1 - 14 ]
+                             => [ 13, -13 ]
+
+  Difference array for "ccc" => [ c - c, c - c ]
+                             => [ 2 - 2, 2 - 2 ]
+                             => [ 0, 0 ]
+
+  Difference array for "ddd" => [ d - d, d - d ]
+                             => [ 3 - 3, 3 - 3 ]
+                             => [ 0, 0 ]
+
+  The difference array for "bob" is the odd one.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. To show the difference array for each string, set $VERBOSE to a true value.
+   (This has no effect on the running of the test suite.)
+
+Assumptions
+-----------
+1. The input list contains at least three strings.
+2. Valid input strings are non-empty, and consist of lower case letters only.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $TEST_FLDS => 3;
+const my $VERBOSE   => 1;
+const my $USAGE     =>
+"Usage:
+  perl $0 [<s> ...]
+  perl $0
+
+    [<s> ...]    A list of 3+ same-length strings of lower case letters\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 193, Task #2: Odd String (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args <  3)
+    {
+        error( "Expected 0 or 3+ arguments, found $args" );
+    }
+    else
+    {
+        my @s   = @ARGV;
+        my $s0  = $s[ 0 ];
+        my $len = length $s0;
+
+        for my $s (@s)
+        {
+            $s =~ / ^ [a-z]+ $ /x
+                or error( qq["$s" is not a valid string] );
+
+            length $s == $len
+                or error( qq[Strings "$s0" and "$s" have different lengths] );
+        }
+
+        printf "Input:  \@s = (%s)\n", join ', ', map { qq["$_"] } @s;
+
+        my ($odd, $diffs) = find_odd_string( \@s );
+
+        print "Output: $odd\n";
+
+        print_diff_arrays( $diffs ) if $VERBOSE;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_odd_string
+#------------------------------------------------------------------------------
+{
+    my ($s)     =  @_;
+    my  $diffs  =  get_all_diff_arrays( $s );
+    my  $odd    = 'None';
+    my  $elems  =  scalar @$s;
+    my  $ndiffs =  scalar keys %$diffs;
+    my  $done   =  0;
+
+    if    ($ndiffs == 1)
+    {
+        $odd .= " (all $elems strings have the same difference array)";
+        $done = 1;
+    }
+    elsif ($ndiffs == 2)
+    {
+        for my $list (values %$diffs)
+        {
+            if (scalar @$list == 1)
+            {
+                $odd  = '"' . $list->[ 0 ] . '"';
+                $done = 1;
+                last;
+            }
+        }
+    }
+
+    $odd .= " (the $elems strings have $ndiffs distinct difference arrays)"
+        unless $done;
+
+    return ($odd, $diffs);
+}
+
+#------------------------------------------------------------------------------
+sub get_all_diff_arrays
+#------------------------------------------------------------------------------
+{
+    my ($s) = @_;
+    my  %diff_arrays;
+
+    for my $str (@$s)
+    {
+        my $diffs = get_one_diff_array( $str );
+        my $gist  = '[ ' . join( ', ', @$diffs ) . ' ]';
+
+        push @{ $diff_arrays{ $gist } }, $str;
+    }
+
+    return \%diff_arrays;
+}
+
+#------------------------------------------------------------------------------
+sub get_one_diff_array
+#------------------------------------------------------------------------------
+{
+    my ($str)  = @_;
+    my  @chars = split //, $str;
+    my  @diffs;
+
+    for my $i (1 .. length( $str ) - 1)
+    {
+        push @diffs, ord( $chars[ $i ] ) - ord( $chars[ $i - 1 ] );
+    }
+
+    return \@diffs;
+}
+
+#------------------------------------------------------------------------------
+sub print_diff_arrays
+#------------------------------------------------------------------------------
+{
+    my ($da2strs) = @_;
+    my  %str2da;
+
+    while (my ($key, $value) = each %$da2strs)               # Reverse the hash
+    {
+        for my $str (@$value)
+        {
+            $str2da{ $str } = $key;
+        }
+    }
+
+    print "\n  Difference arrays:\n";
+
+    for my $str (sort keys %str2da)
+    {
+        printf qq[    "%s" => %s\n], $str, $str2da{ $str };
+    }
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        if ($line =~ s/ \\ $ //x)
+        {
+            $line .= <DATA>;
+            redo;
+        }
+
+        my ($test_name, $in, $expected) = split / , \s* /x, $line, $TEST_FLDS;
+
+        my  @list = split / \s+ /x, $in;
+
+        my ($odd, undef) = find_odd_string( \@list );
+
+        is  $odd, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1, adc wzy abc,     abc
+Example 2, aaa bob ccc ddd, bob
+All same,  adc wzy vyx bed,     \
+           None (all 4 strings have the same difference array)
+Two odd,   mor jlo abc def,     \
+           None (the 4 strings have 2 distinct difference arrays)
+All odd,   abc acd ade aef afg, \
+           None (the 5 strings have 5 distinct difference arrays)
+Odd plus,  adc wzy abc jop kpq, \
+           None (the 5 strings have 3 distinct difference arrays)
diff --git a/challenge-193/athanasius/raku/ch-1.raku b/challenge-193/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..e9ea9cae76
--- /dev/null
+++ b/challenge-193/athanasius/raku/ch-1.raku
@@ -0,0 +1,142 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 193
+=========================
+
+TASK #1
+-------
+*Binary String*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer, $n > 0.
+
+Write a script to find all possible binary numbers of size $n.
+
+Example 1
+
+  Input: $n = 2
+  Output: 00, 11, 01, 10
+
+Example 2
+
+  Input: $n = 3
+  Output: 000, 001, 010, 100, 111, 110, 101, 011
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 193, Task #1: Binary String (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    Pos:D $n                  #= An integer greater than zero
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+    "Output: %s\n".printf: find-binary-numbers( $n ).join: ', ';
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-binary-numbers( Pos:D $n --> List:D[Str:D] )
+#------------------------------------------------------------------------------
+{
+    my Str @binaries;
+
+    for 0 .. 2 ** $n - 1 -> UInt $i
+    {
+        @binaries.push: '%0*b'.sprintf: $n, $i;
+    }
+
+    return @binaries;
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $n, $expected) =
+                $line.split: / \, \s* /, $TEST-FIELDS, :skip-empty;
+
+        my Str  @expected = $expected.split( / \s+ /, :skip-empty ).sort;
+
+        is-deeply( find-binary-numbers( $n.Int ), @expected, $test-name );
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1, 2, 00 11 01 10
+        Example 2, 3, 000 001 010 100 111 110 101 011
+        END
+}
+
+#------------------------------------------------------------------------------
+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;
+}
+
+###############################################################################
diff --git a/challenge-193/athanasius/raku/ch-2.raku b/challenge-193/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..94474684b3
--- /dev/null
+++ b/challenge-193/athanasius/raku/ch-2.raku
@@ -0,0 +1,283 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 193
+=========================
+
+TASK #2
+-------
+*Odd String*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of strings of same length, @s.
+
+Write a script to find the odd string in the given list. Use positional value
+of alphabet starting with 0, i.e. a = 0, b = 1, ... z = 25.
+
+    Find the difference array for each string as shown in the example. Then
+    pick the odd one out.
+
+Example 1:
+
+  Input: @s = ("adc", "wzy", "abc")
+  Output: "abc"
+
+  Difference array for "adc" => [ d - a, c - d ]
+                             => [ 3 - 0, 2 - 3 ]
+                             => [ 3, -1 ]
+
+  Difference array for "wzy" => [ z - w, y - z ]
+                             => [ 25 - 22, 24 - 25 ]
+                             => [ 3, -1 ]
+
+  Difference array for "abc" => [ b - a, c - b ]
+                             => [ 1 - 0, 2 - 1 ]
+                             => [ 1, 1 ]
+
+  The difference array for "abc" is the odd one.
+
+Example 2:
+
+  Input: @s = ("aaa", "bob", "ccc", "ddd")
+  Output: "bob"
+
+  Difference array for "aaa" => [ a - a, a - a ]
+                             => [ 0 - 0, 0 - 0 ]
+                             => [ 0, 0 ]
+
+  Difference array for "bob" => [ o - b, b - o ]
+                             => [ 14 - 1, 1 - 14 ]
+                             => [ 13, -13 ]
+
+  Difference array for "ccc" => [ c - c, c - c ]
+                             => [ 2 - 2, 2 - 2 ]
+                             => [ 0, 0 ]
+
+  Difference array for "ddd" => [ d - d, d - d ]
+                             => [ 3 - 3, 3 - 3 ]
+                             => [ 0, 0 ]
+
+  The difference array for "bob" is the odd one.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. To show the difference array for each string, set $VERBOSE to True. (This
+   has no effect on the running of the test suite.)
+
+Assumptions
+-----------
+1. The input list contains at least three strings.
+2. Valid input strings are non-empty, and consist of lower case letters only.
+
+=end comment
+#==============================================================================
+
+use Test;
+
+subset S-type of Str where * ~~ / ^ <[ a .. z ]>+ $ /;
+
+my UInt constant $TEST-FLDS = 3;
+my Bool constant $VERBOSE   = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 193, Task #2: Odd String (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A list of 3+ same-length strings of lower case letters
+
+    *@s where { .elems > 2 && .all ~~ S-type:D && .all.chars == @s[ 0 ].chars } 
+)
+#==============================================================================
+{
+    "Input:  \@s = (%s)\n".printf: @s.map( { qq["$_"] } ).join: ', ';
+
+    my (Str $odd, Hash[Array[Str],Str] $diffs) = find-odd-string( @s );
+
+    "Output: $odd".put;
+
+    print-diff-arrays( $diffs ) if $VERBOSE;
+}
+
+#==============================================================================
+multi sub MAIN()                                           # Run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub find-odd-string
+(
+    List:D[Str:D] $s
+--> List:D[Str:D, Hash:D[List:D[Str:D]],Str:D]
+)
+#------------------------------------------------------------------------------
+{
+    my Array[Str] %diff-arrays{Str} = get-all-diff-arrays( $s );
+
+    my Str  $odd   = 'None';
+    my UInt $elems = $s.elems;
+
+    given my UInt $diffs = %diff-arrays.keys.elems
+    {
+        when 1
+        {
+            $odd ~= " (all $elems strings have the same difference array)";
+        }
+
+        when 2
+        {
+            for %diff-arrays.values -> Array[Str] $list
+            {
+                $odd = '"' ~ $list[ 0 ] ~ '"', succeed if $list.elems == 1;
+            }
+
+            proceed;
+        }
+
+        default
+        {
+            $odd ~= " (the $elems strings have $diffs distinct difference " ~
+                      'arrays)';
+        }
+    }
+
+    return $odd, %diff-arrays;
+}
+
+#------------------------------------------------------------------------------
+sub get-all-diff-arrays( List:D[Str:D] $s --> Hash:D[List:D[Str:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Str] %diff-arrays{Str};
+
+    for @$s -> Str $str
+    {
+        my Int @diffs = get-one-diff-array( $str );
+        my Str $gist  = '[ ' ~ @diffs.join( ', ' ) ~ ' ]';
+
+        %diff-arrays{ $gist }.push: $str;
+    }
+
+    return %diff-arrays;
+}
+
+#------------------------------------------------------------------------------
+sub get-one-diff-array( Str:D $str --> List:D[Int:D] )
+#------------------------------------------------------------------------------
+{
+    my Int @diffs;
+    my Str @chars = $str.split: '', :skip-empty;
+
+    for 1 .. $str.chars - 1 -> UInt $i
+    {
+        @diffs.push: @chars[ $i ].ord - @chars[ $i - 1 ].ord;
+    }
+
+    return @diffs;
+}
+
+#------------------------------------------------------------------------------
+sub print-diff-arrays( Hash:D[List:D[Str:D],Str] $da2strs )
+#------------------------------------------------------------------------------
+{
+    my Str %str2da;
+
+    for %$da2strs.kv -> Str $key, Array[Str] $value          # Reverse the hash
+    {
+        for @$value -> Str $str
+        {
+            %str2da{ $str } = $key;
+        }
+    }
+
+    "\n  Difference arrays:".put;
+
+    for %str2da.keys.sort -> Str $str
+    {
+        qq[    "%s" => %s\n].printf: $str, %str2da{ $str };
+    }
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $in, $expected) =
+            $line.split: / \, \s* /, $TEST-FLDS, :skip-empty;
+
+        my Str @s = $in.split: / \s+ /, :skip-empty;
+
+        my (Str $odd, Any) = find-odd-string( @s );
+
+        is $odd, $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 S:g/ \\ \n // with q:to/END/;
+        Example 1, adc wzy abc,     abc
+        Example 2, aaa bob ccc ddd, bob
+        All same,  adc wzy vyx bed,     \
+                   None (all 4 strings have the same difference array)
+        Two odd,   mor jlo abc def,     \
+                   None (the 4 strings have 2 distinct difference arrays)
+        All odd,   abc acd ade aef afg, \
+                   None (the 5 strings have 5 distinct difference arrays)
+        Odd plus,  adc wzy abc jop kpq, \
+                   None (the 5 strings have 3 distinct difference arrays)
+        END
+}
+
+###############################################################################