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

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

4 files changed, 683 insertions, 0 deletions

diff --git a/challenge-114/athanasius/perl/ch-1.pl b/challenge-114/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..68bad0f472
--- /dev/null
+++ b/challenge-114/athanasius/perl/ch-1.pl
@@ -0,0 +1,160 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 114
+=========================
+
+TASK #1
+-------
+*Next Palindrome Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer $N.
+
+Write a script to find out the next Palindrome Number higher than the given
+integer $N.
+
+Example
+
+ Input: $N = 1234
+ Output: 1331
+
+ Input: $N = 999
+ Output: 1001
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+
+Let N have digits abc...klm[n]opq...xyz, where m is the middle digit (if N has
+an odd number of digits), or the first of 2 middle digits mn (if N has an even
+number of digits).
+
+First, we form the palindromic number S:
+
+    S = abc...klm[m]lk...cba
+
+by reversing the first (i.e., left, or most significant) half of N's digits. If
+S > N, it must be the solution since it has been constructed as the smallest
+palindromic number > N.
+
+If S <= N, it will be necessary to increment one of the digits abc...klm. To
+form the smallest number, we begin with the the least significant digit, namely
+m. If m < 9, M = m + 1 is guaranteed to produce a palindromic number T greater
+than N but smaller than any other palindromic number greater than N:
+
+    T = abc...klM[M]lk...cba
+
+If m = 9, we set m = 0 and increment l (L = l + 1) to form U:
+
+    U = abc...kL0[0]Lk...cba
+
+But if L is also 9, we increment k; and so on down to c, b, a. Finally, if a
+solution has still not been found and a is also 9, we need to construct a new
+palindromic number V with one more digit than N. The smallest such palindromic
+number has the form:
+
+    V = 1000...0001
+
+with the first and last digits set to 1 and all other digits set to 0.
+
+=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 114, Task #1: Next Palindrome Number (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N        = parse_command_line();
+
+    print "Input: \$N = $N\n";
+
+    my @digits   = split //, $N;
+    my $num_digs = scalar @digits;
+    my $is_even  = $num_digs % 2 == 0;
+    my $mid_i    = int( ($num_digs / 2) + ($is_even ? -0.5 : 0) );
+    my $mid_j    = $is_even ? $mid_i : $mid_i - 1;
+    my @mirror   = ( @digits[ 0 .. $mid_i ], reverse @digits[ 0 .. $mid_j ] );
+    my $solution = join '', @mirror;
+
+    if ($solution <= $N)
+    {
+        for my $i (reverse 0 .. $mid_i)
+        {
+            my $j = $#digits - $i;
+
+            if (++$mirror[ $i ] > 9)
+            {
+                $mirror[ $i ] = $mirror[ $j ] = 0;
+            }
+            else
+            {
+                $mirror[ $j ] = $mirror[ $i ];
+                last;
+            }
+        }
+
+        $solution = ($mirror[ 0 ] == 0) ? '1' . '0' x ($num_digs - 1) . '1'
+                                        :  join '', @mirror;
+    }
+
+    print "Output:     $solution\n";
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $N = $ARGV[0] + 0;                     # Normalize (e.g. 010 becomes 10)
+
+    $N =~ / ^ $RE{num}{int} $ /x
+                  or error( qq["$N" is not an integer] );
+    $N >= 0       or error( qq["$N" is not positive] );
+
+    return $N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-114/athanasius/perl/ch-2.pl b/challenge-114/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..553322638c
--- /dev/null
+++ b/challenge-114/athanasius/perl/ch-2.pl
@@ -0,0 +1,201 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 114
+=========================
+
+TASK #2
+-------
+*Higher Integer Set Bits*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer $N.
+
+Write a script to find the next higher integer having the same number of 1 bits
+in binary representation as $N.
+
+Example
+
+ Input: $N = 3
+ Output: 5
+
+ Binary representation of $N is 011. There are two 1 bits. So the next higher
+ integer is 5 having the same the number of 1 bits i.e. 101.
+
+ Input: $N = 12
+ Output: 17
+
+ Binary representation of $N is 1100. There are two 1 bits. So the next higher
+ integer is 17 having the same number of 1 bits i.e. 10001.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Output
+------
+With DEBUG set to True, the output includes the binary forms of N and the
+solution S, together with a count of their 1-bits. If this extra information is
+not wanted, set DEBUG to False and the output will show N and S only.
+
+Algorithm
+---------
+0. Input N
+1. Convert N to its binary form, N_bin
+     Let d be the number of   digits in N_bin
+     Let n be the number of 1-digits in N_bin
+2. IF
+     Any 0-digit (in position z within N_bin) lies between 1-digits,
+   THEN
+     S_bin is constructed as follows:
+       2.1 the digits above z in N_bin remain unchanged
+       2.2 the digit at z becomes 1
+       2.3 the remaining complement (n - 2) of 1-digits occupy the least
+           significant places in S_bin
+       2.4 any remaining digits between z and the group of least significant
+           1-digits are set to zero, bringing S_bin up to a total of d digits
+3. ELSE
+     S_bin is constructed as follows:
+       3.1 an initial 1-digit
+       3.2 the remaining complement (n - 1) of 1-digits in the least
+           significant places
+       3.3 0-digits for padding, bringing S_bin up to a total of (d + 1) digits
+   ENDIF
+4. Convert S_bin to its decimal form, S
+5. Output S
+
+(Note that a brute force approach -- set S to N + 1 and continue to increment S
+until the number of 1-digits in S_bin equals d -- works well for smaller values
+of N and for certain larger values, but becomes unacceptably slow for large
+values of N where N is a power of 2.)
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+use constant DEBUG => 1;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <N>
+
+    <N>    A non-zero, positive integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 114, Task #2: Higher Integer Set Bits (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N      = parse_command_line();
+
+    print "Input: \$N = $N\n" unless DEBUG;
+
+    my $N_bin  = sprintf '%b', $N;
+    my $N_ones = $N_bin =~ tr/1//;
+    my $S_bin  = solve( $N, $N_bin, $N_ones );
+    my $S      = oct( '0b' . $S_bin );
+
+    if (DEBUG)
+    {
+        printf "Input: \$N = %*d (%d one-bit%s: %*b)\n",
+                length( $S ), $N, $N_ones, ($N_ones == 1 ? '' : 's'),
+                length( $S_bin ), $N;
+
+        my $S_bits = $S_bin =~ tr/1//;
+
+        printf "Output:     %d (%d one-bit%s: %s)\n",
+                $S, $S_bits, ($S_bits == 1 ? '' : 's'), $S_bin;
+    }
+    else
+    {
+        print  "Output:     $S\n";
+    }
+}
+
+#------------------------------------------------------------------------------
+sub solve
+#------------------------------------------------------------------------------
+{
+    my ($N, $N_bin, $N_ones) = @_;
+    my  @N_digits = split //, $N_bin;
+    my  $found_1  =  0;
+    my  $S_bin    = '1';
+    my  $zero_i;
+
+    for my $i (reverse 1 .. $#N_digits)
+    {
+        if ($found_1)
+        {
+            $zero_i  = $i, last if $N_digits[ $i ] == 0;
+        }
+        else
+        {
+            $found_1 = 1        if $N_digits[ $i ] == 1;
+        }
+    }
+
+    if (defined $zero_i)
+    {
+        $S_bin .= substr $N_bin, 1, $zero_i - 1;
+        $S_bin .= '1';
+
+        my $ones_diff = $N_ones - $S_bin =~ tr/1//;
+
+        $S_bin .= '0' x (length( $N_bin ) - length( $S_bin ) - $ones_diff);
+        $S_bin .= '1' x  $ones_diff;
+    }
+    else
+    {
+        $S_bin .= '0' x (length( $N_bin ) - $N_ones + 1);
+        $S_bin .= '1' x ($N_ones - 1);
+    }
+
+    return $S_bin;
+}
+
+#------------------------------------------------------------------------------
+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 or error( qq["$N" is not greater than zero] );
+
+    return $N + 0;                                                  # Normalize
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-114/athanasius/raku/ch-1.raku b/challenge-114/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..498095a1f8
--- /dev/null
+++ b/challenge-114/athanasius/raku/ch-1.raku
@@ -0,0 +1,139 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 114
+=========================
+
+TASK #1
+-------
+*Next Palindrome Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer $N.
+
+Write a script to find out the next Palindrome Number higher than the given
+integer $N.
+
+Example
+
+ Input: $N = 1234
+ Output: 1331
+
+ Input: $N = 999
+ Output: 1001
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+
+Let N have digits abc...klm[n]opq...xyz, where m is the middle digit (if N has
+an odd number of digits), or the first of 2 middle digits mn (if N has an even
+number of digits).
+
+First, we form the palindromic number S:
+
+    S = abc...klm[m]lk...cba
+
+by reversing the first (i.e., left, or most significant) half of N's digits. If
+S > N, it must be the solution since it has been constructed as the smallest
+palindromic number > N.
+
+If S <= N, it will be necessary to increment one of the digits abc...klm. To
+form the smallest number, we begin with the the least significant digit, namely
+m. If m < 9, M = m + 1 is guaranteed to produce a palindromic number T greater
+than N but smaller than any other palindromic number greater than N:
+
+    T = abc...klM[M]lk...cba
+
+If m = 9, we set m = 0 and increment l (L = l + 1) to form U:
+
+    U = abc...kL0[0]Lk...cba
+
+But if L is also 9, we increment k; and so on down to c, b, a. Finally, if a
+solution has still not been found and a is also 9, we need to construct a new
+palindromic number V with one more digit than N. The smallest such palindromic
+number has the form:
+
+    V = 1000...0001
+
+with the first and last digits set to 1 and all other digits set to 0.
+
+=end comment
+#==============================================================================
+
+subset Digit of Int where 0 <= * <= 9;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 114, Task #1: Next Palindrome Number (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $N                      #= A positive integer
+)
+#==============================================================================
+{
+    my UInt  $n        = $N + 0;              # Normalize (e.g. 010 becomes 10)
+
+    "Input: \$N = $n".put;
+
+    my Digit @digits   = $n.split( '', :skip-empty ).map: { .Int };
+    my UInt  $num-digs = @digits.elems;
+    my Bool  $is-even  = $num-digs % 2 == 0;
+    my UInt  $mid-i    = floor( ($num-digs / 2) + ($is-even ?? -0.5 !! 0) );
+    my Int   $mid-j    = $is-even ?? $mid-i !! $mid-i - 1;
+    my Digit @mirror   = @digits[ 0 .. $mid-i ];
+         @mirror.append: @digits[ 0 .. $mid-j ].reverse;
+    my UInt  $solution = @mirror.join( '' ).Int;
+
+    if $solution <= $N
+    {
+        for (0 .. $mid-i).reverse -> UInt $i
+        {
+            my UInt $j = @digits.end - $i;
+
+            if  @mirror[ $i ] == 9
+            {
+                @mirror[ $i ] =   @mirror[ $j ] = 0;
+            }
+            else
+            {
+                @mirror[ $j ] = ++@mirror[ $i ];
+                last;
+            }
+        }
+
+        $solution = (@mirror[ 0 ] == 0 ?? '1' ~ '0' x ($num-digs - 1) ~ '1'
+                                       !!  @mirror.join: '').Int;
+    }
+
+    "Output:     $solution".put;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-114/athanasius/raku/ch-2.raku b/challenge-114/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..52f359f783
--- /dev/null
+++ b/challenge-114/athanasius/raku/ch-2.raku
@@ -0,0 +1,183 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 114
+=========================
+
+TASK #2
+-------
+*Higher Integer Set Bits*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer $N.
+
+Write a script to find the next higher integer having the same number of 1 bits
+in binary representation as $N.
+
+Example
+
+ Input: $N = 3
+ Output: 5
+
+ Binary representation of $N is 011. There are two 1 bits. So the next higher
+ integer is 5 having the same the number of 1 bits i.e. 101.
+
+ Input: $N = 12
+ Output: 17
+
+ Binary representation of $N is 1100. There are two 1 bits. So the next higher
+ integer is 17 having the same number of 1 bits i.e. 10001.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Output
+------
+With DEBUG set to True, the output includes the binary forms of N and the
+solution S, together with a count of their 1-bits. If this extra information is
+not wanted, set DEBUG to False and the output will show N and S only.
+
+Algorithm
+---------
+0. Input N
+1. Convert N to its binary form, N-bin
+     Let d be the number of   digits in N-bin
+     Let n be the number of 1-digits in N-bin
+2. IF
+     Any 0-digit (in position z within N-bin) lies between 1-digits,
+   THEN
+     S-bin is constructed as follows:
+       2.1 the digits above z in N-bin remain unchanged
+       2.2 the digit at z becomes 1
+       2.3 the remaining complement (n - 2) of 1-digits occupy the least
+           significant places in S-bin
+       2.4 any remaining digits between z and the group of least significant
+           1-digits are set to zero, bringing S-bin up to a total of d digits
+3. ELSE
+     S-bin is constructed as follows:
+       3.1 an initial 1-digit
+       3.2 the remaining complement (n - 1) of 1-digits in the least
+           significant places
+       3.3 0-digits for padding, bringing S-bin up to a total of (d + 1) digits
+   ENDIF
+4. Convert S-bin to its decimal form, S
+5. Output S
+
+(Note that a brute force approach -- set S to N + 1 and continue to increment S
+until the number of 1-digits in S-bin equals d -- works well for smaller values
+of N and for certain larger values, but becomes unacceptably slow for large
+values of N where N is a power of 2.)
+
+=end comment
+#==============================================================================
+
+subset Positive of Int where * > 0;
+
+my Bool constant DEBUG = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 114, Task #2: Higher Integer Set Bits (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Positive:D $N               #= A non-zero, positive integer
+)
+#==============================================================================
+{
+    my Positive $n      = $N + 0;                                   # Normalize
+
+    "Input: \$N = $n".put unless DEBUG;
+
+    my Str      $n-bin  =  $n.base( 2 );
+    my Positive $n-ones = +$n-bin.comb: '1';
+    my Str      $s-bin  =  solve( $n, $n-bin, $n-ones );
+    my Positive $s      = ":2<$s-bin>".Int;
+
+    if DEBUG
+    {
+        "Input: \$N = %*d (%d one-bit%s: %*b)\n".printf: $s.chars, $n, $n-ones,
+            ($n-ones == 1 ?? '' !! 's'), $s-bin.chars, $n;
+
+        my Positive $s-bits = +$s-bin.comb: '1'; #$s-bin =~ tr/1//;
+
+        "Output:     %d (%d one-bit%s: %s)\n".printf: $s, $s-bits,
+            ($s-bits == 1 ?? '' !! 's'), $s-bin;
+    }
+    else
+    {
+        "Output:     $s".put;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub solve
+(
+    Positive:D $n,
+    Str:D      $n-bin,
+    Positive:D $n-ones
+--> Str:D
+)
+#------------------------------------------------------------------------------
+{
+    my Str  @n-digits = $n-bin.split: '', :skip-empty;
+    my Bool $found1   = False;
+    my Str  $s-bin    = '1';
+    my UInt $zero-i;
+
+    for (1 .. @n-digits.end).reverse -> UInt $i
+    {
+        if $found1
+        {
+            $zero-i = $i, last if @n-digits[ $i ] == 0;
+        }
+        else
+        {
+            $found1 = True     if @n-digits[ $i ] == 1;
+        }
+    }
+
+    if $zero-i.defined
+    {
+        $s-bin ~= $n-bin.substr: 1, $zero-i - 1;
+        $s-bin ~= '1';
+
+        my UInt $ones-diff = $n-ones - +$s-bin.comb: '1';
+
+        $s-bin ~= '0' x ($n-bin.chars - $s-bin.chars - $ones-diff);
+        $s-bin ~= '1' x  $ones-diff;
+    }
+    else
+    {
+        $s-bin ~= '0' x ($n-bin.chars - $n-ones + 1);
+        $s-bin ~= '1' x ($n-ones - 1);
+    }
+
+    return $s-bin;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################