Week 253 ...

3 files changed, 111 insertions, 0 deletions

diff --git a/challenge-253/peter-campbell-smith/blog.txt b/challenge-253/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..ff99dc73aa
--- /dev/null
+++ b/challenge-253/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/253
diff --git a/challenge-253/peter-campbell-smith/perl/ch-1.pl b/challenge-253/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..887d11cc19
--- /dev/null
+++ b/challenge-253/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-01-22
+use utf8;     # Week 253 task 1 - Split strings
+use strict;   # Peter Campbell Smith
+use warnings; 
+binmode STDOUT, ':utf8';
+
+split_strings(['one.two.three','four.five','six'], '.');
+split_strings(['$perl$$', '$$raku$'], '$');
+split_strings(['xonex', 'xtwox'], 'x');
+
+# some edge cases
+split_strings([',,,,,'], ',');
+split_strings(['\\three\\blind\\', '\\mice\\'], '\\');
+split_strings(['ŐőŕŒœŔŕŖ', 'ŗŘřŚŕ'], 'ŕ');
+
+sub split_strings {
+	
+	my (@words, $separator, $text, @output);
+	
+	# initialise
+	@words = @{$_[0]};
+	$separator = substr($_[1] . ' ', 0, 1); # default is blank
+	
+	# join the input strings together with single separators
+	$text = join($separator, @words);
+	$text =~ s|\Q$separator\E+|$separator|g;
+	
+	# split that into individual words
+	@output = split(/\Q$separator\E+/, $text);
+	
+	# remove an empty first or last word
+	shift @output if (@output > 0 and $output[0] eq '');
+	pop @output if (@output > 0 and $output[-1] eq '');
+
+	# publish results
+	say qq[\nInput:  \@words = ('] . join(qq[', '], @words) . qq[')];
+	say qq[        \$separator = '$separator'];
+	say qq[Output: ('] . join(q[', '], @output) . qq[')];	
+}
diff --git a/challenge-253/peter-campbell-smith/perl/ch-2.pl b/challenge-253/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..949a81b85c
--- /dev/null
+++ b/challenge-253/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-01-22
+use utf8;     # Week 253 task 2 - Weakest row
+use strict;   # Peter Campbell Smith
+use warnings; 
+binmode STDOUT, ':utf8';
+
+weakest_row([[1, 1, 0, 0, 0],
+             [1, 1, 1, 1, 0],
+             [1, 0, 0, 0, 0],
+             [1, 1, 0, 0, 0],
+             [1, 1, 1, 1, 1]]);
+			 
+weakest_row([[1, 0, 0, 0],
+             [1, 1, 1, 1],
+             [1, 0, 0, 0],
+             [1, 0, 0, 0]]);
+			 		 
+sub weakest_row {
+	
+	my ($matrix, $row, $ones, %scores, $row_number, $cell,%legend, @order);
+	
+	$matrix = shift;
+	
+	# count the ones in each row and construct %scores
+	for $row (@$matrix) {
+		$ones = 0;
+		$ones += $_ for @$row;
+		$scores{sprintf('%04d-%04d', $ones, $row_number ++)} = 1;
+	}
+	
+	# list the number of 1s in each row and create @order
+	for $row (sort keys %scores) {
+		$row =~ m|(\d+)-(\d+)|;
+		($ones, $row_number) = ($1, $2);
+		$legend{$row_number} = sprintf("Row %d contains %d one%s", 
+			$row_number, $ones, $ones == 1 ? '' : 's');
+		push @order, $row_number + 0;
+	}
+	
+	# show the results
+	print_matrix(qq{Input:  [}, $matrix, 1);
+	say qq[Output: (] . join(', ', @order) . ')';
+	
+	for $row (sort keys %legend) {
+		say qq[        $legend{$row}];
+	}	
+}
+
+sub print_matrix {
+    
+    my ($legend, $matrix, $j, $out, $max);
+
+    ($legend, $matrix, $max) = @_;
+    
+    # format rows of matrix with numbers of equal width
+    $out = '';
+    for $j (0 .. @$matrix - 1) {
+        $out .= qq[\n$legend] . join(', ', @{$matrix->[$j]}) . qq(]);
+        $legend = (' ' x (length($legend) - 1)) . '[' if $j == 0;
+    }
+    $out =~ s|(\d+)|sprintf("%${max}d", $1)|ge;
+    say qq[$out\n];
+}