Merge pull request #5473 from pjcs00/wk146

My solutions to week 146

3 files changed, 123 insertions, 0 deletions

diff --git a/challenge-146/peter-campbell-smith/blog.txt b/challenge-146/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..4dc110048f
--- /dev/null
+++ b/challenge-146/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/01/large-primes-and-curious-fractions.html
diff --git a/challenge-146/peter-campbell-smith/perl/ch-1.pl b/challenge-146/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..117f246061
--- /dev/null
+++ b/challenge-146/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-01-04
+# PWC 146 task 1
+
+use v5.28;
+use warnings;
+use strict;
+
+# Write a script to generate the 10001st prime number.
+	
+# The sieve of Eratosthenes is a quick way to generate all the primes up to
+# some maximum number.  However, that's not today's question.  This script
+# therefore generates the sieve in 1000 blocks (ie 1-1000, then 1001 to 2000 
+# and so on), counting the number of primes found in each block and stopping
+# when that reaches or exceeds 10001.
+
+# It takes less than 1 second to run on my machine. And to find the 1000001st
+# prime takes only 28 seconds.  I haven't found a faster method.
+
+my ($seeking, $prime_index, $from, $to, $test, $factor, $multiple, @not_a_prime,
+	@prime, $time, $start);
+
+# initialise
+$seeking = 10001;
+$time = time;
+$prime_index = 0;
+
+# find primes in ranges of 1000, and count them until we get to (or past) $seeking
+for ($from = 1; $prime_index <= $seeking; $from += 1000) {
+	$to = $from + 999;
+
+	# loop over all the possible factors, ie primes < sqrt($to)
+	for $factor (2 .. int(sqrt($to))) {
+		next if defined $not_a_prime[$factor];   # already known as not a prime
+		
+		# mark all the multiples of $factor as non-primes
+		$start = int($from / $factor);           # multiples less than $start have already been done
+		$start = 2 if $start < 2;
+		for ($multiple = $start; $factor * $multiple <= $to; $multiple ++) {
+			$not_a_prime[$factor * $multiple] = 1;
+		}
+	}
+	
+	# now enumerate the primes in this range
+	for $test ($from .. $to) {
+		next if $test == 1;                       # 1 is not regarded as a prime
+		if (not defined $not_a_prime[$test]) {    # $test is a new prime
+			$prime[++ $prime_index] = $test;
+		}
+	}
+}
+
+say qq[Prime no $seeking is $prime[$seeking]\nFound in ] . (time - $time) . qq[ seconds];
+say qq[This assumes that that first prime is 2, as per Wikipedia. If you reckon that
+the first prime is 1 then prime number $seeking is $prime[$seeking - 1]];
diff --git a/challenge-146/peter-campbell-smith/perl/ch-2.pl b/challenge-146/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..d78b717649
--- /dev/null
+++ b/challenge-146/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-01-04
+# PWC 146 task 2
+
+use v5.28;
+use warnings;
+use strict;
+
+# You are given a fraction, a member of the curious fraction tree (CFT).
+# Write a script to find out the parent and grandparent of the given member.
+
+# The left child of parent a/b in the CFT is a/(a+b) and the right
+# child is (a+b)/b.  If a member is < 1 then it is a left child
+# of its parent, if > 1 then a right child.
+
+# So given a member a/b ...
+
+my (@given, $given, $a, $b, $pa, $pb, $ga, $gb);
+
+@given = ('3/5', '4/3', '13/20', '1/2', '456/777', '777/456', '144/781', '14/14');
+
+# loop over given children
+for $given (@given) {
+	($a, $b) = split /\//, $given;
+	 
+	# find the parents and grandparents
+	($pa, $pb) = parents($a, $b);
+	($ga, $gb) = parents($pa, $pb);
+	
+	# show result
+	speak("$a/$b", '     parent', $pa, $pb);
+	speak("$a/$b", 'grandparent', $ga, $gb);
+	say '';
+}
+ 
+sub parents {
+ 
+	my ($a, $b, $pa, $pb);
+ 
+	# as described above
+	($a, $b) = @_;
+	if ($a / $b < 1) {   # a left child
+		$pa = $a;
+		$pb = $b - $a;
+	} else {             # a right child
+		$pa = $a - $b;
+		$pb = $b;
+	}
+	
+	# not a member if pa or pb calculates as 0 or if a == b and a != 1
+	return (-1, -1) if ($pa == 0 or $pb == 0 or ($pa == $pb and $pa != 1));
+	return ($pa, $pb);
+}
+
+sub speak {
+	
+	my ($child, $relation, $a, $b) = @_;
+	if ($a > 0) {
+		say qq[The $relation of $child is $a/$b];
+	} else {
+		say qq[The $relation of $child does not exist];
+	}
+}
+ 
+