Merge pull request #5426 from pjcs00/wk145

Week 145 solutions from pjcs00

3 files changed, 106 insertions, 0 deletions

diff --git a/challenge-145/peter-campbell-smith/blog.txt b/challenge-145/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..62b214692c
--- /dev/null
+++ b/challenge-145/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2021/12/how-to-find-palindromes-quickly.html
diff --git a/challenge-145/peter-campbell-smith/perl/ch-1.pl b/challenge-145/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..178bb2cce9
--- /dev/null
+++ b/challenge-145/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2021-12-27
+# PWC 145 task 1
+
+use v5.20;
+use warnings;
+use strict;
+
+# You are given 2 arrays of same size, @a and @b.
+# Write a script to implement Dot Product.
+
+my (@tests, $test, @a, @b, $j, $p, $dp, $string1, $string2);
+
+@tests = ([[1, 2, 3], [4, 5, 6]], [[93, 72, 11], [-1, 1000, 0]], [[1, 2, 3, 4], [1, 2, 3]]);
+
+for $test (@tests) {
+	
+	# extract arrays
+	@a = @{$test->[0]};
+	@b = @{$test->[1]};
+	say qq[\n\@a = (] . join(', ', @a) . qq[)];
+	say qq[\@b = (] . join(', ', @b) . qq[)];
+	
+	# check lengths
+	if (scalar @a != scalar @b) {
+		say 'Not the same length';
+		next;
+	}
+	
+	# make dot product and required output text
+	$string1 = $string2 = '';
+	$dp = 0;
+	for $j (0 .. scalar @a - 1) {
+		$p = $a[$j] * $b[$j];
+		$dp += $p;
+		$string1 .= qq[($a[$j] * $b[$j]) + ];
+		$string2 .= qq[$p + ];
+	}
+	
+	say '$dot_product = ' . substr($string1, 0, -2) . '=> ' . substr($string2, 0, -2) . qq[=> $dp];
+		
+}	
+	
+
diff --git a/challenge-145/peter-campbell-smith/perl/ch-2.pl b/challenge-145/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..7aa09bd6e7
--- /dev/null
+++ b/challenge-145/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2021-12-27
+# PWC 145 task 2
+
+use v5.20;
+use warnings;
+use strict;
+
+# You are given a string $s.
+# Write a script to create a Palindromic Tree for the given string.
+
+# This produces the desired output, but not by explicitly using a palindromic tree,
+# but the 'very_long' test is 1000 characters long and takes < 10sec on my 
+# (quite slow) Raspberry Pi. The optimisation of is_palindromic to return false as 
+# soon as it finds a mismatch helps a lot.
+
+my (@strings, $string, $length, $sub_length, $start_at, $test, %seen, $very_long, $j);
+
+# words
+@strings = qw[redivider deific rotors challenge champion christmas 
+	supercalifragilisticexpialidocious antidisestablishmentarianism abcdedcbfffffgfffffzz];
+
+# add a random 1000-char string
+$very_long = '';
+for $j (0 ..999) {
+	$very_long .= chr(ord('a') + rand(26));
+}
+push @strings, $very_long;
+
+# loop over test strings
+for $string (@strings) {
+	print qq[\nInput:  $string\nOutput: ];
+	%seen = ();
+	
+	# generate all possible substrings of $string
+	$length = length($string);
+	for $start_at (0 .. $length - 1) {
+		for $sub_length (1 .. $length - $start_at) {
+			
+			# check if palindromic and not already seen
+			$test = substr($string, $start_at, $sub_length);
+			print qq[$test ] if (not $seen{$test} and is_palindromic($test));
+			$seen{$test} = 1;
+		}
+	}
+	say '';
+}
+
+sub is_palindromic {   #  ($string) and returns true/false if $string is/isn't palindromic
+
+	my ($string, $string2, $gnirts);
+	$string = $_[0];
+	
+	# compare 1st and last characters, and if the same, strip them off and repeat
+	while ($string =~ s|^(.)(.*)(.)$|$2|g) {
+		return 0 if $1 ne $3;
+	}
+	return 1;	
+}