Add Perl solution to challenge 013

4 files changed, 136 insertions, 0 deletions

diff --git a/challenge-013/paulo-custodio/README b/challenge-013/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-013/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-013/paulo-custodio/perl/ch-1.pl b/challenge-013/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..132cbde073
--- /dev/null
+++ b/challenge-013/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+
+# 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 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
+
+use strict;
+use warnings;
+use 5.030;
+use Date::Calc 'Nth_Weekday_of_Month_Year';
+
+our $Friday = 5;
+
+sub last_friday {
+	my($year,$month) = @_;
+	for my $n (reverse 1..5) {
+		if (my($y,$m,$d) = Nth_Weekday_of_Month_Year($year,$month,$Friday,$n)) {
+			return ($y,$m,$d);
+		}
+	}
+}
+
+my $year = shift || 2021;
+for my $month (1..12) {
+	my($y,$m,$d) = last_friday($year,$month);
+	printf("%04d/%02d/%02d\n", $y,$m,$d);
+}
diff --git a/challenge-013/paulo-custodio/perl/ch-2.pl b/challenge-013/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..11ae51a16a
--- /dev/null
+++ b/challenge-013/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+# 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 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.
+ 
+use strict;
+use warnings;
+use 5.030;
+
+sub F {
+	my($n) = @_;
+	return 1 if $n==0;
+	return $n - M( F($n - 1) );
+}
+
+sub M {
+	my($n) = @_;
+	return 0 if $n==0;
+	return $n - F( M($n - 1) );
+}
+
+my $N = shift || 21;
+
+say "F: ", join(", ", map {F($_)} 0..$N-1), ", ...";
+say "M: ", join(", ", map {M($_)} 0..$N-1), ", ...";
+
diff --git a/challenge-013/paulo-custodio/test.pl b/challenge-013/paulo-custodio/test.pl
new file mode 100644
index 0000000000..30919b0235
--- /dev/null
+++ b/challenge-013/paulo-custodio/test.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use 5.030;
+use Test::More;
+
+is capture("perl perl/ch-1.pl 2019"), <<END;
+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
+
+is capture("perl perl/ch-1.pl 2021"), <<END;
+2021/01/29
+2021/02/26
+2021/03/26
+2021/04/30
+2021/05/28
+2021/06/25
+2021/07/30
+2021/08/27
+2021/09/24
+2021/10/29
+2021/11/26
+2021/12/31
+END
+
+
+is capture("perl perl/ch-2.pl 3"), <<END;
+F: 1, 1, 2, ...
+M: 0, 0, 1, ...
+END
+
+is capture("perl perl/ch-2.pl 21"), <<END;
+F: 1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13, ...
+M: 0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12, ...
+END
+
+done_testing;
+
+
+sub capture {
+	my($cmd) = @_;
+	my $out = `$cmd`;
+	$out =~ s/[ \r\t]*\n/\n/g;
+	return $out;
+}
+