Merge pull request #9981 from pjcs00/master

Week 266 ...

3 files changed, 98 insertions, 0 deletions

diff --git a/challenge-266/peter-campbell-smith/blog.txt b/challenge-266/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..fde98aee8c
--- /dev/null
+++ b/challenge-266/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/pwc/challenge/266
diff --git a/challenge-266/peter-campbell-smith/perl/ch-1.pl b/challenge-266/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..8a971df75d
--- /dev/null
+++ b/challenge-266/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-04-22
+use utf8;     # Week 266 - task 1 - Uncommon words
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+uncommon_words('Mango is sweet', 'Mango is sour');
+uncommon_words('Roses are red', 'Violets are blue');
+uncommon_words('Red red roses are sweet', 'Roses are sweet');
+uncommon_words('London is the capital of the UK', 'The capital of the UK is London');
+uncommon_words('Alpha Bravo Charlie Delta Echo', 'Foxtrot Golf Hotel India Juliett');
+
+sub uncommon_words {
+	
+	my (@words, %counts, $uncommon);
+	
+	# concatenate the lines, lower-cased, and count word frequency
+	@words = split(/ +/, lc(qq[$_[0] $_[1]]));
+	$counts{$_} ++ for @words;
+	
+	# find the words where frequency is 1
+	$uncommon .= $counts{$_} == 1 ? qq['$_', ] : '' for sort keys %counts;
+	
+	# show the answer
+	say qq[\nInput:  \$line1 = '$_[0]'\n        \$line2 = '$_[1]'];
+	say qq[Output: (] . ($uncommon ? substr($uncommon, 0, -2) : q['']) . ')';
+}	
diff --git a/challenge-266/peter-campbell-smith/perl/ch-2.pl b/challenge-266/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..c3dda93812
--- /dev/null
+++ b/challenge-266/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-04-22
+use utf8;     # Week 266 - task 2 - X matrix
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+x_matrix([ [1, 0, 0, 2],
+           [0, 3, 4, 0],
+           [0, 5, 6, 0],
+           [7, 0, 0, 1] ]);
+		   
+x_matrix([ [0, 2, 0],
+           [4, 0, 6],
+           [0, 8, 0] ]);
+		   
+x_matrix([ [1, 0, 0, 0, 1],
+           [0, 2, 0, 2, 0],
+		   [0, 0, 3, 0, 0],
+		   [0, 4, 0, 4, 0],
+           [5, 0, 0, 0, 0] ]);
+		   
+x_matrix([ [1, 0, 2],
+           [0, 3, 0],
+           [4, 0, 5] ]);
+				 
+sub x_matrix {
+	
+	my ($matrix, $dimension, $x, $y);
+	
+	# initialise
+	$matrix = shift;
+	$dimension = scalar @$matrix - 1;
+	print_matrix(qq[Input: ], $matrix);
+	
+	# loop over matrix elements
+	for $x (0 .. $dimension) {
+		for $y (0 .. $dimension) {
+			
+			# conditions that must be met
+			next if ($x == $y or $x == $dimension - $y) ?
+				$matrix->[$x]->[$y] != 0 : $matrix->[$x]->[$y] == 0;
+			
+			# ... but they are not
+			say qq[Output: false (∵ matrix[$x, $y] == $matrix->[$x]->[$y])];
+			return;
+		}
+	}
+	
+	# all values are good
+	say qq[Output: true];
+}
+
+sub print_matrix {
+	
+	my ($legend, $matrix, $j);
+
+	# format rows of matrix
+	($legend, $matrix) = @_;
+	say '';
+	for $j (0 .. @$matrix - 1) {
+		say qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]);
+		$legend = ' ' x length($legend);
+	}
+}