Merge pull request #8975 from pjcs00/wk241

Week 241 ...

3 files changed, 186 insertions, 0 deletions

diff --git a/challenge-241/peter-campbell-smith/blog.txt b/challenge-241/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..5723b19b21
--- /dev/null
+++ b/challenge-241/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/241
diff --git a/challenge-241/peter-campbell-smith/perl/ch-1.pl b/challenge-241/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..3324057a01
--- /dev/null
+++ b/challenge-241/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-10-30
+use utf8;     # Week 241 task 1 - Arithmetic triplets
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+arithmetic_triplets ([0, 1, 4, 6, 7, 10], 3);
+arithmetic_triplets ([(4, 5, 6, 7, 8, 9)], 2);
+
+# generate 200 sorted unique numbers in (0 .. 1999)
+my ($j, @nums, $next, $count, @used);
+$count = 0;
+while ($count < 200) {
+	$next = int(rand(2000));
+	next if $used[$next];
+	push(@nums, $next);
+	$count ++;
+	$used[$next] = 1;
+}
+@nums = sort { $a <=> $b } @nums;
+arithmetic_triplets (\@nums, 19);
+
+sub arithmetic_triplets {
+	
+	my (@nums, $diff, $last, $i, $j, $k, $count, $explain, $ji_diff, $kj_diff);
+	
+	# initialise
+	@nums = @{$_[0]};
+	$diff = $_[1];
+	$last = @nums - 1;
+	
+	# loop over triplets
+	$explain = '';
+	$count = 0;
+	
+	# loop over i any i (except the last 2) could be part of a triplet
+	for $i (0 .. $last - 2) {
+		
+		# loop over j
+		for $j (1 .. $last - 1) {
+			$ji_diff = $nums[$j] - $nums[$i];
+			
+			# if they differ by more than $diff then we can abandon this j
+			last if $ji_diff > $diff;
+			
+			# unless this pair of i and j differ by $diff there's no need to check k
+			next unless $ji_diff == $diff;
+						
+			# loop over k
+			for $k (2 .. $last) {
+				$kj_diff = $nums[$k] - $nums[$j];
+				
+				# we can abandon this k if k differs from j by more than $diff
+				last if ($kj_diff) > $diff;
+				
+				# and at last we've found an answer!
+				if ($kj_diff == $diff) {
+					$count ++;
+					$explain .= qq{        \$nums[$i] = $nums[$i], \$nums[$j] = $nums[$j], \$nums[$k] = $nums[$k]\n};
+				}
+			}
+		}
+	}
+	
+	# show results
+	say qq[\nInput:  \@nums = (] . join(q[, ], @nums) . q[)];
+	say qq[        \$diff = $diff];
+	say qq[Output: $count\n] . ($explain ? substr($explain, 0, -1) : '');
+}
+	
\ No newline at end of file
diff --git a/challenge-241/peter-campbell-smith/perl/ch-2.pl b/challenge-241/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..c6af7e9fe3
--- /dev/null
+++ b/challenge-241/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+use v5.16;    # The Weekly Challenge - 2023-10-30
+use utf8;     # Week 241 task 2 - Prime order
+use strict;   # Peter Campbell Smith
+use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+my (@sieve, $j, @int, $next, $count, @used);
+
+prime_order(11, 8, 27, 4);
+
+# bigger example: 30 unique numbers in (2 .. 500)
+$count = 0;
+while ($count < 30) {
+	$next = int(rand(501));
+	next if $used[$next] or $next < 2;
+	push(@int, $next);
+	$count ++;
+	$used[$next] = 1;
+}
+prime_order(@int);	
+
+sub prime_order {
+	
+	my (@int, $largest, $i, $count, $list, %output, $k, $explain, $ordered);
+	
+	# initialise
+	@int = @_;
+	
+	# find the largest and create sieve of Eratosthenes
+	$largest = 0;
+	for $i (@int) {
+		$largest = $i if $i > $largest;
+	}
+	make_sieve($largest);
+	
+	# loop over @int, get prime factors and provide key to sort in desired order
+	for ($i = 0; $i < @int; $i ++) {
+		($count, $list) = prime_factors($int[$i]);
+		$output{sprintf('%08d~%08d', $count, $int[$i])} = $list;
+	}
+	
+	# extract sorted results and prepare to display
+	$explain = '';
+	$ordered = '';
+	for $k (sort keys %output) {
+		$k =~ m|(\d+)~(\d+)|;
+		$i = $2 + 0;
+		$ordered .= qq[$i, ];
+		$explain .= sprintf(qq[         Prime factors of %3d => %s\n], $i, $output{$k});
+	}
+			
+	# show results
+	say qq[\nInput:  \@int = (] . join(q[, ], @int) . q[)];
+	say qq[Output: (], substr($ordered, 0, -2) . ')';
+	say substr($explain, 0, -1); 
+}
+
+sub make_sieve {
+
+	my ($arg, $j, $k);
+	
+	# set all values provisionally to 1 (ie prime)
+	$arg = shift;
+	for $j (0 .. $arg) {
+		$sieve[$j] = 1;
+	}
+
+	# for each prime in turn, set its multiples to 0 (ie not prime)
+	for $j (2 .. $arg) {
+		next unless $sieve[$j];   # $j is not prime
+		last if $j ** 2 > $arg;
+		for $k ($j .. $arg) {
+			last if $k * $j > $arg;
+			$sieve[$k * $j] = 0;
+		}
+	}
+}
+
+sub prime_factors {
+	
+	# returns count and list of prime factors
+	
+	my ($arg, $pf, $count, $list, $q, $prime);
+	
+	# initialise
+	$arg = shift;
+	$pf = '';
+	$count = 0;
+	$list = '';
+	
+	# loop over all primes <= input
+	for $prime (2 .. $arg) {
+		next unless $sieve[$prime];
+		
+		# try dividing remaining number repeatedly by each prime
+		while (1) {
+			$q = $arg / $prime;
+			
+			# found a prime factor - add to count and list
+			if ($q == int($q)) {
+				$count ++;
+				$list .= qq[$prime, ];
+				$arg = $q;
+				
+			# no more of this prime
+			} else {
+				last;
+			}
+		}
+	}
+	return ($count, substr($list, 0, -2));
+}
+	
\ No newline at end of file