Merge pull request #493 from PerlMonk-Athanasius/branch-for-challenge-020

Perl 5 & 6 solutions to Tasks 1 & 2

4 files changed, 232 insertions, 0 deletions

diff --git a/challenge-020/athanasius/perl5/ch-1.pl b/challenge-020/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..84ba321638
--- /dev/null
+++ b/challenge-020/athanasius/perl5/ch-1.pl
@@ -0,0 +1,43 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 020
+=========================
+
+Task #1
+-------
+Write a script to accept a string from command line and split it on change of
+character. For example, if the string is *"ABBCDEEF"*, then it should split like
+*"A"*, *"BB"*, *"C"*, *"D"*, *"EE"*, *"F"*.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $DEFAULT => 'ABBCDEEF';
+
+MAIN:
+{
+    my $string  = $ARGV[0] // $DEFAULT;
+    my @matches = $string =~ / ( (.) \g{-1}* ) /gx;
+    my $select  = 0;
+       @matches = grep { $select = !$select } @matches;
+
+    print "\n",
+          "Original string:      \"$string\"\n",
+          "After splitting on\n",
+          "changes of character: ",
+           join(', ', map { "\"$_\"" } @matches),
+          "\n";
+}
+
+################################################################################
diff --git a/challenge-020/athanasius/perl5/ch-2.pl b/challenge-020/athanasius/perl5/ch-2.pl
new file mode 100644
index 0000000000..fc50bbc2aa
--- /dev/null
+++ b/challenge-020/athanasius/perl5/ch-2.pl
@@ -0,0 +1,78 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 020
+=========================
+
+Task #2
+-------
+Write a script to print the smallest pair of *Amicable Numbers*. For more infor-
+mation, please checkout wikipedia
+[ https://en.wikipedia.org/wiki/Amicable_numbers |page].
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Math::Prime::Util qw( divisor_sum );
+
+const my $PAIRS   => 1;                 # Number of amicable pairs to find
+const my $PERFECT => 0;                 # Include perfect numbers in the output?
+const my $USAGE   => "USAGE: perl $0 [--pairs <UInt>] [--perfect]\n";
+
+BEGIN
+{
+    $| = 1;
+    print "\n";
+}
+
+MAIN:
+{
+    my $pairs_target = $PAIRS;
+    my $do_perfect   = $PERFECT;
+
+    GetOptions
+    (
+        'pairs=i' => \$pairs_target,
+         perfect  => \$do_perfect,
+
+    ) or die $USAGE;
+
+    $pairs_target > 0
+        or die "Value \"$pairs_target\" invalid for option pairs (must be " .
+               "greater than zero)\n$USAGE";
+
+    my $pairs_found   =   0;
+    my $perfect_found =   0;
+    my %aliquot_sums  = ( 0 => 0 );
+
+    for (my $n = 1; $pairs_found < $pairs_target; ++$n)
+    {
+        my $aliquot_sum = divisor_sum($n) - $n;
+
+        $aliquot_sums{ $n } = $aliquot_sum;
+
+        if ($aliquot_sum == $n)                          # n is a perfect number
+        {
+            printf "Perfect number #%d: %d\n", ++$perfect_found, $n
+                if $do_perfect;
+        }
+        elsif (exists $aliquot_sums{ $aliquot_sum } &&   # n is the larger of an
+                      $aliquot_sums{ $aliquot_sum } == $n)       # amicable pair
+        {
+            printf "Amicable pair %s#%d: (%d, %d)\n",
+                    ($do_perfect ? ' ' : ''), ++$pairs_found, $aliquot_sum, $n;
+        }
+    }
+}
+
+################################################################################
diff --git a/challenge-020/athanasius/perl6/ch-1.p6 b/challenge-020/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..df08246550
--- /dev/null
+++ b/challenge-020/athanasius/perl6/ch-1.p6
@@ -0,0 +1,33 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 020
+=========================
+
+Task #1
+-------
+Write a script to accept a string from command line and split it on change of
+character. For example, if the string is *"ABBCDEEF"*, then it should split like
+*"A"*, *"BB"*, *"C"*, *"D"*, *"EE"*, *"F"*.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+my Str constant $DEFAULT = 'ABBCDEEF';
+
+sub MAIN(Str:D $string = $DEFAULT)
+{
+    my @matches    = $string ~~ m:g/ ( (.) $0* ) /;
+    my @substrings = @matches.map( { '"' ~ .Str ~ '"' } );
+
+    say "\nOriginal string:      \"$string\"\n",
+        "After splitting on\nchanges of character: ", join(', ', @substrings);
+}
+
+################################################################################
diff --git a/challenge-020/athanasius/perl6/ch-2.p6 b/challenge-020/athanasius/perl6/ch-2.p6
new file mode 100644
index 0000000000..d0154e5056
--- /dev/null
+++ b/challenge-020/athanasius/perl6/ch-2.p6
@@ -0,0 +1,78 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 020
+=========================
+
+Task #2
+-------
+Write a script to print the smallest pair of *Amicable Numbers*. For more infor-
+mation, please checkout wikipedia
+[ https://en.wikipedia.org/wiki/Amicable_numbers |page].
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use Math::Prime::Util:from<Perl5> <divisor_sum>;
+
+my Sub $divisor-sum := &Math::Prime::Util::divisor_sum;     # Alias
+
+# Command-line defaults
+
+my UInt constant $PAIRS   = 1;         # Find first/smallest amicable pair only
+my Bool constant $PERFECT = False;     # Ignore perfect numbers
+
+BEGIN
+{
+    say '';
+}
+
+sub MAIN
+(
+    UInt:D :$pairs   = $PAIRS,         #= the number of amicable pairs to find
+    Bool:D :$perfect = $PERFECT,       #= include perfect numbers in the output?
+)
+{
+    $pairs > 0
+        or die "Value \"$pairs\" invalid for option pairs (must be greater " ~
+               "than zero)\n$*USAGE";
+
+    my UInt $pairs-found   =   0;
+    my UInt $perfect-found =   0;
+    my      %aliquot-sums  = ( 0 => 0 );
+
+    for 1 .. ∞ -> UInt $n
+    {
+        last if $pairs-found >= $pairs;
+
+        my UInt $aliquot-sum = $divisor-sum($n) - $n;
+        %aliquot-sums{ $n }  = $aliquot-sum;            # record n's aliquot-sum
+
+        if $aliquot-sum == $n                           # n is a perfect number
+        {
+            "Perfect number #%d: %d\n".printf(++$perfect-found, $n) if $perfect;
+        }
+        elsif %aliquot-sums{ $aliquot-sum }:exists &&   # n is the larger of an
+              %aliquot-sums{ $aliquot-sum } == $n       #   amicable pair
+        {
+            "Amicable pair %s#%d: (%d, %d)\n".printf:
+                ($perfect ?? ' ' !! ''), ++$pairs-found, $aliquot-sum, $n;
+        }
+    }
+
+    CATCH
+    {
+        default
+        {
+            $*ERR.say: .message;
+        }
+    }
+}
+
+################################################################################