Merge pull request #5504 from drbaggy/master

Added some documentation of the method.

6 files changed, 383 insertions, 70 deletions

diff --git a/challenge-146/james-smith/README.md b/challenge-146/james-smith/README.md
index a0c9ed8cc0..5f5f83bebc 100644
--- a/challenge-146/james-smith/README.md
+++ b/challenge-146/james-smith/README.md
@@ -39,6 +39,29 @@ try the next number. If we find a factor we skip the rest of the loop and go on
 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.
 
+For those of you that can't follow/don't like using `?:`, `&&` and `||` instead of `if/else`, `if` and
+`unless`. This is that block of code mapped out in full. The slight difference is that in the example
+above `$c+=2` is done after the main block is executed, and in this case before {so in this case we
+start with `$c=3` which increments to `$c=5` at the start of the loop.
+
+```perl
+my @primes = (3);
+my $c = 3;
+while( @primes < 10000 ) {
+  $c += 2;
+  foreach ( @primes ) {
+    if( $_*$_ > $c ) {
+      push @primes, $c;
+      last;
+    }
+    unless( $c % $_ ) {
+      last;
+    }
+  }
+}
+say $primes[-1];
+```
+
 # Challenge 2 - Curious Fraction Tree
 
 ***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.***
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 `@{[` & `]}`
diff --git a/challenge-147/james-smith/blog.txt b/challenge-147/james-smith/blog.txt
new file mode 100644
index 0000000000..139c9f8b15
--- /dev/null
+++ b/challenge-147/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/manwar/perlweeklychallenge-club/tree/master/challenge-147/james-smith
diff --git a/challenge-147/james-smith/perl/ch-1-right.pl b/challenge-147/james-smith/perl/ch-1-right.pl
new file mode 100644
index 0000000000..9565a26b0f
--- /dev/null
+++ b/challenge-147/james-smith/perl/ch-1-right.pl
@@ -0,0 +1,31 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Time::HiRes qw(time);
+
+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; ## Is this prime?
+      foreach( ;$primes[-1]*$primes[-1]<$n;$c+=2) {
+        ($_*$_>$c)?(push(@primes,$c),last):$c%$_||last for @primes;
+      }
+      ## check if $n is composite;
+      $n%$_||next B foreach @primes;
+      push @tprimes_new, $n;
+      printf $TEMPLATE, ++$idx, $n, time - $t0;
+    }
+  }
+  @tprimes_current = @tprimes_new;
+}
+
diff --git a/challenge-147/james-smith/perl/ch-1.pl b/challenge-147/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..3d9b2ccf72
--- /dev/null
+++ b/challenge-147/james-smith/perl/ch-1.pl
@@ -0,0 +1,141 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Time::HiRes qw(time);
+
+$|=1;
+
+## Finding left-truncated primes.
+
+## Set up primes
+my( $T, $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);
+
+## The 1-digit primes are 2, 3, 5 and 7.
+## All 2-digit primes (that are truncated) end in either 3 or 7, so we use
+## the array (3,7) as the starting list of truncated primes...
+##
+## To get the list of potential truncated primes of length (n+1) by
+## looping through each of the primes of length (n) prefixed by the numbers
+## 1 .. 9.
+##
+## We check to see if these are prime - by looking to see if they have
+## prime factors < sqrt(n)
+##
+## (We may need to update the list of primes {less than sqrt(n)}) before
+## the check)
+##
+## We continue around this loop looking at longer and longer primes,
+## until we have collected enough primes OR @tprimes_current is empty
+
+printf $T, ++$index, $_, time-$t0 for 2,3,5,7;
+while(1) {
+  last unless @tprimes_current; ## Exit if there are no current l-trunc primes
+                                ## We are at the end of the list...
+
+  my @tprimes_new = ();
+
+  for my $first ( 1..9 ) {
+    B: for my $base ( @tprimes_current ) {
+      my $p = $first.$base;
+
+      ## Update list of primes...
+      for( ;$primes[-1]*$primes[-1]<$p;$c+=2) {
+        ($_*$_>$c)?(push(@primes,$c),last):$c%$_||last for @primes;
+      }
+
+      ## check if $p is composite;
+      $p%$_||next B for @primes;
+
+      ## If not we add the prime to the list of primes of length `n+1`
+
+      push @tprimes_new, $p;
+
+      ## And output the index/prime/and time taken..
+      printf $T, ++$index, $p, time - $t0;
+      exit if $index >= $N; ## Stop if we have got to limit set
+    }
+  }
+  ## We use new list we generated as the current list for the
+  ## next loop.
+  @tprimes_current = @tprimes_new;
+}
+
+## Times taken to get to certain truncated primes
+## Note there are 4260 left-truncated primes in total.
+##
+## The largest one is 357,686,312,646,216,567,629,137
+##
+## We know this number is finite as there are no
+## 25 digit left-truncated primes.
+##
+## Below are times for the code to generate the
+## given number of primes [and the value of the
+## last one] you will note that the large indexes
+## the time required per step increases greatly
+## I believe this is mainly in computing all the
+## possible prime factors to look for composites
+
+
+## Index Running time          Value of prime..
+##    20    0.0001 sec                         197
+##   100    0.0005 sec                       5,167
+## -----------------------------------------------
+##   500    0.0045 sec                     543,853
+## 1,000    0.0173 sec                   8,391,283
+## 1,500    0.0477 sec                  79,962,683
+## 2,000    0.1246 sec                 736,275,167
+## 2,500    0.3298 sec               6,946,986,197
+## 3,000    0.9487 sec              75,315,729,173
+## 3,500    3.9416 sec           1,837,839,918,353
+## 4,000   62.3637 sec         313,231,816,543,853
+## -----------------------------------------------
+## 4,100  3 min 54 sec       2,696,154,867,812,347
+## 4,200        41 min      94,669,684,516,387,853
+## -----------------------------------------------
+## 4,210   1 hr 46 min     396,334,245,663,786,197
+## 4,220   2 hr 36 min     686,315,421,273,233,617
+## -----------------------------------------------
+## 4,229   3 hr 59 min   1,276,812,967,623,946,997
+## 4,230   7 hr 48 min   3,396,334,245,663,786,197
+## 4,231   7 hr 57 min   3,484,957,213,536,676,883
+## 4,232   9 hr 46 min   4,686,798,799,354,632,647
+## 4,233  10 hr 46 min   5,396,334,245,663,786,197
+## 4,234  11 hr 48 min   6,165,678,739,293,946,997
+## 4,235  11 hr 57 min   6,276,812,967,623,946,997
+## 4,236  12 hr 00 min   6,312,646,216,567,629,137
+## 4,237  12 hr 13 min   6,484,957,213,536,676,883
+## 4,238  12 hr 48 min   6,918,997,653,319,693,967
+## 4,239  14 hr  8 min   7,986,315,421,273,233,617
+## 4,240  15 hr 15 min   8,918,997,653,319,693,967
+## 4,241  15 hr 18 min   8,963,315,421,273,233,617
+
+## Length   # of length   # cumulative
+##      1             4              4
+##      2            11             15
+##      3            39             54
+##      4            99            153
+##      5           192            345
+##      6           326            671
+##      7           429           1100
+##      8           521           1621
+##      9           545           2166
+##     10           517           2683
+##     11           448           3131
+##     12           354           3485
+##     13           276           3761
+##     14           212           3973
+##     15           117           4090
+##     16            72           4162
+##     17            42           4204
+##     18            24           4228
+##     19            13           4241
+##     20
+##     21
+##     22
+##     23
+##     24
diff --git a/challenge-147/james-smith/perl/ch-2.pl b/challenge-147/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..632d5ac1e1
--- /dev/null
+++ b/challenge-147/james-smith/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+
+my %q = map { $_=>$_ } (my @p = (0,1));
+for(my $o=2;;$o++) {
+  for(my $i=1, ($q{$p[$o]||=$o*(3*$o-1)/2}||=$o); $i<$o; $i++) {
+    (my $t=$q{$p[$o]-$p[$i]}) || next;
+    (push(@p, @p * (3*@p-1)/2), $q{$p[-1]}=@p) while $p[$o]+$p[$i] > $p[-1];
+    (my $s=$q{$p[$o]+$p[$i]}) || next;
+    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[$t] = p($t).\n"
+  }
+}
+