Merge pull request #7864 from pjcs00/wk211

Week 211

3 files changed, 161 insertions, 0 deletions

diff --git a/challenge-211/peter-campbell-smith/blog.txt b/challenge-211/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..8ca8f03329
--- /dev/null
+++ b/challenge-211/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/211
diff --git a/challenge-211/peter-campbell-smith/perl/ch-1.pl b/challenge-211/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..bd20e4b8ce
--- /dev/null
+++ b/challenge-211/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-04-03
+use utf8;     # Week 211 task 1 - Toeplitz matrix
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+toeplitz_matrix( [[4, 3, 2, 1],
+				  [5, 4, 3, 2],
+				  [6, 5, 4, 3]] );
+				  
+toeplitz_matrix( [[4, 3, 2, 1],
+				  [5, 4, 3, 2],
+				  [6, 5, 4, 7]] );
+
+toeplitz_matrix( [[37.1, 114, 0, -23.65, 5, 3],
+				  [-40, 37.1, 114, 0, -23.65, 5],
+				  [-19, -40, 37.1, 114, 0, -23.65],
+				  [3, -19, -40, 37.1, 114, 0],
+				  [55, 3, -19, -40, 37.1, 114],
+				  [0, 55, 3, -19, -40, 37.1],
+				  [999, 0, 55, 3, -19, -40]] );
+				  
+toeplitz_matrix( [[6, 0, 0, 0, 6],
+				  [0, 0, 6, 0, 0],
+				  [6, 0, 0, 0, 6]] );
+		
+sub toeplitz_matrix {
+	
+	my($m, $r, $c, $x, $good);
+	
+	$m = $_[0];
+	
+	# loop over rows and then columns
+	ROW: for $r (1 .. scalar @$m - 1) {
+		for $c (1. .. scalar @{$m->[0]} - 1) {
+			
+			# check each element against the appropriate edge element
+			$x = $m->[$r]->[$c];
+			if ($r >= $c) {
+				$good = $x == $m->[$r - $c]->[0] ? 1 : 0;
+				last ROW unless $good;
+			} else {
+				$good = $x == $m->[0]->[$c - $r] ? 1 : 0;
+				last ROW unless $good;
+			}
+		}
+	}
+	
+	# format the output
+	my ($w, $width, $rubric, $prefix, $spaces);
+	
+	# find maximum width of element (as printed by Perl)
+	$w = 0;
+	for $r (0 .. scalar @$m - 1) {
+		for $c (0. .. scalar @{$m->[0]} - 1) {
+			$width = length($m->[$r]->[$c]);
+			$w = $width if $width > $w;
+		}
+	}
+	
+	# construct and output each row of matrix
+	$rubric = '';
+	$prefix = qq{\nInput: \@matrix = [ [ };
+	for $r (0 .. scalar @$m - 1) {
+		$rubric .= $prefix;
+		for $c (0. .. scalar @{$m->[0]} - 1) {
+			$spaces = $w + 1 - length($m->[$r]->[$c]);
+			$rubric .= (' ' x $spaces) . $m->[$r]->[$c] . ',';
+		}
+		$rubric =~ s|.$| ]|s;
+		$rubric .= ' ]' if $r == scalar @$m - 1;
+		say $rubric;
+		$rubric = '';
+		$prefix = '                   [ ';
+	}
+	say qq[Output: ] . ($good ? 'true' : 'false');
+}
+
diff --git a/challenge-211/peter-campbell-smith/perl/ch-2.pl b/challenge-211/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..ad289c91af
--- /dev/null
+++ b/challenge-211/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-04-03
+use utf8;     # Week 211 task 2 - Split same average
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use Algorithm::Combinatorics ('combinations');
+
+my ($j, @data);
+
+equal_means(1, 2, 3, 4, 5, 6, 7, 8);
+equal_means(1, 3);
+equal_means(10, 1, 7, 5, 3, 11, 8, 4, 2, 9);
+equal_means(6, 3, 1, 9, 12, 25, 18, 20);
+equal_means(8, 6, 3, 5, 1, 4, 2, 7);
+
+for $j (0 .. 20) {
+	$data[$j] = int(rand(15));
+}
+equal_means(@data);
+
+sub equal_means {
+	
+	my (@array, $count, $mean, $sum, $count1, @array1, $mean1, $sum1, 
+		$count2, $sum2, $mean2, $comb, $iter, $d, $array2p, $combs);
+	
+	# initialise
+	@array = @_;
+	($count, $sum, $mean) = stats(@array);
+	
+	# loop over sizes of @array1 to consider
+	OUTER: for $count1 (1 .. int($count / 2)) {
+		
+		# loop over combinations from @array of that size
+		$iter = combinations(\@array, $count1);
+		while ($comb = $iter->next) {
+
+			# calculate @array1 data
+			$combs ++;
+			@array1 = @$comb;
+			($count1, $sum1, $mean1) = stats(@array1);
+			
+			# deduce @array2 data
+			$count2 = $count - $count1;
+			$sum2 = $sum - $sum1;
+			$mean2 = $sum2 / $count2;
+			
+			# means match - result!
+			if ($mean1 == $mean2) {
+				
+				# format and print
+				$array2p = ', ' . join(', ', @array) . ', ';
+				for $d (@array1) {
+					$array2p =~ s|, $d,|,|;
+				}
+				say qq[\nInput:  (] . join(', ', @array) . q[)];
+				say qq[Output: true];
+				say qq[   array1: (] . join(', ', @array1) . q[)];
+				say qq[   array2: (] . substr($array2p, 2, -2) . q[)];
+				say qq[   mean = $mean1 (after $combs combinations tested)];
+				return;
+			}
+		}
+	}
+	say qq[\nInput:  (] . join(', ', @array) . q[)];
+	say qq[Output: false (after $combs combinations tested)];
+}
+
+sub stats {
+	
+	my ($sum, $count, $d);
+	
+	$sum = $count = 0;
+	for $d (@_) {
+		$sum += $d;
+		$count ++;
+	}
+	return ($count, $sum, $sum / $count);
+}
+		
\ No newline at end of file