Week 271 - All about ones

3 files changed, 98 insertions, 0 deletions

diff --git a/challenge-271/peter-campbell-smith/blog.txt b/challenge-271/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..ee5e0322bf
--- /dev/null
+++ b/challenge-271/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/pwc/challenge/271
diff --git a/challenge-271/peter-campbell-smith/perl/ch-1.pl b/challenge-271/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..465f17472e
--- /dev/null
+++ b/challenge-271/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-05-27
+use utf8;     # Week 271 - task 1 - Maximum ones
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+maximum_ones([[0, 1], [1, 0]]);
+maximum_ones([[0, 0, 0], [1, 0, 1]]);
+maximum_ones([[0, 0], [1, 1], [0, 0]]);
+maximum_ones([[2, 3], [4, 1], [5, 6], [7, 1]]);
+maximum_ones([[3, 3, 3], [4, 4, 4], [0, 0, 0]]);
+
+sub maximum_ones {
+	
+	my ($matrix, $max, $ones, $max_row, $r);
+	
+	# initialise
+	$matrix = shift;
+	$max = -1;
+	
+	# loop over rows
+	for $r (0 .. @$matrix - 1) {
+		$ones = grep {$_ == 1 ? 1 : 0} @{$matrix->[$r]};
+		
+		# found a better one
+		if ($ones > $max) {
+			$max_row = $r;
+			$max = $ones;
+		}
+	}
+	
+	# show result
+	print_matrix('Input: ', $matrix);
+	printf  $max > 0 ? (qq[Output: row %d (%d one%s)\n], $max_row + 1, $max, $max == 1 ? '' : 's') :
+		qq[Output: no ones in matrix\n];
+}
+
+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-271/peter-campbell-smith/perl/ch-2.pl b/challenge-271/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..5b8238d3e9
--- /dev/null
+++ b/challenge-271/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-05-27
+use utf8;     # Week 271 - task 2 - Sort by 1 bits
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+my @ints;
+
+sort_by_1_bits(0, 1, 2, 3, 4, 5, 6, 7, 8);
+sort_by_1_bits(1024, 512, 256, 128, 64);
+sort_by_1_bits(1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 
+	1048575, 987654321);
+
+push(@ints, int(rand(50))) for 0 .. 50;
+sort_by_1_bits(@ints);
+
+sub sort_by_1_bits {
+	
+	my (@ints, $int, $j, @bits, %rank, $result);
+	
+	# loop over @ints
+	@ints = @_;
+	for $j (0 .. @ints - 1) {
+		$int = $ints[$j];
+		
+		# get no of 1-bits in $int
+		$bits[$j] = 0;
+		for ($b = 1; $b <= $int; $b *= 2) {
+			$bits[$j] ++ if $int & $b;
+		}
+		
+		# rank them in the desired order
+		$rank{sprintf('%02d', $bits[$j]) . 
+			sprintf('%015d', $int) . 
+			sprintf('%03d', $j)} = $int;
+	}
+	$result .= $rank{$_} . ', ' for sort keys %rank;	
+	
+	# show answer
+	printf(qq[\nInput:  \@ints = (%s)\n], join(', ', @ints));
+	printf(qq[Output:         (%s)\n], substr($result, 0, -2));
+}