Merge pull request #4242 from PerlMonk-Athanasius/branch-for-challenge-116

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

4 files changed, 607 insertions, 0 deletions

diff --git a/challenge-116/athanasius/perl/ch-1.pl b/challenge-116/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..0080d6ffea
--- /dev/null
+++ b/challenge-116/athanasius/perl/ch-1.pl
@@ -0,0 +1,178 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 116
+=========================
+
+TASK #1
+-------
+*Number Sequence*
+
+Submitted by: Mohammad S Anwar
+
+You are given a number $N >= 10.
+
+Write a script to split the given number such that the difference between two
+consecutive numbers is always 1 and it shouldn't have leading 0.
+
+Print the given number if it impossible to split the number.
+
+Example
+
+ Input: $N = 1234
+ Output: 1,2,3,4
+
+ Input: $N = 91011
+ Output: 9,10,11
+
+ Input: $N = 10203
+ Output: 10203 as it is impossible to split satisfying the conditions.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Assumptions
+-----------
+(1) N is an integer.
+(2) Let N's digits be grouped as numbers: n0|n1|n2|...; then "the difference
+    between two consecutive numbers" is defined as (n1 - n0), (n2 - n1), etc.
+    That is, the grouped numbers must *increase* by exactly one from left to
+    right; N = 987 cannot be split into 9|8|7, even though successive numbers
+    in this grouping might be said to "differ by one."
+(3) The condition "and it shouldn't have leading 0" refers to every number in
+    the final grouping; so, in the third Example, 1|02|03 is not a valid split
+    because "02" and "03" have leading "0" digits and so are disallowed.
+
+Observation
+-----------
+For any integers p and q, if q - p = 1 then either
+    (1) p and q have the same number of digits; or
+    (2) p is entirely composed of "9" digits (say a total of D "9" digits) and
+        q comprises a "1" followed by D "0" digits.
+
+Algorithm
+---------
+Let N comprise D digits. Since N >= 10, D >= 2.
+
+FOR each number of starting digits _d_,
+        beginning with 1 and ending with the lower bound of D/2:
+
+    Move from left to right through N, checking that each group of _d_ digits
+        comprises a number exactly 1 greater than the number to its left.
+        (In the special case where the left-hand number is all 9's, first
+        increment _d_ by 1.)
+    On the first failure encountered, abort the search and start again with the
+        next higher value of _d_.
+    IF the search is successful for the whole of N, with all digits accounted-
+        for,
+    THEN record the solution and discontinue the search for higher values of
+        _d_.
+
+ENDFOR
+
+If a solution has been found, output its elements separated by commas;
+    otherwise, output N.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <N>
+
+    <N>    An integer greater than or equal to 10\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 116, Task #1: Number Sequence (Perl)\n\n";
+}
+
+#=============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N = parse_command_line();
+
+    print "Input:  \$N = $N\n";
+
+    my @sequence;
+    my $len_N = length $N;
+
+    DIGITS: for my $digits (1 .. int( $len_N / 2 ))
+    {
+           @sequence = ();
+        my $number0  = substr $N, 0, $digits;
+        my $length1  = $digits;
+        my $offset   = $digits;
+        my $number1;
+
+        while ($offset < $len_N)
+        {
+            ++$length1  if $number0 =~ / ^ 9+ $ /x;
+            next DIGITS if $offset + $length1 > $len_N;
+
+            $number1 = substr $N, $offset, $length1;
+
+            next DIGITS if $number1 - $number0 != 1;
+
+            push @sequence, $number0;
+
+            $offset += $length1;
+            $number0 = $number1;
+        }
+
+        push @sequence, $number1;
+
+        last DIGITS;
+    }
+
+    printf "Output: %s\n", @sequence ? join( ',', @sequence ) : $N;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1 or error( "Expected 1 command line argument, found $args" );
+
+    my $N = $ARGV[ 0 ];
+
+    $N =~ s/ ^ \+ //x;                   # Remove initial "+", if any
+
+    $N =~ / ^ [0-9]+ $ /x
+                  or error( qq["$N" is not a valid integer] );
+
+    $N =~ s/ ^ 0+ //x;                   # Remove initial zero digit(s), if any
+
+    length $N > 1 or error( "$N is less than 10" );
+
+    return $N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-116/athanasius/perl/ch-2.pl b/challenge-116/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..802c44308b
--- /dev/null
+++ b/challenge-116/athanasius/perl/ch-2.pl
@@ -0,0 +1,152 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 116
+=========================
+
+TASK #2
+-------
+*Sum of Squares*
+
+Submitted by: Mohammad Meraj Zia
+
+You are given a number $N >= 10.
+
+Write a script to find out if the given number $N is such that sum of squares
+of all digits is a perfect square. Print 1 if it is otherwise 0.
+
+Example
+
+ Input: $N = 34
+ Output: 1 as 3^2 + 4^2 => 9 + 16 => 25 => 5^2
+
+ Input: $N = 50
+ Output: 1 as 5^2 + 0^2 => 25 + 0 => 25 => 5^2
+
+ Input: $N = 52
+ Output: 0 as 5^2 + 2^2 => 25 + 4 => 29
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Input Argument $N
+-----------------
+Although it is probably intended that $N be an integer, this is not explicitly
+stated in the Task Description and is not really necessary. This script accepts
+any real number >= 10, and includes any digits following the decimal point
+along with the digits that come before. The decimal point (if any) is ignored.
+For example:
+
+    Input:  $N = 14.22
+    Output: 1 as 1^2 + 4^2 + 2^2 + 2^2 = 1 + 16 + 4 + 4 = 25 = 5^2
+
+Output
+------
+The required output (1 or 0) is followed by an explanation as per the Examples.
+If this explanation is not wanted, the constant $SHOW should be set to a false
+value.
+
+Algorithm
+---------
+This is straightforward: split $N into its component digits, square each digit,
+and sum the squares. The sum is itself a perfect square if and only if its
+square root is an integer.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my $SHOW  => 1;
+const my $USAGE =>
+"Usage:
+  perl $0 <N>
+
+    <N>    A number greater than or equal to 10\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 116, Task #2: Sum of Squares (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $N       = parse_command_line();
+
+    print "Input:  \$N = $N\n";
+
+    my @digits  = grep { !/\./ } split //, $N;
+    my @squares = map { $_ * $_ } @digits;
+    my $sum     = 0;
+       $sum    += $_ for @squares;
+    my $root    = perfect_square_root( $sum );
+
+    printf 'Output: %d', $root ? 1 : 0;
+
+    if ($SHOW)
+    {
+        my $terms   = join ' + ', map { "$_^2" } @digits;
+        my $squares = join ' + ',                @squares;
+
+        print ' as ' . join( ' = ', $terms, $squares, $sum ) . 
+              ($root ? " = $root^2" : ' which is not a perfect square');
+    }
+
+    print "\n";
+}
+
+#------------------------------------------------------------------------------
+sub perfect_square_root
+#------------------------------------------------------------------------------
+{
+    my ($N)   = @_;
+    my  $root = int( sqrt( $N ) + 0.5 );
+
+    # Return the square root if $N is a perfect square, or undef otherwise
+
+    return ($root * $root) == $N ? $root : undef;
+}
+
+#------------------------------------------------------------------------------
+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}{real} $ /x
+                  or error( qq["$N" is not a valid real number] );
+       $N +=  0;                                  # Normalize: e.g., 010 --> 10
+       $N >= 10   or error( "$N is less than 10" );
+
+    return $N;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-116/athanasius/raku/ch-1.raku b/challenge-116/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..731f419955
--- /dev/null
+++ b/challenge-116/athanasius/raku/ch-1.raku
@@ -0,0 +1,149 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 116
+=========================
+
+TASK #1
+-------
+*Number Sequence*
+
+Submitted by: Mohammad S Anwar
+
+You are given a number $N >= 10.
+
+Write a script to split the given number such that the difference between two
+consecutive numbers is always 1 and it shouldn’t have leading 0.
+
+Print the given number if it impossible to split the number.
+
+Example
+
+ Input: $N = 1234
+ Output: 1,2,3,4
+
+ Input: $N = 91011
+ Output: 9,10,11
+
+ Input: $N = 10203
+ Output: 10203 as it is impossible to split satisfying the conditions.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Assumptions
+-----------
+(1) N is an integer.
+(2) Let N's digits be grouped as numbers: n0|n1|n2|...; then "the difference
+    between two consecutive numbers" is defined as (n1 - n0), (n2 - n1), etc.
+    That is, the grouped numbers must *increase* by exactly one from left to
+    right; N = 987 cannot be split into 9|8|7, even though successive numbers
+    in this grouping might be said to "differ by one."
+(3) The condition "and it shouldn't have leading 0" refers to every number in
+    the final grouping; so, in the third Example, 1|02|03 is not a valid split
+    because "02" and "03" have leading "0" digits and so are disallowed.
+
+Observation
+-----------
+For any integers p and q, if q - p = 1 then either
+    (1) p and q have the same number of digits; or
+    (2) p is entirely composed of "9" digits (say a total of D "9" digits) and
+        q comprises a "1" followed by D "0" digits.
+
+Algorithm
+---------
+Let N comprise D digits. Since N >= 10, D >= 2.
+
+FOR each number of starting digits _d_, beginning with 1 and ending with ⌊D/2⌋:
+
+    Move from left to right through N, checking that each group of _d_ digits
+        comprises a number exactly 1 greater than the number to its left.
+        (In the special case where the left-hand number is all 9's, first
+        increment _d_ by 1.)
+    On the first failure encountered, abort the search and start again with the
+        next higher value of _d_.
+    IF the search is successful for the whole of N, with all digits accounted-
+        for,
+    THEN record the solution and discontinue the search for higher values of
+        _d_.
+
+ENDFOR
+
+If a solution has been found, output its elements separated by commas;
+    otherwise, output N.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 116, Task #1: Number Sequence (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D $N where { $N >= 10 }      #= An integer greater than or equal to 10
+)
+#==============================================================================
+{
+    my UInt $n = $N + 0;             # Normalize: e.g., 010 --> 10, 0x10 --> 16
+
+    "Input:  \$N = $n".put;
+
+    my UInt @sequence;
+    my UInt $len-n = $n.chars;
+
+    DIGITS: for 1 .. floor( $len-n / 2 ) -> UInt $digits
+    {
+                @sequence = ();
+        my UInt $number0  = $n.substr( 0, $digits ).Int;
+        my UInt $length1  = $digits;
+        my UInt $offset   = $digits;
+        my UInt $number1;
+
+        while $offset < $len-n
+        {
+            ++$length1  if $number0 ~~ / ^ 9+ $ /;
+            next DIGITS if $offset + $length1 > $len-n;
+
+            $number1 = $n.substr( $offset, $length1 ).Int;
+
+            next DIGITS if $number1 - $number0 != 1;
+
+            @sequence.push: $number0;
+
+            $offset += $length1;
+            $number0 = $number1;
+        }
+
+        @sequence.push: $number1;
+
+        last DIGITS;
+    }
+
+    "Output: %s\n".printf: @sequence ?? @sequence.join( ',' ) !! $n;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-116/athanasius/raku/ch-2.raku b/challenge-116/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..6d46d02e44
--- /dev/null
+++ b/challenge-116/athanasius/raku/ch-2.raku
@@ -0,0 +1,128 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 116
+=========================
+
+TASK #2
+-------
+*Sum of Squares*
+
+Submitted by: Mohammad Meraj Zia
+
+You are given a number $N >= 10.
+
+Write a script to find out if the given number $N is such that sum of squares
+of all digits is a perfect square. Print 1 if it is otherwise 0.
+
+Example
+
+ Input: $N = 34
+ Output: 1 as 3^2 + 4^2 => 9 + 16 => 25 => 5^2
+
+ Input: $N = 50
+ Output: 1 as 5^2 + 0^2 => 25 + 0 => 25 => 5^2
+
+ Input: $N = 52
+ Output: 0 as 5^2 + 2^2 => 25 + 4 => 29
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Input Argument $N
+-----------------
+Although it is probably intended that $N be an integer, this is not explicitly
+stated in the Task Description and is not really necessary. This script accepts
+any real number >= 10, and includes any digits following the decimal point
+along with the digits that come before. The decimal point (if any) is ignored.
+For example:
+
+    Input:  $N = 14.22
+    Output: 1 as 1^2 + 4^2 + 2^2 + 2^2 = 1 + 16 + 4 + 4 = 25 = 5^2
+
+Output
+------
+The required output (1 or 0) is followed by an explanation as per the Examples.
+If this explanation is not wanted, the constant SHOW should be set to False.
+
+Algorithm
+---------
+This is straightforward: split $N into its component digits, square each digit,
+and sum the squares. The sum is itself a perfect square if and only if its
+square root is an integer.
+
+=end comment
+#==============================================================================
+
+my Bool constant SHOW = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 116, Task #2: Sum of Squares (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Real:D $N where { $N >= 10 }        #= A number greater than or equal to 10
+)
+#==============================================================================
+{
+    my Real $n       = $N + 0;       # Normalize: e.g., 010 --> 10, 0x10 --> 16
+
+    "Input:  \$N = $n".put;
+
+    my UInt @digits  = $n.split( '', :skip-empty ).grep( none '.' )\
+                                                  .map: { .Int };
+    my UInt @squares = @digits.map: { $_ * $_ };
+    my UInt $sum     = 0;
+            $sum    += $_ for @squares;
+    my UInt $root    = perfect-square-root( $sum );
+
+    'Output: %d'.printf: $root ?? 1 !! 0;
+
+    if SHOW
+    {
+        my Str $terms   = @digits.map( { "$_^2" } ).join: ' + ';
+        my Str $squares = @squares\                .join: ' + ';
+
+        (' as ' ~ ($terms, $squares, $sum).join( ' = ' ) ~
+        ($root ?? " = $root^2" !! ' which is not a perfect square')).print;
+    }
+
+    ''.put;
+}
+
+#------------------------------------------------------------------------------
+sub perfect-square-root( UInt:D $N --> UInt )
+#------------------------------------------------------------------------------
+{
+    my UInt $root = floor( $N.sqrt + 0.5 );
+
+    # Return the square root if $N is a perfect square, or Nil otherwise
+
+    return ($root * $root) == $N ?? $root !! Nil;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################