Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

57 files changed, 2488 insertions, 0 deletions

diff --git a/challenge-279/athanasius/perl/ch-1.pl b/challenge-279/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f3a6fdf715
--- /dev/null
+++ b/challenge-279/athanasius/perl/ch-1.pl
@@ -0,0 +1,219 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 279
+=========================
+
+TASK #1
+-------
+*Sort Letters*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two arrays, @letters and @weights.
+
+Write a script to sort the given array @letters based on the @weights.
+
+Example 1
+
+  Input: @letters = ('R', 'E', 'P', 'L')
+         @weights = (3, 2, 1, 4)
+  Output: PERL
+
+Example 2
+
+  Input: @letters = ('A', 'U', 'R', 'K')
+         @weights = (2, 4, 1, 3)
+  Output: RAKU
+
+Example 3
+
+  Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T')
+         @weights = (5, 4, 2, 6, 1, 3)
+  Output: PYTHON
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input lists are entered as two strings on the command-line. The first
+   string contains only letters; the second string contains positive (non-zero)
+   integers separated by whitespace.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <letters> <weights>
+  perl $0
+
+    <letters>    A string of letters
+    <weights>    A string of whitespace-separated positive integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 279, Task #1: Sort Letters (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my $letters = parse_letters( $ARGV[ 0 ] );
+        my $weights = parse_weights( $ARGV[ 1 ], scalar @$letters );
+
+        printf "Input:  \@letters = (%s)\n", 
+                join ', ', map { "'$_'" } @$letters;
+
+        printf "        \@weights = (%s)\n", join ', ', @$weights; 
+
+        my $sorted = sort_letters( $letters, $weights );
+
+        print "Output: $sorted\n";
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub sort_letters
+#-------------------------------------------------------------------------------
+{
+    my ($letters, $weights) = @_;
+    my  @sorted;
+
+    for my $i (0 .. $#$letters)
+    {
+        $sorted[ $weights->[ $i ] - 1 ] = $letters->[ $i ];
+    }
+
+    return join '', @sorted;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_letters
+#-------------------------------------------------------------------------------
+{
+    my ($letters_str) = @_;
+
+    my  @chars = split //, $letters_str;
+    my  @letters;
+
+    for my $char (@chars)
+    {
+        $char =~ / ^ [A-Z] $ /ix or error( qq[Invalid letter "$char"] );
+
+        push @letters, $char;
+    }
+
+    return \@letters;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_weights
+#-------------------------------------------------------------------------------
+{
+    my ($weights_str, $count) = @_;
+
+    my  @nums = split / \s+ /x, $weights_str;
+    my  @weights;
+
+    for my $weight (@nums)
+    {
+        $weight =~ / ^ $RE{num}{int} $ /x
+                              or  error( qq[Invalid weight "$weight"] );
+        $weight >  0          or  error( "Weight $weight is too small" );
+        $weight <= $count     or  error( "Weight $weight is too large" );
+
+        push @weights, $weight;
+    }
+
+    scalar @weights == $count or  error( 'The number of weights does not ' .
+                                         'match the number of letters' );
+    my %dict;
+     ++$dict{ $_ } for @weights;
+
+    for my $weight (keys %dict)
+    {
+        $dict{ $weight } > 1  and error( "Duplicate weight $weight" );
+    }
+
+    return \@weights;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $letters_str, $weights_str, $expected) =
+             split / \| /x, $line;
+
+        for ($test_name, $letters_str, $weights_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $letters = parse_letters( $letters_str );
+        my $weights = parse_weights( $weights_str, scalar @$letters );
+        my $sorted  = sort_letters ( $letters, $weights );
+
+        is $sorted, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|REPL  |3 2 1 4    |PERL
+Example 2|AURK  |2 4 1 3    |RAKU
+Example 3|OHYNPT|5 4 2 6 1 3|PYTHON
diff --git a/challenge-279/athanasius/perl/ch-2.pl b/challenge-279/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ed76cd7c1e
--- /dev/null
+++ b/challenge-279/athanasius/perl/ch-2.pl
@@ -0,0 +1,246 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 279
+=========================
+
+TASK #2
+-------
+*Split String*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str.
+
+Write a script to split the given string into two containing exactly same number
+of vowels and return true if you can otherwise false.
+
+Example 1
+
+  Input: $str = "perl"
+  Output: false
+
+Example 2
+
+  Input: $str = "book"
+  Output: true
+
+  Two possible strings "bo" and "ok" containing exactly one vowel each.
+
+Example 3
+
+  Input: $str = "good morning"
+  Output: true
+
+  Two possible strings "good " and "morning" containing two vowels each or
+  "good m" and "orning" containing two vowels each.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If an explanation of the output (i.e., one possible solution) is wanted,
+   "--verbose" is entered as a command-line flag.
+3. A single string is given as the last entry on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.36;   # Enables strictures and warnings
+no  warnings qw( experimental::builtin );
+use builtin  qw( true false floor ceil trim );
+use Const::Fast;
+use Getopt::Long;
+use Test::More;
+
+const my $NON_VOWEL => qr/ [^AEIOU] /ix;
+const my $VOWEL     => qr/  [AEIOU] /ix;
+const my $USAGE     => <<END;
+Usage:
+  perl $0 [--verbose] <str>
+  perl $0
+
+    <str>        A string
+    --verbose    Explain the output? [default: False]
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 279, Task #2: Split String (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($str, $verbose) = parse_command_line();
+
+        print qq[Input:  \$str = "$str"\n];
+
+        my ($can_split, $lhs, $rhs, $vowels) = split_string( $str, $verbose );
+
+        printf "Output: %s\n", $can_split ? 'true' : 'false';
+
+        if ($verbose && $can_split)
+        {
+            print   "\nThis is a solution:\n";
+            printf qq["%s" and "%s" each contain %d vowel%s\n],
+                   $lhs, $rhs, $vowels, $vowels == 1 ? '' : 's';
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub split_string
+#-------------------------------------------------------------------------------
+{
+    my ($str, $verbose) = @_;
+    my  $can_split      = false;
+    my  $lhs            = '';
+    my  $rhs            = '';
+    my  $vowel_str      = $str =~ s/ $NON_VOWEL //grx;
+    my  $n_vowels       = length $vowel_str;
+    my  $target         = 0;
+
+    if ($n_vowels % 2 == 0)
+    {
+        $can_split = true;
+
+        if ($verbose)
+        {
+            if ($n_vowels == 0)
+            {
+                my $i = ceil( length( $str ) / 2 );
+
+                $lhs = substr $str, 0, $i;
+                $rhs = substr $str, $i;
+            }
+            else
+            {
+                ($lhs, $rhs, $target) = perform_split( $str, $n_vowels );
+            }
+        }
+    }
+
+    return $can_split, $lhs, $rhs, $target;
+}
+
+#-------------------------------------------------------------------------------
+sub perform_split
+#-------------------------------------------------------------------------------
+{
+    my ($str, $n_vowels) = @_;
+    my  $target = floor( $n_vowels / 2 );
+    my  @chars  = split //, $str;
+    my  $lhs    = '';
+    my  $rhs    = '';
+    my  $v      =  0;
+
+    for my $i (0 .. $#chars)
+    {
+        if ($chars[ $i ] =~ / $VOWEL /x && ++$v == $target)
+        {
+            $lhs = join '', @chars[ 0      .. $i      ];
+            $rhs = join '', @chars[ $i + 1 .. $#chars ];
+            last;
+        }
+    }
+
+    $rhs  =~ / ^ ( $NON_VOWEL* ) /x;
+    my $w = ceil( length( $1 ) / 2 );
+    $lhs .= substr $rhs, 0, $w;
+            substr $rhs, 0, $w, '';
+
+    return $lhs, $rhs, $target;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $verbose = 0;
+
+    GetOptions
+    (
+        verbose => \$verbose
+
+    )          or error( 'Error in command line arguments' );
+
+    my $argc = scalar @ARGV;
+
+    $argc == 1 or error( "Expected 1 command-line argument, found $argc" );
+
+    return $ARGV[ 0 ], $verbose;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $str, $exp_can, $exp_lhs, $exp_rhs) = split /\|/, $line;
+
+        $_ = trim $_ for $test_name, $str, $exp_can, $exp_lhs, $exp_rhs;
+        s/_/ /g      for             $str,           $exp_lhs, $exp_rhs;
+
+        my ($can_split, $lhs, $rhs) = split_string( $str, true );
+
+        is  $can_split, $exp_can, $test_name;
+
+        if ($can_split)
+        {
+            is $lhs, $exp_lhs, $test_name;
+            is $rhs, $exp_rhs, $test_name;
+        }
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+# An initial or trailing space in the input and output strings is represented by
+# an underscore (e.g., "good_ " represents "good ")
+
+__DATA__
+Example 1  |perl        | |      |
+Example 2  |book        |1|bo    |ok
+Example 3  |good morning|1|good_ |morning
+No vowels 1|BcdfghJklmnp|1|Bcdfgh|Jklmnp
+No vowels 2|BcdfghJklmn |1|Bcdfgh|Jklmn
+All vowels |aeiouAEIOU  |1|aeiou |AEIOU
+Empty      |            |1|      |
diff --git a/challenge-279/athanasius/raku/ch-1.raku b/challenge-279/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..29c75b8fb5
--- /dev/null
+++ b/challenge-279/athanasius/raku/ch-1.raku
@@ -0,0 +1,218 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 279
+=========================
+
+TASK #1
+-------
+*Sort Letters*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two arrays, @letters and @weights.
+
+Write a script to sort the given array @letters based on the @weights.
+
+Example 1
+
+  Input: @letters = ('R', 'E', 'P', 'L')
+         @weights = (3, 2, 1, 4)
+  Output: PERL
+
+Example 2
+
+  Input: @letters = ('A', 'U', 'R', 'K')
+         @weights = (2, 4, 1, 3)
+  Output: RAKU
+
+Example 3
+
+  Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T')
+         @weights = (5, 4, 2, 6, 1, 3)
+  Output: PYTHON
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The input lists are entered as two strings on the command-line. The first
+   string contains only letters; the second string contains positive (non-zero)
+   integers separated by whitespace.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Letter of Str where m:i/ ^ <[ A .. Z ]> $ /;
+subset Pos    of Int where * > 0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 279, Task #1: Sort Letters (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $letters,        #= A string of letters
+    Str:D $weights         #= A string of whitespace-separated positive integers
+)
+#===============================================================================
+{
+    my Letter @letters = parse-letters( $letters );
+    my Pos    @weights = parse-weights( $weights, @letters.elems );
+
+    "Input:  \@letters = (%s)\n".printf: @letters.map( { "'$_'" } ).join: ', ';
+    "        \@weights = (%s)\n".printf: @weights.join: ', ';
+
+    my Str $sorted = sort-letters( @letters, @weights );
+
+    "Output: $sorted".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub sort-letters( List:D[Letter:D] $letters, List:D[Pos:D] $weights --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Letter @sorted;
+
+    for 0 .. $letters.end -> UInt $i
+    {
+        @sorted[ $weights[ $i ] - 1 ] = $letters[ $i ];
+    }
+
+    return @sorted.join;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-letters( Str:D $letters --> List:D[Letter:D] )
+#-------------------------------------------------------------------------------
+{
+    my Str    @chars = $letters.split: '', :skip-empty;
+    my Letter @letters;
+
+    for @chars -> Str $char
+    {
+        $char ~~ Letter or error( qq[Invalid letter "$char"] );
+
+        @letters.push: $char;
+    }
+
+    return @letters;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-weights( Str:D $weights, UInt:D $count --> List:D[Pos:D] )
+#-------------------------------------------------------------------------------
+{
+    my Str @nums = $weights.split: / \s+ /, :skip-empty;
+    my Pos @weights;
+
+    for @nums -> Str $num
+    {
+        +$num ~~ Pos         or  error( qq[Invalid weight "$num"] );
+
+        my Pos $weight = +$num;
+
+        $weight <= $count    or  error( "Weight $weight is too large" );
+
+        @weights.push: $weight;
+    }