- Added solutions by Pete Houston.

2 files changed, 140 insertions, 0 deletions

diff --git a/challenge-119/pete-houston/perl/ch-1.pl b/challenge-119/pete-houston/perl/ch-1.pl
new file mode 100644
index 0000000000..7deaf7aa55
--- /dev/null
+++ b/challenge-119/pete-houston/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 11901.pl
+#
+#        USAGE: ./11901.pl [ N ]
+#
+#  DESCRIPTION: Swap the nybbles and output the decimal.
+#
+#      OPTIONS: If N is omitted, run the test suite instead
+# REQUIREMENTS: Bit::Manip, Test::More
+#        NOTES: If N is given but not a small whole number an error is thrown.
+#               Either swap subroutine could be used as the main one or the
+#               test one in reality, of course.
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 28/06/21
+#===============================================================================
+
+use strict;
+use warnings;
+use Bit::Manip qw/bit_get bit_set/;
+use Test::More;
+
+if (scalar @ARGV) {
+	my $n = valid_input ();
+	print 0+nybble_swap ($n) . "\n";
+	exit;
+}
+
+plan tests => 256;
+for my $i (1 .. 255, 0) {
+	is nybble_swap ($i), check_swap ($i),
+		"$i swaps match to " .  nybble_swap ($i);
+}
+
+sub valid_input {
+	my ($input) = $ARGV[0] =~ /^([0-9][0-9]*)$/
+		or die "Argument must be positive int\n";
+	die "Input must be less than 256" if $input >= 256;
+	return $input;
+}
+
+sub nybble_swap {
+	my $byte   = shift;
+	my $nybble = bit_get ($byte, 7, 4);
+	$byte = bit_set ($byte, 4, 4, bit_get ($byte, 3, 0));
+	$byte = bit_set ($byte, 0, 4, $nybble);
+	return $byte;
+}
+
+sub check_swap {
+	my $num   = shift;
+	my $upper = int $num / 16;
+	my $lower = $num % 16;
+	return $lower * 16 + $upper;
+}
diff --git a/challenge-119/pete-houston/perl/ch-2.pl b/challenge-119/pete-houston/perl/ch-2.pl
new file mode 100644
index 0000000000..59af059e7c
--- /dev/null
+++ b/challenge-119/pete-houston/perl/ch-2.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 11902.pl
+#
+#        USAGE: ./11902.pl [-v] N
+#
+#  DESCRIPTION: Print the nth member of the increasing sequence with
+#               only digits 1, 2 and 3 and no double 1s.
+#
+#      OPTIONS: -v will additionally list all values up to the Nth
+# REQUIREMENTS: List::Util, Getopt::Std (both in core)
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 28/06/21
+#===============================================================================
+
+use strict;
+use warnings;
+
+use List::Util 'max';
+use Getopt::Std 'getopts';
+
+# Parse the command line options and args
+my $verbose = 0;
+{
+	my %opts;
+	getopts ('v', \%opts);
+	$verbose++ if $opts{v};
+}
+
+my ($n) = $ARGV[0] =~ /^([0-9]+)$/ or die "Argument must be positive int\n";
+
+# Loop through the sequence up to the Nth entry
+my $x = 1;
+for (2 .. $n) {
+	print "$x\n" if $verbose;
+	$x = next_seq ($x);
+}
+print "$x\n";
+
+# Generate the next element of the sequence from the current one.
+sub next_seq {
+	my $cur = shift;
+
+	# Handle the trivial case
+	return $cur + 1 unless substr ($cur, -1) eq 3;
+
+	# Find the last non-3 and increment from there
+	my $loc = max rindex ($cur, 1), rindex ($cur, 2);
+
+	if ($loc < 0) {
+		# They're all threes, so replace them all with repetitions of
+		# '21' and prepend with 1
+		my $new = "1$cur";
+		$new =~ s/33/21/g;
+		$new =~ s/3$/2/;
+		return $new;
+	}
+
+	# Increment the last non-3 and replace the 3s following it with the
+	# minimal pattern which is '12121212...'
+	my $lastnon3 = substr $cur, $loc, 1;
+	my $new      = $cur;
+	my $len      = length $cur;
+	my $rstr     = $lastnon3 + 1 . string_fill ('12', $len - $loc - 1);
+
+	substr $new, $loc, $len - $loc + 1, $rstr;
+
+	return $new;
+}
+
+# Given a pattern to repeat and a length, return a string of precisely
+# that length filled with the pattern.
+sub string_fill {
+	my ($pat, $len) = @_;
+	my $lpat = length $pat;
+	my $buf = $pat x ($len / $lpat);
+	$buf .= substr ($pat, 0, $len % $lpat);
+	return $buf;
+}