Week 218 committed from rural North Carolina!

3 files changed, 144 insertions, 0 deletions

diff --git a/challenge-218/peter-campbell-smith/blog.txt b/challenge-218/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..dd93a4f003
--- /dev/null
+++ b/challenge-218/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/218
diff --git a/challenge-218/peter-campbell-smith/perl/ch-1.pl b/challenge-218/peter-campbell-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..c416af456e
--- /dev/null
+++ b/challenge-218/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-05-22
+use utf8;     # Week 218 task 1 - Maximum product
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+max_product(1, 2, 3, 4, 5);
+max_product(-8, 2, -9, 0, -4, 3);
+max_product(-9, -8, -7, -6, -5);
+max_product(5, 6, 0);
+
+sub max_product {
+	
+	my (@list, $product, $count, $j, $last_negative, $explain, $k, $last, $negatives);
+	
+	@list = @_;
+	say qq[\nInput:  (] . join(', ', @list) . ')';
+	@list = sort { abs($b) <=> abs($a) } @list;
+	
+	$product = 1;
+	$count = 3;
+	$last = scalar @list - 1;
+	die 'Not enough data' if $last < 2;
+	
+	# check for special case where list is all negatives
+	$negatives = 0;
+	$negatives += $_ < 0 ? 1 : 0 for @list;
+	
+	# not the special case
+	if ($negatives != $last + 1) {
+		for $k (0 .. $last) {
+
+			# multiply next number into product
+			$j = $list[$k];
+			$product *= $j;
+			$explain .= qq[$j x ];
+			
+			# note last negative one in case we need to back it out
+			$last_negative = $j if $j < 0;
+			$count --;
+			
+			# if we've multiplied 3 and the result is +ve then we're done
+			if ($count == 0) {
+				last if $product >= 0;
+				
+				# and we're done if there are no more entries
+				last if $k == $last;
+				
+				# else we need to back out the last negative one and try again
+				$product /= $last_negative;
+				$explain =~ s|$last_negative x ||;
+				$count = 1;
+			}		
+		}
+		
+	# special case
+	} else {
+		$product = $list[$last - 2] * $list[$last - 1] * $list[$last];
+		$explain =  qq[$list[$last - 2] x $list[$last - 1] x $list[$last] x ];
+		
+	}
+	say qq[Output: $product = ] . substr($explain, 0, -3);
+}
diff --git a/challenge-218/peter-campbell-smith/perl/ch-2.pl b/challenge-218/peter-campbell-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..dcc081d5f0
--- /dev/null
+++ b/challenge-218/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-05-22
+use utf8;     # Week 218 task 2 - Matrix score
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+matrix_score( [ [0,0,1,1],
+                [1,0,1,0],
+                [1,1,0,0] ]);
+matrix_score( [ [0] ]);
+matrix_score( [ [0, 0, 0, 0, 1],
+				[0, 1, 0, 0, 0],
+				[0, 0, 0, 1, 0],
+				[0, 0, 1, 0, 0] ]);
+
+
+sub matrix_score {
+	
+	my ($matrix, $last_row, $last_col, $row, $col, $sum, $value);
+	
+	# initialise
+	$matrix = $_[0];
+	say '';
+	show_matrix(qq{Input:  }, $matrix);
+	$last_row = scalar @$matrix - 1;
+	$last_col = scalar @{$matrix->[0]} - 1;
+	
+	# flip rows so that column 1 is 1
+	for $row (0 .. $last_row) {
+		if ($matrix->[$row]->[0] == 0 ) {
+			for $col (0 .. $last_col) {
+				$matrix->[$row]->[$col] = 1 - $matrix->[$row]->[$col];
+			}
+		}
+	}
+	
+	# flip columns to maximise no of 1s
+	for $col (1 .. $last_col) {
+		$sum = 0;
+		for $row (0 .. $last_row) {
+			$sum += $matrix->[$row]->[$col];
+		}
+		if ($sum < ($last_row + 1) / 2) {
+			for $row (0 .. $last_row) {
+				$matrix->[$row]->[$col] = 1 - $matrix->[$row]->[$col];
+			}
+		}
+	}
+	
+	# evaluate
+	$value = 2 ** $last_col;
+	$sum = 0;
+	for $col (0 .. $last_col) {
+		for $row (0 .. $last_row) {
+			$sum += $matrix->[$row]->[$col] * $value;
+		}
+		$value /= 2;
+	}
+	
+	say '';
+	show_matrix(qq[Output: ], $matrix);
+	say qq[        sum = $sum];
+}
+
+sub show_matrix {
+	
+	my ($intro, $row, $matrix, $last_row); 	
+	($intro, $matrix) = @_;
+	
+	# print out a matrix
+	$last_row = scalar @$matrix - 1;
+	for $row (0 .. $last_row) {
+		say qq{$intro\[ } . join(', ', @{$matrix->[$row]}) . ' ]';
+		$intro = ' ' x length($intro);
+	}
+
+}
+