Merge pull request #2433 from PerlMonk-Athanasius/branch-for-challenge-080

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

4 files changed, 512 insertions, 0 deletions

diff --git a/challenge-080/athanasius/perl/ch-1.pl b/challenge-080/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..29a478e2b6
--- /dev/null
+++ b/challenge-080/athanasius/perl/ch-1.pl
@@ -0,0 +1,79 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 080
+=========================
+
+Task #1
+-------
+*Smallest Positive Number Bits*
+
+Submitted by: Mohammad S Anwar
+
+You are given unsorted list of integers @N.
+
+Write a script to find out the smallest positive number missing.
+
+Example 1:
+
+ Input: @N = (5, 2, -2, 0)
+ Output: 1
+
+Example 2:
+
+ Input: @N = (1, 8, -1)
+ Output: 2
+
+Example 3:
+
+ Input: @N = (2, 0, -1)
+ Output: 1
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+                                       # Exports:
+use strict;
+use warnings;
+use Const::Fast;                       # const()
+use Regexp::Common qw( number );       # %RE{num}
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<N> ...]
+
+    [<N> ...]    An unsorted list of integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 080, Task #1: Smallest Positive Number Bits (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @N = @ARGV;
+    /\A$RE{num}{int}\z/ or die "ERROR: Non-integer '$_'\n$USAGE" for @N;
+
+    printf "Input: \@N = (%s)\n", join(', ', @N);
+
+    my %N;                                          # Make a dictionary of the
+     ++$N{ $_ } for @N;                             #   listed integers
+
+    my $num = 1;                                    # Find the lowest integer >
+     ++$num while exists $N{ $num };                #   0 not in the list
+
+    print "Output: $num\n";
+}
+
+###############################################################################
diff --git a/challenge-080/athanasius/perl/ch-2.pl b/challenge-080/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..5263a309d8
--- /dev/null
+++ b/challenge-080/athanasius/perl/ch-2.pl
@@ -0,0 +1,176 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 080
+=========================
+
+Task #2
+-------
+*Count Candies*
+
+Submitted by: Mohammad S Anwar
+
+You are given rankings of @N candidates.
+
+Write a script to find out the total candies needed for all candidates. You are
+asked to follow the rules below:
+
+a) You must given at least one candy to each candidate.
+b) Candidate with higher ranking get more candies than their immediate neigh-
+   bors on either side.
+
+Example 1:
+
+ Input: @N = (1, 2, 2)
+
+Explanation:
+
+ Applying rule #a, each candidate will get one candy. So total candies needed
+ so far 3. Now applying rule #b, the first candidate do not get any more candy
+ as its rank is lower than it's neighbours. The second candidate gets one more
+ candy as it's ranking is higher than it's neighbour. Finally the third candi-
+ date do not get any extra candy as it's ranking is not higher than neighbour.
+ Therefore total candies required is 4.
+
+ Output: 4
+
+Example 2:
+
+ Input: @N = (1, 4, 3, 2)
+
+Explanation:
+
+ Applying rule #a, each candidate will get one candy. So total candies needed
+ so far 4. Now applying rule #b, the first candidate do not get any more candy
+ as its rank is lower than it's neighbours. The second candidate gets two more
+ candies as it's ranking is higher than it's both neighbour. The third candi-
+ date gets one more candy as it's ranking is higher than it's neighbour. Final-
+ ly the fourth candidate do not get any extra candy as it's ranking is not
+ higher than neighbour. Therefore total candies required is 7.
+
+ Output: 7
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+                                       # Exports:
+use strict;
+use warnings;
+use Const::Fast;                       # const()
+use List::Util     qw( sum0 );
+use Regexp::Common qw( number );       # %RE{num}
+
+#------------------------------------------------------------------------------
+# Constants
+#------------------------------------------------------------------------------
+
+use constant
+{
+    CHECK_RULE_B      => 1,
+    SHOW_DISTRIBUTION => 1,
+};
+
+const my $USAGE =>
+"Usage:
+  perl $0 [<N> ...]
+
+    [<N> ...]    A list of candidate rankings (numeric)\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 080, Task #2: Count Candies (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @N = @ARGV;
+    /\A$RE{num}{real}\z/ or die "ERROR: Non-numeric '$_'\n$USAGE" for @N;
+
+    my @candies = (1) x scalar @N;                    # Apply Rule (a)
+
+    1 while distribute_candies(\@N, \@candies);       # Apply Rule (b) until it
+                                                      #   produces no changes
+    if (CHECK_RULE_B)
+    {
+        satisfies_b(\@N, \@candies)
+            or die 'ERROR: The solution breaks Rule (b), stopped';
+    }
+
+    printf "Input: \@N = (%s)\n", join ', ', @N;
+    printf "Candies:    (%s)\n",  join ', ', @candies if SHOW_DISTRIBUTION;
+
+    printf "Total candies needed: %d\n", sum0 @candies;
+}
+
+#------------------------------------------------------------------------------
+sub distribute_candies
+#------------------------------------------------------------------------------
+{
+    my ($N, $C)  = @_;
+    my  $changed = 0;
+
+    for my $i (0 .. $#$N - 1)                    # (1) Distribute left-to-right
+    {
+        my $j = $i + 1;
+
+        if ($N->[$i] > $N->[$j] && $C->[$i] <= $C->[$j])
+        {
+            $C->[$i] = $C->[$j] + 1;
+            $changed = 1;
+        }
+    }
+
+    for my $i (reverse 1 .. $#$N)                # (2) Distribute right-to-left
+    {
+        my $j = $i - 1;
+
+        if ($N->[$i] > $N->[$j] && $C->[$i] <= $C->[$j])
+        {
+            $C->[$i] = $C->[$j] + 1;
+            $changed = 1;
+        }
+    }
+
+    return $changed;
+}
+
+if (CHECK_RULE_B)
+{
+    #--------------------------------------------------------------------------
+    sub satisfies_b
+    #--------------------------------------------------------------------------
+    {
+        my ($N, $C) = @_;
+
+        for my $i (0 .. $#$N - 1)            # (1) Check Rule (b) left-to-right
+        {
+            if ($N->[$i] > $N->[$i + 1])
+            {
+                $C->[$i] > $C->[$i + 1] or return 0;
+            }
+        }
+
+        for my $i (reverse 1 .. $#$N)        # (2) Check Rule (b) right-to-left
+        {
+            if ($N->[$i] > $N->[$i - 1])
+            {
+                $C->[$i] > $C->[$i - 1] or return 0;
+            }
+        }
+
+        return 1;
+    }
+}
+
+###############################################################################
diff --git a/challenge-080/athanasius/raku/ch-1.raku b/challenge-080/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..30a48a1d32
--- /dev/null
+++ b/challenge-080/athanasius/raku/ch-1.raku
@@ -0,0 +1,76 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 080
+=========================
+
+Task #1
+-------
+*Smallest Positive Number Bits*
+
+Submitted by: Mohammad S Anwar
+
+You are given unsorted list of integers @N.
+
+Write a script to find out the smallest positive number missing.
+
+Example 1:
+
+ Input: @N = (5, 2, -2, 0)
+ Output: 1
+
+Example 2:
+
+ Input: @N = (1, 8, -1)
+ Output: 2
+
+Example 3:
+
+ Input: @N = (2, 0, -1)
+ Output: 1
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 080, Task #1: Smallest Positive Number Bits (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    *@N where { .all ~~ Int:D }                 #= An unsorted list of integers
+)
+##=============================================================================
+{
+    "Input: @N = (%s)\n".printf: @N.join: ', ';
+
+    my Set[Int] $N = Set[Int].new: @N.map: { .Int };    # Make a dictionary of
+                                                        #   the listed integers
+
+    my UInt $num = 1;                                   # Find the lowest int >
+          ++$num while $num ∈ $N;                       #   0 not in the list
+
+    "Output: $num".put;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-080/athanasius/raku/ch-2.raku b/challenge-080/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..ba539ac1ac
--- /dev/null
+++ b/challenge-080/athanasius/raku/ch-2.raku
@@ -0,0 +1,181 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 080
+=========================
+
+Task #2
+-------
+*Count Candies*
+
+Submitted by: Mohammad S Anwar
+
+You are given rankings of @N candidates.
+
+Write a script to find out the total candies needed for all candidates. You are
+asked to follow the rules below:
+
+a) You must given at least one candy to each candidate.
+b) Candidate with higher ranking get more candies than their immediate neigh-
+   bors on either side.
+
+Example 1:
+
+ Input: @N = (1, 2, 2)
+
+Explanation:
+
+ Applying rule #a, each candidate will get one candy. So total candies needed
+ so far 3. Now applying rule #b, the first candidate do not get any more candy
+ as its rank is lower than it's neighbours. The second candidate gets one more
+ candy as it's ranking is higher than it's neighbour. Finally the third candi-
+ date do not get any extra candy as it's ranking is not higher than neighbour.
+ Therefore total candies required is 4.
+
+ Output: 4
+
+Example 2:
+
+ Input: @N = (1, 4, 3, 2)
+
+Explanation:
+
+ Applying rule #a, each candidate will get one candy. So total candies needed
+ so far 4. Now applying rule #b, the first candidate do not get any more candy
+ as its rank is lower than it's neighbours. The second candidate gets two more
+ candies as it's ranking is higher than it's both neighbour. The third candi-
+ date gets one more candy as it's ranking is higher than it's neighbour. Final-
+ ly the fourth candidate do not get any extra candy as it's ranking is not
+ higher than neighbour. Therefore total candies required is 7.
+
+ Output: 7
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+my Bool constant $CHECK-RULE-B      = True;
+my Bool constant $SHOW-DISTRIBUTION = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 080, Task #2: Count Candies (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    *@N               #= A list of candidate rankings (numeric)
+)
+##=============================================================================
+{
+    my Num  @rankings;
+            @rankings.push: .Num for @N;
+
+    my UInt @candies = 1 xx @rankings.elems;                   # Apply Rule (a)
+
+    Nil while distribute-candies(@rankings, @candies);         # Apply Rule (b)
+
+    if $CHECK-RULE-B
+    {
+        satisfies-b(@rankings, @candies) or
+            die 'ERROR: The solution breaks Rule (b)';
+    }
+
+    "Input: @N = (%s)\n".printf: @rankings.join: ', ';
+    "Candies:    (%s)\n".printf: @candies\.join: ', ' if $SHOW-DISTRIBUTION;
+
+    "Total candies needed: %d\n".printf: @candies.sum;
+
+    CATCH
+    {
+        when X::TypeCheck::Assignment
+        {
+            'Non-numeric input'.put;
+            USAGE();
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub distribute-candies
+(
+    Array:D[Num:D] $N,               #= Candidate rankings
+    Array:D[Num:D] $C,               #= Candy distribution
+--> Bool:D                           #= The candy distribution has been changed
+)
+#------------------------------------------------------------------------------
+{
+    my Bool $changed = False;
+
+    for 0 .. $N.end - 1 -> UInt $i                # 1. Distribute left-to-right
+    {
+        my UInt $j = $i + 1;
+
+        if $N[$i] > $N[$j] && $C[$i] <= $C[$j]
+        {
+            $C[$i]   = $C[$j] + 1;
+            $changed = True;
+        }
+    }
+
+    for (1 .. $N.end).reverse -> UInt $i          # 2. Distribute right-to-left
+    {
+        my UInt $j = $i - 1;
+
+        if $N[$i] > $N[$j] && $C[$i] <= $C[$j]
+        {
+            $C[$i]   = $C[$j] + 1;
+            $changed = True;
+        }
+    }
+
+    return $changed;
+}
+
+#------------------------------------------------------------------------------
+sub satisfies-b
+(
+    Array:D[Num:D] $N,             #= Candidate rankings
+    Array:D[Num:D] $C,             #= Candy distribution
+--> Bool:D                         #= The candy distribution satisfies Rule (b)
+)
+#------------------------------------------------------------------------------
+{
+    for 0 .. $N.end - 1 -> UInt $i            # 1. Check Rule (b) left-to-right
+    {
+        if  $N[$i] > $N[$i + 1]
+        {
+            $C[$i] > $C[$i + 1] or return False;
+        }
+    }
+
+    for (1 .. $N.end).reverse -> UInt $i      # 2. Check Rule (b) right-to-left
+    {
+        if  $N[$i] > $N[$i - 1]
+        {
+            $C[$i] > $C[$i - 1] or return False;
+        }
+    }
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################