Merge pull request #5711 from PerlMonk-Athanasius/branch-for-challenge-153

Perl & Raku solutions to Tasks 1 (2 versions) & 2 for Week 153

6 files changed, 674 insertions, 0 deletions

diff --git a/challenge-153/athanasius/perl/ch-1.pl b/challenge-153/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..7dd89abffd
--- /dev/null
+++ b/challenge-153/athanasius/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 153
+=========================
+
+TASK #1
+-------
+*Left Factorials*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to compute Left Factorials of 1 to 10. Please refer 
+[ http://oeis.org/A003422 |OEIS A003422] for more information.
+
+Expected Output:
+
+ 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+On each iteration of the main loop, the next factorial is computed, then it is
+added to the cumulative sum to give the next left factorial.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $TARGET => 10;
+const my $USAGE  =>
+"Usage:
+  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 153, Task #1: Left Factorials (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' .
+                         "$args\n$USAGE";
+
+    my @left_facts = (1);           # !1 = 0! = 1
+    my $factorial  =  1;            # Last factorial
+    my $cum_sum    =  1;            # Cumulative sum of factorials
+
+    for my $n (1 .. $TARGET - 1)    # Compute !2 to !$TARGET
+    {
+        $factorial *= $n;
+        $cum_sum   += $factorial;
+
+        push @left_facts, $cum_sum;
+    }
+
+    print "The left factorials of 1 to $TARGET:\n";
+    print  join( ', ', @left_facts ), "\n";
+}
+
+###############################################################################
diff --git a/challenge-153/athanasius/perl/ch-1a.pl b/challenge-153/athanasius/perl/ch-1a.pl
new file mode 100644
index 0000000000..ebb75a0759
--- /dev/null
+++ b/challenge-153/athanasius/perl/ch-1a.pl
@@ -0,0 +1,119 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 153
+=========================
+
+TASK #1
+-------
+*Left Factorials*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to compute Left Factorials of 1 to 10. Please refer 
+[ http://oeis.org/A003422 |OEIS A003422] for more information.
+
+Expected Output:
+
+ 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Note
+----
+This alternative solution to Task 1 is provided only for interest; it is less
+efficient than the solution provided in "ch-1.pl".
+
+Algorithm
+---------
+From OEIS A003422 [1]:
+
+   "Also, numbers left over after the following sieving process: At step 1,
+    keep all numbers of the set N = {0, 1, 2, ...}. In step 2, keep only every
+    second number after a(2) = 2: N' = {0, 1, 2, 4, 6, 8, 10, ...}. In step 3,
+    keep every third of the numbers following a(3) = 4, N" = {0, 1, 2, 4, 10,
+    16, 22, ...}. In step 4, keep every fourth of the numbers beyond a(4) = 10:
+    {0, 1, 2, 4, 10, 34, 58, ...}, and so on. - M. F. Hasler, Oct 28 2010"
+
+Reference
+---------
+[1] OEIS:  A003422  Left factorials: !n = Sum_{k=0..n-1} k!.
+    (http://oeis.org/A003422)
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $TARGET     => 10;
+const my $SIEVE_SIZE => 410_000;
+const my $USAGE      =>
+"Usage:
+  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 153, Task #1a: Left Factorials (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' .
+                         "$args\n$USAGE";
+
+    my @sieve = 0 .. $SIEVE_SIZE;
+
+    for my $step (2 .. $TARGET - 1)
+    {
+        # Find the index of a(step)
+
+        my $i     = 0;
+        my $count = $step;
+
+        while ($count > 0)
+        {
+            --$count if defined $sieve[ ++$i ];
+        }
+
+        # Beginning at the first defined number beyond a(step): for each
+        # consecutive set of step defined numbers, remove all but the last
+
+        while ($i < $#sieve)
+        {
+            $count = $step;
+
+            while ($count > 0 && $i < $#sieve)
+            {
+                if (defined $sieve[ ++$i ])
+                {
+                    $sieve[ $i ] = undef unless --$count == 0;
+                }
+            }
+        }
+    }
+
+    my @left_facts = grep { defined $_ } @sieve;
+
+    print "The left factorials of 1 to $TARGET:\n";
+    print  join( ', ', @left_facts[ 1 .. $TARGET ] ), "\n";
+}
+
+###############################################################################
diff --git a/challenge-153/athanasius/perl/ch-2.pl b/challenge-153/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..5c8e0a7549
--- /dev/null
+++ b/challenge-153/athanasius/perl/ch-2.pl
@@ -0,0 +1,149 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 153
+=========================
+
+TASK #2
+-------
+*Factorions*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer, $n.
+
+Write a script to figure out if the given integer is factorion.
+
+    A factorion is a natural number that equals the sum of the factorials of
+    its digits.
+
+Example 1:
+
+ Input: $n = 145
+ Output: 1
+
+     Since 1! + 4! + 5! => 1 + 24 + 120 = 145
+
+Example 2:
+
+ Input: $n = 125
+ Output: 0
+
+     Since 1! + 2! + 3! => 1 + 2 + 6 <> 123
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Output
+------
+If the constant $VERBOSE is set to a true value (the default), an explanation
+like those given in the Examples is added to the output.
+
+Algorithm
+---------
+Using a look-up for the factorials of numbers 0 to 9 [1], the factorials of the
+digits of $n are summed and the result compared with $n.
+
+Reference
+---------
+[1] Wikipedia article "Factorial" (https://en.wikipedia.org/wiki/Factorial)
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+
+const my %FACTORIAL => (0 =>       1,
+                        1 =>       1,
+                        2 =>       2,
+                        3 =>       6,
+                        4 =>      24,
+                        5 =>     120,
+                        6 =>     720,
+                        7 =>   5_040,
+                        8 =>  40_320,
+                        9 => 362_880);
+const my $VERBOSE   =>  1;
+const my $USAGE     =>
+"Usage:
+  perl $0 <n>
+
+    <n>    An integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 153, Task #2: Factorions (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $n      = parse_command_line();
+    my $sign   = $n >= 0 ? 1 : -1;
+    my $n_abs  = $n =~ s/ ^ [+-] //rx;          # Remove initial sign  (if any)
+       $n_abs *= 1;                             # Remove initial zeros (if any)
+
+    printf "Input:  \$n = %d\n", $n_abs * $sign;
+
+    my @digits   = split '', $n_abs;
+    my $sum      = 0;
+       $sum     += $_ for map { $FACTORIAL{ $_ } } @digits;
+    my $is_factn = $sum == $n;
+
+    printf "Output: %d\n", $is_factn ? 1 : 0;
+
+    if ($VERBOSE)
+    {
+        if (length $n_abs == 1)
+        {
+            printf "\n    Since %s! = %d\n", $n_abs, $sum;
+        }
+        else
+        {
+            printf "\n    Since %s! = %s = %d\n", join( '! + ', @digits ),
+                join( ' + ', map { $FACTORIAL{ $_ } } @digits ), $sum;
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+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["$_" is not a valid integer] );
+
+    return $n;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-153/athanasius/raku/ch-1.raku b/challenge-153/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..f68287bcea
--- /dev/null
+++ b/challenge-153/athanasius/raku/ch-1.raku
@@ -0,0 +1,80 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 153
+=========================
+
+TASK #1
+-------
+*Left Factorials*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to compute Left Factorials of 1 to 10. Please refer 
+[ http://oeis.org/A003422 |OEIS A003422] for more information.
+
+Expected Output:
+
+ 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+On each iteration of the main loop, the next factorial is computed, then it is
+added to the cumulative sum to give the next left factorial.
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET = 10;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 153, Task #1: Left Factorials (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @left-facts = 1;            # !1 = 0! = 1
+    my UInt $factorial  = 1;
+    my UInt $cum-sum    = 1;
+
+    for 1 .. $TARGET - 1 -> UInt $n     # Compute !2 to !$TARGET
+    {
+        $factorial *= $n;
+        $cum-sum   += $factorial;
+
+        @left-facts.push: $cum-sum;
+    }
+
+    "The left factorials of 1 to $TARGET:".put;
+    "%s\n".printf: @left-facts.join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-153/athanasius/raku/ch-1a.raku b/challenge-153/athanasius/raku/ch-1a.raku
new file mode 100644
index 0000000000..4d62798c62
--- /dev/null
+++ b/challenge-153/athanasius/raku/ch-1a.raku
@@ -0,0 +1,118 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 153
+=========================
+
+TASK #1
+-------
+*Left Factorials*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to compute Left Factorials of 1 to 10. Please refer 
+[ http://oeis.org/A003422 |OEIS A003422] for more information.
+
+Expected Output:
+
+ 1, 2, 4, 10, 34, 154, 874, 5914, 46234, 409114
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+This alternative solution to Task 1 is provided only for interest; it is *much*
+less efficient than the solution provided in "ch-1.raku".
+
+Algorithm
+---------
+From OEIS A003422 [1]:
+
+   "Also, numbers left over after the following sieving process: At step 1,
+    keep all numbers of the set N = {0, 1, 2, ...}. In step 2, keep only every
+    second number after a(2) = 2: N' = {0, 1, 2, 4, 6, 8, 10, ...}. In step 3,
+    keep every third of the numbers following a(3) = 4, N" = {0, 1, 2, 4, 10,
+    16, 22, ...}. In step 4, keep every fourth of the numbers beyond a(4) = 10:
+    {0, 1, 2, 4, 10, 34, 58, ...}, and so on. - M. F. Hasler, Oct 28 2010"
+
+Reference
+---------
+[1] OEIS:  A003422  Left factorials: !n = Sum_{k=0..n-1} k!.
+    (http://oeis.org/A003422)
+
+=end comment
+#==============================================================================
+
+my UInt constant $TARGET     = 10;
+my UInt constant $SIEVE-SIZE = 410_000;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 153, Task #1: Left Factorials (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @sieve = 0 .. $SIEVE-SIZE;
+
+    for 2 .. $TARGET - 1 -> UInt $step
+    {
+        # Find the index of a(step)
+
+        my UInt $i     = 0;
+        my UInt $count = $step;
+
+        while $count > 0
+        {
+            --$count if @sieve[ ++$i ].defined;
+        }
+
+        # Beginning at the first defined number beyond a(step): for each
+        # consecutive set of step defined numbers, remove all but the last
+
+        while $i < @sieve.end
+        {
+            $count = $step;
+
+            while $count > 0 && $i < @sieve.end
+            {
+                if @sieve[ ++$i ].defined
+                {
+                    @sieve[ $i ] = Nil unless --$count == 0;
+                }
+            }
+        }
+    }
+
+    my UInt @left-facts = @sieve.grep: { .defined };
+
+    "The left factorials of 1 to $TARGET:".put;
+    "%s\n".printf: @left-facts[ 1 .. $TARGET ].join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-153/athanasius/raku/ch-2.raku b/challenge-153/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..9ac6ff208d
--- /dev/null
+++ b/challenge-153/athanasius/raku/ch-2.raku
@@ -0,0 +1,127 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 153
+=========================
+
+TASK #2
+-------
+*Factorions*
+
+Submitted by: Mohammad S Anwar
+
+You are given an integer, $n.
+
+Write a script to figure out if the given integer is factorion.
+
+    A factorion is a natural number that equals the sum of the factorials of
+    its digits.
+
+Example 1:
+
+ Input: $n = 145
+ Output: 1
+
+     Since 1! + 4! + 5! => 1 + 24 + 120 = 145
+
+Example 2:
+
+ Input: $n = 125
+ Output: 0
+
+     Since 1! + 2! + 3! => 1 + 2 + 6 <> 123
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Output
+------
+If the constant $VERBOSE is set to True (the default), an explanation like
+those given in the Examples is added to the output.
+
+Algorithm
+---------
+Using a look-up for the factorials of numbers 0 to 9 [1], the factorials of the
+digits of $n are summed and the result compared with $n.
+
+Reference
+---------
+[1] Wikipedia article "Factorial" (https://en.wikipedia.org/wiki/Factorial)
+
+=end comment
+#==============================================================================
+
+my Bool constant $VERBOSE   = True;
+my      constant %FACTORIAL = Hash[UInt].new: 0 =>       1,
+                                              1 =>       1,
+                                              2 =>       2,
+                                              3 =>       6,
+                                              4 =>      24,
+                                              5 =>     120,
+                                              6 =>     720,
+                                              7 =>   5_040,
+                                              8 =>  40_320,
+                                              9 => 362_880;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 153, Task #2: Factorions (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Int:D $n                           #= An integer
+)
+#==============================================================================
+{
+    # Remove sign and initial zeros (if any)
+
+    my Int $sign  = $n >= 0 ?? 1 !! -1;
+    my Int $n-abs = $n.subst( / ^ <[+-]> / ).Int;
+
+    "Input:  \$n = %d\n".printf: $n-abs * $sign;
+
+    my Str  @digits   = $n-abs.split: '', :skip-empty;
+    my UInt $sum      = [+] @digits.map: { %FACTORIAL{ $_ } };
+    my Bool $is-factn = $sum == $n;
+
+    "Output: %d\n".printf: $is-factn ?? 1 !! 0;
+
+    if $VERBOSE
+    {
+        if $n-abs.chars == 1
+        {
+            "\n    Since %s! = %d\n".printf: $n-abs, $sum;
+        }
+        else
+        {
+            "\n    Since %s! = %s = %d\n".printf: @digits.join( '! + ' ),
+                @digits.map( { %FACTORIAL{ $_ } } ).join( ' + ' ), $sum;
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################