Merge pull request #5410 from drbaggy/master

notes

4 files changed, 155 insertions, 109 deletions

diff --git a/challenge-144/james-smith/README.md b/challenge-144/james-smith/README.md
index 1dbf64a12e..d479af154d 100644
--- a/challenge-144/james-smith/README.md
+++ b/challenge-144/james-smith/README.md
@@ -1,6 +1,6 @@
-[< Previous 142](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-142/james-smith) |
-[Next 144 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-144/james-smith)
-# Perl Weekly Challenge #143
+[< Previous 143](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-143/james-smith) |
+[Next 145 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-145/james-smith)
+# Perl Weekly Challenge #144
 
 You can find more information about this weeks, and previous weeks challenges at:
 
@@ -12,129 +12,48 @@ 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-143/james-smith
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-144/james-smith
 
-# Challenge 1 - Calculator
+# Challenge 1 - Semiprimes
 
-***You are given a string, `$s`, containing mathematical expression. Write a script to print the result of the mathematical expression. To keep it simple, please only accept `+ - * ()`.***`
+***Write a script to generate all Semiprime number <= 100. (A semiprime is a number which is a multiple of two primes)***`
 
 ## The solution
 
-The simple solution is just to "`eval`" the string, but where is the fun in that... We can either go for a tokenizing parser - where we create an array of elements brackets, symbols, numbers, or we can use regular expressions to reduce the equation.
-
-All students will remember BODMAS - Brackets, order, Division/Multiplication, Addition/Division. (or BIDMAS, PIDMAS, PEMDAS or whatever you used to remember it). So we have to break our prasing down into:
-
- * Brackets
- * Order    - we don't have this in our equations
- * Division/Multiplication - we only have the latter
- * Addition/Subtraction.
-
-So our logic becomes:
-
- * **B** - Find brackets without brackets within - for these we evaluate the contents using the same algorithm;
- * **M** - If there are no brackets left - we then looking for multiplications from left to right and evaluate these.
- * **AS** - If there are no brackets or multiplications we look at the addition/subtraction again left to right.
- * This gives the following perl function:
+Rather than looping through each number to find if it is a semiprime - instead we find all the primes and multiply these together.
+We realise we need the primes up to $N/2, and so compute them. Then for each prime we push all multiples of the prime with all
+the previous primes (filtering for values less than or equal to $N)
 
+This method is faster than the loop method about 9x faster than the loop method for `$N = 10,000`.
 ```perl
-sub evaluate  {
-  my $str = shift;
-  1 while $str =~ s/\(\s*([^()]*?)\s*\)/       evaluate($1)             /e;
-  1 while $str =~ s/(-?\d+)\s*\*\s*(-?\d+)/    $1 * $2                  /e;
-  1 while $str =~ s/(-?\d+)\s*([-+])\s*(-?\d+)/$2 eq '+' ? $1+$3 : $1-$3/e;
-  return $str;
+my $N = 1000;
+my @primes      = (2);
+my @semi_primes = (4);
+
+foreach my $p ( map { 1+2*$_ } 1..($N/4) ) {
+  map { ($p%$_)||(next) } @primes;
+  push @primes,$p;
+  push @semi_primes,grep {$_<=$N} map{$p*$_} @primes;
 }
-```
-
-For small strings - this is about the same speed as `eval`, for larger strings not so, but in both cases it is "safer" as string `eval` of "tainted" input is a real security risk.
-
-## As a challenge infix->RPN converter than evaluate
 
-On the Perl Programming Facebook Group - the use or RPN was mentioned - and so the challenge lead to reimplementing this by converting the infix notation to Reverse Polish and then evaluating the RPN stack.
-
-Infix `(a+b)*c+d` would become `a b + c * d +` in Reverse Polish Notation. 
-
-To achieve this we set up a dispatch table - which stores methods for every operator we see in the string...
-And then when we see an operator in the stream (either infix or rpn) we use the appropriate function. This simplifies the code considerably...
-
-```perl
-my( @s, @o, %f ); ## @s <- stack, @o <- output, %f <- method "dispatch" table
-
-## THe 3 values are:
-##  precedence
-##  fn to apply when finding operator in infix stream
-##  fn to apply when finding operator in RPN stream
- 
-       ##  Precedence
-%f = ( ##     Convertion function Infix -> RPN                                 RPN processing function
-  '(' => [ 0, sub{ push @s, '('                                             },                        ],
-  ')' => [ 0, sub{ push @o, $_     while ($_=pop@s) ne '('                  },                        ],
-  '*' => [ 2, sub{ push @o, pop @s while @s && $f{$s[-1]}[0]>1; push@s, '*' }, sub{ $s[-2] *= pop @s }],
-  '+' => [ 1, sub{ push @o, pop @s while @s && $f{$s[-1]}[0];   push@s, '+' }, sub{ $s[-2] += pop @s }],
-  '-' => [ 1, sub{ push @o, pop @s while @s && $f{$s[-1]}[0];   push@s, '-' }, sub{ $s[-2] -= pop @s }],
-);
-
-## Two loops - first line converts infix to rpn
-##             second evaluates the rpn string.
-sub evaluate_rpn  {
-  @o= @s= (); ## Clear output and stack.
-              ## If operator use function in f hash to update output/stack
-              ##    othewise it is a number and we push to output.
-  ($f{$_}) ? (&{$f{$_}[1]}) : (push@o,$_) for $_[0] =~ m{(-?\d+|[-+*()])}g;
-              ## If operator use function in f to update stack
-              ##    otherwise we push the value onto the stack
-              ## ** we use reverse splice to reverse the string AND clear the stack at the
-              ##    same time for the loop to work.
-  ($f{$_}) ? (&{$f{$_}[2]}) : (push@s,$_) for @o, reverse splice @s,0;
-  $s[0];      ## The result is the remaining value in the stack.
-}
+say for sort {$a<=>$b} @semi_primes;
 ```
 
-# Challenge 2 - Stealthy Number
+# Challenge 2 - Ulam Sequence
 
-***You are given a positive number, `$n`.  Write a script to find out if the given number is Stealthy Number. A positive integer `N` is stealthy, if there exist positive integers `a`, `b`, `c`, `d` such that `a * b = c * d = N` and `a + b = c + d + 1`.***
+***You are given two positive numbers, `$u` and `$v`. Write a script to generate Ulam Sequence having at least 10 Ulam numbers where `$u` and `$v` are the first 2 Ulam numbers.
+The standard Ulam sequence (the (1, 2)-Ulam sequence) starts with U1 = 1 and U2 = 2. Then for n > 2, Un is defined to be the smallest integer that is the sum of two distinct earlier terms in exactly one way and larger than all earlier terms.***
 
 ## The solution
 
-First we find all the factors of `N` (well the ones for where `N=a*b` and `a<b`)
-
-We then store the sum of the factors in a hash (as the keys), we also store the sum of the factors + 1 in the hash {using `++` so what is stored is the count of these numbers}.
-
-So if we have the condition `a+b == c+d+1` is equivalent to seeing which keys in the hash have a value greater than 1. In which case we have our value. For the problem we don't need this value - just whether there is a value. So our function comes down to this.
-
-```perl
-sub stealthy_number {
-  my($n,%c) = shift;
-  $n%$_||($c{$n/$_+$_ }++,$c{$n/$_+$_+1}++) for 1..sqrt$n;
-  (grep { $_ > 1 } values %c) ? 1 : 0;
-}
-```
-
-## An alternative solution
-
-Having played with the solution above - I realised (it should have been obvious) that the pairs of factors will be consecutive, e.g. 12 has 3 pairs 1,12 2,6, 3,4, and the pair that makes this a stealthy number is going to be `2+6 = 3+4+1`.
-
-We can therefore we don't need to keep an array of valid factors - only the previous factor. The code thus becomes:
-
-```perl
-sub stealthy_number_1pass {
-  my($p,$n) = (1,@_);
-  $n%$_?1:$n/$p+$p-$n/$_-$_-1?($p=$_):(return 1)for 2..sqrt$n;
-  0;
-}
-```
-
-OK - that's a bit golfed. So lets unravel the ternaries in the middle to make the code more readable.
+For ulam numbers - we use an array and a hash to store previous ulam numbers. That allows us to quickly find those which have 1 unique partition. We do this with the grep in the 3rd line of the function. We then continue until the the array has the appropriate size. (We know there will be at least one solution the sum of the last two ulam numbers)
 
 ```perl
-sub stealthy_number_1pass {
-  my $n = shift;
-  my $p = 1;
-  foreach ( 2 .. sqrt $n ) {
-    next     if $n % $_;
-    return 1 if $n/$p + $p == $n/$_ + $_ + 1;
-    $p = $_;
+sub ulam {
+  my%seq_hash=map{$_,$_}my@seq=($_[0],my$n=$_[1]);
+  for(;scalar @seq<$_[2];++$n){
+    push@seq,$seq_hash{$n}=$n if 1==grep{2*$_<$n&&$seq_hash{$n-$_}}@seq;
   }
-  return 0;
+  @seq;
 }
 ```
diff --git a/challenge-144/james-smith/blog.txt b/challenge-144/james-smith/blog.txt
new file mode 100644
index 0000000000..7712f1c885
--- /dev/null
+++ b/challenge-144/james-smith/blog.txt
@@ -0,0 +1 @@
+https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-144
diff --git a/challenge-144/james-smith/perl/ch-1.pl b/challenge-144/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..39a78002de
--- /dev/null
+++ b/challenge-144/james-smith/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/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);
+
+my($C,$I) = (100,100_000);
+#say foreach sp_loop(100);exit;
+cmpthese( 100, {
+  'sp' => sub { semiprimes($I); },
+  'sl' => sub { sp_loop(   $I); },
+  'sm' => sub { sp_map(    $I); },
+});
+
+sub sp_loop {
+  my $N = shift;
+  my @p; my %ph;
+  my @sp;
+  foreach my $t ( 2..$N ) {
+    my $prime = 1;
+    foreach(@p) {
+      next if $t%$_;
+      $prime = 0;
+      (push @sp,$t) && (last) if exists $ph{$t/$_};
+    }
+    if( $prime ) {
+      push @p,$t; $ph{$t}=1;
+    }
+  }
+  @sp;
+}
+
+sub sp_map {
+  my $N = shift;
+  my @primes      = (2);
+  my @semi_primes = (4);
+
+  foreach my $p ( map { 1+2*$_ } 1..($N/4) ) {
+    map { ($p%$_)||(next) } @primes;
+    push @primes,$p;
+    push @semi_primes,grep {$_<=$N} map{$p*$_} @primes;
+  }
+  sort {$a<=>$b} @semi_primes;
+}
+
+sub semiprimes {
+  my $N = shift;
+  my @primes      = (2);
+  my @semi_primes = (4);
+
+  foreach my $p ( map { 1+2*$_ } 1..($N/4) ) {
+    map { ($p%$_)||(next) } @primes;
+    push @primes,$p;
+    ($p*$_>$N) ? (next) : (push @semi_primes,$p*$_) for @primes;
+  }
+  sort {$a<=>$b} @semi_primes;
+}
+
diff --git a/challenge-144/james-smith/perl/ch-2.pl b/challenge-144/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..a3a2b2590e
--- /dev/null
+++ b/challenge-144/james-smith/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!/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);
+
+say "@{[ ulam_expanded(1,2,1000) ]}";
+say "@{[ ulam_map(1,2,1000) ]}";
+say "@{[ ulam(1,2,1000) ]}";
+say "@{[ ulam_expanded(1,2,100) ]}";
+say "@{[ ulam_map(1,2,100) ]}";
+say "@{[ ulam(1,2,100) ]}";
+say "@{[ ulam(2,3,100) ]}";
+say "@{[ ulam(2,5,100) ]}";
+
+cmpthese( 200, {
+  'u' => sub { ulam(1,2,1000) },
+#  'm' => sub { ulam_map(1,2,1000) },
+  'e' => sub { ulam_expanded(1,2,1000) },
+} );
+
+sub ulam {
+  my%h=map{$_,$_}my@s=($_[0],my$n=$_[1]);
+  for(my$c=0;@s<$_[2];++$n,$c=0){
+    ($_>=$n/2)?(last):($h{$n-$_})&&$c++&&(last) for@s;
+    push@s,$h{$n}=$n if$c==1;
+  }
+  @s;
+}
+
+sub ulam_expanded {
+  my ($m, $n, $l) = @_;
+  my @seq = ($m,$n);
+  my %seq_hash = ( $m => 1, $n => 1 );
+  while( @seq < $l ) {
+    $n++;
+    my $count = 0;
+    foreach ( @seq ) {
+      last if $_ >= $n/2;
+      if( exists $seq_hash{ $n - $_ } ) {
+        $count++;
+        last if $count>1;
+      }
+    }
+    if( $count == 1 ) {
+      push @seq, $n;
+      $seq_hash{ $n } = 1;
+    }
+  }
+  return @seq;
+}
+
+sub ulam_map {
+  my%seq_hash=map{$_,$_}my@seq=($_[0],my$n=$_[1]);
+  for(;scalar @seq<$_[2];++$n){
+    push@seq,$seq_hash{$n}=$n if 1==grep{2*$_<$n&&$seq_hash{$n-$_}}@seq;
+  }
+  @seq;
+}
+