Merge pull request #289 from PerlMonk-Athanasius/branch-for-challenge-013

Solutions to Challenge #013 + blog URL

5 files changed, 318 insertions, 0 deletions

diff --git a/challenge-013/athanasius/blog.txt b/challenge-013/athanasius/blog.txt
new file mode 100644
index 0000000000..0c502b5112
--- /dev/null
+++ b/challenge-013/athanasius/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/athanasius/2019/06/perl-weekly-challenge-013.html
diff --git a/challenge-013/athanasius/perl5/ch-1.pl b/challenge-013/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..f243222b07
--- /dev/null
+++ b/challenge-013/athanasius/perl5/ch-1.pl
@@ -0,0 +1,86 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 013
+=========================
+
+Challenge #1
+------------
+
+Write a script to print the date of last *Friday* of every month of a given
+year. For example, if the given year is *2019* then it should print the follow-
+ing:
+
+2019/01/25
+2019/02/22
+2019/03/29
+2019/04/26
+2019/05/31
+2019/06/28
+2019/07/26
+2019/08/30
+2019/09/27
+2019/10/25
+2019/11/29
+2019/12/27
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use DateTime;
+use Regexp::Common;
+
+const my @DAYS_IN_MONTH  => ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
+const my $DAYS_IN_WEEK   =>    7;
+const my $DEFAULT_YEAR   => 2019;
+const my $FEBRUARY_INDEX =>    1;
+const my @OFFSET_1ST_FRI => (  4,  3,  2,  1,  0,  6,  5 );
+const my $USAGE          => "USAGE: perl $0 <year>";
+
+$| = 1;
+
+MAIN:
+{
+    my $year  = get_year();
+    my $dt    = DateTime->new(year => $year, month => 1, day => 1);
+    my $first = 1 + $OFFSET_1ST_FRI[ $dt->day_of_week - 1 ];
+    my @days  = @DAYS_IN_MONTH;
+     ++$days[ $FEBRUARY_INDEX ] if $dt->is_leap_year();
+
+    print "\nLast Fridays in each month of $year:\n\n";
+
+    for my $month (0 .. 11)
+    {
+        my $days  = $days[ $month ];
+        my $last  = $first;
+           $last += $DAYS_IN_WEEK until $last > $days;
+           $first = $last - $days;
+           $last -= $DAYS_IN_WEEK;
+
+        printf "%4d/%02d/%02d\n", $year, ($month + 1), $last;
+    }
+}
+
+sub get_year
+{
+    scalar @ARGV <= 1
+        or die "\n$USAGE\n";
+
+    my $year = $ARGV[0] // $DEFAULT_YEAR;
+
+    $year =~ /^$RE{num}{int}$/
+        or die "\nInvalid year '$year': must be an integer\n";
+
+    return $year;
+}
+
+################################################################################
diff --git a/challenge-013/athanasius/perl5/ch-2.pl b/challenge-013/athanasius/perl5/ch-2.pl
new file mode 100644
index 0000000000..dc5f816364
--- /dev/null
+++ b/challenge-013/athanasius/perl5/ch-2.pl
@@ -0,0 +1,92 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 013
+=========================
+
+Challenge #2
+------------
+
+Write a script to demonstrate *Mutually Recursive* methods. Two methods are
+mutually recursive if the first method calls the second and the second calls
+first in turn. Using the mutually recursive methods, generate
+[ https://en.wikipedia.org/wiki/Hofstadter_sequence#
+Hofstadter_Female_and_Male_sequences |Hofstadter Female and Male sequences].
+
+ F ( 0 ) = 1   ;   M ( 0 ) = 0
+ F ( n ) = n − M ( F ( n − 1 ) ) , n > 0
+ M ( n ) = n − F ( M ( n − 1 ) ) , n > 0.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use utf8;
+use warnings;
+use Const::Fast;
+use Memoize;
+use Regexp::Common;
+use constant TIMER => 1;
+
+const my $DEFAULT =>  21;
+const my $USAGE   => "perl $0 [ <series_length> ]";
+
+$| = 1;
+
+MAIN:
+{
+    @ARGV <= 1
+        or die "\n$USAGE\n";
+
+    my $n = $ARGV[0] // $DEFAULT;
+
+    $n =~ /^$RE{num}{int}$/ && $n > 0
+        or die "\nInvalid series length '$n': must be an integer > 0\n";
+
+    --$n;  # Convert series length to index of final term (series is zero-based)
+
+    # Memoization produces an enormous speed-up for even moderately-sized n
+
+    memoize('F');
+    memoize('M');
+
+    for my $func ('F', 'M')
+    {
+        printf "\n%s(%s%d): %s\n", $func, ($n == 0 ? '' : '0..'), $n,
+                                   join( ', ', seq(\&{$func}, $n)->@* );
+    }
+}
+
+sub seq     # Accumulate terms ( X(0) .. X(max) ), where X is either F or M
+{
+    my ($func, $max) = @_;     # max ∊ N ∪ {0}
+
+    my   @series;
+    push @series, $func->($_) for 0 .. $max;
+
+    return \@series;
+}
+
+sub F       # Find term n in the "Female" series
+{
+    my ($n) = @_;           # n ∊ N ∪ {0}
+
+    return $n == 0 ? 1                          # Base case
+                   : $n - M( F($n - 1) );       # Mutual recursion
+}
+
+sub M       # Find term n in the "Male" series
+{
+    my ($n) = @_;           # n ∊ N ∪ {0}
+
+    return $n == 0 ? 0                          # Base case
+                   : $n - F( M($n - 1) );       # Mutual recursion
+}
+
+################################################################################
diff --git a/challenge-013/athanasius/perl6/ch-1.p6 b/challenge-013/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..7f8c3acf10
--- /dev/null
+++ b/challenge-013/athanasius/perl6/ch-1.p6
@@ -0,0 +1,66 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 013
+=========================
+
+Challenge #1
+------------
+
+Write a script to print the date of last *Friday* of every month of a given
+year. For example, if the given year is *2019* then it should print the follow-
+ing:
+
+2019/01/25
+2019/02/22
+2019/03/29
+2019/04/26
+2019/05/31
+2019/06/28
+2019/07/26
+2019/08/30
+2019/09/27
+2019/10/25
+2019/11/29
+2019/12/27
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use DateTime:from<Perl5>;
+
+my Int constant $DAYS_IN_WEEK   :=    7;
+my Int constant $DEFAULT_YEAR   := 2019;
+my Int constant $FEBRUARY_INDEX :=    1;
+my     constant @DAYS_IN_MONTH  := Array[Int].new: 31, 28, 31, 30, 31, 30,
+                                                   31, 31, 30, 31, 30, 31;
+my     constant @OFFSET_1ST_FRI := Array[Int].new:  4,  3,  2,  1,  0,  6,  5;
+
+sub MAIN(Int:D $year = $DEFAULT_YEAR)
+{
+    my $dt    = DateTime.new( :$year, month => 1, day => 1 );
+    my $first = 1 + @OFFSET_1ST_FRI[ $dt.day_of_week - 1 ];
+    my @days  = @DAYS_IN_MONTH;
+     ++@days[ $FEBRUARY_INDEX ] if $dt.is_leap_year;
+
+    say "\nLast Fridays in each month of $year:\n";
+
+    for 1 .. 12 -> Int $month
+    {
+        my $days  = @days[ $month - 1 ];
+        my $last  = $first;
+           $last += $DAYS_IN_WEEK until $last > $days;
+           $first = $last - $days;
+           $last -= $DAYS_IN_WEEK;
+
+        printf "%4d/%02d/%02d\n", $year, $month, $last;
+    }
+}
+
+################################################################################
diff --git a/challenge-013/athanasius/perl6/ch-2.p6 b/challenge-013/athanasius/perl6/ch-2.p6
new file mode 100644
index 0000000000..ab9cd3262a
--- /dev/null
+++ b/challenge-013/athanasius/perl6/ch-2.p6
@@ -0,0 +1,73 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 013
+=========================
+
+Challenge #2
+------------
+
+Write a script to demonstrate *Mutually Recursive* methods. Two methods are
+mutually recursive if the first method calls the second and the second calls
+first in turn. Using the mutually recursive methods, generate
+[ https://en.wikipedia.org/wiki/Hofstadter_sequence#
+Hofstadter_Female_and_Male_sequences |Hofstadter Female and Male sequences].
+
+ F ( 0 ) = 1   ;   M ( 0 ) = 0
+ F ( n ) = n − M ( F ( n − 1 ) ) , n > 0
+ M ( n ) = n − F ( M ( n − 1 ) ) , n > 0.
+
+=end comment
+
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use Sub::Memoized;					# Memoization produces an enormous speed-up
+									# for even moderately-long series
+my Int constant $DEFAULT := 21;
+
+subset Non-negative-integer of Int where * >= 0;
+subset Positive-integer     of Int where * >  0;
+
+sub MAIN(Positive-integer:D $length = $DEFAULT)
+{
+    my Int $n      = $length - 1;        # Convert length to index of final term
+    my Str $format = "\n" ~ '%s(%s%d): %s' ~ "\n";
+    my Str $prefix = $n == 0 ?? '' !! '0..';
+    my     %funcs  = (:&F, :&M);
+
+    $format.printf: $_, $prefix, $n, seq(%funcs{$_}, $n).join(', ') for < F M >;
+}
+
+# seq(): Accumulate terms X(0), X(1), .. X(max), where X is either F or M
+
+sub seq(Sub:D $func, Non-negative-integer:D $max --> Array)
+{
+    my     @series;
+    push   @series, $func($_) for 0 .. $max;
+
+    return @series;
+}
+
+# F(): Find term n in the "Female" series
+
+sub F(Non-negative-integer:D $n --> Non-negative-integer) is memoized
+{
+    return $n == 0 ?? 1                         # Base case
+                   !! $n - M( F($n - 1) );      # Mutual recursion
+}
+
+# M(): Find term n in the "Male" series
+
+sub M(Non-negative-integer:D $n --> Non-negative-integer) is memoized
+{
+    return $n == 0 ?? 0                         # Base case
+                   !! $n - F( M($n - 1) );      # Mutual recursion
+}
+
+################################################################################