2 files changed, 98 insertions, 0 deletions
diff --git a/challenge-147/pete-houston/perl/ch-1.pl b/challenge-147/pete-houston/perl/ch-1.pl
new file mode 100755
index 0000000000..996ee8e815
--- /dev/null
+++ b/challenge-147/pete-houston/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 14701.pl
+#
+#        USAGE: ./14701.pl
+#
+#  DESCRIPTION: Output the first 20 left-truncatable prime numbers in
+#               base 10.
+#
+# REQUIREMENTS: Math::Prime::Util
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 10/01/22
+#===============================================================================
+
+use strict;
+use warnings;
+use Math::Prime::Util qw/next_prime/;
+
+my $count = 20;
+my $n     = 1;
+my @found;
+my %primes;
+
+while ($count > @found) {
+	$n = next_prime ($n);
+	$primes{$n} = 1;
+	push @found, $n if left_trunc ($n);
+}
+print "@found\n";
+
+# This is a closure over %primes
+sub left_trunc {
+	my $x = shift;
+	return if -1 < index $x, 0;
+	my $len = length ($x);
+	for (2 .. $len) {
+		$x = substr $x, 1;
+		return unless $primes{$x};
+	}
+	return 1;
+}
diff --git a/challenge-147/pete-houston/perl/ch-2.pl b/challenge-147/pete-houston/perl/ch-2.pl
new file mode 100755
index 0000000000..dea9d0226e
--- /dev/null
+++ b/challenge-147/pete-houston/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 14702.pl
+#
+#        USAGE: ./14702.pl  
+#
+#  DESCRIPTION: Find the first pair of Pentagon Numbers whose sum and
+#               difference are also themselves Pentagon Numbers.
+#
+#         BUGS: O(n^2) - could use some optimisation
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 10/01/22
+#===============================================================================
+
+use strict;
+use warnings;
+
+# Pentagon numbers can be defined as P(n) = n(3n - 1)/2
+
+my $limit = 1_000_000;
+my (%seen, @pns);
+
+for my $i (1 .. $limit) {
+	# Calculate this one
+	my $pn = $i * ( 3 * $i - 1) / 2;
+	# Loop over all previous ones
+	for my $j (@pns) {
+		my ($diff, $sum) = ($pn - $j, $pn + $j);
+		if ($seen{$diff} && is_pentagon ($sum)) {
+			print "$pn and $j are the first pair\n";
+			exit;
+		}
+	}
+	# Store this one
+	push @pns, $pn;
+	$seen{$pn} = 1;
+}
+
+# Just in case we don't find a valid pair
+die "Bailing out after trying $limit pentagon numbers.\n";
+
+sub is_pentagon {
+	my $x = shift;
+	# Quadratic: 3i^2 -i - 2x = 0
+	# root = (-b +/- sqrt(b^2 - 4ac)) / 2a
+	my $term = sqrt (1 + 24 * $x);
+	# Cannot be negative
+	my $root = (1 + $term) / 6;
+	# So numerator must be an integer multiple of 6, I think.
+	return $root == int $root;
+}