From 8c03232e8641237c44f27cb1943d81e57b8e7bf3 Mon Sep 17 00:00:00 2001 From: Peter Campbell Smith Date: Tue, 4 Jan 2022 18:23:23 +0000 Subject: My solutions to week 146 --- challenge-146/peter-campbell-smith/blog.txt | 1 + challenge-146/peter-campbell-smith/perl/ch-1.pl | 56 +++++++++++++++++++++ challenge-146/peter-campbell-smith/perl/ch-2.pl | 66 +++++++++++++++++++++++++ 3 files changed, 123 insertions(+) create mode 100644 challenge-146/peter-campbell-smith/blog.txt create mode 100755 challenge-146/peter-campbell-smith/perl/ch-1.pl create mode 100755 challenge-146/peter-campbell-smith/perl/ch-2.pl 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]; + } +} + + -- cgit