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

4 files changed, 851 insertions, 0 deletions

diff --git a/challenge-285/athanasius/perl/ch-1.pl b/challenge-285/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..7a60e71670
--- /dev/null
+++ b/challenge-285/athanasius/perl/ch-1.pl
@@ -0,0 +1,199 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 285
+=========================
+
+TASK #1
+-------
+*No Connection*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of routes, @routes.
+
+Write a script to find the destination with no further outgoing connection.
+
+Example 1
+
+  Input: @routes = (["B","C"], ["D","B"], ["C","A"])
+  Output: "A"
+
+  "D" -> "B" -> "C" -> "A".
+  "B" -> "C" -> "A".
+  "C" -> "A".
+  "A".
+
+Example 2
+
+  Input: @routes = (["A","Z"])
+  Output: "Z"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single string is entered on the command-line: this string consists of
+   routes separated by semicolons; each route consists of exactly two strings
+   separated by whitespace.
+
+Assumptions
+-----------
+1. There may be more than one terminus.
+2. A cycle has no terminus, e.g., "A" -> "B" -> "C" -> "A".
+3. "A" -> "A" is a cycle.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <routes>
+  perl $0
+
+    <routes>    String of routes, e.g., "X Y; Z A; A B; W X"
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 285, Task #1: No Connection (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $routes = parse_routes_str( $ARGV[ 0 ] );
+
+        printf "Input:  \@routes = (%s)\n",
+                join ', ', map { qq(["$_->[ 0 ]","$_->[ 1 ]"]) } @$routes;
+
+        my $termini = find_termini( $routes );
+
+        printf "Output: %s\n",
+                @$termini ? join( ', ', map { qq["$_"] } @$termini ) : '<none>';
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_termini
+#-------------------------------------------------------------------------------
+{
+    my ($routes) = @_;
+    my  %count;
+
+    for my $route (@$routes)
+    {
+        my ($lhs, $rhs) = @$route;
+
+        ++$count{ $lhs };
+
+        exists $count{ $rhs } or $count{ $rhs } = 0;
+    }
+
+    my @termini;
+
+    for my $node (keys %count)
+    {
+        push @termini, $node if $count{ $node } == 0;
+    }
+
+    @termini = sort @termini;
+
+    return \@termini;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_routes_str
+#-------------------------------------------------------------------------------
+{
+    my ($routes_str) = @_;
+    my  @routes;
+
+    for my $route_str (split / \; /x, $routes_str)
+    {
+        my ($lhs, $rhs) = $route_str =~ / ^ \s* (\S+) \s+ (\S+) \s* $ /x
+            or  error( qq[Invalid route "$route_str"] );
+
+        push @routes, [ $lhs => $rhs ];
+    }
+
+    return \@routes;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $routes_str, $expected_str) = split / \| /x, $line;
+
+        for ($test_name, $routes_str, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $routes   = parse_routes_str( $routes_str );
+        my $termini  = find_termini( $routes );
+        my @expected = split / \s+ /x, $expected_str;
+
+        is_deeply $termini, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1    |B C; D B; C A|A
+Example 2    |A Z          |Z
+Trivial cycle|A A          |
+Long cycle   |A B; B C; C A|
+Forest       |A B; B C; D E|C E
diff --git a/challenge-285/athanasius/perl/ch-2.pl b/challenge-285/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..6d1ab683b6
--- /dev/null
+++ b/challenge-285/athanasius/perl/ch-2.pl
@@ -0,0 +1,233 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 285
+=========================
+
+TASK #2
+-------
+*Making Change*
+
+Submitted by: David Ferrone
+
+Compute the number of ways to make change for given amount in cents. By using
+the coins e.g. Penny, Nickel, Dime, Quarter and Half-dollar, in how many
+distinct ways can the total value equal to the given amount? Order of coin
+selection does not matter.
+
+  A penny (P) is equal to 1 cent.
+  A nickel (N) is equal to 5 cents.
+  A dime (D) is equal to 10 cents.
+  A quarter (Q) is equal to 25 cents.
+  A half-dollar (HD) is equal to 50 cents.
+
+Example 1
+
+  Input: $amount = 9
+  Output: 2
+
+  1: 9P
+  2: N + 4P
+
+Example 2
+
+  Input: $amount = 15
+  Output: 6
+
+  1: D + 5P
+  2: D + N
+  3: 3N
+  4: 2N + 5P
+  5: N + 10P
+  6: 15P
+
+Example 3
+
+  Input: $amount = 100
+  Output: 292
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. An unsigned integer is entered on the command-line. This is the target amount
+   (in cents) for making change.
+
+Algorithm
+---------
+Distinct ways of making change for the target amount are calculated recursively.
+The base case is reached whenever the largest coin to be considered is a penny.
+
+As many of the recursive calls are identical, considerable savings can be made
+through memoization (for large values of the target amount). To accomplish this,
+the module Memoize is used, and the recursive subroutine make-change() is memo-
+ized for target amounts of one thousand or more.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures and warnings
+use Const::Fast;
+use List::Util     qw( max );
+use Memoize;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my @COINS   => (50, 25, 10, 5, 1);
+const my $MIN_MEM => 1e3;              # Minimum value of $amount at which memo-
+                                       # ization makes a noticeable improvement
+const my $USAGE   => <<END;
+Usage:
+  perl $0 <amount>
+  perl $0
+
+    <amount>    Amount of change in cents (unsigned integer)
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 285, Task #2: Making Change (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $amount =  $ARGV[ 0 ];
+           $amount =~ / ^ $RE{num}{int} $ /x
+                        or error( qq["$amount" is not a valid integer] );
+           $amount >= 0 or error( "$amount is negative");
+
+        print "Input:  \$amount = $amount\n";
+
+        my $count = count_ways_to_make_change( $amount );
+
+        printf "Output: %s\n", add_commas( $count );
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub count_ways_to_make_change                                 # Wrapper function
+#-------------------------------------------------------------------------------
+{
+    my ($amount)  = @_;
+    my  $max_coin = max( grep { $_ <= $amount } @COINS ) // 1;
+
+    memoize( 'make_change' ) if $amount >= $MIN_MEM;
+
+    return make_change( $amount, $max_coin );
+}
+
+#-------------------------------------------------------------------------------
+sub make_change                                             # Recursive function
+#-------------------------------------------------------------------------------
+{
+    my ($amount, $max_coin) = @_;
+    my  $count = 0;
+
+    if ($max_coin == 1)
+    {
+        ++$count;                                               # Base case
+    }
+    else
+    {
+        my $next_coin = max grep { $_ < $max_coin } @COINS;
+
+        for (my $target = $amount; $target >= 0; $target -= $max_coin)
+        {
+            $count += make_change( $target, $next_coin );       # Recursive call
+        }
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+# Adapted from sub commify() at:
+#   https://perldoc.perl.org/perlfaq5#How-can-I-output-my-numbers-with-commas-
+#   added?
+#
+sub add_commas
+#-------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    1 while $n =~ s/ ^ (\+? \d+) (\d{3}) /$1,$2/x;
+
+    return $n;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $amount, $expected) = split / \| /x, $line;
+
+        for ($test_name, $amount, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $count = count_ways_to_make_change( $amount );
+
+        is $count, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1  |  9|  2
+Example 2  | 15|  6
+Example 3  |100|292
+Zero       |  0|  1
+Penny      |  1|  1
+Nickel     |  5|  2
+Dime       | 10|  4
+Quarter    | 25| 13
+Half dollar| 50| 50
+Forty-two  | 42| 31
diff --git a/challenge-285/athanasius/raku/ch-1.raku b/challenge-285/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..f37cc38865
--- /dev/null
+++ b/challenge-285/athanasius/raku/ch-1.raku
@@ -0,0 +1,201 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 285
+=========================
+
+TASK #1
+-------
+*No Connection*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of routes, @routes.
+
+Write a script to find the destination with no further outgoing connection.
+
+Example 1
+
+  Input: @routes = (["B","C"], ["D","B"], ["C","A"])
+  Output: "A"
+
+  "D" -> "B" -> "C" -> "A".
+  "B" -> "C" -> "A".
+  "C" -> "A".
+  "A".
+
+Example 2
+
+  Input: @routes = (["A","Z"])
+  Output: "Z"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A single string is entered on the command-line: this string consists of
+   routes separated by semicolons; each route consists of exactly two strings
+   separated by whitespace.
+
+Assumptions
+-----------
+1. There may be more than one terminus.
+2. A cycle has no terminus, e.g., "A" -> "B" -> "C" -> "A".
+3. "A" -> "A" is a cycle.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Route of List where (Str, Str);
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 285, Task #1: No Connection (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $routes                #= String of routes, e.g., "X Y; Z A; A B; W X"
+)
+#===============================================================================
+{
+    my @routes = parse-routes-str( $routes );
+
+    "Input:  \@routes = (%s)\n".printf:
+        @routes.map( { qq<["$_[ 0 ]","$_[ 1 ]"]> } ).join: ', ';
+
+    my Str @termini = find-termini( @routes );
+
+    "Output: %s\n".printf:
+        @termini ?? @termini.map( { qq<"$_"> } ).join( ', ' ) !! '<none>';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-termini( List:D[Route:D] $routes --> List:D[Str:D] )
+#-------------------------------------------------------------------------------
+{
+    my UInt %count{Str};
+
+    for @$routes -> Route $route
+    {
+        my Str ($lhs, $rhs) = @$route;
+
+        ++%count{ $lhs };
+
+        %count{ $rhs }:exists or %count{ $rhs } = 0;
+    }
+
+    my Str @termini;
+
+    for %count.keys -> Str $node
+    {
+        @termini.push: $node if %count{ $node } == 0;
+    }
+
+    @termini .= sort;
+
+    return @termini;
+}
+
+#-------------------------------------------------------------------------------
+sub parse-routes-str( Str:D $routes-str --> List:D[Route:D] )
+#-------------------------------------------------------------------------------
+{
+    my Route @routes;
+
+    for $routes-str.split( / \; /, :skip-empty ) -> Str $route-str
+    {
+        $route-str ~~ / ^ \s* (\S+) \s+ (\S+) \s* $ /
+            or error( qq<Invalid route "$route-str"> );
+
+        @routes.push: (~$0, ~$1);
+    }
+
+    return @routes;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $routes-str, $expected-str) = $line.split: / \| /;
+
+        for     $test-name, $routes-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Route @routes   = parse-routes-str( $routes-str );
+        my Str   @termini  = find-termini( @routes );
+        my Str   @expected = $expected-str.split: / \s+ /, :skip-empty;
+
+        is-deeply @termini, @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    |B C; D B; C A|A
+        Example 2    |A Z          |Z
+        Trivial cycle|A A          |
+        Long cycle   |A B; B C; C A|
+        Forest       |A B; B C; D E|C E
+        END
+}
+
+################################################################################
diff --git a/challenge-285/athanasius/raku/ch-2.raku b/challenge-285/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..382005b08d
--- /dev/null
+++ b/challenge-285/athanasius/raku/ch-2.raku
@@ -0,0 +1,218 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 285
+=========================
+
+TASK #2
+-------
+*Making Change*
+
+Submitted by: David Ferrone
+
+Compute the number of ways to make change for given amount in cents. By using
+the coins e.g. Penny, Nickel, Dime, Quarter and Half-dollar, in how many
+distinct ways can the total value equal to the given amount? Order of coin
+selection does not matter.
+
+  A penny (P) is equal to 1 cent.
+  A nickel (N) is equal to 5 cents.
+  A dime (D) is equal to 10 cents.
+  A quarter (Q) is equal to 25 cents.
+  A half-dollar (HD) is equal to 50 cents.
+
+Example 1
+
+  Input: $amount = 9
+  Output: 2
+
+  1: 9P
+  2: N + 4P
+
+Example 2
+
+  Input: $amount = 15
+  Output: 6
+
+  1: D + 5P
+  2: D + N
+  3: 3N
+  4: 2N + 5P
+  5: N + 10P
+  6: 15P
+
+Example 3
+
+  Input: $amount = 100
+  Output: 292
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. An unsigned integer is entered on the command-line: this is the target amount
+   (in cents) for making change.
+
+Algorithm
+---------
+Distinct ways of making change for the target amount are calculated recursively.
+The base case is reached whenever the largest coin to be considered is a penny.
+
+As many of the recursive calls are identical, considerable savings can be made
+through memoization (for large values of the target amount). To accomplish this,
+the module Sub::Memoized is used, and the recursive subroutine make-change() is
+given the trait "is memoized".
+
+=end comment
+#===============================================================================
+
+use Sub::Memoized;
+use Test;
+
+my constant @COINS = Array[UInt].new: 50, 25, 10, 5, 1;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 285, Task #2: Making Change (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    UInt:D $amount               #= Amount of change in cents (unsigned integer)
+)
+#===============================================================================
+{
+    "Input:  \$amount = $amount".put;
+
+    my UInt $count = count-ways-to-make-change( $amount );
+
+    "Output: %s\n".printf: add-commas( $count );
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub count-ways-to-make-change( UInt:D $amount --> UInt:D )    # Wrapper function
+#-------------------------------------------------------------------------------
+{
+    my UInt $count = 1;
+
+    if $amount > 1
+    {
+        my UInt $max-coin = @COINS.grep( { $_ <= $amount } ).max;
+
+        $count = make-change( $amount, $max-coin );
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+sub make-change( UInt:D $amount, UInt:D $max-coin --> UInt:D ) is memoized
+#-------------------------------------------------------------------------------
+{
+    my UInt $count = 0;
+
+    if $max-coin == 1
+    {
+        ++$count;                                               # Base case
+    }
+    else
+    {
+        my UInt $next-coin = @COINS.grep( { $_ < $max-coin } ).max;
+
+        loop (my Int $target = $amount; $target >= 0; $target -= $max-coin)
+        {
+            $count += make-change( $target, $next-coin );       # Recursive call
+        }
+    }
+
+    return $count;
+}
+
+#-------------------------------------------------------------------------------
+# Adapted from the Rosetta Code commatize() subroutine at:
+#   https://rosettacode.org/wiki/Commatizing_numbers#Raku
+#
+sub add-commas( UInt:D $n --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return $n.subst: :continue( 0 ),
+                     :1st,
+                     / <[ 1..9 ]> <[ 0..9 ]>* /,
+                     *.flip.comb( / <{ ". ** 1..3" }> / ).join( ',' ).flip;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $amount, $expected) = $line.split: / \| /;
+
+        for     $test-name, $amount, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my UInt $count = count-ways-to-make-change( $amount.Int );
+
+        is $count, $expected.Int, $test-name;
+    }
+
+    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  |  9|  2
+        Example 2  | 15|  6
+        Example 3  |100|292
+        Zero       |  0|  1
+        Penny      |  1|  1
+        Nickel     |  5|  2
+        Dime       | 10|  4
+        Quarter    | 25| 13
+        Half dollar| 50| 50
+        Forty-two  | 42| 31
+        END
+}
+
+################################################################################