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

6 files changed, 865 insertions, 0 deletions

diff --git a/challenge-130/athanasius/perl/BinTree.pm b/challenge-130/athanasius/perl/BinTree.pm
new file mode 100644
index 0000000000..d7a12a1570
--- /dev/null
+++ b/challenge-130/athanasius/perl/BinTree.pm
@@ -0,0 +1,189 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 130, Task #2: Binary Search Tree
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+The BinTree class below is adapted from class BinaryTree used in the solution
+to Task #2 of the Perl Weekly Challenge 94.
+
+The implementation of method is_bst() and sub _isBST() is adapted from:
+
+    https://en.wikipedia.org/wiki/Binary_search_tree#Verification
+
+=cut
+#==============================================================================
+
+#==============================================================================
+package BinTreeNode;
+#==============================================================================
+
+#------------------------------------------------------------------------------
+sub new                                                           # Constructor
+#------------------------------------------------------------------------------
+{
+    my ($class, $value, $parent) = @_;
+
+    my  %self = ( value => $value, parent => $parent,
+                  left  => undef,  right  => undef );
+
+    return bless \%self, $class;
+}
+
+#------------------------------------------------------------------------------
+sub value                                                         # Getter only
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{value};
+}
+
+#------------------------------------------------------------------------------
+sub parent                                                      # Getter/setter
+#------------------------------------------------------------------------------
+{
+    my ($self, $new_parent) = @_;
+
+    if (defined $new_parent)
+    {
+        $self->{parent} = $new_parent;
+    }
+
+    return $self->{parent};
+}
+
+#------------------------------------------------------------------------------
+sub left                                                        # Getter/setter
+#------------------------------------------------------------------------------
+{
+    my ($self, $new_left) = @_;
+
+    if (defined $new_left)
+    {
+        $self->{left} = $new_left;
+    }
+
+    return $self->{left};
+}
+
+#------------------------------------------------------------------------------
+sub right                                                       # Getter/setter
+#------------------------------------------------------------------------------
+{
+    my ($self, $new_right) = @_;
+
+    if (defined $new_right)
+    {
+        $self->{right} = $new_right;
+    }
+
+    return $self->{right};
+}
+
+#==============================================================================
+package BinTree;
+#==============================================================================
+
+#------------------------------------------------------------------------------
+sub new                                                           # Constructor
+#------------------------------------------------------------------------------
+{
+    my ($class, $value) = @_;
+
+    my  %self = ( root => BinTreeNode->new( $value ) );
+
+    return bless \%self, $class;
+}
+
+#------------------------------------------------------------------------------
+sub root                                                          # Getter only
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return $self->{root};
+}
+
+#------------------------------------------------------------------------------
+sub append_node
+#------------------------------------------------------------------------------
+{
+    my ($self, $depth, $sequence, $value) = @_;
+
+    my  $parent = $self->root;
+    my  $m      = 2 ** $depth;
+    my  $seq    = $sequence;
+    my  $level  = $depth;
+
+    while ($level > 1)
+    {
+        $m /= 2;
+
+        if ($seq < $m)
+        {
+            defined   $parent->left  or return 0;
+            $parent = $parent->left;
+        }
+        else
+        {
+            defined   $parent->right or return 0;
+            $parent = $parent->right;
+            $seq   -= $m;
+        }
+
+        --$level;
+    }
+
+    my $new_node = BinTreeNode->new( $value, $parent );
+
+    if ($seq == 0)
+    {
+        $parent->left(  $new_node );
+    }
+    else
+    {
+        $parent->right( $new_node );
+    }
+
+    return 1;
+}
+
+use POSIX qw( INT_MIN INT_MAX );
+
+#------------------------------------------------------------------------------
+sub is_bst
+#------------------------------------------------------------------------------
+{
+    my ($self) = @_;
+
+    return _isBST( $self->root, INT_MIN, INT_MAX );
+}
+
+#------------------------------------------------------------------------------
+sub _isBST                                                       # Not a method
+#------------------------------------------------------------------------------
+{
+    my ($node, $min, $max) = @_;
+
+    return 1 if !defined $node;
+    return 0 if  $node->value < $min || $node->value > $max;
+
+    return _isBST( $node->left,  $min, $node->value - 1 ) &&
+           _isBST( $node->right, $node->value + 1, $max );
+}
+
+##############################################################################
+1;
+##############################################################################
diff --git a/challenge-130/athanasius/perl/ch-1.pl b/challenge-130/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..bd3861d204
--- /dev/null
+++ b/challenge-130/athanasius/perl/ch-1.pl
@@ -0,0 +1,116 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 130
+=========================
+
+TASK #1
+-------
+*Odd Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers, such that all the numbers appear
+even number of times except one number.
+
+Write a script to find that integer.
+
+Example 1
+
+ Input: @N = (2, 5, 4, 4, 5, 5, 2)
+ Output: 5 as it appears 3 times in the array where as all other numbers 2 and
+         4 appears exactly twice.
+
+Example 2
+
+ Input: @N = (1, 2, 3, 4, 3, 2, 1, 4, 4)
+ Output: 4
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<N> ...]
+
+    [<N> ...]    List of +ve ints: exactly 1 appears an odd number of times\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 130, Task #1: Odd Number (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @N = parse_command_line();
+
+    printf "Input:  \@N = (%s)\n", join ', ', @N;
+
+    my %dict;
+     ++$dict{ $_ } for @N;
+
+    my %odd;
+
+    while (my ($key, $value) = each %dict)
+    {
+        $odd{ $key } = $value if $value % 2 == 1;
+    }
+
+    my $count = scalar keys %odd;
+
+    if    ($count == 0)
+    {
+        error( 'No entries appear an odd number of times' );
+    }
+    elsif ($count == 1)
+    {
+         printf "Output: %s\n", (keys %odd)[ 0 ];
+    }
+    else
+    {
+        error( "$count entries appear an odd number of times" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x
+            or error( qq["$_" is not a valid integer] );
+
+        $_ >= 0
+            or error( qq["$_" is not a positive integer] );
+    }
+
+    return @ARGV;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "\nERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-130/athanasius/perl/ch-2.pl b/challenge-130/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..cc4d94d823
--- /dev/null
+++ b/challenge-130/athanasius/perl/ch-2.pl
@@ -0,0 +1,171 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 130
+=========================
+
+TASK #2
+-------
+*Binary Search Tree*
+
+Submitted by: Mohammad S Anwar
+
+You are given a tree.
+
+Write a script to find out if the given tree is Binary Search Tree (BST).
+
+According to [https://en.wikipedia.org/wiki/Binary_search_tree|wikipedia], the
+definition of BST:
+
+    A binary search tree is a rooted binary tree, whose internal nodes each
+    store a key (and optionally, an associated value), and each has two
+    distinguished sub-trees, commonly denoted left and right. The tree
+    additionally satisfies the binary search property: the key in each node is
+    greater than or equal to any key stored in the left sub-tree, and less than
+    or equal to any key stored in the right sub-tree. The leaves (final nodes)
+    of the tree contain no key and have no structure to distinguish them from
+    one another.
+
+Example 1
+
+ Input:
+         8
+        / \
+       5   9
+      / \
+     4   6
+
+ Output: 1 as the given tree is a BST.
+
+Example 2
+
+ Input:
+         5
+        / \
+       4   7
+      / \
+     3   6
+
+ Output: 0 as the given tree is a not BST.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+For simplicity, only integers are accepted as node values.
+
+Input is a single string representing the contents of a binary tree in level-
+order (i.e., with nodes specified as per a breadth-first traversal). Nodes are
+separated by the pipe character ("|"); empty nodes are indicated by adjacent
+separators.
+
+See the file BinTree.pm for implementation details.
+
+NOTE: Pretty-printing of the binary tree (as in the Examples) has not been
+      implemented.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use lib            qw( . );
+use BinTree;
+
+const my $USAGE =>
+qq[Usage:
+  perl $0 <tree>
+
+    <tree>    Level-order tree representation, e.g. "8|5|9|4|6"\n];
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 130, Task #2: Binary Search Tree (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 1
+            or error( "Expected 1 command line argument, found $args" );
+
+    printf "Input:  %s\n",   $ARGV[ 0 ];
+
+    my $btree  = build_tree( $ARGV[ 0 ] );
+    my $is_bst = $btree->is_bst;
+
+    printf "Output: %d as the given tree is %sa BST\n",
+        $is_bst ? 1 : 0, $is_bst ? '' : 'NOT ';
+}
+
+#------------------------------------------------------------------------------
+sub build_tree
+#------------------------------------------------------------------------------
+{
+    my ($tree_rep) = @_;
+
+    # The pipe character "|" is used as the node separator; if a pipe character
+    # is followed immediately by another pipe character, the node is empty:
+    # i.e., there is no node in this position within the tree. Trailing empty
+    # nodes may be omitted, so "a|b|c" is equivalent to "a|b|c|||||".
+
+    my   @nodes = split / \| /x, $tree_rep;
+    push @nodes, '' if scalar @nodes == 0;
+
+    for (@nodes)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+    }
+
+    my $btree = BinTree->new( shift @nodes );
+    my $depth =  1;
+    my $count =  1;
+    my $seq   = -1;
+
+    for my $node (@nodes)
+    {
+        if (++$count == 2 ** ($depth + 1))
+        {
+            ++$depth;
+            $seq = 0;
+        }
+        else
+        {
+            ++$seq;
+        }
+
+        if ($node ne '')
+        {
+            $btree->append_node( $depth, $seq, $node )
+                or die qq[ERROR: Node "$node" has no parent\n];
+        }
+    }
+
+    return $btree;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-130/athanasius/raku/BinTree.rakumod b/challenge-130/athanasius/raku/BinTree.rakumod
new file mode 100644
index 0000000000..32494825d8
--- /dev/null
+++ b/challenge-130/athanasius/raku/BinTree.rakumod
@@ -0,0 +1,121 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 130, Task #2: Binary Search Tree
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+The BinTree class below is adapted from class BinaryTree used in the solution
+to Task #2 of the Perl Weekly Challenge 94.
+
+The implementation of methods is-bst() and !isBST() is adapted from:
+
+    https://en.wikipedia.org/wiki/Binary_search_tree#Verification
+
+=end comment
+#==============================================================================
+
+#==============================================================================
+unit class BinTree;
+#==============================================================================
+
+#------------------------------------------------------------------------------
+my class Node
+#------------------------------------------------------------------------------
+{
+    has Int  $.value;
+    has Node $.parent is rw;
+    has Node $.left   is rw;
+    has Node $.right  is rw;
+}
+
+has Node $!root;
+
+#------------------------------------------------------------------------------
+submethod BUILD( Int:D :$value )
+#------------------------------------------------------------------------------
+{
+    $!root = Node.new( value => $value, parent => Nil,
+                       left  => Nil,    right  => Nil );
+}
+
+#------------------------------------------------------------------------------
+method append-node( UInt:D $depth, UInt:D $sequence, Int:D $value --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    my Node $parent = $!root;
+    my UInt $m      = 2 ** $depth;
+    my UInt $seq    = $sequence;
+    my UInt $level  = $depth;
+
+    while $level > 1
+    {
+        $m = ($m / 2).Int;
+
+        if $seq < $m
+        {
+            $parent.left.defined  or return False;
+            $parent = $parent.left;
+        }
+        else
+        {
+            $parent.right.defined or return False;
+            $parent = $parent.right;
+            $seq   -= $m;
+        }
+
+        --$level;
+    }
+
+    my Node $new-node = Node.new( value => $value, parent => $parent,
+                                  left  => Nil,    right  => Nil );
+
+    if $seq == 0
+    {
+        $parent.left  = $new-node;
+    }
+    else
+    {
+        $parent.right = $new-node;
+    }
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+method is-bst( --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    return self!isBST( $!root, -Inf, +Inf );
+}
+
+subset Int-or-Inf where Int:D | -Inf | +Inf;
+
+#------------------------------------------------------------------------------
+method !isBST
+(
+    Node         $node,
+    Int-or-Inf:D $min,
+    Int-or-Inf:D $max
+--> Bool:D
+)
+#------------------------------------------------------------------------------
+{
+    return True  if !$node.defined;
+    return False if  $node.value < $min || $node.value > $max;
+
+    return self!isBST( $node.left,  $min, $node.value - 1 ) &&
+           self!isBST( $node.right, $node.value + 1, $max );
+}
+
+##############################################################################
diff --git a/challenge-130/athanasius/raku/ch-1.raku b/challenge-130/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..87c22f3e1e
--- /dev/null
+++ b/challenge-130/athanasius/raku/ch-1.raku
@@ -0,0 +1,101 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 130
+=========================
+
+TASK #1
+-------
+*Odd Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers, such that all the numbers appear
+even number of times except one number.
+
+Write a script to find that integer.
+
+Example 1
+
+ Input: @N = (2, 5, 4, 4, 5, 5, 2)
+ Output: 5 as it appears 3 times in the array where as all other numbers 2 and
+         4 appears exactly twice.
+
+Example 2
+
+ Input: @N = (1, 2, 3, 4, 3, 2, 1, 4, 4)
+ Output: 4
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 130, Task #1: Odd Number (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    *@N where { .all ~~ UInt:D }    #= List of +ve ints: exactly one appears an
+                                    #= odd number of times
+)
+#==============================================================================
+{
+    "Input:  @N = (%s)\n".printf: @N.join: ', ';
+
+    my UInt %dict;
+          ++%dict{ $_ } for @N;
+
+    my UInt %odd = %dict<>:p.grep: { .value % 2 == 1 };
+
+    given %odd.elems
+    {
+        when 0
+        {
+            error( 'No entries appear an odd number of times' );
+        }
+
+        when 1
+        {
+            "Output: { %odd<>:k }".put;
+        }
+
+        default
+        {
+            error( %odd.elems ~ ' entries appear an odd number of times' );
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "\nERROR: $message".put;
+
+    USAGE();
+
+    exit;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-130/athanasius/raku/ch-2.raku b/challenge-130/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..caf110c93b
--- /dev/null
+++ b/challenge-130/athanasius/raku/ch-2.raku
@@ -0,0 +1,167 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 130
+=========================
+
+TASK #2
+-------
+*Binary Search Tree*
+
+Submitted by: Mohammad S Anwar
+
+You are given a tree.
+
+Write a script to find out if the given tree is Binary Search Tree (BST).
+
+According to [https://en.wikipedia.org/wiki/Binary_search_tree|wikipedia], the
+definition of BST:
+
+    A binary search tree is a rooted binary tree, whose internal nodes each
+    store a key (and optionally, an associated value), and each has two
+    distinguished sub-trees, commonly denoted left and right. The tree
+    additionally satisfies the binary search property: the key in each node is
+    greater than or equal to any key stored in the left sub-tree, and less than
+    or equal to any key stored in the right sub-tree. The leaves (final nodes)
+    of the tree contain no key and have no structure to distinguish them from
+    one another.
+
+Example 1
+
+ Input:
+         8
+        / \
+       5   9
+      / \
+     4   6
+
+ Output: 1 as the given tree is a BST.
+
+Example 2
+
+ Input:
+         5
+        / \
+       4   7
+      / \
+     3   6
+
+ Output: 0 as the given tree is a not BST.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+For simplicity, only integers are accepted as node values.
+
+Input is a single string representing the contents of a binary tree in level-
+order (i.e., with nodes specified as per a breadth-first traversal). Nodes are
+separated by the pipe character ("|"); empty nodes are indicated by adjacent
+separators.
+
+See the file BinTree.rakumod for implementation details.
+
+NOTE: Pretty-printing of the binary tree (as in the Examples) has not been
+      implemented.
+
+=end comment
+#==============================================================================
+
+use lib < . >;
+use BinTree;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 130, Task #2: Binary Search Tree (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D $tree            #= Level-order tree representation, e.g. "8|5|9|4|6"
+)
+#==============================================================================
+{
+    "Input:  $tree".put;
+
+    my BinTree $btree  = build-tree( $tree );
+    my Bool    $is-bst = $btree.is-bst;
+
+    "Output: %d as the given tree is %sa BST\n".printf:
+        $is-bst ?? 1 !! 0, $is-bst ?? '' !! 'NOT ';
+}
+
+#------------------------------------------------------------------------------
+sub build-tree( Str:D $tree-rep --> BinTree:D )
+#------------------------------------------------------------------------------
+{
+    # The pipe character "|" is used as the node separator; if a pipe character
+    # is followed immediately by another pipe character, the node is empty:
+    # i.e., there is no node in this position within the tree. Trailing empty
+    # nodes may be omitted, so "a|b|c" is equivalent to "a|b|c|||||".
+
+    my Str @s-nodes = $tree-rep.split: '|', :skip-empty;
+
+    for @s-nodes
+    {
+        val( $_ ).^name eq 'IntStr'
+            or do
+               {
+                   qq[ERROR: Node value "$_" is not an integer].put;
+                   exit;
+               }
+    }
+
+    my Int     @nodes = @s-nodes.map: { .Int };
+    my BinTree $btree = BinTree.new( value => @nodes.shift );
+    my UInt    $depth =  1;
+    my UInt    $count =  1;
+    my Int     $seq   = -1;
+
+    for @nodes -> Int $node
+    {
+        if ++$count == 2 ** ($depth + 1)
+        {
+            ++$depth;
+            $seq = 0;
+        }
+        else
+        {
+            ++$seq;
+        }
+
+        if $node ne ''
+        {
+            $btree.append-node( $depth, $seq, $node )
+                or do
+                   {
+                       qq[ERROR: Node "$node" has no parent].put;
+                       exit;
+                   };
+        }
+    }
+
+    return $btree;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################