aboutsummaryrefslogtreecommitdiff
path: root/challenge-013/dave-jacoby
diff options
context:
space:
mode:
authorMohammad S Anwar <Mohammad.Anwar@yahoo.com>2019-06-17 18:05:35 +0100
committerGitHub <noreply@github.com>2019-06-17 18:05:35 +0100
commitda4e523c5705c9dcd4e6b106928e0c4ccc1ec0ea (patch)
tree8f8c0329c17c1606f972cc0e4d0e3bbdc9c3ff7c /challenge-013/dave-jacoby
parent7dd4d6b58cf6ad2cbdb1b576f311246b7e079ef5 (diff)
parent470de748e3963d6028a9eca21dc72affbde509ed (diff)
downloadperlweeklychallenge-club-da4e523c5705c9dcd4e6b106928e0c4ccc1ec0ea.tar.gz
perlweeklychallenge-club-da4e523c5705c9dcd4e6b106928e0c4ccc1ec0ea.tar.bz2
perlweeklychallenge-club-da4e523c5705c9dcd4e6b106928e0c4ccc1ec0ea.zip
Merge pull request #271 from jacoby/p013
Friday, Friday! Gotta deploy on Friday!
Diffstat (limited to 'challenge-013/dave-jacoby')
-rw-r--r--challenge-013/dave-jacoby/c1.pl81
-rw-r--r--challenge-013/dave-jacoby/c2.pl69
2 files changed, 150 insertions, 0 deletions
diff --git a/challenge-013/dave-jacoby/c1.pl b/challenge-013/dave-jacoby/c1.pl
new file mode 100644
index 0000000000..5a5e0131dc
--- /dev/null
+++ b/challenge-013/dave-jacoby/c1.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/env perl
+
+# Perl Weekly Challenge 013-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 following:
+
+# 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
+
+# I should not have read the challenge during the start of TPC
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings
+ qw{ experimental::postderef experimental::smartmatch experimental::signatures };
+
+use DateTime;
+
+my $year = shift @ARGV;
+$year //= 2019; # because sawyer x mentioned the //= operator to applause
+
+last_fridays($year);
+
+# best to not think of this in terms of the year, but as 12
+# instances of last friday in the month
+sub last_fridays ( $year ) {
+ for my $mon ( 1 .. 12 ) { say last_friday( $year, $mon ); }
+}
+
+sub last_friday ( $year, $mon ) {
+ # Thank you Dave Rolsky and everyone else who made this simple
+
+ # Months are not of a standard size. We don't know the last day
+ # but we do know what the first day is
+ my $dt = DateTime->new(
+ year => $year,
+ month => $mon,
+ day => 1,
+ hour => 12,
+ minute => 0,
+ second => 0,
+ time_zone => 'floating'
+ );
+
+ # and no month is 32 days long
+ $dt->add( days => 32 );
+
+ # while does nothing if the test is true
+ $dt->subtract( days => 1 ) while $dt->day_of_week != 5; # find a friday
+ $dt->subtract( days => 7 ) while $dt->month != $mon; # and move backto the right month
+ return $dt->ymd('/'); # example solution uses slashes
+}
+
+__DATA__
+
+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
diff --git a/challenge-013/dave-jacoby/c2.pl b/challenge-013/dave-jacoby/c2.pl
new file mode 100644
index 0000000000..8a7c0663a4
--- /dev/null
+++ b/challenge-013/dave-jacoby/c2.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/env perl
+
+# Perl Weekly Challenge 013-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 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.
+
+# Thinking through this problem
+
+# ff(1) = 1 - mm( ff( 0 ) )
+# ff(1) = 1 - mm( 1 )
+# mm(1) = 1 - ff( mm( 0 ) )
+# mm(1) = 1 - ff( 0 )
+# mm(1) = 1 - 1
+# mm(1) = 0
+# ff(1) = 1 - 0
+# ff(1) = 1
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch fc };
+no warnings
+ qw{ experimental::postderef experimental::smartmatch experimental::signatures };
+
+for my $n ( 0 .. 3 ) {
+ my $f = ff($n);
+ my $m = mm($n);
+ # say '';
+ say qq{ f( $n ) = $f \t m( $n ) = $m };
+}
+
+exit;
+
+sub ff( $n ) {
+ # print qq{ ff($n) };
+ return 1 if $n == 0 ;
+ return $n - mm( ff( $n-1 ));
+}
+
+# using mm() because m() is a match operator, and using ff() to
+# keep consistent, even though there isn't an f() operator.
+sub mm( $n ) {
+ # print qq{ mm($n) };
+ return 0 if $n == 0 ;
+ return $n - ff( mm( $n-1 ));
+}
+
+__DATA__
+ ff(0) mm(0)
+ f( 0 ) = 1 m( 0 ) = 0
+
+ ff(1) ff(0) mm(1) mm(0) ff(0) mm(1) mm(0) ff(0)
+ f( 1 ) = 1 m( 1 ) = 0
+
+ ^^^ Verified
+
+ ff(2) ff(1) ff(0) mm(1) mm(0) ff(0) mm(1) mm(0) ff(0) mm(2) mm(1) mm(0) ff(0) ff(0)
+ f( 2 ) = 2 m( 2 ) = 1
+
+ ff(3) ff(2) ff(1) ff(0) mm(1) mm(0) ff(0) mm(1) mm(0) ff(0) mm(2) mm(1) mm(0) ff(0) ff(0) mm(3) mm(2) mm(1) mm(0) ff(0) ff(0) ff(1) ff(0) mm(1) mm(0) ff(0)
+ f( 3 ) = 2 m( 3 ) = 2