Merge pull request #9076 from pjcs00/wk243

Week 243

3 files changed, 98 insertions, 0 deletions

diff --git a/challenge-243/peter-campbell-smith/blog.txt b/challenge-243/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..2c2885bce5
--- /dev/null
+++ b/challenge-243/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/243
diff --git a/challenge-243/peter-campbell-smith/perl/ch-1.pl b/challenge-243/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..c191266407
--- /dev/null
+++ b/challenge-243/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-11-13
+use utf8;     # Week 243 task 1 - Reverse pairs
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+binmode(STDOUT, ':utf8');
+
+reverse_pairs(1, 3, 2, 3, 1);
+reverse_pairs(2, 4, 3, 5, 1);
+reverse_pairs(1, 1, 1, 1, 1);
+
+my (@nums, $i);
+for $i (0 .. 10) {
+	@nums[$i] = int(rand(200)) + 1;
+}
+reverse_pairs(@nums);
+
+sub reverse_pairs {
+	
+	my (@nums, @nums2, $last, $i, $j, $k, $pairs, $explain);
+	
+	# initialise
+	@nums = @_;
+	$last = @nums - 1;
+	$pairs = 0;
+	$explain = '';
+	@nums2 = map {$_ * 2} @nums;
+	
+	# loop over i and j
+	for $i (0 .. $last - 1) {
+		for $j ($i + 1 .. $last) {
+			
+			# test for condition
+			if ($nums[$i] > $nums2[$j]) {
+				$pairs ++;
+				$explain .= qq[   \$nums[$i] = $nums[$i], \$nums[$j] = $nums[$j] ∵ $nums[$i] > $nums2[$j]] . qq[\n];
+			}
+		}
+	}
+	
+	say qq[\nInput:  \@nums = (] . join(', ', @nums) . ')';
+	say qq[Output: $pairs] . ($explain ? (qq[\n] . substr($explain, 0, -1)) : '');
+}
\ No newline at end of file
diff --git a/challenge-243/peter-campbell-smith/perl/ch-2.pl b/challenge-243/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..334f518cb1
--- /dev/null
+++ b/challenge-243/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-11-13
+use utf8;     # Week 243 task 2 - Floor sum
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+floor_sum(2, 5, 9);
+floor_sum(7, 7, 7);
+
+# more interesting one
+my @nums;
+$nums[$_] = int(rand(100)) + 1 for 0 .. 10;
+floor_sum(@nums);
+
+sub floor_sum {
+	
+	my (@nums, $m, $n, $sum, $floor, $explain);
+	
+	# initialise  and sort input
+	$sum = $floor = 0;
+	$explain = '';
+	@nums = sort {$a <=> $b} @_;
+	
+	# loop over m and n
+	for $m (@nums) {
+		for $n (@nums) {
+			
+			# skip the rest of the (sorted) $n's because $floor will be 0
+			last if $m < $n;
+			
+			# floor will be 1 if $m less than twice $n
+			if ($m < $n * 2) {
+				$floor = 1;
+				
+			# otherwsie do the division
+			} else {
+				$floor = int($m / $n);
+			}
+			
+			$sum += $floor;
+			$explain .= qq[floor($m / $n) = $floor~];
+		}
+	}
+	
+	# reformat and display
+	$explain =~ s/(.*?)~(.*?)~/sprintf(qq[   %-21s |  %-21s\n], $1, $2)/egm;
+	$explain =~ s|\nf|\n   f|;
+	
+	say qq[\nInput:  \@nums = (] . join(', ', @_) . ')';
+	say qq[Output: $sum\n] . substr($explain, 0, -1);
+}
\ No newline at end of file