Merge pull request #8850 from pjcs00/wk238

Week 238 ...

3 files changed, 87 insertions, 0 deletions

diff --git a/challenge-238/peter-campbell-smith/blog.txt b/challenge-238/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..51f3afcf81
--- /dev/null
+++ b/challenge-238/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/238
diff --git a/challenge-238/peter-campbell-smith/perl/ch-1.pl b/challenge-238/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..d6d7ac5e48
--- /dev/null
+++ b/challenge-238/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-10-09
+use utf8;     # Week 237 task 1 - Running sum
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+running_sum(1, 2, 3, 4, 5);
+running_sum(1, 1, 1, 1, 1);
+running_sum(0, -1, 1, 2);
+running_sum(34, 65, 12, -98, 87, 44, 72, 0, 39, 92);
+
+sub running_sum {
+	
+	my (@ints, $j, @sums);
+	
+	@ints = @_;
+	say qq[\nInput:  \@ints = (], join(', ', @ints) . ')';
+	
+	for $j (1 .. @ints - 1) {
+		$ints[$j] = $ints[$j - 1] + $ints[$j];
+	}
+	
+	say qq[Output:         (] . join(', ', @ints) . ')';
+}
+	
\ No newline at end of file
diff --git a/challenge-238/peter-campbell-smith/perl/ch-2.pl b/challenge-238/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..63a12b71a2
--- /dev/null
+++ b/challenge-238/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-10-09
+use utf8;     # Week 238 task 2 - Persistence sort
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+persistence_sort(15, 99, 1, 34);
+persistence_sort(50, 25, 33, 22);
+persistence_sort(644, 939, 265, 312, 5);
+persistence_sort(81, 71, 61, 51, 41);
+persistence_sort(1, 10, 25, 39, 77, 679, 6788, 68889);
+
+sub persistence_sort {
+	
+	my (@ints, $j, $product, @steps, $num_ints, $todo, $s, @results, $explain);
+	
+	@ints = @_;
+	say qq[\nInput:  (] . join(', ', @ints) . ')';
+	
+	# sort ints so that end results are sorted within each step count
+	@ints = sort {$a <=> $b} @ints;
+	$num_ints = @ints - 1;
+	$explain = '';
+	
+	# calculate digit products
+	for $j (0 .. $num_ints) {
+		$product = $ints[$j];
+		$steps[$j] = 0;
+		$explain .= qq[   $ints[$j] =>];
+		
+		# loop while product is not a single digit
+		while ($product > 9) {
+			$product =~ s|(\d)|\* $1 |g;  # converts 123 to *1*2*3
+			$explain .= substr($product, 1, -1) . ' =>';
+			$product = eval(qq[1$product]);   # evaluates 1*1*2*3
+			$steps[$j] ++;
+		}
+		$explain .= qq[ $product (steps: $steps[$j])\n];
+	}
+	
+	# loop over number of steps
+	$todo = $num_ints + 1;
+	STEPS: for $s (0 .. 99) {
+		
+		# find step counts == $s
+		for $j (0 .. $num_ints) {
+			if ($steps[$j] == $s) {
+				push(@results, $ints[$j]);
+				
+				# check whether we've got them all
+				$todo --;
+				last STEPS unless $todo;
+			}
+		}
+	}
+	say qq[Output: (]. join(', ', @results) . qq[)\n]  . substr($explain, 0, -1);
+}
+
+	
\ No newline at end of file