- Added solutions by Pete Houston.

2 files changed, 131 insertions, 0 deletions

diff --git a/challenge-114/pete-houston/perl/ch-1.pl b/challenge-114/pete-houston/perl/ch-1.pl
new file mode 100644
index 0000000000..f6e8dfe6f7
--- /dev/null
+++ b/challenge-114/pete-houston/perl/ch-1.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 11401.pl
+#
+#        USAGE: ./11401.pl N 
+#
+#  DESCRIPTION: Output the next palindromic number above natural number N
+#
+# REQUIREMENTS: POSIX
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 24/05/21
+#===============================================================================
+
+use strict;
+use warnings;
+use POSIX 'ceil';
+
+my $n = shift;
+
+my $digits  = length $n;
+my $halflen = ceil $digits / 2;
+
+my $pal = palindrome ($n, $digits, $halflen);
+if ($pal <= $n) {
+	# Not high enough so increment the first half and try again
+	$pal = substr ($pal, 0, $halflen) + 1 . substr ($pal, $halflen);
+	# Bump the digits and halflength if the number is now longer
+	if ($digits < length $pal) {
+		$digits++;
+		$halflen = ceil $digits / 2;
+	}
+	$pal = palindrome ($pal, $digits, $halflen);
+}
+print "$pal\n";
+
+
+sub palindrome {
+	my ($num, $d, $halfl) = @_;
+
+	# Set the length of the reverse part
+	my $revlen = $d % 2 ? $halfl - 1 : $halfl;
+	# Create the palindrome based on the first half
+	substr $num, $halfl, $d - $halfl, reverse substr $num, 0, $revlen;
+	return $num;
+}
diff --git a/challenge-114/pete-houston/perl/ch-2.pl b/challenge-114/pete-houston/perl/ch-2.pl
new file mode 100644
index 0000000000..ecce38b9d0
--- /dev/null
+++ b/challenge-114/pete-houston/perl/ch-2.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 11402.pl
+#
+#        USAGE: ./11402.pl [ N ]
+#
+#  DESCRIPTION: Output the next higher integer having the same number of
+#               1 bits in binary representation as $N.
+#
+#      OPTIONS: If N is not supplied (or zero) then the test suite is
+#               run instead
+# REQUIREMENTS: Test::More for the test suite
+#         BUGS: N is not checked to be a natural number. GIGO.
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 24/05/21
+#===============================================================================
+
+use strict;
+use warnings;
+use Test::More;
+
+if (0 < @ARGV) {
+	print nextint(shift) . "\n";
+	exit;
+}
+
+sub nextint {
+	my $prev = int abs shift;
+	my $bstr = sprintf "%b", $prev;
+	my @bits = split //, $bstr;
+
+	# Power of 2 special case
+	return $prev * 2 if $bstr =~ /^10*$/;
+
+	# Logic: to increase the number, at least one 1 must move left.
+	# From the right, find the first 1 which has a zero to its left
+	# and move the rightmost available 1 there.
+	my $i          = $#bits;
+	my $least1     = $i + 1;
+	my $nextleast0 = $least1;
+	my $ones       = 0;
+	while ($i >= 0) {
+		if ($bits[$i]) {
+			$least1 = $i if $least1 > $#bits;
+			$ones++;
+		} elsif ($least1 <= $#bits) {
+			$nextleast0 = $i;
+			last;
+		}
+		$i--;
+	}
+	if ($ones > $#bits) {
+		# All 1s special case
+		$bits[0] = 0;
+		unshift @bits, 1;
+	} else {
+		$bits[$least1]     = 0;
+		$bits[$nextleast0] = 1;
+	}
+	$bstr = join '', @bits;
+	return oct "0b$bstr";
+}
+
+my @tests = (
+	{ in =>  1, out =>  2 },
+	{ in =>  2, out =>  4 },
+	{ in =>  3, out =>  5 },
+	{ in =>  4, out =>  8 },
+	{ in =>  5, out =>  6 },
+	{ in =>  6, out =>  9 },
+	{ in =>  7, out => 11 },
+	{ in =>  8, out => 16 },
+	{ in => 12, out => 17 },
+);
+
+plan tests => scalar @tests;
+
+for my $t (@tests) {
+	is nextint($t->{in}), $t->{out}, "$t->{in} becomes $t->{out}";
+}