Merge pull request #6401 from pjcs00/wk172

Week 172 answers

3 files changed, 167 insertions, 0 deletions

diff --git a/challenge-172/peter-campbell-smith/blog.txt b/challenge-172/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..2c0109d8c6
--- /dev/null
+++ b/challenge-172/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/07/tricky-partitions-and-easy-stats.html
diff --git a/challenge-172/peter-campbell-smith/perl/ch-1.pl b/challenge-172/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..00176a223e
--- /dev/null
+++ b/challenge-172/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-07-07
+# PWC 171 task 1
+
+use v5.28;
+use strict;
+use warnings;
+use utf8;
+binmode(STDOUT, ':utf8');
+
+# You are given two positive integers, $m and $n.
+# Write a script to find out the Prime Partition of the given number. No duplicates allowed.
+
+# I assume (from the examples) this means $n distinct prime numbers which sum to $m.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/07/tricky-partitions-and-easy-stats.html
+
+my (@tests, @is_prime, $test, $m, $n, @is_used, @parts, $or, $output, $start);
+
+@tests = ([18, 2], [19, 3], [501, 4]);
+@is_prime = make_sieve(1000);   # $sieve[$j] == 1 if $j is prime
+$is_prime[1] = 0;               # examples suggest that 1 is not allowed as a prime
+
+# loop over tests
+for $test (@tests) {
+	($m, $n) = @$test;
+	say qq[\nInput:  \$m = $m, \$n = $n];
+	
+	# initialise
+	@is_used = ();   # we are looking for distinct primes, so set $is_used[$j] if $j is already used
+	@parts = ();     # these are the components of the set of primes
+	$or = '';
+	$output = 'Output: ';
+	$start = $m;     # the largest possible number that fits in the initial gap
+	
+	# find the answer
+	fill_gap($m, $n);
+	say $output;
+}
+		
+sub fill_gap {  # 
+
+	# fill_gap($gap, $count) finds all the sets of $count distinct primes which add up to $gap
+
+	my ($gap, $count, $j, $result, $new_gap);
+	$gap = shift;
+	$count = shift;
+	
+	# loop downwards over primes from the last one tried
+	for ($j = $start; $j >= 1; $j --) {
+		next if (not $is_prime[$j] or $is_used[$j]);
+		
+		# let's assume this is the right one
+		$parts[$n - $count] = $j;
+		
+		# ... and it would reduce the gap to $new_gap
+		$new_gap = $gap - $j;
+		
+		# if $new gap is zero and $count == 1 then we have a result
+		if ($new_gap == 0 and $count == 1) {
+			$output .= $or . join(', ', reverse @parts);  # Mohammad wants them in increasing order
+			$or = ' or ';
+			
+		# or if $count is > 1 we call fill_gap recursively to fill $new_gap with $count - 1 primes	
+		} elsif ($count != 1) {
+			$is_used[$j] = 1;
+			$start = $j;
+			fill_gap($new_gap, $count - 1);
+			$is_used[$j] = 0;
+			
+		# or if $count == 0 but this prime won't fill the gap then we keep on trying
+		} else {
+			$is_used[$j] = 0;
+		}
+	}
+	$parts[$n - $count] = 0;
+}
+
+sub make_sieve {
+	
+	# make sieve of Eratosthenes - $j is prime if $sieve[$j];
+	my ($arg, $j, $k, @sieve);
+	
+	# set all values provisionally to 1 (ie prime)
+	$arg = $_[0];
+	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;
+		}
+	}
+	return @sieve;
+}
\ No newline at end of file
diff --git a/challenge-172/peter-campbell-smith/perl/ch-2.pl b/challenge-172/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..4bc691e8a7
--- /dev/null
+++ b/challenge-172/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-07-07
+# PWC 171 task 2
+
+use v5.28;
+use strict;
+use warnings;
+use utf8;
+binmode(STDOUT, ':utf8');
+
+# You are given an array of integers.  Write a script to compute the five-number 
+# summary (FNS) of the given set of integers.  Wikipedia tells us that the FNS
+# comprises the minimum, 1st quartile, median, 3rd quartile and maximum of the set.
+
+# Blog: https://pjcs-pwc.blogspot.com/2022/07/tricky-partitions-and-easy-stats.html
+
+my (@tests, $test, @sorted, $count, $median, $first_quartile, $third_quartile);
+
+@tests = ([1, 2, 3, 4, 5, 6, 7, 8, 9, 10],
+	[8, 42, -3, 0, 99, 66, 21, 100], 
+	[1, 1, 1, 1, 1, 1, 1],
+	[1, 2, 3, 4, 5, 6, 7, 8, 1000],
+	[20,67,81,14,54,53,78,6,47,54,51,93,38,40,98,60,26,24,27,12,85,36,93,40,55,73,6,47,41,
+	64,39,86,1,71,92,19,14,54,5,59,65,77,34,45,78,27,68,51,24,4,97,69,4,9,55,85,6,95,51,45,
+	88,54,52,5,29,64,84,83,89,31,76,92,10,49,3,2,88,59,77,68,16,85,59,57,52,65,79,48,90,67,
+	90,27,25,56,45,58,82,49,51,58]);
+
+# loop over tests
+for $test (@tests) {
+	
+	# sort numerically and count
+	@sorted = sort	{$a <=> $b} @$test;
+	$count = scalar @sorted;
+
+    # determine value at a position (which might not be integral)
+	$median = value(($count - 1) / 2);
+	$first_quartile = value(($count - 1) / 4);
+	$third_quartile = value(3 * ($count - 1) / 4);
+	
+	# show the answers
+	say qq[\n] . join(', ', @sorted);
+	say qq[minimum $sorted[0] first quartile $first_quartile median $median ] .
+		qq[third quartile $third_quartile maximum $sorted[$count - 1]];
+	
+}
+
+sub value {
+	
+	my ($position, $lower, $upper, $fraction);
+	
+	# returns the value at the given position
+	# if position is non-integral returns the weighted intermediate value
+	$position = shift;
+	
+	# integral position
+	return $sorted[$position] if $position == int($position);
+	
+	# find intergral position below and above given position and 
+	# calculate weighted intermediate value
+	$lower = int($position);
+	$upper = $lower + 1;
+	$fraction = $position - $lower;
+	return $sorted[$lower] * (1 - $fraction) + $sorted[$upper] * $fraction;
+}