Perl and Raku solutions to Challenge #056

On branch branch-for-challenge-056
Changes to be committed:
	new file:   challenge-056/athanasius/perl/ch-1.pl
	new file:   challenge-056/athanasius/perl/ch-2.pl
	new file:   challenge-056/athanasius/raku/ch-1.raku

3 files changed, 390 insertions, 0 deletions

diff --git a/challenge-056/athanasius/perl/ch-1.pl b/challenge-056/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..548e8e9d10
--- /dev/null
+++ b/challenge-056/athanasius/perl/ch-1.pl
@@ -0,0 +1,121 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 056
+=========================
+
+Task #1
+-------
+*Diff-K*
+
+You are given an array *@N* of positive integers (sorted) and another non
+negative integer *k*.
+
+Write a script to find if there exists 2 indices *i* and *j* such that
+*A[i] - A[j] = k* and *i != j*.
+
+It should print the pairs of indices, if any such pairs exist.
+
+Example:
+
+    @N = (2, 7, 9)
+    $k = 2
+
+Output : 2,1
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Data::Util qw( is_integer );
+use Getopt::Long;
+
+const my $USAGE => "USAGE: perl $0 --k=<K> <L> <M> <N> ...\n"  . ' ' x 20 .
+                   "- where     K is a non-negative integer\n" . ' ' x 20 .
+                   "  and L, M, N, ... are positive integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 056, Task #1: Diff-K (Perl)\n\n";
+
+    # 1. Get, validate, and print @N and K
+
+    my ($n, $k) = parse_command_line();
+
+    printf "\@N = (%s)\n K =  %d\n\n", join(', ', @$n), $k;
+
+    # 2. Find all solutions
+
+    my @solutions;
+
+    for my $i (1 .. $#$n)
+    {
+        for my $j (0 .. $i - 1)
+        {
+            push @solutions, [$i, $j] if $n->[$i] - $n->[$j] == $k;
+        }
+    }
+
+    # 3. Output the solutions
+
+    my  $solutions = scalar @solutions;
+
+    if ($solutions == 0)
+    {
+        print  "No solutions found\n";
+    }
+    else
+    {
+        printf "Found %d solution%s: %s\n",
+                $solutions, $solutions == 1 ? '' : 's',
+                join ', ', map "($_->[0], $_->[1])", @solutions;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $k;
+    GetOptions('k=i' => \$k) or error();
+    defined $k               or error('K is missing on the command line');
+    $k >= 0                  or error('K must be non-negative');
+
+    my     @n = @ARGV;
+    scalar @n > 0            or error('The array is empty');
+
+    is_integer($_) && $_ > 0 or error("Invalid array value '$_'") for @n;
+
+    @n = sort { $a <=> $b } @n;
+
+    return (\@n, $k);
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($msg) = @_;
+
+    die defined $msg ? "ERROR: $msg\n$USAGE" : $USAGE;
+}
+
+################################################################################
diff --git a/challenge-056/athanasius/perl/ch-2.pl b/challenge-056/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..d97f257f95
--- /dev/null
+++ b/challenge-056/athanasius/perl/ch-2.pl
@@ -0,0 +1,178 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 056
+=========================
+
+Task #2
+-------
+*Path Sum*
+
+You are given a binary tree and a sum, write a script to find if the tree has a
+path such that adding up all the values along the path equals the given sum.
+Only complete paths (from root to leaf node) may be considered for a sum.
+
+*Example*
+
+Given the below binary tree and sum = 22,
+
+          5
+         / \
+        4   8
+       /   / \
+      11  13  9
+     /  \      \
+    7    2      1
+
+For the given binary tree, the partial path sum *5 → 8 → 9 = 22* is *not* valid.
+
+The script should return the path *5 → 4 → 11 → 2* whose sum is *22*.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#-------------------------------------------------------------------------------
+# Assumptions:
+#
+# (1) All tree values are positive numbers greater than zero.
+#     This simplifies the search, because it means that searching a path can be
+#     safely discontinued as soon as the path sum becomes >= the target sum.
+#
+# (2) If multiple solutions exist, only the first (via depth-first traversal) is
+#     required.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+use Const::Fast;
+use Tree::Binary2;
+use constant DEBUG => 0;
+
+const my $SUM => 22;
+
+my @path;
+my $solution_found;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 056, Task #2: Path Sum (Perl)\n\n";
+
+    my $tree = populate_tree();
+
+    if (DEBUG)
+    {
+        # The example tree's mirror (i.e., all nodes reversed) is a better test
+        # of the algorithm because the invalid solution 5 -> 8 -> 9 is examined
+        # BEFORE the correct solution 5 -> 4 -> 11 -> 2
+
+        $tree->mirror;
+
+        printf "%s\n\n", join "\n",
+                              @{ $tree->tree2string({ no_attributes => 1 }) };
+    }
+
+    find_path($tree, $SUM);
+
+    if ($solution_found)
+    {
+        printf "Found path: %s, whose sum is %d\n", join(' -> ', @path), $SUM; 
+    }
+    else
+    {
+        print  "No path found for sum $SUM\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+# See the Wikipedia article "Backtracking", section "Pseudocode"
+#
+sub find_path
+#-------------------------------------------------------------------------------
+{
+    my ($tree, $sum) = @_;
+
+    return if $solution_found;
+
+    my $root = $tree->{ _value };
+
+    push @path, $root;
+
+    if ($root > $sum)
+    {
+        pop @path;
+        return;
+    }
+
+    my $left  = $tree->left;
+    my $right = $tree->right;
+
+    if ($root == $sum)
+    {
+        if (!$left && !$right)      # Leaf node
+        {
+            $solution_found = 1;
+        }
+        else                        # Internal node
+        {
+            pop @path;
+        }
+
+        return;
+    }
+
+    find_path($left,  $sum - $root) if $left;       # Recursive calls
+    find_path($right, $sum - $root) if $right;
+
+    pop @path unless $solution_found;
+}
+
+#-------------------------------------------------------------------------------
+sub populate_tree
+#-------------------------------------------------------------------------------
+{
+    my $tree  = Tree::Binary2->new( 5 );
+    my $left  = Tree::Binary2->new( 4 );
+    my $right = Tree::Binary2->new( 8 );
+
+    $tree->left(  $left  );
+    $tree->right( $right );
+
+    $left = Tree::Binary2->new( 11 );
+    $tree->left->left( $left );
+
+    $left  = Tree::Binary2->new( 7 );
+    $right = Tree::Binary2->new( 2 );
+
+    $tree->left->left->left(  $left  );
+    $tree->left->left->right( $right );
+
+    $left  = Tree::Binary2->new( 13 );
+    $right = Tree::Binary2->new(  9 );
+
+    $tree->right->left(  $left  );
+    $tree->right->right( $right );
+
+    $right = Tree::Binary2->new( 1 );
+
+    $tree->right->right->right( $right );
+
+    return $tree;
+}
+
+################################################################################
diff --git a/challenge-056/athanasius/raku/ch-1.raku b/challenge-056/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ce51271f9f
--- /dev/null
+++ b/challenge-056/athanasius/raku/ch-1.raku
@@ -0,0 +1,91 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 056
+=========================
+
+Task #1
+-------
+*Diff-K*
+
+You are given an array *@N* of positive integers (sorted) and another non
+negative integer *k*.
+
+Write a script to find if there exists 2 indices *i* and *j* such that
+*A[i] - A[j] = k* and *i != j*.
+
+It should print the pairs of indices, if any such pairs exist.
+
+Example:
+
+    @N = (2, 7, 9)
+    $k = 2
+
+Output : 2,1
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN
+(
+    UInt:D :$K,         #=  K is a non-negative integer
+           *@N,         #= @N is an array of positive integers
+)
+#===============================================================================
+{
+    "Challenge 056, Task #1: Diff-K (Raku)\n".put;
+
+    # 1. Validate and print @N and K
+
+    @N.elems > 0 or die 'ERROR: The array is empty';
+
+    for @N
+    {
+        my UInt $entry = $_;
+        $entry > 0 or die "ERROR: Invalid array entry '$_'";
+    }
+
+    @N = @N.sort;
+
+    "\@N = (%s)\n K =  %d\n\n".printf: @N.join(', '), $K;
+
+    # 2. Find all solutions
+
+    my @solutions;
+
+    for 1 .. @N.elems - 1 -> UInt $i
+    {
+        for 0 .. $i - 1 -> UInt $j
+        {
+            @solutions.push: [$i, $j] if @N[$i] - @N[$j] == $K;
+        }
+    }
+
+    # 3. Output the solutions
+
+    my UInt $solutions = @solutions.elems;
+
+    if $solutions == 0
+    {
+        "No solutions found".put;
+    }
+    else
+    {
+        printf "Found %d solution%s: %s\n",
+                $solutions, $solutions == 1 ?? '' !! 's',
+                @solutions.map( { "($_[0], $_[1])" } ).join: ', ';
+    }
+}
+
+###############################################################################