Merge pull request #9043 from PerlMonk-Athanasius/branch-for-challenge-242

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

4 files changed, 816 insertions, 0 deletions

diff --git a/challenge-242/athanasius/perl/ch-1.pl b/challenge-242/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..98e8305eb2
--- /dev/null
+++ b/challenge-242/athanasius/perl/ch-1.pl
@@ -0,0 +1,196 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 242
+=========================
+
+TASK #1
+-------
+*Missing Members*
+
+Submitted by: Mohammad S Anwar
+
+You are given two arrays of integers.
+
+Write a script to find out the missing members in each other arrays.
+
+Example 1
+
+  Input: @arr1 = (1, 2, 3)
+         @arr2 = (2, 4, 6)
+  Output: ([1, 3], [4, 6])
+
+  (1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).
+  (2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).
+
+Example 2
+
+  Input: @arr1 = (1, 2, 3, 3)
+         @arr2 = (1, 1, 2, 2)
+  Output: ([3])
+
+  (1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2). Since
+  they are same, keep just one.
+  (1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Set::Tiny      qw( set );
+use Test::More;
+
+const my $SEPARATOR => '*';
+const my $USAGE     =>
+qq[Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    Two lists of integers, separated by "*"\n];
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 242, Task #1: Missing Members (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($arr1, $arr2) = parse_command_line();
+
+        printf "Input:  \@arr1 = (%s)\n", join ', ', @$arr1;
+        printf "        \@arr2 = (%s)\n", join ', ', @$arr2;
+
+        my ($out1, $out2) = find_missing_members( $arr1, $arr2 );
+
+        printf "Output: ([%s], [%s])\n", join( ', ', @$out1 ),
+                                         join  ', ', @$out2;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_missing_members
+#-------------------------------------------------------------------------------
+{
+    my ($arr1, $arr2) = @_;
+
+    my $set1  = set( $arr1 );
+    my $set2  = set( $arr2 );
+    my $inter = $set1->intersection( $set2 );
+    my $out1  = $set1->difference( $inter );
+    my $out2  = $set2->difference( $inter );
+    my @out1  = sort { $a <=> $b } $out1->elements;
+    my @out2  = sort { $a <=> $b } $out2->elements;
+
+    return (\@out1, \@out2);
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $separators = 0;
+    my $pivot;
+
+    for my $i (0 .. $#ARGV)
+    {
+        if ($ARGV[ $i ] eq $SEPARATOR)
+        {
+            ++$separators;
+            $pivot = $i;
+        }
+    }
+
+    $separators == 0 and error( 'No separator character found' );
+    $separators >  1 and error( 'More than one separator character found' );
+
+    my @arr1 = @ARGV[ 0          .. $pivot - 1 ];
+    my @arr2 = @ARGV[ $pivot + 1 .. $#ARGV     ];
+
+    for (@arr1, @arr2)
+    {
+        / ^ $RE{num}{int} $ /x
+                     or  error( qq["$_" is not a valid integer] );
+    }
+
+    return (\@arr1, \@arr2);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $arr1_str, $arr2_str, $exp1_str, $exp2_str) =
+             split / \| /x, $line;
+
+        for ($test_name, $arr1_str, $arr2_str, $exp1_str, $exp2_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @arr1 = split / \s+ /x, $arr1_str;
+        my @arr2 = split / \s+ /x, $arr2_str;
+        my @exp1 = split / \s+ /x, $exp1_str;
+        my @exp2 = split / \s+ /x, $exp2_str;
+
+        my ($out1, $out2) = find_missing_members( \@arr1, \@arr2 );
+
+        is_deeply $out1, \@exp1, $test_name . ': array 1';
+        is_deeply $out2, \@exp2, $test_name . ': array 2';
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1 | 1 2 3   | 2  4 6  | 1 3| 4 6
+Example 2 | 1 2 3  3| 1  1 2 2| 3  |
+Example 2a| 1 1 2  2| 1  2 3 3|    | 3
+Negatives |-3 5 7 -1|-1 -2 0 5|-3 7|-2 0
diff --git a/challenge-242/athanasius/perl/ch-2.pl b/challenge-242/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..44085fec23
--- /dev/null
+++ b/challenge-242/athanasius/perl/ch-2.pl
@@ -0,0 +1,199 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 242
+=========================
+
+TASK #2
+-------
+*Flip Matrix*
+
+Submitted by: Mohammad S Anwar
+
+You are given n x n binary matrix.
+
+Write a script to flip the given matrix as below.
+
+  1 1 0
+  0 1 1
+  0 0 1
+
+  a) Reverse each row
+
+  0 1 1
+  1 1 0
+  1 0 0
+
+  b) Invert each member
+
+  1 0 0
+  0 0 1
+  0 1 1
+
+Example 1
+
+  Input: @matrix = ([1, 1, 0], [1, 0, 1], [0, 0, 0])
+  Output: ([1, 0, 0], [0, 1, 0], [1, 1, 1])
+
+Example 2
+
+  Input: @matrix = ([1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0])
+  Output: ([1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0])
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=cut
+#===============================================================================
+
+use v5.32.1;          # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<matrix> ...]
+  perl $0
+
+    [<matrix> ...]    An n x n binary matrix, for example: 110 011 001\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 242, Task #2: Flip Matrix (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $matrix  = parse_matrix( \@ARGV );
+
+        printf "Input: \@matrix = (%s)\n",
+            join ', ', map { '[' . join( ', ', @$_ ) . ']' } @$matrix;
+
+        my $flipped = flip_matrix( $matrix );
+
+        printf "Output:          (%s)\n",
+            join ', ', map { '[' . join( ', ', @$_ ) . ']' } @$flipped;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub flip_matrix
+#-------------------------------------------------------------------------------
+{
+    my ($matrix) = @_;
+    my  @flipped = @$matrix;
+    my  $end     = $#flipped;
+
+    # a) Reverse each row
+
+    for my $i (0 .. $end)
+    {
+        $flipped[ $i ] = [ reverse @{ $flipped[ $i ] } ];
+    }
+
+    # b) Invert each member
+
+    for my $i (0 .. $end)
+    {
+        for my $j (0 .. $end)
+        {
+            $flipped[ $i ][ $j ] = $flipped[ $i ][ $j ] == 0 ? 1 : 0;
+        }
+    }
+
+    return \@flipped;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_matrix
+#-------------------------------------------------------------------------------
+{
+    my ($rows) = @_;
+    my  $n     = scalar @$rows;
+    my  @matrix;
+
+    for my $row (@$rows)
+    {
+        length $row == $n or error( 'The input matrix is not square' );
+
+        my @new_row = split //, $row;
+
+        for (@new_row)
+        {
+            / ^ [01] $ /x or error( qq["$_" is not a binary number] );
+        }
+
+        push @matrix, [ @new_row ];
+    }
+
+    return \@matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $matrix_str, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $matrix_str, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $matrix   = parse_matrix( [ split / \s+ /x, $matrix_str   ] );
+        my $flipped  = flip_matrix( $matrix );
+        my $expected = parse_matrix( [ split / \s+ /x, $expected_str ] );
+
+        is_deeply $flipped, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 0|110  011  001      |100  001  011
+Example 1|110  101  000      |100  010  111
+Example 2|1100 1001 0111 1010|1100 0110 0001 1010
diff --git a/challenge-242/athanasius/raku/ch-1.raku b/challenge-242/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..c18a61e7f6
--- /dev/null
+++ b/challenge-242/athanasius/raku/ch-1.raku
@@ -0,0 +1,215 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 242
+=========================
+
+TASK #1
+-------
+*Missing Members*
+
+Submitted by: Mohammad S Anwar
+
+You are given two arrays of integers.
+
+Write a script to find out the missing members in each other arrays.
+
+Example 1
+
+  Input: @arr1 = (1, 2, 3)
+         @arr2 = (2, 4, 6)
+  Output: ([1, 3], [4, 6])
+
+  (1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).
+  (2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).
+
+Example 2
+
+  Input: @arr1 = (1, 2, 3, 3)
+         @arr2 = (1, 1, 2, 2)
+  Output: ([3])
+
+  (1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2). Since
+  they are same, keep just one.
+  (1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).
+
+=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 integer is negative, it must be preceded by "--" to indicate
+   that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Str constant SEPARATOR = '*';
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 242, Task #1: Missing Members (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@ints where { .elems >= 1 }      #= Two lists of integers, separated by "*"
+)
+#===============================================================================
+{
+    my Array[Int] ($arr1, $arr2) = parse-command-line( @ints );
+
+    "Input:  \@arr1 = (%s)\n".printf: $arr1.join: ', ';
+    "        \@arr2 = (%s)\n".printf: $arr2.join: ', ';
+
+    my Array[Int] ($out1, $out2) = find-missing-members( $arr1, $arr2 );
+
+    "Output: ([%s], [%s])\n".printf:  $out1.join( ', ' ),
+                                      $out2.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-missing-members
+(
+    List:D[Int:D] $arr1,
+    List:D[Int:D] $arr2,
+--> List:D[List:D[Int:D], List:D[Int:D]]
+)
+#-------------------------------------------------------------------------------
+{
+    my Set[Int] $set1  = Set[Int].new: |$arr1;
+    my Set[Int] $set2  = Set[Int].new: |$arr2;
+    my Set[Int] $inter = $set1  ∩  $set2;           # Intersection
+    my Set[Int] $out1  = $set1 (-) $inter;          # Set difference
+    my Set[Int] $out2  = $set2 (-) $inter;          # Set difference
+    my Int      @out1  = $out1.keys.sort;
+    my Int      @out2  = $out2.keys.sort;
+
+    return @out1, @out2;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-command-line
+(
+    List:D[Str:D] $ints where { .elems >= 1 }
+--> List:D[List:D[Int:D], List:D[Int:D]]
+)
+#-------------------------------------------------------------------------------
+{
+    $ints.none eq SEPARATOR
+        and error( 'No separator character found' );
+
+    $ints.one  eq SEPARATOR
+        or  error( 'More than one separator character found' );
+
+    my UInt $pivot;
+
+    for 0 .. $ints.end -> UInt $i
+    {
+        if $ints[ $i ] eq SEPARATOR
+        {
+            $pivot = $i;
+            last;
+        }
+    }
+
+    my Str @arr1 = $ints[ 0       ..^ $pivot    ];
+    my Str @arr2 = $ints[ $pivot ^..  $ints.end ];
+
+    @arr1.all ~~ Int:D
+        or  error( 'An element in the first list is not a valid integer'  );
+
+    @arr2.all ~~ Int:D
+        or  error( 'An element in the second list is not a valid integer' );
+
+    return Array[Int].new( @arr1 ), Array[Int].new( @arr2 );
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $arr1-str, $arr2-str, $exp1-str, $exp2-str) =
+                $line.split: / \| /;
+
+        for     $test-name, $arr1-str, $arr2-str, $exp1-str, $exp2-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @arr1 = $arr1-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Int @arr2 = $arr2-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Int @exp1 = $exp1-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Int @exp2 = $exp2-str.split( / \s+ /, :skip-empty ).map: { .Int };
+
+        my Array[Int] ($out1, $out2) = find-missing-members( @arr1, @arr2 );
+
+        is-deeply $out1, @exp1, $test-name ~ ': array 1';
+        is-deeply $out2, @exp2, $test-name ~ ': array 2';
+    }
+
+    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   | 2  4 6  | 1 3| 4 6
+        Example 2 | 1 2 3  3| 1  1 2 2| 3  |
+        Example 2a| 1 1 2  2| 1  2 3 3|    | 3
+        Negatives |-3 5 7 -1|-1 -2 0 5|-3 7|-2 0
+        END
+}
+
+################################################################################
diff --git a/challenge-242/athanasius/raku/ch-2.raku b/challenge-242/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..1c1a338569
--- /dev/null
+++ b/challenge-242/athanasius/raku/ch-2.raku
@@ -0,0 +1,206 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 242
+=========================
+
+TASK #2
+-------
+*Flip Matrix*
+
+Submitted by: Mohammad S Anwar
+
+You are given n x n binary matrix.
+
+Write a script to flip the given matrix as below.
+
+  1 1 0
+  0 1 1
+  0 0 1
+
+  a) Reverse each row
+
+  0 1 1
+  1 1 0
+  1 0 0
+
+  b) Invert each member
+
+  1 0 0
+  0 0 1
+  0 1 1
+
+Example 1
+
+  Input: @matrix = ([1, 1, 0], [1, 0, 1], [0, 0, 0])
+  Output: ([1, 0, 0], [0, 1, 0], [1, 1, 1])
+
+Example 2
+
+  Input: @matrix = ([1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0])
+  Output: ([1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0])
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Bit    of Int where 0 | 1;
+subset BitStr of Str where / ^ <[01]>+ $ /;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 242, Task #2: Flip Matrix (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| An n x n binary matrix, for example: 110 011 001
+
+    *@matrix where { .all ~~ BitStr:D }
+)
+#===============================================================================
+{
+    my Array[Bit] @binary  = parse-matrix( @matrix );
+
+    "Input: \@matrix = (%s)\n".printf:
+        @binary\.map( { '[' ~ @$_.join( ', ' ) ~ ']' } ).join: ', ';
+
+    my Array[Bit] @flipped = flip-matrix( @binary );
+
+    "Output:          (%s)\n".printf:
+        @flipped.map( { '[' ~ @$_.join( ', ' ) ~ ']' } ).join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub flip-matrix( List:D[List:D[Bit:D]] $matrix --> List:D[List:D[Bit:D]] )
+#-------------------------------------------------------------------------------
+{
+    my Array[Bit] @flipped = @$matrix;
+    my UInt       $end     = @flipped.end;
+
+    # a) Reverse each row
+
+    for 0 .. $end -> UInt $i
+    {
+        @flipped[ $i ] = Array[Bit].new: @flipped[ $i ].reverse;
+    }
+
+    # b) Invert each member
+
+    for 0 .. $end -> UInt $i
+    {
+        for 0 .. $end -> UInt $j
+        {
+            @flipped[ $i; $j ] = @flipped[ $i; $j ] == 0 ?? 1 !! 0;
+        }
+    }
+
+    return @flipped;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-matrix( List:D[BitStr:D] $rows --> List:D[List:D[Bit:D]] )
+#-------------------------------------------------------------------------------
+{
+    my Array[Bit] @matrix;
+    my UInt       $n = $rows.elems;
+
+    for @$rows -> Str $row
+    {
+        $row.chars == $n or error( 'The input matrix is not square' );
+
+        my Bit @new-row = $row.split( '', :skip-empty ).map: { .Int };
+
+        @matrix.push: @new-row;
+    }
+
+    return @matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $matrix-str, $expect-str) = $line.split: / \| /;
+
+        for     $test-name, $matrix-str, $expect-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Array[Bit] @bnry = parse-matrix( $matrix-str.split( / \s+ / ).list );
+        my Array[Bit] @flip = flip-matrix\( @bnry );
+        my Array[Bit] @expt = parse-matrix( $expect-str.split( / \s+ / ).list );
+
+        is-deeply @flip, @expt, $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 0|110  011  001      |100  001  011
+        Example 1|110  101  000      |100  010  111
+        Example 2|1100 1001 0111 1010|1100 0110 0001 1010
+        END
+}
+
+################################################################################