Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #068

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

6 files changed, 707 insertions, 0 deletions

diff --git a/challenge-068/athanasius/perl/SinglyLinkedList.pm b/challenge-068/athanasius/perl/SinglyLinkedList.pm
new file mode 100644
index 0000000000..f1157ad61f
--- /dev/null
+++ b/challenge-068/athanasius/perl/SinglyLinkedList.pm
@@ -0,0 +1,136 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 068
+=========================
+
+Task #2
+-------
+*Reorder List*
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+package SinglyLinkedList;
+#===============================================================================
+
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+sub new
+#-------------------------------------------------------------------------------
+{
+    my ($class, @args) = @_;
+
+    my  $self = { head => undef };
+    my  $curr;
+
+    for my $arg (@args)
+    {
+        my $node = { datum => $arg, next => undef };
+
+        if (defined $curr)
+        {
+            $curr = $curr->{next} = $node;
+        }
+        else
+        {
+            $curr = $self->{head} = $node;
+        }
+    }
+
+    return bless $self, $class;
+}
+
+#-------------------------------------------------------------------------------
+sub get_head
+#-------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{head};
+}
+
+#-------------------------------------------------------------------------------
+sub remove_tail
+#-------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+    my  $tail;
+
+    if (my $curr = $self->{head})
+    {
+        if ($curr->{next})
+        {
+            $curr = $curr->{next} while $curr->{next} && $curr->{next}{next};
+            $tail = $curr->{next};
+            $curr->{next} = undef;
+        }
+        else
+        {
+            $tail = $curr;
+            $self->{head} = undef;
+        }
+    }
+
+    return $tail;
+}
+
+#-------------------------------------------------------------------------------
+sub insert
+#-------------------------------------------------------------------------------
+{
+    my ($self, $curr, $node_to_add) = @_;
+    my  $old_next;
+
+    if (defined $self->{head} && defined $curr && $curr)
+    {
+        $old_next     = $curr->{next};
+        $curr->{next} = $node_to_add;
+    }
+    else
+    {
+        $old_next     = $self->{head};
+        $self->{head} = $node_to_add;
+    }
+
+    $node_to_add->{next} = $old_next;
+}
+
+#-------------------------------------------------------------------------------
+sub print
+#-------------------------------------------------------------------------------
+{
+    my ($self, $title) = @_;
+
+    print $title if defined $title;
+
+    if (my $curr = $self->{head})
+    {
+        while ($curr)
+        {
+            print   $curr->{datum};
+            $curr = $curr->{next};
+
+            print ' -> ' if defined $curr;
+        }
+    }
+    else
+    {
+        print '<empty>';
+    }
+
+    print "\n";
+}
+
+################################################################################
+1;
+################################################################################
diff --git a/challenge-068/athanasius/perl/ch-1.pl b/challenge-068/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..01f5fa0dd3
--- /dev/null
+++ b/challenge-068/athanasius/perl/ch-1.pl
@@ -0,0 +1,120 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 068
+=========================
+
+Task #1
+-------
+*Zero Matrix*
+
+*Submitted by:* Mohammad S Anwar
+
+You are given a matrix of size M x N having only 0s and 1s.
+
+Write a script to set the entire row and column to 0 if an element is 0.
+
+*Example 1*
+
+ Input: [1, 0, 1]
+        [1, 1, 1]
+        [1, 1, 1]
+
+ Output: [0, 0, 0]
+         [1, 0, 1]
+         [1, 0, 1]
+
+*Example 2*
+
+ Input: [1, 0, 1]
+        [1, 1, 1]
+        [1, 0, 1]
+
+ Output: [0, 0, 0]
+         [1, 0, 1]
+         [0, 0, 0]
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Test::More;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 068, Task #1: Zero Matrix (Perl)\n\n";
+
+    while (<DATA>)
+    {
+        my  ($M, $N, $input, $expected) = split;
+
+        my  (@input, @expected);
+        push @input,    [ split //, $1 ] while $input    =~ /(.{$N})/g;
+        push @expected, [ split //, $1 ] while $expected =~ /(.{$N})/g;
+
+        my   @actual = zero_matrix($M, $N, @input);
+
+        is_deeply(\@actual, \@expected, "$M x $N array");
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub zero_matrix
+#-------------------------------------------------------------------------------
+{
+    my ($rows, $cols, @array) = @_;
+    my (%zero_rows, %zero_cols);
+
+    for my $row (0 .. $rows - 1)
+    {
+        for my $col (0 .. $cols - 1)
+        {
+            if ($array[$row][$col] == 0)
+            {
+                ++$zero_rows{$row};
+                ++$zero_cols{$col};
+            }
+        }
+    }
+
+    for my $row (keys %zero_rows)
+    {
+        $array[$row][$_] = 0 for 0 .. $cols - 1;
+    }
+
+    for my $col (keys %zero_cols)
+    {
+        $array[$_][$col] = 0 for 0 .. $rows - 1;
+    }
+
+    return @array;
+}
+
+################################################################################
+
+__DATA__
+3 3 101111111            000101101
+3 3 101111101            000101000
+2 4 11111110             11100000
+4 5 11111111111011111111 10111101110000010111
+2 3 111111               111111
+1 7 1110111              0000000
diff --git a/challenge-068/athanasius/perl/ch-2.pl b/challenge-068/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b98c4d6f65
--- /dev/null
+++ b/challenge-068/athanasius/perl/ch-2.pl
@@ -0,0 +1,96 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 068
+=========================
+
+Task #2
+-------
+*Reorder List*
+
+*Submitted by:* Mohammad S Anwar
+
+You are given a singly linked list $L as below:
+
+ L0 →  L1 →  … →  Ln-1 →  Ln
+
+Write a script to reorder list as below:
+
+ L0 →  Ln →  L1 →  Ln-1 →  L2 →  Ln-2 → […]
+
+You are *ONLY* allowed to do this in-place without altering the nodes' values.
+
+*Example*
+
+ Input:  1 →  2 →  3 →  4
+ Output: 1 →  4 →  2 →  3
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use lib            qw( . );
+use SinglyLinkedList;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <num-elements>
+  perl $0 [<elements> ...]
+
+    <num-elements>      (UInt > 0) Num. of elements (with values 1, 2, 3, ...)
+    [<elements> ...]    (Str+) Explicit element values, in order\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 068, Task #2: Reorder List (Perl)\n\n";
+
+    my $args = scalar @ARGV;
+       $args > 0 or die $USAGE;
+
+    my @args = @ARGV;
+       @args = 1 .. $ARGV[0]
+            if $args == 1 && $ARGV[0] =~ /\A$RE{num}{int}\z/ && $ARGV[0] > 0;
+
+    my $L = SinglyLinkedList->new(@args);
+
+    $L->print('Input:  ');
+
+    reorder_list($L);
+
+    $L->print('Output: ');
+}
+
+#-------------------------------------------------------------------------------
+sub reorder_list
+#-------------------------------------------------------------------------------
+{
+    my ($list) = @_;
+
+    for (my $curr = $list->get_head;
+            $curr->{next} && $curr->{next}{next};
+            $curr = $curr->{next}{next})
+    {
+        $list->insert($curr, $list->remove_tail);
+    }
+}
+
+################################################################################
diff --git a/challenge-068/athanasius/raku/SinglyLinkedList.rakumod b/challenge-068/athanasius/raku/SinglyLinkedList.rakumod
new file mode 100644
index 0000000000..7169b2f4e4
--- /dev/null
+++ b/challenge-068/athanasius/raku/SinglyLinkedList.rakumod
@@ -0,0 +1,117 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 068
+=========================
+
+Task #2
+-------
+*Reorder List*
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+unit class SinglyLinkedList;
+#===============================================================================
+
+has $.head = Nil;
+
+#-------------------------------------------------------------------------------
+method append(Str:D $element)
+#-------------------------------------------------------------------------------
+{
+    my %node = datum => $element, next => Nil;
+
+    if $!head
+    {
+        my Hash $current = $!head;
+
+        $current = $current{'next'} while $current{'next'};
+
+        $current{'next'} = %node;
+    }
+    else
+    {
+        $!head = %node;
+    }
+}
+
+#-------------------------------------------------------------------------------
+method remove-tail(--> Hash:D)
+#-------------------------------------------------------------------------------
+{
+    my Hash $tail;
+    my Hash $current = $!head;
+
+    if $current
+    {
+        if $current{'next'}
+        {
+            $current = $current{'next'}
+                 while $current{'next'} && $current{'next'}{'next'};
+
+            $tail = $current{'next'};
+
+            $current{'next'} = Nil;
+        }
+        else
+        {
+            $tail  = $current;
+            $!head = Nil;
+        }
+    }
+
+    return $tail;
+}
+
+#-------------------------------------------------------------------------------
+method insert(Hash:D $current, Hash:D $node-to-add)
+#-------------------------------------------------------------------------------
+{
+    my $old-next;
+
+    if $!head && $current
+    {
+        $old-next        = $current{'next'};
+        $current{'next'} = $node-to-add;
+    }
+    else
+    {
+        $old-next        = $!head;
+        $!head           = $node-to-add;
+    }
+
+    $node-to-add{'next'} = $old-next;
+}
+
+#-------------------------------------------------------------------------------
+method print(Str:D $title)
+#-------------------------------------------------------------------------------
+{
+    $title.print if $title;
+
+    if $!head
+    {
+        my $current = $!head;
+
+        while $current
+        {
+            $current{'datum'}.print;
+            $current = $current{'next'};
+           ($current ?? ' -> ' !! "\n").print;
+        }
+    }
+    else
+    {
+        '<empty>'.put;
+    }
+}
+
+################################################################################
diff --git a/challenge-068/athanasius/raku/ch-1.raku b/challenge-068/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..a94386dc25
--- /dev/null
+++ b/challenge-068/athanasius/raku/ch-1.raku
@@ -0,0 +1,133 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 068
+=========================
+
+Task #1
+-------
+*Zero Matrix*
+
+*Submitted by:* Mohammad S Anwar
+
+You are given a matrix of size M x N having only 0s and 1s.
+
+Write a script to set the entire row and column to 0 if an element is 0.
+
+*Example 1*
+
+ Input: [1, 0, 1]
+        [1, 1, 1]
+        [1, 1, 1]
+
+ Output: [0, 0, 0]
+         [1, 0, 1]
+         [1, 0, 1]
+
+*Example 2*
+
+ Input: [1, 0, 1]
+        [1, 1, 1]
+        [1, 0, 1]
+
+ Output: [0, 0, 0]
+         [1, 0, 1]
+         [0, 0, 0]
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN
+(
+    UInt:D $M where { $M > 0 },          #= (UInt > 0) Matrix height (rows)
+    UInt:D $N where { $N > 0 },          #= (UInt > 0) Matrix width (cols)
+          *@input,                       #= ( [0|1]+ ) Matrix elements
+)
+#===============================================================================
+{
+    "Challenge 068, Task #1: Zero Matrix (Raku)\n".put;
+
+    @input.elems  == $M * $N or die $*USAGE;
+    $_ == 0 || $_ == 1       or die $*USAGE for @input;
+
+    my @matrix;
+
+    for 0 .. $M - 1 -> UInt $row
+    {
+        my UInt $start = $row   * $N;
+        my UInt $end   = $start + $N - 1;
+
+        @matrix.push: [ @input[ $start .. $end ] ];
+    }
+
+    print-matrix('Input',  $M, $N, @matrix);
+
+    zero-matrix($M, $N, @matrix);
+
+    ''.put;
+    print-matrix('Output', $M, $N, @matrix);
+}
+
+#-------------------------------------------------------------------------------
+sub print-matrix(Str:D $title, UInt:D $rows, UInt:D $cols, @matrix)
+#-------------------------------------------------------------------------------
+{
+    "%s:\n".printf: $title if $title;
+
+    for 0 .. $rows - 1 -> UInt $row
+    {
+        "[%s]\n".printf: @matrix[ $row; 0 .. $cols - 1 ].join: ', ';
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub zero-matrix(UInt:D $rows, UInt:D $cols, @matrix)
+#-------------------------------------------------------------------------------
+{
+    my (%zero-rows, %zero-cols);
+
+    for 0 .. $rows - 1 -> UInt $row
+    {
+        for 0 .. $cols - 1 -> UInt $col
+        {
+            if @matrix[$row; $col] == 0
+            {
+                ++%zero-rows{ $row };
+                ++%zero-cols{ $col };
+            }
+        }
+    }
+
+    for %zero-rows.keys.map: { .Int } -> UInt $row
+    {
+        @matrix[$row; $_] = 0 for 0 .. $cols - 1;
+    }
+
+    for %zero-cols.keys.map: { .Int } -> UInt $col
+    {
+        @matrix[$_; $col] = 0 for 0 .. $rows - 1;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+################################################################################
diff --git a/challenge-068/athanasius/raku/ch-2.raku b/challenge-068/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..ac5a1482ef
--- /dev/null
+++ b/challenge-068/athanasius/raku/ch-2.raku
@@ -0,0 +1,105 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 068
+=========================
+
+Task #2
+-------
+*Reorder List*
+
+*Submitted by:* Mohammad S Anwar
+
+You are given a singly linked list $L as below:
+
+ L0 →  L1 →  … →  Ln-1 →  Ln
+
+Write a script to reorder list as below:
+
+ L0 →  Ln →  L1 →  Ln-1 →  L2 →  Ln-2 → […]
+
+You are *ONLY* allowed to do this in-place without altering the nodes' values.
+
+*Example*
+
+ Input:  1 →  2 →  3 →  4
+ Output: 1 →  4 →  2 →  3
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use lib < . >;
+use SinglyLinkedList;
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+multi sub MAIN
+(
+    #| (UInt > 0) Num. of elements (with values 1, 2, 3, ...)
+    UInt:D $num-elements where { $num-elements > 0 }
+)
+#===============================================================================
+{
+    main(1 .. $num-elements);
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| (Str+) Explicit element values, in order
+    *@elements where { @elements.elems > 0 }
+)
+#===============================================================================
+{
+    main(@elements);
+}
+
+#-------------------------------------------------------------------------------
+sub main(*@elements)                #= List elements, in order
+#-------------------------------------------------------------------------------
+{
+    "Challenge 068, Task #2: Reorder List (Raku)\n".put;
+
+    my $L = SinglyLinkedList.new;
+
+    $L.append(.Str) for @elements;
+
+    $L.print('Input:  ');
+
+    reorder-list($L);
+
+    $L.print('Output: ');
+}
+
+#-------------------------------------------------------------------------------
+sub reorder-list(SinglyLinkedList:D $list)
+#-------------------------------------------------------------------------------
+{
+    loop (my Hash $current = $list.head;
+                  $current{'next'} && $current{'next'}{'next'};
+                  $current = $current{'next'}{'next'})
+    {
+        $list.insert($current, $list.remove-tail);
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+################################################################################