week 270 - Lonely ones and equalities

3 files changed, 124 insertions, 0 deletions

diff --git a/challenge-270/peter-campbell-smith/blog.txt b/challenge-270/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..6fa0ae55be
--- /dev/null
+++ b/challenge-270/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/270
diff --git a/challenge-270/peter-campbell-smith/perl/ch-1.pl b/challenge-270/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..3a478a9bc8
--- /dev/null
+++ b/challenge-270/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-05-20
+use utf8;     # Week 270 - task 1 - Special positions
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+special_positions([[1, 0, 0],
+                   [0, 0, 1],
+                   [1, 0, 0]]);
+				   
+special_positions([[1, 0, 0],
+                   [0, 0, 1],
+                   [0, 0, 1]]);
+
+special_positions([[1, 0, 1],
+                   [0, 0, 0],
+                   [1, 0, 1]]);
+				   
+special_positions([[1, 0, 0, 0, 0, 0],
+				   [0, 1, 0, 0, 0, 0],
+				   [0, 0, 1, 0, 0, 0],
+				   [0, 0, 0, 1, 0, 0],
+				   [0, 0, 0, 0, 1, 1]]);
+
+sub special_positions {
+	
+	my ($matrix, $ones, $r, $c, $special, $r1, $c1, $count);
+	
+	$matrix = shift;
+	$special = '';
+	
+	# look for 1s
+	ROW: for $r (0 .. @$matrix - 1) {
+		COL: for $c (0 .. @{$matrix->[$r]} - 1) {
+			next COL unless $matrix->[$r]->[$c] == 1;
+			
+			# check that it's the only 1 in its row
+			for $r1 (0 .. @$matrix - 1) {
+				next COL if ($matrix->[$r1]->[$c] != 0 and $r1 != $r);
+			}
+			
+			# and in its column
+			for $c1 (0 .. @{$matrix->[$r]} - 1) {
+				next COL if ($matrix->[$r]->[$c1] != 0 and $c1 != $c); 
+			}
+			
+			# found one!
+			$special .= qq[r$r c$c, ];
+		}
+	}
+	
+	# count the commas and show answer
+	$count = $special =~ s|,|,|g + 0;
+	print_matrix(q[Input: ], $matrix);
+	say qq[Output: $count] . ($count > 0 ? ' - ' . substr($special, 0, -2) : '');
+}
+
+sub print_matrix {
+	
+	my ($legend, $matrix, $j);
+
+	# format matrix
+	($legend, $matrix) = @_;
+	say '';
+	for $j (0 .. @$matrix - 1) {
+		say qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]);
+		$legend = ' ' x length($legend);
+	}
+}
diff --git a/challenge-270/peter-campbell-smith/perl/ch-2.pl b/challenge-270/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..356a009180
--- /dev/null
+++ b/challenge-270/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-05-20
+use utf8;     # Week 270 - task 2 - Distribute elements
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+distribute_elements([4, 1], 3, 2);
+distribute_elements([2, 3, 3, 3, 5], 2, 1);
+distribute_elements([2, 3, 3, 3, 5], 2, 5);
+distribute_elements([7, 7, 7, 7, 7], 2, 1);
+distribute_elements([2, 3, 3, 3, 5], 2, 5);
+
+sub distribute_elements {
+	
+	my ($list_ref, @list, $x, $y, $largest, $bought_x, $bought_y);
+
+	# initialise
+	($list_ref, $x, $y) = @_;
+	@list = sort {$a <=> $b} @$list_ref;
+	$largest = $bought_x = $bought_y = 0;
+	$largest = ($_ > $largest ? $_ : $largest) for @list;
+	
+	# if $y is not a bargain just buy lots of $x
+	if ($y > 2 * $x) {
+		$bought_x += $largest - $_ for @list;
+	
+	# buy until all values match the largest
+	} else {
+		while ($list[0] != $largest) {
+			
+			# can buy $y and add 1 to two smallest values
+			if ($list[1] < $largest) {
+				$bought_y ++;
+				$list[0] ++;
+				$list[1] ++;
+				
+			# only one value needs incrementing so buy an $x	
+			} else {
+				$bought_x ++;
+				$list[0] ++;
+			}
+			@list = sort {$a <=> $b} @list;
+		}
+	}
+
+	printf(qq[\nInput:  \@list = (%s), \$x = %d, \$y = %d\n], join(', ', @$list_ref), $x, $y);
+	printf(qq[Output: %d (%d * \$x + %d * \$y)\n], $bought_x * $x + $bought_y * $y, $bought_x, $bought_y);
+}