diff options
| author | James Smith <js5@sanger.ac.uk> | 2022-01-11 17:19:27 +0000 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2022-01-11 17:19:27 +0000 |
| commit | 98b0daeb24d1a614c9cfeaac4675078aef84c33b (patch) | |
| tree | 823d068620336750b2c33b5f761747e73aab953a /challenge-147 | |
| parent | 80a1b64153ca8fcde1b2f59b98fd21ecf0ac716a (diff) | |
| download | perlweeklychallenge-club-98b0daeb24d1a614c9cfeaac4675078aef84c33b.tar.gz perlweeklychallenge-club-98b0daeb24d1a614c9cfeaac4675078aef84c33b.tar.bz2 perlweeklychallenge-club-98b0daeb24d1a614c9cfeaac4675078aef84c33b.zip | |
Added some notes.
Diffstat (limited to 'challenge-147')
| -rw-r--r-- | challenge-147/james-smith/README.md | 240 |
1 files changed, 170 insertions, 70 deletions
diff --git a/challenge-147/james-smith/README.md b/challenge-147/james-smith/README.md index a0c9ed8cc0..6941c1b663 100644 --- a/challenge-147/james-smith/README.md +++ b/challenge-147/james-smith/README.md @@ -1,6 +1,6 @@ -[< Previous 145](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-145/james-smith) | -[Next 147 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-147/james-smith) -# Perl Weekly Challenge #146 +[< Previous 146](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-146/james-smith) | +[Next 148 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-148/james-smith) +# Perl Weekly Challenge #147 You can find more information about this weeks, and previous weeks challenges at: @@ -12,101 +12,201 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-146/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-147/james-smith -# Challenge 1 - 10,001st Prime Number +# Challenge 1 - Truncatable Prime -***Write a script to generate the 10,001st prime number.*** +***Write a script to generate first 20 left-truncatable prime numbers in base 10. In number theory, a left-truncatable prime is a prime number which, in a given base, contains no 0, and if the leading left digit is successively removed, then all resulting numbers are primes.*** ## The solution -We could use a Prime module, but finding primes is not that difficult so we will roll our own generator. +Another prime problem this week so we can reuse our generator from last week... ```perl -my($c,@p)=(5,3); -for(;@p<10000;$c+=2){ +for(;;$c+=2){ ($_*$_>$c)?((push@p,$c),last):$c%$_||last for@p; } -say$p[-1]; ``` -The crux of the code is in the `for @p` line. This sees if a given odd number is prime. +We are asked to find the first 20 left-truncatable primes. Primes which when you repeatedly remove the first digit you get another prime. -We loop through all the primes up to and including the square root of the value we are checking. -If we don't find a prime factor by then we push the new value to the primes list, and go on to -try the next number. If we find a factor we skip the rest of the loop and go on to try the next number. +The naïve approach is to loop through all numbers and the check that any prime found has this property. Well this works OK for `N = 20`, but what if `N = 100` or `N = 1000` or larger. This approach doesn't scale well. -We stop when we have 10,000 records in the array (as we don't include the prime number 2 in the list - we -explicitly exclude even numbers in the list we search over), so the last element is the 10,001st prime. +So how can we resolve this. We note that for left-truncatable prime of length `n+1` is a prime, whose first digit is one of `1 .. 9`, and the remaining digits are a left-truncatable prime of length `n`. -# Challenge 2 - Curious Fraction Tree +This means we can create a series of left-truncatable primes of a given length, by using the short left-truncatable primes. This may slow down things when `n` is small - but it greatly reduces the search space as `n` increases. -***The tree below is defined by the following rules. For a fraction `a/b` the children are `a/(b+a)` & `(a+b)/b`. Given a node in the tree `n/m` we need to find the pate back up to the root node.*** +We still need to keep a list of all prime numbers, but only up to the square root of the left-truncatable prime. Greatly reducing the number we have to find/store. -``` - 1/1 - | - +-------------------+-------------------+ - 1/2 2/1 - | | - +---------+---------+ +---------+---------+ - | | | | - 1/3 3/2 2/3 3/1 - | | | | - +----+----+ +----+----+ +----+----+ +----+----+ - | | | | | | | | - 1/4 4/3 3/5 5/2 2/5 5/3 3/4 4/1 - | | | | | | | | - +-+-+ +-+-+ +-+-+ +-+-+ +-+-+ +-+-+ +-+-+ +-+-+ - | | | | | | | | | | | | | | | | -1/5 5/4 4/7 7/3 3/8 8/5 5/7 7/2 2/7 7/5 5/8 8/3 3/7 7/4 4/5 5/1 +Now there are 4,260 such numbers the largest having 24 digits: 357,686,312,646,216,567,629,137. The code works up until left-truncatable prime 4,241 - as this is the largest l-truncatable prime less than `2^63` the largest 64-bit unsigned integer. It took about 15.5 hours to generate this list. + +```perl +## Set up primes +my( $TEMPLATE, $t0, $index, $N, $c, @primes ) = + ( "%6d\t%28d\t%15.6f\n", time, 0, @ARGV ? $ARGV[0] : 20, 5, 3 ); +my @tprimes_current = (3,7); + +printf $TEMPLATE, ++$index, $_, time-$t0 for 2,3,5,7; +while(1) { + # ** Stop if there are no primes of length `n`. + last unless @tprimes_current; + my @tprimes_new = (); + # ** Loop through each of possible left-truncatable primes... + for my $first ( 1..9 ) { + B: for my $base ( @tprimes_current ) { + # ** New left-truncated prime candidate. + my $p = $first.$base; + # ** Use our prime generator this stopping when we have enough + # primes - to sqrt of left-truncatable prime. + for( ;$primes[-1]*$primes[-1]<$p;$c+=2) { + ($_*$_>$c)?(push(@primes,$c),last):$c%$_||last for @primes; + } + # ** See if left-truncatable prime is prime... + $p%$_||next B for @primes; + push @tprimes_new, $p; + printf $TEMPLATE, ++$index, $p, time - $t0; + exit if $index >= $N; + } + } + ## Replace current list with new list for the next loop round. + @tprimes_current = @tprimes_new; +} ``` -## The solution +### Notes: + + * As we are printing out the truncatable primes we don't keep a record of them, only the list of length `n` (`@tprimes_current`) and those of length `n+1` (`@tprimes_new`). + * Although primes of length 1 can end in `2` and `5`, all other left-truncatable primes end in `3` or `7`. So we initialise `@tprimes_current` with 2 values `3` and `7`. + * We know the number of left-truncatable primes as there are no 25 digit left-truncatable primes... + * We use the label version of `next` - `next B` to jump out of the loop through the primes and also the inner loop ( `@tprimes_current` ). + +### Results.. -We note if the node is `N/D` and the parent node is `n/d`: -* To get the parent of the left child we note that `n+d = D` and `n = N`, so the parent denominator is `N-D` and numerator doesn't change -* To get the parent of the right child we note that `n = N+D` and `d = D`, so the parent numerator is `N-D` and denominator doesn't change. -* For all nodes the numerator/denominator are co-prime. +There are 4260 left-truncatable primes - 4241 are less than the max integer value in perl (2^63) - and takes about 15.5 hours. -We repeat this until `n` and `d` are the same - in the tree above both will have a value of `1`. If the initial numbers of not co-prime. The function stops when `n` and `d` are both the greatest common divisor of `n` and `d`. +``` + 1 2 0.000006 + 2 3 0.000467 + 3 5 0.000721 + 4 7 0.000930 + 5 13 0.000025 +... +... +... + 4238 6,918,997,653,319,693,967 46025.573958 + 4239 7,986,315,421,273,233,617 50835.182091 + 4240 8,918,997,653,319,693,967 54882.080819 + 4241 8,963,315,421,273,233,617 55078.314226 +``` +## Aside - Right-truncatable primes -The `stringify` function just converts the tree into a single string (list of fractions) so we can test the tree code. +We can modify our script slightly to handle right truncatable primes - this is actually a simpler problem to the left truncatable primes, as there is a lot less of them, as they all have the form `[2357][1379]*`. Obviously we have to modify the code to add the extra digit at the end of the number rather than at the front but we also have to switch the order of the two for loops. Rather than the outer one being the digit added and the inner one the list of truncatable primes of length `n-1` we have to make the outer loop as the list of right truncatable primes and the inner loop the additional digits - there are only 4 options here 1, 3, 7 & 9. This ensures the primes come out in numerical order. ```perl -sub tree { - my@tr=[my($n,$d)=@_]; - push@tr,$d>$n?[$n,$d-=$n]:[$n-=$d,$d]while$n-$d; - \@tr; +my ( $TEMPLATE, $idx, $t0, $c, @primes ) = + ( "%6d\t%28d\t%15.6f\n", 0, time, 5, 3 ); +my @tprimes_current = (2,3,5,7); +printf $TEMPLATE, ++$idx, $_, time - $t0 foreach @tprimes_current; + +for my $p ( 1 .. 100 ) { + last unless @tprimes_current; + my @tprimes_new = (); + foreach my $base ( @tprimes_current ) { + B: foreach my $last ( 1,3,7,9 ) { + my $n = $base.$last; + foreach( ;$primes[-1]*$primes[-1]<$n;$c+=2) { + ($_*$_>$c)?(push(@primes,$c),last):$c%$_||last for @primes; + } + $n%$_||next B foreach @primes; + push @tprimes_new, $n; + printf $TEMPLATE, ++$idx, $n, time - $t0; + } + } + @tprimes_current = @tprimes_new; } +``` -sub stringify { - "@{[map{join'/',@{$_}}@{$_[0]}]}"; -} +### Results.. -sub tree_expanded { - my ($n,$d) = @_; - my $traverse = [ [ $n, $d ] ]; - while( $n != $d ) { - if($d>$n) { - $d -= $n; - } else { - $n -= $d; - } - push @{$traverse}, [ $n, $d ]; +There are 83 right-truncatable primes - the script runs for less than 0.02 seconds. + +``` + 1 2 0.000006 + 2 3 0.000467 + 3 5 0.000721 + 4 7 0.000930 + 5 23 0.001119 +... +... +... + 81 37,337,999 0.011444 + 82 59,393,339 0.012381 + 83 73,939,133 0.013005 +``` + +# Challenge 2 - Pentagon Numbers + +***Write a sript to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number. A pentagon number has the form: `P(n) = n(3n - 1)/2`*** + +## The solution + +We create an array of pentagon numbers, along with a map from value to key. The while loop makes sure that we have enough pentagonal numbers to be greater than the sum of the two pentagonal numbers (indexed by by `$o` and `$i`). + + +```perl +my %q = map { $_=>$_ } (my @p = (0,1)); #1 +for(my $o=2;;$o++) { + for(my $i=1, ($q{$p[$o]||=$o*(3*$o-1)/2}||=$o); $i<$o; $i++) { #2 + (my $d=$q{$p[$o]-$p[$i]}) || next; #3 + (push(@p, @p * (3*@p-1)/2), $q{$p[-1]}=@p) while $p[$o]+$p[$i] > $p[-1]; #4 + (my $s=$q{$p[$o]+$p[$i]}) || next; #5 + die "First 2 pents are:\n p($o) = $p[$o]\n p($i) = $p[$i],\n p($o) + p($i) = $p[$s] = p($s),\n p($o) - p($i) = $p[$d] = p($d).\n" #6 } - return $traverse; } +``` +### The result -sub stringify_expanded { - my traverse = $_[0]; ## Ref passed - return join ' ', - map { $_->[0].'/'.$_->[1] } - @{ $traverse }; +The output of the script is: +``` +First 2 pents are: + p(2167) = 7042750 + p(1020) = 1560090, + p(2167) + p(1020) = 8610026 = p(2396), + p(2167) - p(1020) = 5488397 = p(1913). +``` + +### Notes: + * #1 - initialise the map of pentagonal numbers. + * #2 - make sure that the next entry in the pentagonal numbers is present + * #3 - try next combination if the difference is not a pentagonal number + * #4 - extend pentagonal number list so that it contains all pentagonal numbers up to and including the sum of the two pentagonal numbers. + * #5 - try next combination if the sum is not a pentagonal number + * #6 - we display the summary information about the pentagonal numbers + +## Expanded solution. + +For those that want this a bit more expanded this is the same code expanded out. + +```perl +my @pents = ( 0, 1 ); +my %rev_pents = ( 0 => 0, 1 => 1 ); + +for( my $o=2; ; $o++ ) { + $pents[$o] ||= $o * (3 * $o - 1 ) / 2; + $rev_pents{ $pents[$o] } ||= $o; + for my $i ( 1 .. $o-1 ) { + next unless my $diff_idx = $rev_pents{ $pents[$o] - $pents[$i] }; + while( $pents[-1] < $pents[$o] + $pents[$i] ) { + push @pents, @pents * ( 3 * @pents - 1 ) / 2; + $rev_pents{ $pents[-1] } = @pents; + } + next unless my $sum_idx = $rev_pents{ $pents[$o] + $pents[$i] }; + say 'First 2 pents are:'; + say ' p($i) = $pents[$i],'; + say ' p($o) = $pents[$o],'; + say ' p($o) + p($i) = $pents[$sum_idx] = p($sum_idx),'; + say ' p($o) - p($i) = $pents[$diff_idx] = p($diff_idx).'; + exit; + } } ``` -**Notes** - * In the tree function we work with an array, and return it's reference (the last result is returned if no explicit `return` is given, so if you are returning from the last command in the function you do not have to include the `return` keyword.) This just makes for shorter code. - * Rather than using an `if/else` we use a ternary ` ? : ` to implement the same switch - and we update `$d` and `$n` when we create the new element to the array. This allows us to embed the code in a postfix `while`. - * Rather than using `$n==$d` we use `$n-$d` to save 1 byte but these are essentially the same in an if statement. - * In `stringify` we use a number of tricks for compactness. Rather than using explicit `$n.'/'.$d` we note that we can rewrite as a join. But where we want to join on `" "` we can use the fact that if you embed an array in a string "@a" it does an implicit join on `" "`. You can then embed any code within a string by wrapping it in `@{[` & `]}` |
