Week 212

3 files changed, 102 insertions, 0 deletions

diff --git a/challenge-212/peter-campbell-smith/blog.txt b/challenge-212/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..482c42b793
--- /dev/null
+++ b/challenge-212/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/212
diff --git a/challenge-212/peter-campbell-smith/perl/ch-1.pl b/challenge-212/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..6c5a1c904f
--- /dev/null
+++ b/challenge-212/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-04-10
+use utf8;     # Week 212 task 1 - Jumping letters
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+advance_letters('Perl', [2, 22, 19, 9]);
+advance_letters('Lead', [21, 10, 11, 0]);
+advance_letters('Failure', [13, 20, 20, 17, 10, 1, 14]);
+
+sub advance_letters {
+	
+	my (@letters, $j, $new, @jumps, $l, $ord_a);
+	
+	# input
+	@letters = split('', $_[0]);
+	@jumps = @{$_[1]};
+	
+	# loop over letters
+	for $j (0 .. scalar @letters - 1) {
+		$l = $letters[$j];
+		
+		# get offset - a or A
+		$ord_a = ord($l) < ord('a') ? ord('A') : ord('a');
+		
+		# append jumped character
+		$new .= chr((ord($l) - $ord_a + $jumps[$j]) % 26 + $ord_a);
+	}
+	
+	# show result
+	say qq[\nInput  \$word = '$_[0]' and \@jump = (] . join(', ', @jumps) . q[)];
+	say qq[Output:        '$new'];
+}
+		
\ No newline at end of file
diff --git a/challenge-212/peter-campbell-smith/perl/ch-2.pl b/challenge-212/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..45bcf46270
--- /dev/null
+++ b/challenge-212/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-04-10
+use utf8;     # Week 212 task 2 -
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+sequences(3, [8, 7, 3, 5, 2, 1, 0, 4, 6, 9]);
+sequences(3, [1, 2, 3, 1, 2, 3, 2, 3, 4, 4, 5, 6]);
+sequences(4, [4, 5, 6, 7, 123, 122, 121, 120, 120, 121, 122, 123]);
+
+sub sequences {
+	
+	my ($length, @list, $j, @pool, $rubric, $good, $k);
+	
+	# initialise
+	$length = $_[0];
+	@list = sort {$a <=> $b} @{$_[1]};
+	
+	say qq[\nInput: \@list = (] . join(', ',@{$_[1]}) . qq[), length = $length];
+	
+	# make pool (see blog) - $pool[$j] is the no of $j's in $list
+	for $j (0 .. scalar @list - 1) {
+		$pool[$list[$j]] ++;
+	}
+	
+	# start looping
+	$j = $list[0];
+	while (1) {
+		
+		# nothing left
+		last if $j > $list[scalar @list - 1] - 2;
+		
+		# is there any a(nother) $j entry?
+		$pool[$j] += 0;
+		if ($pool[$j] > 0) {
+		
+			# is there a sequence starting here?
+			$good = 1;
+			for $k ($j .. $j + $length - 1) {
+				$pool[$k] += 0;
+				$good = 0 unless $pool[$k] > 0;
+			}
+			
+			# yes there is
+			if ($good) {
+				$rubric .= '(';
+				
+				# take members of sequence out of pool
+				for $k ($j .. $j + $length - 1) {
+					$pool[$k] --;
+					$rubric .= qq[$k, ];
+				}
+				$rubric = qq[] . substr($rubric, 0, -2) . q[), ];
+			} else {
+				say qq[Output: -1 ($j cannot be part of a substring)];
+				return;
+			}
+		}
+		
+		# try next pool member unless there is another $j
+		$j ++ unless $pool[$j];
+	}
+	say qq[Output: ] . substr($rubric, 0, -2);
+}
+