From ee4acfd9c139e158146c2faf096f4f94f994869b Mon Sep 17 00:00:00 2001 From: drbaggy Date: Mon, 20 Dec 2021 18:52:39 +0000 Subject: first pass --- challenge-144/james-smith/perl/ch-1.pl | 23 +++++++++++++++++++++++ challenge-144/james-smith/perl/ch-2.pl | 24 ++++++++++++++++++++++++ 2 files changed, 47 insertions(+) create mode 100644 challenge-144/james-smith/perl/ch-1.pl create mode 100644 challenge-144/james-smith/perl/ch-2.pl 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..97fe5b4e33 --- /dev/null +++ b/challenge-144/james-smith/perl/ch-1.pl @@ -0,0 +1,23 @@ +#!/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 $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; +} + +say for 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..024a36197b --- /dev/null +++ b/challenge-144/james-smith/perl/ch-2.pl @@ -0,0 +1,24 @@ +#!/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 (@seq,%seq_hash); + +say "@{[ ulam(1,2,100) ]}"; +say "@{[ ulam(2,3,100) ]}"; +say "@{[ ulam(2,5,100) ]}"; + +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; + } + @seq; +} + -- cgit From fc60aacd55917860821d41f37ba4627a65a870b5 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Dec 2021 18:56:04 +0000 Subject: Update README.md --- challenge-144/james-smith/README.md | 132 ++++++------------------------------ 1 file changed, 22 insertions(+), 110 deletions(-) diff --git a/challenge-144/james-smith/README.md b/challenge-144/james-smith/README.md index 1dbf64a12e..caef49b926 100644 --- a/challenge-144/james-smith/README.md +++ b/challenge-144/james-smith/README.md @@ -1,5 +1,5 @@ -[< 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) +[< 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 #143 You can find more information about this weeks, and previous weeks challenges at: @@ -12,129 +12,41 @@ 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: - ```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 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. - ```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; } ``` -- cgit From e8e56ec5fec50202a137e0b45d057811e8a5c510 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Dec 2021 18:56:39 +0000 Subject: Create blog.txt --- challenge-144/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-144/james-smith/blog.txt 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 -- cgit From 59bc75f5714160e5e36543659eb44356c3494e47 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Dec 2021 18:56:51 +0000 Subject: Update README.md --- challenge-144/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-144/james-smith/README.md b/challenge-144/james-smith/README.md index caef49b926..09e1bfe578 100644 --- a/challenge-144/james-smith/README.md +++ b/challenge-144/james-smith/README.md @@ -1,6 +1,6 @@ [< 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 #143 +# Perl Weekly Challenge #144 You can find more information about this weeks, and previous weeks challenges at: -- cgit From 4a21974fd493b6f19d141c278badf706470682d1 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Tue, 21 Dec 2021 16:14:00 +0000 Subject: add some more methods and performance) --- challenge-144/james-smith/perl/ch-1.pl | 55 +++++++++++++++++++++++++++++----- challenge-144/james-smith/perl/ch-2.pl | 44 +++++++++++++++++++++++++-- 2 files changed, 89 insertions(+), 10 deletions(-) diff --git a/challenge-144/james-smith/perl/ch-1.pl b/challenge-144/james-smith/perl/ch-1.pl index 97fe5b4e33..39a78002de 100644 --- a/challenge-144/james-smith/perl/ch-1.pl +++ b/challenge-144/james-smith/perl/ch-1.pl @@ -8,16 +8,55 @@ 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); }, +}); -my $N = 1000; -my @primes = (2); -my @semi_primes = (4); +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; + 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; } -say for 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 index 024a36197b..a3a2b2590e 100644 --- a/challenge-144/james-smith/perl/ch-2.pl +++ b/challenge-144/james-smith/perl/ch-2.pl @@ -8,13 +8,53 @@ use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); -my (@seq,%seq_hash); - +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; -- cgit From c139fdc57151c6da87eca44ab018d5e3a2f25ea3 Mon Sep 17 00:00:00 2001 From: James Smith Date: Sat, 25 Dec 2021 02:10:46 +0000 Subject: Update README.md --- challenge-144/james-smith/README.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/challenge-144/james-smith/README.md b/challenge-144/james-smith/README.md index 09e1bfe578..d479af154d 100644 --- a/challenge-144/james-smith/README.md +++ b/challenge-144/james-smith/README.md @@ -20,6 +20,11 @@ https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-144/ja ## The solution +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 my $N = 1000; my @primes = (2); @@ -41,6 +46,8 @@ The standard Ulam sequence (the (1, 2)-Ulam sequence) starts with U1 = 1 and U2 ## The solution +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 ulam { my%seq_hash=map{$_,$_}my@seq=($_[0],my$n=$_[1]); -- cgit