Merge pull request #8404 from pjcs00/wk226

Week 226 ...

3 files changed, 76 insertions, 0 deletions

diff --git a/challenge-226/peter-campbell-smith/blog.txt b/challenge-226/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..1fcae5340b
--- /dev/null
+++ b/challenge-226/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/226
diff --git a/challenge-226/peter-campbell-smith/perl/ch-1.pl b/challenge-226/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..11f892eb53
--- /dev/null
+++ b/challenge-226/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-07-17
+use utf8;     # Week 226 task 1 - Shuffle string
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+shuffle_string('lacelengh', [3, 2, 0, 5, 4, 8, 6, 7, 1]);
+shuffle_string('rulepark', [4, 7, 3, 1, 0, 5, 2, 6]);
+shuffle_string('aaacccdeefgiiiiiiillloopprrssstuux',
+	[6, 11, 24, 5, 19, 29, 27, 3, 20, 9, 12, 8, 13, 15, 18, 23, 26, 30, 
+	7, 14, 25, 28, 31, 2, 22, 4, 10, 0, 16, 33, 17, 1, 32, 21]);
+	
+sub shuffle_string {
+	
+	my ($string, @indices, $result);
+	
+	# initialise
+	$string = $_[0];
+	@indices = @{$_[1]};
+	
+	# prepopulate $result with '_'
+	$result = '_' x length($string);
+	
+	# copy chars: string[j] -> result[indices[j]]
+	substr($result, $indices[$_], 1) = substr($string, $_, 1) for 0 .. @indices - 1;
+
+	say qq[\nInput:  \$string = '$string',\n        \@indices = (] . join(qq[, ], @indices) . qq[)];
+	say qq[Output: '$result'];
+}
diff --git a/challenge-226/peter-campbell-smith/perl/ch-2.pl b/challenge-226/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..6ee93f547f
--- /dev/null
+++ b/challenge-226/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-07-17
+use utf8;     # Week 226 task 2 - Zero array
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+my ($j, @ints);
+
+zero_array(1, 5, 0, 3, 5);
+zero_array(2, 1, 4, 0, 3);
+
+for $j (0 .. 20) {
+	push @ints, int(rand(20));
+}
+zero_array(@ints);
+
+sub zero_array {
+	
+	my (@ints, @sorted, $j, $count, $least, $explain);
+	
+	@ints = @_;
+	say qq[\nInput:  \@ints = (] . join(', ', @ints) . qq[)];
+	$count = 0;
+	$explain = '';
+
+	while (1) {
+		
+		# find the least non-zero element left
+		@sorted = sort { $a <=> $b } @ints;
+		shift @sorted while (@sorted and $sorted[0] == 0);
+		last unless @sorted;
+		$least = $sorted[0];
+		
+		# subtract least from all non-zeroes
+		for $j (0 .. @ints - 1) {
+			$ints[$j] -= $least if $ints[$j];
+		}
+		$count ++;
+		$explain .= qq[operation $count: pick $least => (] . join(', ', @ints) . qq[)\n];
+	}
+	$explain =~ s|\n$||;
+	say qq[Output: $count\n$explain];
+
+}
\ No newline at end of file