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

4 files changed, 536 insertions, 0 deletions

diff --git a/challenge-119/athanasius/perl/ch-1.pl b/challenge-119/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..cb48d1cadc
--- /dev/null
+++ b/challenge-119/athanasius/perl/ch-1.pl
@@ -0,0 +1,140 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 119
+=========================
+
+TASK #1
+-------
+*Swap Nibbles*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer $N.
+
+Write a script to swap the two nibbles of the binary representation of the
+given number and print the decimal number of the new binary representation.
+
+    A nibble is a four-bit aggregation, or half an octet.
+
+To keep the task simple, we only allow integer less than or equal to 255.
+
+Example
+
+ Input: $N = 101
+ Output: 86
+
+ Binary representation of decimal 101 is 1100101 or as 2 nibbles (0110)(0101).
+ The swapped nibbles would be (0101)(0110) same as decimal 86.
+
+ Input: $N = 18
+ Output: 33
+
+ Binary representation of decimal 18 is 10010 or as 2 nibbles (0001)(0010).
+ The swapped nibbles would be (0010)(0001) same as decimal 33.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Usage
+-----
+If the constant $SHOW_BITS is set to a true value, the output will include
+binary representations of the nibbles in $N and its nibble-swapped counterpart.
+For example:
+
+  Input: $N = 101 (0110)(0101)
+  Output:      86 (0101)(0110)
+
+Otherwise, only the decimal values will be shown:
+
+  Input: $N = 101
+  Output:      86
+
+Algorithm
+---------
+1. Convert decimal $N to its 8-bit binary representation using sprintf '%08b'
+2. Extract the 2 nibbles with a regular expression
+3. Form $S_bin, the binary representation of the solution, by concatenating the
+   nibbles in reverse order
+4. Find the decimal equivalent of $S_bin by using oct with an argument formed
+   by prefixing '0b' to $S_bin (this indicates to the built-in oct function
+   that its argument is a binary number)
+5. Output the solution (with suitable vertical alignment for ease of viewing)
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $SHOW_BITS => 1;
+const my $USAGE     =>
+"Usage:
+  perl $0 <N>
+
+    <N>    A positive integer not greater than 255\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 119, Task #1: Swap Nibbles (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N_dec = parse_command_line();                            # Decimal
+    my $N_bin = sprintf '%08b', $N_dec;                          # Binary
+    my @nibs  = $N_bin =~ / (\d{4}) (\d{4}) /x;                  # Nibbles
+    my $S_bin = $nibs[ 1 ] . $nibs[ 0 ];                         # S for "swap"
+    my $S_dec = oct "0b$S_bin";
+    my $len_N = length $N_dec;
+    my $len_S = length $S_dec;
+    my $width = $len_N >= $len_S ? $len_N : $len_S;
+
+    printf "Input: \$N = %*d%s\nOutput:     %*d%s\n",
+            $width, $N_dec, $SHOW_BITS ? " ($nibs[ 0 ])($nibs[ 1 ])" : '',
+            $width, $S_dec, $SHOW_BITS ? " ($nibs[ 1 ])($nibs[ 0 ])" : '';
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $N =  $ARGV[ 0 ];
+       $N =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$N" is not a valid integer] );
+       $N +=   0;                                 # Normalize: e.g., 010 --> 10
+       $N >=   0  or error( "$N is less than 0" );
+       $N <= 255  or error( "$N is greater than 255" );
+
+    return $N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-119/athanasius/perl/ch-2.pl b/challenge-119/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..02f6cdf522
--- /dev/null
+++ b/challenge-119/athanasius/perl/ch-2.pl
@@ -0,0 +1,152 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 119
+=========================
+
+TASK #2
+-------
+*Sequence without 1-on-1*
+
+Submitted by: Cheok-Yin Fung
+
+Write a script to generate sequence starting at 1. Consider the increasing
+sequence of integers which contain only 1’s, 2’s and 3’s, and do not have any
+doublets of 1’s like below. Please accept a positive integer $N and print the
+$Nth term in the generated sequence.
+
+    1, 2, 3, 12, 13, 21, 22, 23, 31, 32, 33, 121, 122, 123, 131, …
+
+Example
+
+ Input: $N = 5
+ Output: 13
+
+ Input: $N = 10
+ Output: 32
+
+ Input: $N = 60
+ Output: 2223
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+1. Generate the series *with* doublets of '1' digits by:
+   (a) Producing each successive term by incrementing the previous term by 1.
+   (b) Converting any '4' digit that results to a 1 with a left-carry. This
+       conversion continues from least- to most-significant digit until all of
+       the '4' digits have been eliminated.
+2. Filter out any term that contains adjacent 1 digits.
+3. Continue until the number of terms generated equals $N. The final term to be
+   generated is the solution.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 <N>
+
+    <N>    A positive integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 119, Task #2: Sequence without 1-on-1 (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N = parse_command_line();
+
+    print "Input:  \$N = $N\n";
+
+    my $term = generate_series( $N );
+
+    print "Output: $term\n";
+}
+
+#------------------------------------------------------------------------------
+sub generate_series
+#------------------------------------------------------------------------------
+{
+    my ($N)    = @_;
+    my  $term  = 1;
+    my  $terms = 1;
+
+    while ($terms < $N)           # Continue until $N terms have been generated
+    {
+        if (++$term =~ /4/)       # Handle overflow: 4 -> (+1)1
+        {
+            my @digits = split //, $term;
+
+            for my $i (reverse( 1 .. $#digits ))
+            {
+                if ($digits[ $i ] == 4)
+                {
+                    $digits[ $i     ] = 1;
+                  ++$digits[ $i - 1 ];
+                }
+            }
+
+            if ($digits[ 0 ] ==  4)
+            {
+                $digits[ 0 ]  =  1;
+                unshift @digits, 1;
+            }
+
+            $term = join '', @digits;
+        }
+
+        ++$terms unless $term =~ /11/;       # Filter out terms containing '11'
+    }
+
+    return $term;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $N =  $ARGV[ 0 ];
+       $N =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$N" is not a valid integer] );
+       $N += 0;                                   # Normalize: e.g., 010 --> 10
+       $N >  0    or error( "$N is not greater than 0" );
+
+    return $N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-119/athanasius/raku/ch-1.raku b/challenge-119/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..76e968e4bb
--- /dev/null
+++ b/challenge-119/athanasius/raku/ch-1.raku
@@ -0,0 +1,117 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 119
+=========================
+
+TASK #1
+-------
+*Swap Nibbles*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer $N.
+
+Write a script to swap the two nibbles of the binary representation of the
+given number and print the decimal number of the new binary representation.
+
+    A nibble is a four-bit aggregation, or half an octet.
+
+To keep the task simple, we only allow integer less than or equal to 255.
+
+Example
+
+ Input: $N = 101
+ Output: 86
+
+ Binary representation of decimal 101 is 1100101 or as 2 nibbles (0110)(0101).
+ The swapped nibbles would be (0101)(0110) same as decimal 86.
+
+ Input: $N = 18
+ Output: 33
+
+ Binary representation of decimal 18 is 10010 or as 2 nibbles (0001)(0010).
+ The swapped nibbles would be (0010)(0001) same as decimal 33.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Usage
+-----
+If the constant $SHOW-BITS is set to True, the output will include binary
+representations of the nibbles in $N and its nibble-swapped counterpart. For
+example:
+
+  Input: $N = 101 (0110)(0101)
+  Output:      86 (0101)(0110)
+
+Otherwise, only the decimal values will be shown:
+
+  Input: $N = 101
+  Output:      86
+
+Algorithm
+---------
+1. Convert decimal $N to its 8-bit binary representation using sprintf '%08b'
+2. Extract the 2 nibbles with a regular expression
+3. Form $S-bin, the binary representation of the solution, by concatenating the
+   nibbles in reverse order
+4. Find the decimal equivalent of $S-bin using the adverbial form :2( $S-bin )
+   which interprets $S-bin as a binary (base 2) number representation
+5. Output the solution (with suitable vertical alignment for ease of viewing)
+
+=end comment
+#==============================================================================
+
+my Bool constant $SHOW-BITS = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 119, Task #1: Swap Nibbles (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $N where { $N <= 255 }    #= A positive integer not greater than 255
+)
+#==============================================================================
+{
+    my UInt $N-dec =  $N + 0;        # Normalize: e.g., 010 --> 10, 0x10 --> 16
+    my Str  $N-bin = '%08b'.sprintf: $N-dec;                  # Binary
+            $N-bin ~~ rx/ (\d ** 4) (\d ** 4) /;              # Extract nibbles
+    my Str  @nibs  =  @$/.map: { .Str };
+    my Str  $S-bin =  @nibs[ 1 ] ~ @nibs[ 0 ];                # S for "swap"
+    my UInt $S-dec =  :2( $S-bin );
+    my UInt $len-N =  $N-dec.chars;
+    my UInt $len-S =  $S-dec.chars;
+    my UInt $width =  $len-N >= $len-S ?? $len-N !! $len-S;
+
+    "Input: \$N = %*d%s\nOutput:     %*d%s\n".printf:
+        $width, $N-dec, $SHOW-BITS ?? " (@nibs[ 0 ])(@nibs[ 1 ])" !! '',
+        $width, $S-dec, $SHOW-BITS ?? " (@nibs[ 1 ])(@nibs[ 0 ])" !! '';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-119/athanasius/raku/ch-2.raku b/challenge-119/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..a015bc411a
--- /dev/null
+++ b/challenge-119/athanasius/raku/ch-2.raku
@@ -0,0 +1,127 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 119
+=========================
+
+TASK #2
+-------
+*Sequence without 1-on-1*
+
+Submitted by: Cheok-Yin Fung
+
+Write a script to generate sequence starting at 1. Consider the increasing
+sequence of integers which contain only 1’s, 2’s and 3’s, and do not have any
+doublets of 1’s like below. Please accept a positive integer $N and print the
+$Nth term in the generated sequence.
+
+    1, 2, 3, 12, 13, 21, 22, 23, 31, 32, 33, 121, 122, 123, 131, …
+
+Example
+
+ Input: $N = 5
+ Output: 13
+
+ Input: $N = 10
+ Output: 32
+
+ Input: $N = 60
+ Output: 2223
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+1. Generate the series *with* doublets of '1' digits by:
+   (a) Producing each successive term by incrementing the previous term by 1.
+   (b) Converting any '4' digit that results to a 1 with a left-carry. This
+       conversion continues from least- to most-significant digit until all of
+       the '4' digits have been eliminated.
+2. Filter out any term that contains adjacent 1 digits.
+3. Continue until the number of terms generated equals $N. The final term to be
+   generated is the solution.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 119, Task #2: Sequence without 1-on-1 (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $N where { $N > 0 }                            #= A positive integer
+)
+#==============================================================================
+{
+    my UInt $n = $N + 0;             # Normalize: e.g., 010 --> 10, 0x10 --> 16
+
+    "Input:  \$N = $n".put;
+
+    my UInt $term = generate-series( $N );
+
+    "Output: $term".put;
+}
+
+#------------------------------------------------------------------------------
+sub generate-series( UInt:D $N where { $N > 0 } --> UInt:D )
+#------------------------------------------------------------------------------
+{
+    my UInt $term  = 1;
+    my UInt $terms = 1;
+
+    while $terms < $N             # Continue until $N terms have been generated
+    {
+        if ++$term ~~ /4/         # Handle overflow: 4 -> (+1)1
+        {
+            my UInt @digits = $term.split( '', :skip-empty ).map: { .Int };
+
+            for (1 .. @digits.end).reverse -> UInt $i
+            {
+                if @digits[ $i ] == 4
+                {
+                    @digits[ $i     ] = 1;
+                  ++@digits[ $i - 1 ];
+                }
+            }
+
+            if  @digits[ 0 ] ==  4
+            {
+                @digits[ 0 ]  =  1;
+                @digits.unshift: 1;
+            }
+
+            $term = @digits.join.Int;
+        }
+
+        ++$terms unless $term ~~ /11/;       # Filter out terms containing '11'
+    }
+
+    return $term;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################