Merge pull request #9465 from PerlMonk-Athanasius/branch-for-challenge-253

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

4 files changed, 811 insertions, 0 deletions

diff --git a/challenge-253/athanasius/perl/ch-1.pl b/challenge-253/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..4099e548ba
--- /dev/null
+++ b/challenge-253/athanasius/perl/ch-1.pl
@@ -0,0 +1,174 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 253
+=========================
+
+TASK #1
+-------
+*Split Strings*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of strings and a character separator.
+
+Write a script to return all words separated by the given character excluding
+empty string.
+
+Example 1
+
+  Input: @words = ("one.two.three","four.five","six")
+         $separator = "."
+  Output: "one","two","three","four","five","six"
+
+Example 2
+
+  Input: @words = ("$perl$$", "$$raku$")
+         $separator = "$"
+  Output: "perl","raku"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 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 Getopt::Long;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [--separator <Str>] [<strings> ...]
+  perl $0
+
+    --separator <Str>    A single-character separator
+    [<strings> ...]      A non-empty list of strings
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 253, Task #1: Split Strings (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($separator, $strings) = parse_command_line();
+
+        printf qq[Input:  \@strings   = (%s)\n],
+               join ', ', map { qq["$_"] } @$strings;
+        print  qq[        \$separator =  "$separator"\n];
+
+        my $words = split_strings( $separator, $strings );
+
+        printf qq[Output: %s\n], join ', ', map { qq["$_"] } @$words;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub split_strings
+#-------------------------------------------------------------------------------
+{
+    my ($separator, $strings) = @_;
+    my  @words;
+
+    for my $string (@$strings)
+    {
+        push @words, split / \Q$separator\E /x, $string;
+    }
+
+    @words = grep { length > 0 } @words;
+
+    return \@words;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $separator;
+
+    GetOptions( 'separator=s' => \$separator )
+        or error( 'Invalid command line argument(s)' );
+
+    defined $separator
+        or error( 'Missing separator' );
+
+    length $separator == 1
+        or error( 'Invalid separator' );
+
+    scalar @ARGV > 0
+        or error( 'No input strings found' );
+
+    return ($separator, \@ARGV);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $strings_str, $separator, $expected_str) =
+             split / \| /x, $line;
+
+        for ($test_name, $strings_str, $separator, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @strings  = split / \s+ /x, $strings_str;
+        my @expected = split / \s+ /x, $expected_str;
+        my $output   = split_strings( $separator, \@strings );
+
+        is_deeply $output, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|one.two.three four.five six|.|one two three four five six
+Example 2|$perl$$ $$raku$            |$|perl raku
diff --git a/challenge-253/athanasius/perl/ch-2.pl b/challenge-253/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..d4cb8ae437
--- /dev/null
+++ b/challenge-253/athanasius/perl/ch-2.pl
@@ -0,0 +1,240 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 253
+=========================
+
+TASK #2
+-------
+*Weakest Row*
+
+Submitted by: Mohammad S Anwar
+
+You are given an m x n binary matrix i.e. only 0 and 1 where 1 always appear
+before 0.
+
+A row i is weaker than a row j if one of the following is true:
+
+  a) The number of 1s in row i is less than the number of 1s in row j.
+  b) Both rows have the same number of 1 and i < j.
+
+Write a script to return the order of rows from weakest to strongest.
+
+Example 1
+
+  Input: $matrix = [
+                     [1, 1, 0, 0, 0],
+                     [1, 1, 1, 1, 0],
+                     [1, 0, 0, 0, 0],
+                     [1, 1, 0, 0, 0],
+                     [1, 1, 1, 1, 1]
+                   ]
+  Output: (2, 0, 3, 1, 4)
+
+  The number of 1s in each row is:
+  - Row 0: 2
+  - Row 1: 4
+  - Row 2: 1
+  - Row 3: 2
+  - Row 4: 5
+
+Example 2
+
+  Input: $matrix = [
+                     [1, 0, 0, 0],
+                     [1, 1, 1, 1],
+                     [1, 0, 0, 0],
+                     [1, 0, 0, 0]
+                   ]
+  Output: (0, 2, 3, 1)
+
+  The number of 1s in each row is:
+  - Row 0: 1
+  - Row 1: 4
+  - Row 2: 1
+  - Row 3: 1
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 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 => <<END;
+Usage:
+  perl $0 [<matrix> ...]
+  perl $0
+
+    [<matrix> ...]    Non-empty binary matrix in which each row begins with 1
+                      e.g., 11000 11110 10000 11000 11111
+
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 253, Task #2: Weakest Row (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my $matrix = parse_matrix( \@ARGV );
+
+        print_matrix( 'Input:  $matrix = ', $matrix );
+
+        my $ranked = rank_rows( $matrix );
+
+        printf "Output: (%s)\n", join ', ', @$ranked;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub rank_rows
+#-------------------------------------------------------------------------------
+{
+    my ($matrix) = @_;
+    my  @ranked  = sort
+        {
+            count_ones( $matrix->[ $a ] ) <=> count_ones( $matrix->[ $b ] )
+                                          ||
+                                       $a <=> $b
+        } 0 .. $#$matrix;
+
+    return \@ranked;
+}
+
+#-------------------------------------------------------------------------------
+sub count_ones
+#-------------------------------------------------------------------------------
+{
+    my ($row)   = @_;
+    my  $count  = 0;
+        $count += $_ for @$row;
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_matrix
+#-------------------------------------------------------------------------------
+{
+    my ($matrix_strs) = @_;
+    my  @matrix;
+    my  $num_cols;
+    
+    for my $row (@$matrix_strs)
+    {
+        $row =~ / ^ 1 [01]* $ /x
+                or error( qq["$row" is not a valid row] );
+
+        my @row = split '', $row;
+
+        if (defined $num_cols)
+        {
+            scalar @row == $num_cols
+                or error( 'The input matrix is not rectangular' );
+        }
+        else
+        {
+            $num_cols = scalar @row;
+        }
+
+        push @matrix, \@row;
+    }
+
+    return \@matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub print_matrix
+#-------------------------------------------------------------------------------
+{
+    my ($prefix, $matrix) = @_;
+    my  $tab = ' ' x length $prefix;
+
+    print "$prefix\[ ";
+
+    for my $i (0 .. $#$matrix)
+    {
+        my $row = $matrix->[ $i ];
+
+        printf '%s[%s]', $i == 0 ? '' : "$tab  ", join ', ', @$row;
+
+        print  "\n" unless $i == $#$matrix;
+    }
+
+    print " ]\n";
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $matrix_strs, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $matrix_strs, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @rows     = split / \s+ /x, $matrix_strs;
+        my $matrix   = parse_matrix( \@rows );
+        my $ranked   = rank_rows( $matrix );
+        my @expected = split / \s+ /x, $expected_str;
+
+        is_deeply $ranked, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|11000 11110 10000 11000 11111|2 0 3 1 4
+Example 2|1000  1111  1000  1000       |0 2 3 1
+Singleton|1                            |0
diff --git a/challenge-253/athanasius/raku/ch-1.raku b/challenge-253/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..8533692691
--- /dev/null
+++ b/challenge-253/athanasius/raku/ch-1.raku
@@ -0,0 +1,155 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 253
+=========================
+
+TASK #1
+-------
+*Split Strings*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of strings and a character separator.
+
+Write a script to return all words separated by the given character excluding
+empty string.
+
+Example 1
+
+  Input: @words = ("one.two.three","four.five","six")
+         $separator = "."
+  Output: "one","two","three","four","five","six"
+
+Example 2
+
+  Input: @words = ("$perl$$", "$$raku$")
+         $separator = "$"
+  Output: "perl","raku"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 253, Task #1: Split Strings (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D :$separator where { .chars == 1 },     #= A single-character separator
+          *@strings   where { .elems >  0 }      #= A non-empty list of strings
+)
+#===============================================================================
+{
+    qq[Input:  \@strings   = (%s)\n].printf:
+                @strings.map( { qq["$_"] } ).join( ', ' );
+    qq[        \$separator =  "$separator"].put;
+
+    my Str @words = split-strings( $separator, @strings );
+
+    qq[Output: %s\n].printf: @words.map( { qq["$_"] } ).join( ', ' );
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub split-strings( Str:D $separator, List:D[Str:D] $strings --> List:D[Str:D] )
+#-------------------------------------------------------------------------------
+{
+    my Str @words;
+
+    for @$strings -> Str $string
+    {
+        @words.push: |$string.split: $separator, :skip-empty;
+    }
+
+    return @words;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $strings-str, $separator, $expected-str) =
+            $line.split: / \| /;
+
+        for     $test-name, $strings-str, $separator, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str @strings  = $strings-str\.split: / \s+ /;
+        my Str @expected = $expected-str.split: / \s+ /;
+        my Str @output   = split-strings( $separator, @strings );
+
+        is-deeply @output, @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|one.two.three four.five six|.|one two three four five six
+        Example 2|$perl$$ $$raku$            |$|perl raku
+        END
+}
+
+################################################################################
diff --git a/challenge-253/athanasius/raku/ch-2.raku b/challenge-253/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..1ffc7f7a23
--- /dev/null
+++ b/challenge-253/athanasius/raku/ch-2.raku
@@ -0,0 +1,242 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 253
+=========================
+
+TASK #2
+-------
+*Weakest Row*
+
+Submitted by: Mohammad S Anwar
+
+You are given an m x n binary matrix i.e. only 0 and 1 where 1 always appear
+before 0.
+
+A row i is weaker than a row j if one of the following is true:
+
+  a) The number of 1s in row i is less than the number of 1s in row j.
+  b) Both rows have the same number of 1 and i < j.
+
+Write a script to return the order of rows from weakest to strongest.
+
+Example 1
+
+  Input: $matrix = [
+                     [1, 1, 0, 0, 0],
+                     [1, 1, 1, 1, 0],
+                     [1, 0, 0, 0, 0],
+                     [1, 1, 0, 0, 0],
+                     [1, 1, 1, 1, 1]
+                   ]
+  Output: (2, 0, 3, 1, 4)
+
+  The number of 1s in each row is:
+  - Row 0: 2
+  - Row 1: 4
+  - Row 2: 1
+  - Row 3: 2
+  - Row 4: 5
+
+Example 2
+
+  Input: $matrix = [
+                     [1, 0, 0, 0],
+                     [1, 1, 1, 1],
+                     [1, 0, 0, 0],
+                     [1, 0, 0, 0]
+                   ]
+  Output: (0, 2, 3, 1)
+
+  The number of 1s in each row is:
+  - Row 0: 1
+  - Row 1: 4
+  - Row 2: 1
+  - Row 3: 1
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Bin    of Int where 0 | 1;
+subset BinStr of Str where / ^ 1 <[ 0 1 ]>* $ /;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 253, Task #2: Weakest Row (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| Non-empty binary matrix in which each row begins with 1
+    #  e.g., 11000 11110 10000 11000 11111
+
+    *@matrix where { .elems > 0 && .all ~~ BinStr:D }
+)
+#===============================================================================
+{
+    my Array[Array[Bin]] $matrix = parse-matrix( @matrix );
+
+    print-matrix( 'Input:  $matrix = ', $matrix );
+
+    my UInt @ranked = rank-rows( $matrix );
+
+    "Output: (%s)\n".printf: @ranked.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub rank-rows( List:D[List:D[Bin:D]] $matrix --> List:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt @ranked = (0 .. $matrix.end).sort:
+                {
+                    ([+] $matrix[ $^a ].list) <=> ([+] $matrix[ $^b ].list)
+                                              ||
+                                          $^a <=> $^b
+                };
+
+    return  @ranked;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-matrix
+(
+    List:D[BinStr:D] $matrix-strs where { .elems > 0 }
+--> List:D[List:D[Bin:D]]
+)
+#-------------------------------------------------------------------------------
+{
+    my Array[Bin] @matrix;
+    my UInt       $num-cols;
+    
+    for @$matrix-strs -> Str $row
+    {
+        my Bin @row = $row.split( '', :skip-empty ).map: { .Int };
+
+        @row[ 0 ] == 1 or error( 'Row does not begin with 1' );
+
+        @matrix.push: @row;
+
+        if $num-cols.defined
+        {
+            @row.elems == $num-cols
+                       or error( 'The matrix is not rectangular' );
+        }
+        else
+        {
+            ($num-cols = @row.elems) > 0
+                       or error( 'The first row is empty' );
+        }
+    }
+
+    return @matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub print-matrix( Str:D $prefix, List:D[List:D[Bin:D]] $matrix )
+#-------------------------------------------------------------------------------
+{
+    my Str $tab = ' ' x $prefix.chars;
+
+    "$prefix\[ ".print;
+
+    for 0 .. $matrix.end -> UInt $i
+    {
+        my Array[Bin] $row = $matrix[ $i ];
+
+        '%s[%s]'.printf: $i == 0 ?? '' !! "$tab  ", $row.join: ', ';
+
+        put() unless $i == $matrix.end;
+    }
+
+    ' ]'.put;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $matrix-strs, $expected-str) = $line.split: / \| /;
+
+        for     $test-name, $matrix-strs, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my BinStr     @rows     = $matrix-strs\.split: / \s+ /;
+        my Array[Bin] @matrix   = parse-matrix( @rows );
+        my UInt       @ranked   = rank-rows( @matrix );
+        my UInt       @expected = $expected-str.split( / \s+ / ). map: { .Int };
+
+        is-deeply @ranked, @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|11000 11110 10000 11000 11111|2 0 3 1 4
+        Example 2|1000  1111  1000  1000       |0 2 3 1
+        Singleton|1                            |0
+        END
+}
+
+################################################################################