Merge pull request #6180 from drbaggy/master

First pass - sans blog...

4 files changed, 126 insertions, 289 deletions

diff --git a/challenge-167/james-smith/README.md b/challenge-167/james-smith/README.md
index 4cc3055242..17a6e5bc23 100644
--- a/challenge-167/james-smith/README.md
+++ b/challenge-167/james-smith/README.md
@@ -1,7 +1,7 @@
-[< Previous 165](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-165/james-smith) |
-[Next 167 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-167/james-smith)
+[< Previous 166](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-166/james-smith) |
+[Next 168 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-168/james-smith)
 
-# The Weekly Challenge 166
+# The Weekly Challenge 167
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -13,312 +13,79 @@ 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-166/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-167/james-smith
 
-# Challenge 1 - Hex words....
+# Challenge 1 - Circular Prime
 
-Now I've concentrated on challenge 2 this week but here is some of my code for Challenge 1
+***Write a script to find out first 10 circular primes having at least 3 digits (base 10). A circular prime is a prime number with the property that the number generated at each intermediate step when cyclically permuting its (base 10) digits will also be prime.***
 
 ## Solution
-Find all hex words, this generates all words, with options for adding filters - to
-restrict the number of numbers - to only letters or all letters. By commenting/uncommenting
-the filter lines.... I have added one more mapping that is in standard use which is
-`g` -> `9` {others use `6` but it still works}
 
-```perl
-while(<>) {
-  chomp;
-  next unless m{^[abcdefoilstg]+$};
-  my $t = $_;
-  my $N = tr/oilstg/011579/;
-  next if $N < length $_;
-  #next if $N > 0;
-  #next if $N > 15;
-  warn "$N\t$t\t$_\n" if $N == length $_;
-  $words->[length $_]{$N}{$t}="$_ (".hex($_).")";
-}
-
-print Dumper( $words );
-```
-
-## Some observations
-
-### Longest words
-```
- falsifiabilities  0x fa15 1f1a b111 71e5  (18,020,343,683,493,229,029)
- dissociabilities  0x d155 0c1a b111 71e5  (15,083,975,835,726,737,893)
- lactobacillaceae  0x 1ac7 0bac 111a ceae  ( 1,929,523,799,000,796,846)
-```
-Can add (if we include the g->9 mapping):
-```
- silicoflagellate  0x 5111 c0f1 a9e1 1a7e  ( 5,841,662,335,845,997,182)
-```
-### Longest word with at most `n` numbers:
-
-**0-numbers** - 8 letters
-```
- fabaceae          0x 0000 0000 faba ceae  (             4,206,546,606)
-```
-**1-number**  - 10 lettters
-```
- defaceable        0x 0000 00de face ab1e  (           957,690,587,934)
- defaecated        0x 0000 00de faec a7ed  (           957,692,553,197)
- effaceable        0x 0000 00ef face ab1e  (         1,030,705,031,966)
-```
-**2-numbers/3-numbers** - 12 letters
-```
- fiddledeedee      0x 0000 f1dd 1ede edee  (       265,932,007,992,814)
-```
-**4-numbers** - 12 letters
-```
- fiddledeedee      0x 0000 f1dd 1ede edee  (       265,932,007,992,814)
- acetoacetate      0x 0000 ace7 0ace 7a7e  (       190,108,318,726,782)
- cicadellidae      0x 0000 c1ca de11 1dae  (       213,077,053,218,222)
-```
-**5-numbers** - 13 letters
-```
- blastodiaceae     0x 000b 1a57 0d1a ceae  (     3,125,185,928,154,798)
-```
-**6-numbers -- 9-numbers** - 16 letters
-```
- lactobacillaceae  0x 1ac7 0bac 111a ceae  ( 1,929,523,799,000,796,846)
-```
-**10-numbers** - 16 letters
-```
- lactobacillaceae  0x 1ac7 0bac 111a ceae  ( 1,929,523,799,000,796,846)
- falsifiabilities  0x fa15 1f1a b111 71e5  (18,020,343,683,493,229,029)
-```
-Can add (if we include the g->9 mapping {could also do g->6}):
-```
- silicoflagellate  0x 5111 c0f1 a9e1 1a7e  ( 5,841,662,335,845,997,182)
-```
-**11+-numbers** - 16 letters
-```
- lactobacillaceae  0x 1ac7 0bac 111a ceae  ( 1,929,523,799,000,796,846)
- falsifiabilities  0x fa15 1f1a b111 71e5  (18,020,343,683,493,229,029)
- dissociabilities  0x d155 0c1a b111 71e5  (15,083,975,835,726,737,893)
-```
-Can add (if we include the g->9 mapping {could also do g->6}):
-```
- silicoflagellate  0x 5111 c0f1 a9e1 1a7e  ( 5,841,662,335,845,997,182)
-```
-
-### Longest word with all numbers:
-```
- soloists          0x 0000 0000 5010 1575  (             1,343,231,349)
- titlists          0x 0000 0000 7171 1575  (             1,903,236,469)
-```
-If we include the g->9 mapping we can have:
-```
- glossologists     0x 0000 91055 0109 1575 (     2,551,232,066,033,013)
-```
-
-# Challenge 2 - k-diff
-
-## The solution
-
-I approached this in a few different ways:
-
-### Getting the filenames...
-
-We can:
- 1) Cheat - and create a hash of arrays;
- 2) Use `opendir`/`readdir`/`closedir`;
- 3) Use `blob '*/*'`;
- 4) Use `<*/*>`.
-
-Each have advantages/disadvantages:
+*We are going to slightly extend this to find the first 19 circular primes - includes 4 1-digit primes and 5 2-digit circular primes and the 10 3+-digit ciruclar primes < one-million - After the largest 6-digit circular prime the next circular prime is the 19 digit prime - 1,111,111,111,111,111,111*
 
- * the first doesn't require us to create files on disk for testing;
- * 2 allows you to find hidden file names but then you have to be careful with `.` & `..`. You have to join directory and filename to get the path
- * 3 & 4 are essentially the same and get all "folders/entries". You have to split the path to get the directory and filename.
+We use `Math::Prime::Util`s `next_prime` function to loop through the primes. Before we check for primality of each of the permutations we can remove trivial cases:
+ 
+ * We know all 1-digit primes are circular so we take these out first `#1` - in fact the remaining logic does not work as we assume there are other rotations - and the regex we see next would remove `2` & `5` the only primes that contain either of these digits;
+ * We then remove numbers containing `0`, `2`, `4`, `5`, `6` or `8` as at least one rotation would end in this digit and therefore the number sould not be prime;
+ * As we are looking for an exemplar for each rotation we take the lowest one - we just check that the supplied prime is less than any of the rotations.
 
-The simplest approach is to use 3/4.
+   **Note** we use next here to short cut the map and jump to the next loop element.
 
-### Finding a complete list of different filenames
+   In this line we use `@q` to initially be the individual digits, but at the end we reuse it to conatain all the rotations.
 
-We collect a unique list of filenames, by putting them as the keys of a hash. We
-could do this with a map - but it is useful to keep track of the number of times
-we see each file.
+ * Now we look to see if we have any non-primes in the rotation using `is_prime`.. If we do then we skip the loop
 
-```perl
-  my( %directories, %filenames );
-  for( sort <*/*> ) {
-    my( $dir, $file ) = split m{/}, $_;
-    $directories{$dir}=1;
-    $file.='/' if -d $_;
-    $filenames{ $file }{ $dir } = 1;
-  }
-  my @paths = sort keys %directories;
-```
-
-### Compute the length of the longest directory or filename
-
-For the output we will want to pretty print it - and so need to work out the width
-of the columns - this is a simple loop over the directories and filenames.
-```perl
-  my $length = 0;
-  for ( @paths, keys %filenames ) {
-    $length = length $_ if length $_ > $length;
-  }
-```
-### Build templates for printing page horizontal line, sprintf table of heading/contents
-
-We draw the horizontal line three times, so it is useful to keep a copy of it, we
-in the code also need a template to sprintf the header and the body of the table.
-So we generate these now. We use the length we computed above to compute the runs of
-characters needed.
-
-```perl
-  my $HORIZONTAL_LINE = join '-' x ( $length+2 ), ('+') x (1+@paths);
-  my $TEMPLATE        = '|' . " %-${length}s |" x @paths;
-
-  say $HORIZONTAL_LINE;
-  say sprintf $TEMPLATE, @paths;
-  say $HORIZONTAL_LINE;
-```
-
-### Workout what to print and printing
-
-This loops through the unique filenames we stored earlier. Then
-for each filename we first check that it is present in all lists.
-If it is we remove it and go onto the next filename. As we kept
-counts of each filename this is as easy as checking that the
-count is the same as the number of directories - this is the
-first if in the loop.
-
-We then loop through each column - if the filename is present
-we display it o/w we display a blank string.
-
-```perl
-  for my $filename ( sort keys %filenames ) {
-    next if @paths == keys %{$filenames{$filename}};
-    my @columns;
-    for (@paths) {
-      if( exists $filenames{$filename}{$_} ) {
-        push @columns, $filename;
-      } else {
-        push @columns, '';
-      }
-    }
-    say sprintf $TEMPLATE, @columns;
-  }
-```
-
-### Add the last line...
-
-We print the bottom of the table:
-
-```perl
-say $1;
-```
-
-## The full code (with comments)
+ * Finally if we have got through all the filters we push the prime `$p` on to the results array.>
 
 ```perl
-sub k_diff {
-        ## my($l,%d,%u)=0;
-  my( $length, %directories, %filenames )=0;
-
-        ## /\//,$u{$'.'/'x-d}{$d{$`}=$`}++for<*/*>
-  for( sort <*/*> ) {
-    my( $dir, $file ) = split m{/}, $_;
-    $directories{$dir}=1;
-    $file.='/' if -d $_;
-    $filenames{ $file }{ $dir } = 1;
-  }
-
-        ## $l<length?$l=length:1for(my@p=sort keys%d),@_=keys%u
-  my @paths = sort keys %directories;
-  for ( @paths, keys %filenames ) {
-    $length = length $_ if length $_ > $length;
-  }
-
-        ## say$a=join('-'x$l,('+--')x@p,"+\n"),sprintf($b="| %-${l}s "x@p."|\n",@p),$a,
-  my $HORIZONTAL_LINE = join '-' x ( $length+2 ), ('+') x (1+@paths);
-  my $TEMPLATE        = '|' . " %-${length}s |" x @paths;
-  say $HORIZONTAL_LINE;
-  say sprintf $TEMPLATE, @paths;
-  say $HORIZONTAL_LINE;
-
-        ## map({//;@p-%{$u{$'}}?sprintf$b,map{$u{$'}{$_}?$':''}@p:()}sort@_)
-  for my $filename ( sort keys %filenames ) {
-    next if @paths == keys %{$filenames{$filename}};
-    my @columns;
-    for (@paths) {
-      if( exists $filenames{$filename}{$_} ) {
-        push @columns, $filename;
-      } else {
-        push @columns, '';
-      }
-    }
-    say sprintf $TEMPLATE, @columns;
-  }
-
-        ## $a
-  say $HORIZONTAL_LINE;
+use Math::Prime::Util qw(next_prime is_prime);
+my( $p, $N, @q, @res ) = ( 1, 19 );
+
+while( @res < $N ) {
+  ( ( $p = next_prime $p ) < 10 #1
+    || $p !~ /[024568]/
+    && ( @q = split//, $p )
+    && ( @q = map { push @q, shift @q; ( $_ = join '', @q ) < $p ? (next) : $_ } 2..@q )
+    && ( ! grep { ! is_prime( $_ ) } @q )
+  ) && ( push @res, $p )
 }
-```
-## Obfurscated/Golf code...
-
-I started with a "simple" compact version of the code and then came
-discussions with Eliza on the Perl Programmers Facebook group and things
-slowly got smaller. A few bytes at a time to the 259 bytes:
 
-```perl
-sub z{my($l,%d,%u)=0;/\//,$u{$'.'/'x-d}{$d{$`}=$`}++for<*/*>;$l<length?$l=length
-:1for(my@p=sort keys%d),@_=keys%u;say$a=join('-'x$l,('+--')x@p,"+\n"),sprintf($b
-="| %-${l}s "x@p."|\n",@p),$a,map({//;@p-%{$u{$'}}?sprintf$b,map{$u{$'}{$_}?$':
-''}@p:()}sort@_),$a}
+say for @res;
 ```
 
-**or** if we "allow" return characters inside strings - this is 257 bytes of
-perly goodness...
+# Challenge 2 - Gamma function
 
-```perl
-sub z{my($l,%d,%u)=0;/\//,$u{$'.'/'x-d}{$d{$`}=$`}++for<*/*>;$l<length?$l=length
-:1for(my@p=sort keys%d),@_=keys%u;say$a=join('-'x$l,('+--')x@p,'+
-'),sprintf($b="| %-${l}s "x@p.'|
-',@p),$a,map({//;@p-%{$u{$'}}?sprintf$b,map{$u{$'}{$_}?$':''}@p:()}sort@_),$a}
-```
-
-**Notes**
- - We replace many of the loops and conditionals with `map`s and `_?_:_`
- - Where we use `$_` there are numerous function calls which use this when no
-   parameter is passed - in this case `length`, `split`, `-d`.
- - When a "string" starts with a number than has a letter in it treats it as if
-   to add a space between the number and the rest of the string so we can rewrite
-   `1 for @array` as `1for@array`.
- - we don't need to do `sort blob '*/*'` or `sort <*/*>` as for all "current"
-   versions of Perl we can assume that perl does this for us.
- - Rather than using `split /\//`, we use the match operator `/\//` in one place
-   and `//` in another to split - the first half goes in `$`` and the second half
-   in `$'`.
- - When using `//` this just copies `$_` into `$'`.
- - if you subtract a hash in scalar context then it subtracts the numbers of keys.
-   Sp we can compute the number ot times a file is missing by doing `@p-%u`.
-## Coda - taking the brakes off...
-
-For ultimate compactness we can remove the function overhead off, turn off both
-`strict` and `warnings`. We can reduce this to either 233 bytes (or 231 bytes)
-
-```perl
-/\//,$u{$'.'/'x-d}{$d{$`}=$`}++for<*/*>;$l<length?$l=length:1for(@p=sort keys%d),@_=keys%u;print$a=join('-'x$l,('+--')x@p,'+
-'),sprintf($b="| %-${l}s "x@p.'|
-',@p),$a,map({//;@p-%{$u{$'}}?sprintf$b,map{$' x$u{$'}{$_}}@p:()}sort@_),$a
-```
-This is the 233 byte version - we could reduce it to 231 bytes by replacing
-`print` with `say` again... But ultimately that makes the execution more bytes.
+***Implement subroutine gamma() using the Lanczos approximation method.***
 
-Command line with `print`:
+## Solution
 
-```perl
-perl ch-2-ns.pl
-```
+The gamma function is the genaralisation of the factorial function `Gamma(n) = (n-1)!` for positive integers.
 
-Command line with `say` 
+We will use Lanczos approximation...
 
+ * If z is an integer and less than or equal to 0 - we return the special string 'inf' as the value is infinite.
+ * If z is less than 0.5 - we use the calulation beased on `gamma(1-z)` multiplied the the factor `PI/sin(PI * z)`
+ * Finally we use the lanczos approximation.
+   * This starts by computing the sum in the map, then computing the value based on this sum
+   * we use `( map( {} @PV ), fn(z,x) )[-1]` to put this all in one line, we also re-use `$i` after the loop, to store the value of `$z+@PV-1.5` which is used twice AND again to store the final value - so we can decide to round it back down to an integer if we are close to integer value. This I agree is nasty!!!
+   * `$RP` is `sqrt(2*$PI)` but evaluated for speed 
+ 
 ```perl
-perl -M5.10.0 ch-2-ns.pl
+const my $PI => 3.1415926535897932384626433832;
+const my $RP => 2.5066282746310002416123552393;
+const my $EP => 0.000000000001;
+const my $X  => 0.99999999999980993;
+const my @PV => (
+  676.5203681218851,  -1259.1392167224028,    771.32342877765313,     -176.61502916214059,
+   12.507343278686905,   -0.13857109526572012,  9.9843695780195716e-6,   1.5056327351493116e-7,
+);
+
+sub gamma {
+  my($i,$x,$z)=(0,$X,$_[0]);
+  ( $z<=0 && abs( $z - int$z ) < $EP ) ? 'inf'
+  : $z < 0.5                     ? $PI / sin( $PI * $z ) * gamma( 1 - $z )
+  : ( map( { $x += $_ / ( $z + $i++ ) } @PV ),
+      abs( ( $i = $RP * ( $i = $z + @PV - 1.5 ) ** ( $z - 0.5 ) * $x * exp -$i ) - int $i
+    ) < $EP ? int $i : $i )[-1]
+}
 ```
-So to save 2 bytes we use 9 more to run the command... of course you could just run it as a 1-liner on the command line (with the -E) but that would just be silly!
diff --git a/challenge-167/james-smith/blog.txt b/challenge-167/james-smith/blog.txt
new file mode 100644
index 0000000000..68298febed
--- /dev/null
+++ b/challenge-167/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-167/james-smith
diff --git a/challenge-167/james-smith/perl/ch-1.pl b/challenge-167/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..4082d3b7c7
--- /dev/null
+++ b/challenge-167/james-smith/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+use Math::Prime::Util qw(next_prime is_prime);
+
+my($p,$N,@q,@res) = (1,19);
+
+# Cannot raise $N above 10 as the 11th value is:
+#   1,111,111,111,111,111,111
+# which is 5.5 trillion times larger than the 10th value...
+
+while(@res<$N) {
+    ## Get the next prime - skip to next one if contains an even digit
+    ## As each digit is used as the last digit we know that this is not
+    ## a circular prime... (also skip 5 for a similar reason)
+    ## Include acception for 1 digit primes { as we don't want to block
+    ## 2 and 5 }
+    ## Split the string into consituent numbers...
+    ## Check $p is the lowest of the permutations
+    ## Here @q starts out as the list of digits - but gets assigned the
+    ## list of rotations... This avoids us using a cache to see if we
+    ## have seen that combination of digits - slower but more memory
+    ## efficient...
+    ## If it is we then check to see if all are prime!
+    ## Again we have an exception for 2 digit primes as the map returns an
+    ## empty array
+  ( ( $p = next_prime $p ) < 10
+    || $p !~ /[024568]/
+    && (@q = split//,$p)
+    && ( @q = map { push @q, shift @q; ($_ = join '',@q) < $p ? (next) : $_ } 2..@q )
+    && ( ! grep { !is_prime( $_ ) } @q )
+  ) && (push @res,$p)
+}
+
+
+say for @res;
+
diff --git a/challenge-167/james-smith/perl/ch-2.pl b/challenge-167/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..1d255a5aec
--- /dev/null
+++ b/challenge-167/james-smith/perl/ch-2.pl
@@ -0,0 +1,26 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Const::Fast qw(const);
+
+const my $PI => 3.1415926535897932384626433832;
+const my $RP => 2.5066282746310002416123552393;
+const my $EP => 0.000000000001;
+const my $X  => 0.99999999999980993;
+const my @PV => (
+  676.5203681218851,  -1259.1392167224028,    771.32342877765313,     -176.61502916214059,
+   12.507343278686905,   -0.13857109526572012,  9.9843695780195716e-6,   1.5056327351493116e-7,
+);
+
+say sprintf( '%5.2f - %30.4f', $_/2, gamma($_/2) ) =~ s{[.]0000$}{}r  for -40..40;
+
+sub gamma {
+  my($i,$x,$z)=(0,$X,$_[0]);
+  ($z<=0 && abs($z-int$z)<$EP) ? 'inf'
+  : $z < 0.5                   ? $PI / sin($PI*$z) * gamma( 1-$z )
+  : (map({$x+=$_/($z+$i++)}@PV),abs(($i=$RP*($i=$z+@PV-1.5)**($z-0.5)*exp(-$i)*$x)-int$i)<$EP?int$i:$i)[-1]
+}
+