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

4 files changed, 738 insertions, 0 deletions

diff --git a/challenge-137/athanasius/perl/ch-1.pl b/challenge-137/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..d9d861d1b3
--- /dev/null
+++ b/challenge-137/athanasius/perl/ch-1.pl
@@ -0,0 +1,144 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 137
+=========================
+
+TASK #1
+-------
+*Long Year*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to find all the years between 1900 and 2100 which is a Long
+Year.
+
+    A year is Long if it has 53 weeks.
+
+[UPDATED][2021-11-01 16:20:00]: For more information about Long Year, please
+refer to [ https://en.wikipedia.org/wiki/ISO_week_date#Weeks_per_year |wiki-
+pedia].
+
+Expected Output
+
+  1903, 1908, 1914, 1920, 1925,
+  1931, 1936, 1942, 1948, 1953,
+  1959, 1964, 1970, 1976, 1981,
+  1987, 1992, 1998, 2004, 2009,
+  2015, 2020, 2026, 2032, 2037,
+  2043, 2048, 2054, 2060, 2065,
+  2071, 2076, 2082, 2088, 2093,
+  2099
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Algorithm
+---------
+
+From https://en.wikipedia.org/wiki/Week#Week_52_and_53 :-
+
+    "Week 52 and 53
+
+    It is also possible to determine if the last week of the previous year was
+    Week 52 or Week 53 as follows:
+
+     - If January 1 falls on a Friday, then it is part of Week 53 of the
+       previous year (W53-5).
+     - If January 1 falls on a Saturday,
+         - then it is part of Week 53 of the previous year if that is a leap
+           year (W53-6),
+         - and part of Week 52 otherwise (W52-6), i.e. if the previous year is
+           a common year.
+     - If January 1 falls on a Sunday, then it is part of Week 52 of the
+       previous year (W52-7)."
+
+Implementation
+--------------
+The CPAN DateTime module provides methods day_of_week() and is_leap_year().
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use DateTime;
+
+const my $START     => 1_900;
+const my $END       => 2_100;
+const my $YR_PER_LN =>     5;
+const my $FRIDAY    =>     5;
+const my $SATURDAY  =>     6;
+const my $USAGE     => "Usage:\n  perl $0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 137, Task #1: Long Year (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    die "ERROR: Expected 0 command line arguments, found $args\n$USAGE"
+        unless $args == 0;
+
+    my @long_years;
+
+    for my $year ($START .. $END)
+    {
+        my $jan1 = DateTime->new( year => $year + 1, month => 1, day => 1 );
+        my $dow  = $jan1->day_of_week;
+
+        if    ($dow == $FRIDAY)
+        {
+            push @long_years, $year;
+        }
+        elsif ($dow == $SATURDAY)
+        {
+            my $dt = DateTime->new( year => $year );
+
+            push @long_years, $year if $dt->is_leap_year;
+        }
+    }
+
+    print_years( \@long_years );
+}
+
+#------------------------------------------------------------------------------
+sub print_years
+#------------------------------------------------------------------------------
+{
+    my ($long_years) = @_;
+
+    printf "There are %d long years between %d and %d inclusive:\n\n",
+            scalar @$long_years, $START, $END;
+
+    my $idx = 0;
+
+    while ($idx + $YR_PER_LN - 1 < $#$long_years)
+    {
+        printf "%s,\n",
+                    join ', ', @$long_years[ $idx .. $idx + $YR_PER_LN - 1 ];
+        $idx += $YR_PER_LN;
+    }
+
+    printf "%s\n",  join ', ', @$long_years[ $idx .. $#$long_years ];
+}
+
+###############################################################################
diff --git a/challenge-137/athanasius/perl/ch-2.pl b/challenge-137/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..6c4007e006
--- /dev/null
+++ b/challenge-137/athanasius/perl/ch-2.pl
@@ -0,0 +1,243 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 137
+=========================
+
+TASK #2
+-------
+*Lychrel Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given a number, 10 <= $n <= 1000.
+
+Write a script to find out if the given number is Lychrel number. To keep the
+task simple, we impose the following rules:
+
+ a. Stop if the number of iterations reached 500.
+ b. Stop if you end up with number >= 10_000_000.
+
+[UPDATED][2021-11-01 16:20:00]: If you stop because of any of the above two
+rules then we expect 1 as an output.
+
+According to [ https://en.wikipedia.org/wiki/Lychrel_number |wikipedia]:
+
+A Lychrel number is a natural number that cannot form a palindrome through the
+iterative process of repeatedly reversing its digits and adding the resulting
+numbers.
+
+Example 1
+
+  Input: $n = 56
+  Output: 0
+
+  After 1 iteration, we found palindrome number.
+  56 + 65 = 121
+
+Example 2
+
+  Input: $n = 57
+  Output: 0
+
+  After 2 iterations, we found palindrome number.
+   57 +  75 = 132
+  132 + 231 = 363
+
+Example 3
+
+  Input: $n = 59
+  Output: 0
+
+  After 3 iterations, we found palindrome number.
+   59 +  95 =  154
+  154 + 451 =  605
+  605 + 506 = 1111
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Definitions
+-----------
+1. Let rev(N) be defined as the integer formed by reversing the digits of N (as
+   represented in decimal notation). Where the least significant digit(s) of N
+   are 0s (zeros), rev(N) has fewer digits than N. For example, rev(1200) =
+   "0021" = 21.
+2. Let an _Iteration_ be defined as the production of a new term from the
+   previous term as follows: term[N+1] = term[N] + rev(term[N])
+3. Let a Lychrel number be defined as a number N such that no finite series of
+   _Iterations_ beginning with term[0] = N results in a term which is a
+   palindrome.
+
+Notes:
+
+(i) "In base ten, no Lychrel numbers have been yet proved to exist, but many,
+     including 196, are suspected on heuristic and statistical grounds."
+     (Wikipedia). An output of 1 is therefore an indication that the given $n
+     is *probably* a Lychrel number.
+
+(ii) There is an ambiguity in the definition of Lychrel numbers: how are we to
+     treat the degenerative case in which term[0] is a palindrome, but no
+     term[x: x > 0] is a palindrome?
+
+     (a) If a finite series of _Iterations_ is taken to mean *one or more*,
+         then a palindromic N might be a Lychrel number (OEIS A088753)
+     (b) Otherwise -- i.e., if a finite series is *zero or more* -- then a
+         palindromic N is by definition NOT a Lychrel number (OEIS A023108).
+
+     The first palindromic value of N to otherwise satisfy Definition 3 is
+     9999. Since this is greater than the maximum value of 1000 specified in
+     the Task Description, I have simply assumed interpretation (b) and
+     included up-front a test to eliminate palindromic values of N as non-
+     Lychrel numbers.
+
+Interface
+---------
+By default, the solution below displays the result (0 = $n is not a Lychrel
+number, 1 = $n is probably a Lychrel number) followed by an explanation of how
+this result was reached. The explanation may be omitted by including the flag
+--terse (or just -t) on the command line.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+
+const my $MIN_N    =>         10;
+const my $MAX_N    =>      1_000;
+const my $MAX_ITER =>        500;
+const my $MAX_TERM => 10_000_000;
+const my $USAGE    =>
+"Usage:
+  perl $0 [--terse|-t] <n>
+
+    --terse    Omit the explanation?
+    <n>        A decimal integer between 10 and 1000 inclusive\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 137, Task #2: Lychrel Number (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($n, $terse) = parse_command_line();
+
+    print "Input:  \$n = $n\n";
+
+    my $is_lychrel = 0;
+    my $explanation;
+
+    if (is_palindrome( $n ))
+    {
+        $explanation = '$n is already a palindrome';
+    }
+    else
+    {
+       ($is_lychrel, $explanation) = iterate( $n );
+    }
+
+    print "Output: $is_lychrel\n";
+
+    print "\nExplanation: $explanation\n" unless $terse;
+}
+
+#------------------------------------------------------------------------------
+sub iterate
+#------------------------------------------------------------------------------
+{
+    my ($n)          =  @_;
+    my  $is_lychrel  =  1;
+    my  $explanation = "Reached the limit of $MAX_ITER iterations without " .
+                       'finding a palindrome';
+    my  $term        =  $n;
+
+    for my $i (1 .. $MAX_ITER)
+    {
+        # Reverse then add
+
+        my @digits  = split '', $term;
+        my $reverse = join  '', reverse @digits;
+           $term   += $reverse;
+
+        if (is_palindrome( $term ))
+        {
+            $is_lychrel  = 0;
+            $explanation = sprintf 'Palindrome %d found after %d iteration%s',
+                                    $term, $i, $i == 1 ? '' : 's';
+            last;
+        }
+
+        if ($term >= $MAX_TERM)
+        {
+            $explanation = sprintf 'Term %d too large after %d iteration%s',
+                                    $term, $i, $i == 1 ? '' : 's';
+            last;
+        }
+    }
+
+    return ($is_lychrel, $explanation);
+}
+
+#------------------------------------------------------------------------------
+sub is_palindrome
+#------------------------------------------------------------------------------
+{
+    my ($n)      = @_;
+    my  @digits  = split '', $n;
+    my  $reverse = join  '', reverse @digits;
+
+    return $reverse == $n;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $terse = 0;
+
+    GetOptions( terse => \$terse )
+                  or error( 'Invalid command line flag' );
+
+    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 >= $MIN_N  or error( "$n is too small (must be >= $MIN_N)" );
+    $n <= $MAX_N  or error( "$n is too large (must be <= $MAX_N)" );
+
+    return ($n, $terse);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-137/athanasius/raku/ch-1.raku b/challenge-137/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..8c66479890
--- /dev/null
+++ b/challenge-137/athanasius/raku/ch-1.raku
@@ -0,0 +1,142 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 137
+=========================
+
+TASK #1
+-------
+*Long Year*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to find all the years between 1900 and 2100 which is a Long
+Year.
+
+    A year is Long if it has 53 weeks.
+
+[UPDATED][2021-11-01 16:20:00]: For more information about Long Year, please
+refer to [ https://en.wikipedia.org/wiki/ISO_week_date#Weeks_per_year |wiki-
+pedia].
+
+Expected Output
+
+  1903, 1908, 1914, 1920, 1925,
+  1931, 1936, 1942, 1948, 1953,
+  1959, 1964, 1970, 1976, 1981,
+  1987, 1992, 1998, 2004, 2009,
+  2015, 2020, 2026, 2032, 2037,
+  2043, 2048, 2054, 2060, 2065,
+  2071, 2076, 2082, 2088, 2093,
+  2099
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Algorithm
+---------
+
+From https://en.wikipedia.org/wiki/Week#Week_52_and_53 :-
+
+    "Week 52 and 53
+
+    It is also possible to determine if the last week of the previous year was
+    Week 52 or Week 53 as follows:
+
+     - If January 1 falls on a Friday, then it is part of Week 53 of the
+       previous year (W53-5).
+     - If January 1 falls on a Saturday,
+         - then it is part of Week 53 of the previous year if that is a leap
+           year (W53-6),
+         - and part of Week 52 otherwise (W52-6), i.e. if the previous year is
+           a common year.
+     - If January 1 falls on a Sunday, then it is part of Week 52 of the
+       previous year (W52-7)."
+
+Implementation
+--------------
+Raku's inbuilt Date class provides methods day-of-week() and is-leap-year().
+
+=end comment
+#==============================================================================
+
+my UInt constant $START     = 1_900;
+my UInt constant $END       = 2_100;
+my UInt constant $YR-PER-LN =     5;
+my UInt constant $FRIDAY    =     5;
+my UInt constant $SATURDAY  =     6;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 137, Task #1: Long Year (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @long-years = gather        # Note use of the gather/take construct
+    {
+        for $START .. $END -> UInt $year
+        {
+            my Date $jan1 = Date.new: $year + 1, 1, 1;
+            my UInt $dow  = $jan1.day-of-week;
+
+            if    $dow == $FRIDAY
+            {
+                take $year;
+            }
+            elsif $dow == $SATURDAY
+            {
+                my Date $dt = Date.new: year => $year;
+
+                take $year if $dt.is-leap-year;
+            }
+        }
+    }
+
+    print-years( @long-years );
+}
+
+#------------------------------------------------------------------------------
+sub print-years( Array:D[UInt:D] $long-years )
+#------------------------------------------------------------------------------
+{
+    "There are %d long years between %d and %d inclusive:\n\n".printf:
+        $long-years.elems, $START, $END;
+
+    my UInt $idx = 0;
+
+    while $idx + $YR-PER-LN - 1 < $long-years.end
+    {
+        "%s,\n".printf:
+                    $long-years[ $idx .. $idx + $YR-PER-LN - 1 ].join: ', ';
+        $idx += $YR-PER-LN;
+    }
+
+    printf "%s\n",  $long-years[ $idx .. $long-years.end       ].join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-137/athanasius/raku/ch-2.raku b/challenge-137/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..dc3b753749
--- /dev/null
+++ b/challenge-137/athanasius/raku/ch-2.raku
@@ -0,0 +1,209 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 137
+=========================
+
+TASK #2
+-------
+*Lychrel Number*
+
+Submitted by: Mohammad S Anwar
+
+You are given a number, 10 <= $n <= 1000.
+
+Write a script to find out if the given number is Lychrel number. To keep the
+task simple, we impose the following rules:
+
+ a. Stop if the number of iterations reached 500.
+ b. Stop if you end up with number >= 10_000_000.
+
+[UPDATED][2021-11-01 16:20:00]: If you stop because of any of the above two
+rules then we expect 1 as an output.
+
+According to [ https://en.wikipedia.org/wiki/Lychrel_number |wikipedia]:
+
+A Lychrel number is a natural number that cannot form a palindrome through the
+iterative process of repeatedly reversing its digits and adding the resulting
+numbers.
+
+Example 1
+
+  Input: $n = 56
+  Output: 0
+
+  After 1 iteration, we found palindrome number.
+  56 + 65 = 121
+
+Example 2
+
+  Input: $n = 57
+  Output: 0
+
+  After 2 iterations, we found palindrome number.
+   57 +  75 = 132
+  132 + 231 = 363
+
+Example 3
+
+  Input: $n = 59
+  Output: 0
+
+  After 3 iterations, we found palindrome number.
+   59 +  95 =  154
+  154 + 451 =  605
+  605 + 506 = 1111
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Definitions
+-----------
+1. Let rev(N) be defined as the integer formed by reversing the digits of N (as
+   represented in decimal notation). Where the least significant digit(s) of N
+   are 0s (zeros), rev(N) has fewer digits than N. For example, rev(1200) =
+   "0021" = 21.
+2. Let an _Iteration_ be defined as the production of a new term from the
+   previous term as follows: term[N+1] = term[N] + rev(term[N])
+3. Let a Lychrel number be defined as a number N such that no finite series of
+   _Iterations_ beginning with term[0] = N results in a term which is a
+   palindrome.
+
+Notes:
+
+(i) "In base ten, no Lychrel numbers have been yet proved to exist, but many,
+     including 196, are suspected on heuristic and statistical grounds."
+     (Wikipedia). An output of 1 is therefore an indication that the given $n
+     is *probably* a Lychrel number.
+
+(ii) There is an ambiguity in the definition of Lychrel numbers: how are we to
+     treat the degenerative case in which term[0] is a palindrome, but no
+     term[x: x > 0] is a palindrome?
+
+     (a) If a finite series of _Iterations_ is taken to mean *one or more*,
+         then a palindromic N might be a Lychrel number (OEIS A088753)
+     (b) Otherwise -- i.e., if a finite series is *zero or more* -- then a
+         palindromic N is by definition NOT a Lychrel number (OEIS A023108).
+
+     The first palindromic value of N to otherwise satisfy Definition 3 is
+     9999. Since this is greater than the maximum value of 1000 specified in
+     the Task Description, I have simply assumed interpretation (b) and
+     included up-front a test to eliminate palindromic values of N as non-
+     Lychrel numbers.
+
+Interface
+---------
+By default, the solution below displays the result (0 = $n is not a Lychrel
+number, 1 = $n is probably a Lychrel number) followed by an explanation of how
+this result was reached. The explanation may be omitted by including the flag
+--terse on the command line.
+
+=end comment
+#==============================================================================
+
+my UInt constant $MIN-N    =         10;
+my UInt constant $MAX-N    =      1_000;
+my UInt constant $MAX-ITER =        500;
+my UInt constant $MAX-TERM = 10_000_000;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 137, Task #2: Lychrel Number (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D  $n where { $MIN-N <= $n <= $MAX-N },   #= A decimal integer between
+                                                   #=   10 and 1000 inclusive
+    Bool:D :$terse = False                         #= Omit the explanation?
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    my Bool $is-lychrel = False;
+    my Str  $explanation;
+
+    if is-palindrome( $n )
+    {
+        $explanation = '$n is already a palindrome';
+    }
+    else
+    {
+       ($is-lychrel, $explanation) = iterate( $n );
+    }
+
+    "Output: %d\n".printf: $is-lychrel ?? 1 !! 0;
+
+    "\nExplanation: $explanation".put unless $terse;
+}
+
+#------------------------------------------------------------------------------
+sub iterate( UInt:D $n --> Array:D[ Bool:D, Str:D ] )
+#------------------------------------------------------------------------------
+{
+    my Bool $is-lychrel  =  True;
+    my Str  $explanation = "Reached the limit of $MAX-ITER iterations " ~
+                           'without finding a palindrome';
+    my UInt $term        =  $n;
+
+    for 1 .. $MAX-ITER -> UInt $i
+    {
+        # Reverse then add
+
+        my UInt @digits  = $term.split( '', :skip-empty ).map: { .Int };
+        my UInt $reverse = @digits.reverse.join( '' ).Int;
+                $term   += $reverse;
+
+        if is-palindrome( $term )
+        {
+            $is-lychrel  =  False;
+            $explanation = 'Palindrome %d found after %d iteration%s'.sprintf:
+                            $term, $i, $i == 1 ?? '' !! 's';
+            last;
+        }
+
+        if $term >= $MAX-TERM
+        {
+            $explanation = 'Term %d too large after %d iteration%s'.sprintf:
+                            $term, $i, $i == 1 ?? '' !! 's';
+            last;
+        }
+    }
+
+    return [ $is-lychrel, $explanation ];
+}
+
+#------------------------------------------------------------------------------
+sub is-palindrome( UInt:D $n --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    my UInt @digits  = $n.split( '', :skip-empty ).map: { .Int };
+    my UInt $reverse = @digits.reverse.join( '' ).Int;
+
+    return $reverse == $n;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################