Add Perl solutions

4 files changed, 106 insertions, 0 deletions

diff --git a/challenge-147/paulo-custodio/perl/ch-1.pl b/challenge-147/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..85b81d6210
--- /dev/null
+++ b/challenge-147/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+
+# Challenge 147
+#
+# TASK #1 › Truncatable Prime
+# Submitted by: Mohammad S Anwar
+# Write a script to generate first 20 left-truncatable prime numbers in base 10.
+#
+# In number theory, a left-truncatable prime is a prime number which, in a given
+# base, contains no 0, and if the leading left digit is successively removed,
+# then all resulting numbers are primes.
+#
+# Example
+# 9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are all
+# prime numbers.
+
+use Modern::Perl;
+use ntheory qw( is_prime next_prime );
+
+my $it = left_truncatable_prime_it();
+my @out;
+for (1..20) {
+    push @out, $it->();
+}
+say join(", ", @out);
+
+
+sub left_truncatable_prime_it {
+    my $prime;
+    return sub {
+        while (1) {
+            $prime = defined($prime) ? next_prime($prime) : 2;
+            return $prime if is_left_truncatable_prime($prime);
+        }
+    };
+}
+
+sub is_left_truncatable_prime {
+    my($p) = @_;
+    while (1) {
+        return 0 if !is_prime($p);
+        $p =~ s/.(.*)/$1/;
+        return 1 if $p eq '';
+    }
+}
diff --git a/challenge-147/paulo-custodio/perl/ch-2.pl b/challenge-147/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..f81f51987d
--- /dev/null
+++ b/challenge-147/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+
+# Challenge 147
+#
+# TASK #2 › Pentagon Numbers
+# Submitted by: Mohammad S Anwar
+# Write a script to find the first pair of Pentagon Numbers whose sum and
+# difference are also a Pentagon Number.
+#
+# Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
+#
+# Example
+# The first 10 Pentagon Numbers are:
+# 1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.
+#
+# P(4) + P(7) = 22 + 70 = 92 = P(8)
+# but
+# P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.
+
+use Modern::Perl;
+my $limit = 100_000_000;
+
+my @pentagon = (1);
+my %is_pentagon;
+
+my($a, $b) = find_pair();
+say "($a,$b)";
+
+sub is_pentagon {
+    my($num) = @_;
+    while ($pentagon[-1] < $num) {
+        my $n = scalar(@pentagon)+1;
+        my $p = $n*(3*$n - 1)/2;
+        push @pentagon, $p;
+        $is_pentagon{$p} = 1;
+    }
+    return $is_pentagon{$num};
+}
+
+sub find_pair {
+    is_pentagon($limit);        # build pentagon up to N
+    my @try = @pentagon;
+    for my $a (@try) {
+        for my $b (@try) {
+            if (is_pentagon($a+$b) && is_pentagon(abs($a-$b))) {
+                return ($a, $b);
+            }
+        }
+    }
+    die;
+}
diff --git a/challenge-147/paulo-custodio/t/test-1.yaml b/challenge-147/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..3a593af5b9
--- /dev/null
+++ b/challenge-147/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:
+  input:
+  output:   2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 103, 107, 113, 137, 167
diff --git a/challenge-147/paulo-custodio/t/test-2.yaml b/challenge-147/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..d00c852d5d
--- /dev/null
+++ b/challenge-147/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:
+  input:
+  output:   (1560090,7042750)