Perl 5 & 6 solutions to Tasks #1 & #2, and Perl 5 solution to Task #3.

On branch branch-for-challenge-023
Changes to be committed:
	new file:   challenge-023/athanasius/perl5/ch-1.pl
	new file:   challenge-023/athanasius/perl5/ch-2.pl
	new file:   challenge-023/athanasius/perl5/ch-3.pl
	new file:   challenge-023/athanasius/perl6/ch-1.p6
	new file:   challenge-023/athanasius/perl6/ch-2.p6

2 files changed, 190 insertions, 0 deletions

diff --git a/challenge-023/athanasius/perl6/ch-1.p6 b/challenge-023/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..bec5457e96
--- /dev/null
+++ b/challenge-023/athanasius/perl6/ch-1.p6
@@ -0,0 +1,98 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 023
+=========================
+
+Task #1
+-------
+Create a script that prints nth order forward difference series. You should be a
+able to pass the list of numbers and order number as command line parameters.
+Let me show you with an example.
+
+  Suppose we have list (X) of numbers: 5, 9, 2, 8, 1, 6 and we would like to
+  create 1st order forward difference series (Y). So using the formula Y(i) =
+  X(i+1) - X(i), we get the following numbers: (9-5), (2-9), (8-2), (1-8),
+  (6-1). In short, the final series would be: 4, -7, 6, -7, 5. If you noticed,
+  it has one less number than the original series. Similary you can carry on 2nd
+  order forward difference series like: (-7-4), (6+7), (-7-6), (5+7) => -11, 13,
+  -13, 12.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+my UInt:D constant $ORDER = 1;
+
+BEGIN say '';
+
+#===============================================================================
+sub MAIN(*@series, UInt:D :$order = $ORDER)
+#===============================================================================
+{
+    check-arguments(@series, $order);
+
+    for 1 .. $order
+    {
+        my UInt $max-index = @series.elems - 1;
+
+        my @new-series;
+           @new-series.push(@series[$_] - @series[$_ - 1]) for 1 .. $max-index;
+
+        @series = @new-series;
+    }
+
+    "%s order forward difference series:\n(%s)\n".printf:
+        ordinal($order), join(', ', @series);
+
+    CATCH
+    {
+        default 
+        {
+            $*ERR.say: .message ~ "\n" ~ $*USAGE;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub check-arguments(@series, UInt:D $order)
+#-------------------------------------------------------------------------------
+{
+    my UInt $elements = @series.elems;
+
+    $elements > 1
+        or die "Invalid number of elements ($elements) in the series: must " ~
+               "be at least 2";
+
+    $order > 0
+        or die "Invalid order ($order): must be an integer > 0";
+
+    $order < $elements
+        or die "Invalid order ($order): a series of $elements elements " ~
+               "cannot have an order > { $elements - 1 }";
+}
+
+#-------------------------------------------------------------------------------
+sub ordinal(UInt:D $cardinal)
+#-------------------------------------------------------------------------------
+{
+    my $suffix  = 'th';
+    my $digit_0 =  $cardinal % 10;
+    my $digit_1 = ($cardinal / 10).floor % 10;
+
+    if ($digit_1 != 1)
+    {
+        $suffix = $digit_0 == 1 ?? 'st' !!
+                  $digit_0 == 2 ?? 'nd' !!
+                  $digit_0 == 3 ?? 'rd' !! 'th';
+    }
+
+    return $cardinal ~ $suffix;
+}
+
+################################################################################
diff --git a/challenge-023/athanasius/perl6/ch-2.p6 b/challenge-023/athanasius/perl6/ch-2.p6
new file mode 100644
index 0000000000..24048e5626
--- /dev/null
+++ b/challenge-023/athanasius/perl6/ch-2.p6
@@ -0,0 +1,92 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 023
+=========================
+
+Task #2
+-------
+Create a script that prints *Prime Decomposition* of a given number. The prime
+decomposition of a number is defined as a list of prime numbers which when all
+multiplied together, are equal to that number. For example, the Prime decomposi-
+tion of 228 is 2,2,3,19 as 228 = 2 * 2 * 3 * 19.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+BEGIN say '';
+
+#===============================================================================
+sub MAIN(UInt:D $number )                                #= Unsigned integer > 1
+#===============================================================================
+{
+    die $*USAGE if $number <= 1;
+
+    say "The prime decomposition of $number is: ", factor($number).join(', ');
+
+    CATCH
+    {
+        default 
+        {
+            $*ERR.say: .message;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub factor(UInt:D $number)
+#-------------------------------------------------------------------------------
+{
+    my UInt $remainder = $number;
+    my      @factors;
+
+    MY-OUTER:
+    for 2 .. $number -> UInt $f
+    {
+        if $f.is-prime
+        {
+            while $remainder % $f == 0
+            {
+                @factors.push:  $f;
+                $remainder div= $f;
+
+                last MY-OUTER if $remainder == 1;
+            }
+        }
+    }
+
+    die "ERROR: for number $number, remainder is $remainder"
+        unless $remainder == 1;
+
+    return @factors;
+}
+
+################################################################################
+
+=begin note
+
+The label used in sub factor() was originally "OUTER:". Here is the explanation
+of the (cryptic!) error message that resulted:
+
+From https://perl6.eu/colonoscopy.html
+
+"Upper Case letters are normally used for labels, but this will cause an error
+if you happen to choose a name that is already in use internally by Perl 6. The
+label itself isn't a problem, as the trailing colon tells the compiler that it
+is a label. The usage, where it is used as a bareword causes the problem, and
+there is no way to fix it.
+
+Some examples:
+
+OUTER, which seems perfectly logical as a label name, will give the run time
+error («Cannot resolve caller next(OUTER:U); ...»), as OUTER is a built-in
+package name and Perl 6 isn't clever enough to spot that it is used as a label
+in this case."
+
+=end note