From 4fb04e07c03615e0130d0d8dcdb9d3db6b26b313 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 19 Jan 2022 09:26:20 +0000 Subject: pass one --- challenge-148/james-smith/perl/ch-1.pl | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 challenge-148/james-smith/perl/ch-1.pl (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..ade1c05955 --- /dev/null +++ b/challenge-148/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 = @ARGV ? $ARGV[0] : 1; +## works for $N up 5... +my @digits = (0,2,4,6); +my @tens = (0,30,40,50,60); +my @three_digit_eban_nos = map { my $a=$_; map { $a+$_ } @digits } @tens; + +dump_list( my @next_order = grep {$_} @three_digit_eban_nos ); +dump_list( @next_order = map { my $a = $_; map { sprintf "%s,%03d", $a,$_ } @three_digit_eban_nos } @next_order ) + for 2..$N; + +sub dump_list { + say $_ foreach map { $_ ? s{^0+}{}r : () } @_; +} -- cgit From e794607b45ee9edaf7c3dbc8364b89b943f7dbce Mon Sep 17 00:00:00 2001 From: drbaggy Date: Thu, 20 Jan 2022 05:08:14 +0000 Subject: updated --- challenge-148/james-smith/perl/ch-1.pl | 45 +++++++++++++++++++++++---- challenge-148/james-smith/perl/ch-2.pl | 57 ++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+), 6 deletions(-) create mode 100644 challenge-148/james-smith/perl/ch-2.pl (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl index ade1c05955..8f2d2c10df 100644 --- a/challenge-148/james-smith/perl/ch-1.pl +++ b/challenge-148/james-smith/perl/ch-1.pl @@ -9,15 +9,48 @@ use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); my $N = @ARGV ? $ARGV[0] : 1; -## works for $N up 5... + +## works for $N up to 7 (numbers up to but not including 1 sextillion) +## There are no additional numbers for $N = 8 and 9. +## Then we have additional numbers for $N = 10 and 11. +## And then no eban numbers until we get to $N = 22 +## So we need to some more complex code to work from $N=10 onwards +## as we have no solutions for numbers containing sextillion, septillion +## decillion to novemdecillion .. + my @digits = (0,2,4,6); my @tens = (0,30,40,50,60); -my @three_digit_eban_nos = map { my $a=$_; map { $a+$_ } @digits } @tens; -dump_list( my @next_order = grep {$_} @three_digit_eban_nos ); -dump_list( @next_order = map { my $a = $_; map { sprintf "%s,%03d", $a,$_ } @three_digit_eban_nos } @next_order ) - for 2..$N; +## We only need to find 2 digit eban numbers here as there are no 3 +## digit eban numbers - hundred contains an "e"... + +## We need to dump our first eban numbers! + +dump_list(my@eb=grep{$_}my@nx=map{my$a=$_;map{$a+$_}@digits}@tens); + +######################################################################## +## Now we extend these by adding more digits at the end so we get those +## less than 1 million, 1 billion etc. +## Note there would need to be a slight tweak when we get to sextillion, +## septillion to skip those numbers + +dump_list(@eb=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@nx}@eb)for 2..$N; + +######################################################################## +## Just as an aside the number of eban numbers for $N is precisely +## 20^$N - 1 (up to including $N==7) +## The -1 is that the 20^$N includes the number 0 (which a isn't +## positive but contains a zero anyway if you call it "zero") +## There is an imprecise nature to this list as the definition does not +## specify where eban numbers can be negative - if this is the case any +## +ve eban number has an associated -ve eban number - and visa-versa. + +## In dump_list below we remove leading zeros and blank entries +## To avoid grep - we check to see if $_ is "non-zero" +## and if it is we add an empty array element rather +## than blank. This avoids the additional map, and potential double +## array calculation sub dump_list { - say $_ foreach map { $_ ? s{^0+}{}r : () } @_; + say for map { $_ ? s{^0+}{}r : () } @_; } diff --git a/challenge-148/james-smith/perl/ch-2.pl b/challenge-148/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..a7509916b9 --- /dev/null +++ b/challenge-148/james-smith/perl/ch-2.pl @@ -0,0 +1,57 @@ +#!/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); + +## All solutions where $a < 10,000 + +## The problem can be re-written as: +## 8.a^3 + 15.a^2 + 6.a - 27.b^2.c = 1 +## Further mode if we re-write: +## a = 3.k - 1 +## Then this further reduces to: +## b^2.c = k^2 . (8.k-3) +## Where k starts at 1 + +## This greatly reduces the time it takes to calculate the triplets. + +## We loop over $k from 1 .. ($N+1)/3 ## We then loop of $b until such +## time as the calculated value of $c < 1 +## +## In this case it is (8*$k-3)*$k*$k / $b*b +## +## Trying to avoid issues with rounding due to division we can change +## this to just +## (8*$k-3).$k*$k < $b*$b +## +## Check to see if the value of $c is an integer and if so display it. +## +## It is an integer if $n%$d is zero. Again saves rounding error issues + + +for my $k (1..3333) { + for( my ($b, $n) = (1, $k*$k*(8*$k-3) ); $n > $b*$b; $b++ ) { + say join "\t", 3*$k-1,$b,$n/$b/$b unless $n%($b*$b); + } +} + +## To check the values are truly a Cardano triplet I wrote this +## function. + +sub is_card { + my($a,$b,$c) = @_; + return abs( cr($a+$b*sqrt$c) + cr($a-$b*sqrt$) - 1 ) < 0.000001; +} + +## To get the cube route - the code would fail if the value +## was negative. The following works by finding the cube +## root of the absolute value. And multiplying by -1 if negative + +sub cr { + return $_[0] < 0 ? -(-$_[0])**(1/3) : $_[0]**(1/3); +} -- cgit From 9f29efbb117c84cb8d7276a7e99ac368a9b798f2 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Thu, 20 Jan 2022 05:17:52 +0000 Subject: removed dump list with a join --- challenge-148/james-smith/perl/ch-1.pl | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl index 8f2d2c10df..3bd0a56989 100644 --- a/challenge-148/james-smith/perl/ch-1.pl +++ b/challenge-148/james-smith/perl/ch-1.pl @@ -26,7 +26,7 @@ my @tens = (0,30,40,50,60); ## We need to dump our first eban numbers! -dump_list(my@eb=grep{$_}my@nx=map{my$a=$_;map{$a+$_}@digits}@tens); +say join "\n",(my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}@digits}@tens); ######################################################################## ## Now we extend these by adding more digits at the end so we get those @@ -34,7 +34,7 @@ dump_list(my@eb=grep{$_}my@nx=map{my$a=$_;map{$a+$_}@digits}@tens); ## Note there would need to be a slight tweak when we get to sextillion, ## septillion to skip those numbers -dump_list(@eb=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@nx}@eb)for 2..$N; +say join"\n",(@e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e)for 2..$N; ######################################################################## ## Just as an aside the number of eban numbers for $N is precisely @@ -45,12 +45,3 @@ dump_list(@eb=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@nx}@eb)for 2..$N; ## specify where eban numbers can be negative - if this is the case any ## +ve eban number has an associated -ve eban number - and visa-versa. -## In dump_list below we remove leading zeros and blank entries -## To avoid grep - we check to see if $_ is "non-zero" -## and if it is we add an empty array element rather -## than blank. This avoids the additional map, and potential double -## array calculation - -sub dump_list { - say for map { $_ ? s{^0+}{}r : () } @_; -} -- cgit From 7af313d6d646e1e6392ca264c8b6cd98e96ea734 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 21 Jan 2022 06:54:46 +0000 Subject: Update README.md --- challenge-148/james-smith/README.md | 195 +++--------------------------------- 1 file changed, 16 insertions(+), 179 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/README.md b/challenge-148/james-smith/README.md index 6941c1b663..9e9c847415 100644 --- a/challenge-148/james-smith/README.md +++ b/challenge-148/james-smith/README.md @@ -1,5 +1,5 @@ -[< 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) +[< Previous 147](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-145/james-smith) | +[Next 149 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-149/james-smith) # Perl Weekly Challenge #147 You can find more information about this weeks, and previous weeks challenges at: @@ -12,201 +12,38 @@ 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-147/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-148/james-smith -# Challenge 1 - Truncatable Prime +# Challenge 1 - Eban Numbers -***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.*** +***Write a script to generate all Eban Numbers <= 100. An Eban number is a number that has no letter ‘e’ in it when the number is spelled in English (American or British).*** ## The solution -Another prime problem this week so we can reuse our generator from last week... - ```perl -for(;;$c+=2){ - ($_*$_>$c)?((push@p,$c),last):$c%$_||last for@p; -} -``` - -We are asked to find the first 20 left-truncatable primes. Primes which when you repeatedly remove the first digit you get another prime. - -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. - -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`. - -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. - -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. - -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; -} ``` ### 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.. - -There are 4260 left-truncatable primes - 4241 are less than the max integer value in perl (2^63) - and takes about 15.5 hours. - -``` - 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 +# Challenge 2 - Cardano Triplets +***Write a script to generate first 5 Cardano Triplets. A triplet of positive integers (a,b,c) is called a Cardano Triplet if it satisfies the below condition.*** -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. +*(a+b.sqrt(c))^(1/3) + (a-b.sqrt(c))^(1/3) = 1* -```perl -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; -} -``` - -### Results.. +## The solution -There are 83 right-truncatable primes - the script runs for less than 0.02 seconds. +There is a very naive solution which tries all combinations of *a*,*b*,*c*. But there is a more performant solution. -``` - 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 -``` +You can rewrite the equation in the form: -# Challenge 2 - Pentagon Numbers +*8.a^3 + 15.a^2 + 6.a - 27.b^2.c = 1* -***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`*** +Which can be further parametrized as: -## The solution +*b^2.c = k^2 . (8.k-3)* -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`). +Where *a=3.k-1* *k* starts at 1. - -```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 - } -} -``` +So the first entry *k=1*, *b^2.c=5* - so is solved by *a=2*, *b=1*, *c=5*. ### The result -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; - } -} -``` -- cgit From 68ab7d171c7ba4e28ff1a30430265967718ac840 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 21 Jan 2022 07:29:25 +0000 Subject: Update README.md --- challenge-148/james-smith/README.md | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/README.md b/challenge-148/james-smith/README.md index 9e9c847415..bd31e18284 100644 --- a/challenge-148/james-smith/README.md +++ b/challenge-148/james-smith/README.md @@ -45,5 +45,23 @@ Which can be further parametrized as: Where *a=3.k-1* *k* starts at 1. So the first entry *k=1*, *b^2.c=5* - so is solved by *a=2*, *b=1*, *c=5*. + +So the code to find all cardano triplets with *a<10,000* is: + +```perl +for my $k (1..3333) { + for( my ($b, $n) = (1, $k*$k*(8*$k-3) ); $n > $b*$b; $b++ ) { + say join "\t", 3*$k-1, $b, $n/$b/$b unless $n%($b*$b); + } +} + +We loop through each value of `$k` up to 3,333, this gives the maximum value of `$a` 9,998. Largest less than or equal to 10,000. +We then loop `$b` from 1 up to the value where `$c < 1`. Rather than computing `$c` at this stage (there could be rounding errors). +We just compare the numerator (*k^2 . (8.k-3)*) with the denominator (*b^2*). We then check to see `$c` is an integer - we again +do this without computing `$c` to avoid rounding errors - to compute the results and display them. + +Time taken to caluclate these **32,235** cardano triplets is **78.5sec**. + +``` ### The result -- cgit From 3653c728d921f8e1b3bd713921bc92213d638a2d Mon Sep 17 00:00:00 2001 From: drbaggy Date: Fri, 21 Jan 2022 12:23:44 +0000 Subject: pushed new versions --- challenge-148/james-smith/perl/ch-1.pl | 50 +++++++++++++++++++++++++++++----- challenge-148/james-smith/perl/ch-2.pl | 4 +-- 2 files changed, 45 insertions(+), 9 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl index 3bd0a56989..653e93ed85 100644 --- a/challenge-148/james-smith/perl/ch-1.pl +++ b/challenge-148/james-smith/perl/ch-1.pl @@ -9,6 +9,13 @@ use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); my $N = @ARGV ? $ARGV[0] : 1; +$N<0?(method_one(-$N)):(method_two($N)); + +sub method_zero { + my @e = map { my $a=$_; map {$a+$_}(0,2,4,6) }(0,30,40,50,60); + shift @e; + say join "\n",@e; +} ## works for $N up to 7 (numbers up to but not including 1 sextillion) ## There are no additional numbers for $N = 8 and 9. @@ -18,15 +25,36 @@ my $N = @ARGV ? $ARGV[0] : 1; ## as we have no solutions for numbers containing sextillion, septillion ## decillion to novemdecillion .. -my @digits = (0,2,4,6); -my @tens = (0,30,40,50,60); - +## Units for which there are no "e" are used: +## 0 not-spelled at all except for Zero +## 2 +## 4 +## 6 +## Tens for which there a no "e": +## 0 not-spelled at all (except when 0) +## 30 +## 40 +## 50 +## 60 ## We only need to find 2 digit eban numbers here as there are no 3 ## digit eban numbers - hundred contains an "e"... -## We need to dump our first eban numbers! -say join "\n",(my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}@digits}@tens); +sub method_one { + say for my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}(0,2,4,6)}(0,30,40,50,60); + for(2..$_[0]) { + say for @e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e; + } +} + +## Slight optimization - we avoid sprintf which is sub-optimal +sub method_two { + say for my@e=grep{$_}map{0+$_}(my@n=map{my$a=$_;map{'0'.$a.$_}(0,2,4,6)}(0,3..6)); + #say for my@e=map{0+$_}@n[1..@n-1]; + for(2..$_[0]) { + say for @e=map{my$a=$_;map{$a.','.$_}@n}@e; + } +} ######################################################################## ## Now we extend these by adding more digits at the end so we get those @@ -34,8 +62,6 @@ say join "\n",(my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}@digits}@tens); ## Note there would need to be a slight tweak when we get to sextillion, ## septillion to skip those numbers -say join"\n",(@e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e)for 2..$N; - ######################################################################## ## Just as an aside the number of eban numbers for $N is precisely ## 20^$N - 1 (up to including $N==7) @@ -45,3 +71,13 @@ say join"\n",(@e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e)for 2..$N; ## specify where eban numbers can be negative - if this is the case any ## +ve eban number has an associated -ve eban number - and visa-versa. +# | Max | (in words) | Rate method 1 | Rate method 2 | %diff (2v1) | +# | ----: | :---------: | ------------: : ------------: : ----------: | +# | 10^3 | Thousand | 200,481 /s | 104,559 /s | -48% | +# | 10^6 | Million | 6,996 /s | 10,311 /s | 47% | +# | 10^9 | Billion | 343 /s | 500a /s | 46% | +# | 10^12 | Trillion | 15.4 /s | 26.2 /s | 70% | +# | ----: | :---------: | ------------: : ------------: : ----------: | +# | 10^15 | Quadrillion | 1.57 s | 0.811 s | 94% | +# | 10^18 | Quintillion | 29.5 s | 16.7 s | 77% | + diff --git a/challenge-148/james-smith/perl/ch-2.pl b/challenge-148/james-smith/perl/ch-2.pl index a7509916b9..b56a4f9aa2 100644 --- a/challenge-148/james-smith/perl/ch-2.pl +++ b/challenge-148/james-smith/perl/ch-2.pl @@ -34,7 +34,7 @@ use Data::Dumper qw(Dumper); ## It is an integer if $n%$d is zero. Again saves rounding error issues -for my $k (1..3333) { +for my $k (1..333) { for( my ($b, $n) = (1, $k*$k*(8*$k-3) ); $n > $b*$b; $b++ ) { say join "\t", 3*$k-1,$b,$n/$b/$b unless $n%($b*$b); } @@ -45,7 +45,7 @@ for my $k (1..3333) { sub is_card { my($a,$b,$c) = @_; - return abs( cr($a+$b*sqrt$c) + cr($a-$b*sqrt$) - 1 ) < 0.000001; + return abs( cr($a+$b*sqrt$c) + cr($a-$b*sqrt$c) - 1 ) < 0.000001; } ## To get the cube route - the code would fail if the value -- cgit From 6c29f6eb4249a0f0c707519f3321b39f4e79fdfb Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 21 Jan 2022 14:32:42 +0000 Subject: Update README.md --- challenge-148/james-smith/README.md | 70 ++++++++++++++++++++++++++++++++++--- 1 file changed, 65 insertions(+), 5 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/README.md b/challenge-148/james-smith/README.md index bd31e18284..896948c560 100644 --- a/challenge-148/james-smith/README.md +++ b/challenge-148/james-smith/README.md @@ -20,10 +20,63 @@ https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-148/ja ## The solution +I will present two different solutions for the more general problem of large Eban numbers, but for numbers less than 1,000 we have: + +* The units must be 0, 2, 4, 6 +* The tens must be 0, 30, 40,50, 60, + +So to compute the eban numbers less than 100 (and consequently all eban numbers less than one thousand) we can use: + +```perl +my @e = map { my $a=$_; map {$a+$_}(0,2,4,6) }(0,30,40,50,60); +shift @e; +say "@e"; +``` + +The `shift` removes the zero value which is not an eban number. + +This gives us the following numbers less than 1,000: + +`2 4 6 30 32 34 36 40 42 44 46 50 52 54 56 60 62 64 66` + +Now we can use this sequence to generate all eban numbers. + +For eban numbers of order *1000^n* we just need to multiply all the eban numbers of order "*1000^(n-1)*" these by 1000 and add each one add each of the eban numbers less than 100 (this time including 0). This assumes that for values of 1000, 1000000 etc we say *one thousand*, *one million*, ... + ```perl +sub method_one { + say for my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}(0,2,4,6)}(0,30,40,50,60); + for(2..$_[0]) { + say for @e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e; + } +} ``` -### Notes: +We modify the creation of `@n` by padding with *0*s, and convert them back to numbers when creating `@e` by converting the strings back to numbers and remove the `0`. + +```perl +sub method_two { + say for my@e=grep{$_}map{0+$_}(my@n=map{my$a=$_;map{'0'.$a.$_}(0,2,4,6)}(0,3..6)); + for(2..$_[0]) { + say for @e=map{my$a=$_;map{$a.','.$_}@n}@e; + } +} +``` + +The second removes the need to use `sprintf` everytime in the subsequent loops, by generating the list of numbers padded with 0s - we can see this with the performance gain in all but the first case (the first loop is made slightly more complex). + +### Notes: Timings + +| Max | (in words) | Rate method_one | Rate method_two | %diff (2v1) | +| ----: | :---------: | --------------: | --------------: | ----------: | +| 10^3 | Thousand | 200,481.00 /s | 104,559.00 /s | -48% | +| 10^6 | Million | 6,996.00 /s | 10,311.00 /s | 47% | +| 10^9 | Billion | 343.00 /s | 500.00 /s | 46% | +| 10^12 | Trillion | 15.40 /s | 26.20 /s | 70% | +| 10^15 | Quadrillion | 0.63 /s | 1.23 /s | 94% | +| 10^18 | Quintillion | 0.03 /s | 0.06 /s | 77% | + +Larger values of *n* would require too much memory to compute and alternative solution would be required {using seek etc to rewind the file} # Challenge 2 - Cardano Triplets ***Write a script to generate first 5 Cardano Triplets. A triplet of positive integers (a,b,c) is called a Cardano Triplet if it satisfies the below condition.*** @@ -42,7 +95,7 @@ Which can be further parametrized as: *b^2.c = k^2 . (8.k-3)* -Where *a=3.k-1* *k* starts at 1. +Where *a=3.k-1*. *k* starts at 1. So the first entry *k=1*, *b^2.c=5* - so is solved by *a=2*, *b=1*, *c=5*. @@ -54,14 +107,21 @@ for my $k (1..3333) { say join "\t", 3*$k-1, $b, $n/$b/$b unless $n%($b*$b); } } +``` We loop through each value of `$k` up to 3,333, this gives the maximum value of `$a` 9,998. Largest less than or equal to 10,000. We then loop `$b` from 1 up to the value where `$c < 1`. Rather than computing `$c` at this stage (there could be rounding errors). We just compare the numerator (*k^2 . (8.k-3)*) with the denominator (*b^2*). We then check to see `$c` is an integer - we again do this without computing `$c` to avoid rounding errors - to compute the results and display them. -Time taken to caluclate these **32,235** cardano triplets is **78.5sec**. +Time taken to calculate these **32,235** cardano triplets is **78.5sec**. -``` -### The result +If we go back to the original problem and look at the first 5 cardano triplets we have either: + +The first 5 (if you sort by *a* and *b*) are: + + (2,1,5), (5,1,52), (5,2,13), (8,1,189), (8,3,21). + +The first 5 (if you sort by total *a+b+c*) are: + (2,1,5), (5,2,13), (8,3,21), (17,18,5), (11,4,29). -- cgit From fdd84cc900adc3a9409ac61b2b09b96e520938e0 Mon Sep 17 00:00:00 2001 From: James Smith Date: Sat, 22 Jan 2022 00:41:24 +0000 Subject: Update README.md --- challenge-148/james-smith/README.md | 41 ++++++++++++------------------------- 1 file changed, 13 insertions(+), 28 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/README.md b/challenge-148/james-smith/README.md index 896948c560..785b3c233d 100644 --- a/challenge-148/james-smith/README.md +++ b/challenge-148/james-smith/README.md @@ -28,12 +28,10 @@ I will present two different solutions for the more general problem of large Eba So to compute the eban numbers less than 100 (and consequently all eban numbers less than one thousand) we can use: ```perl -my @e = map { my $a=$_; map {$a+$_}(0,2,4,6) }(0,30,40,50,60); -shift @e; -say "@e"; +say for map{my$a=$_;map{10*$a+2*$_||()}(0..3)}(0,3..6); ``` -The `shift` removes the zero value which is not an eban number. +The `||()` removes the zero value which is not an eban number. This gives us the following numbers less than 1,000: @@ -44,22 +42,9 @@ Now we can use this sequence to generate all eban numbers. For eban numbers of order *1000^n* we just need to multiply all the eban numbers of order "*1000^(n-1)*" these by 1000 and add each one add each of the eban numbers less than 100 (this time including 0). This assumes that for values of 1000, 1000000 etc we say *one thousand*, *one million*, ... ```perl -sub method_one { - say for my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}(0,2,4,6)}(0,30,40,50,60); - for(2..$_[0]) { - say for @e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e; - } -} -``` - -We modify the creation of `@n` by padding with *0*s, and convert them back to numbers when creating `@e` by converting the strings back to numbers and remove the `0`. - -```perl -sub method_two { - say for my@e=grep{$_}map{0+$_}(my@n=map{my$a=$_;map{'0'.$a.$_}(0,2,4,6)}(0,3..6)); - for(2..$_[0]) { - say for @e=map{my$a=$_;map{$a.','.$_}@n}@e; - } +say for my@e=grep{$_}my@n=map{my$a=$_;map{10*$a+2*$_}(0..3)}(0,3..6); +for(2..$N){ + say for@e=map{my$a=$_;map{$a*1e3+$_}@n}@e; } ``` @@ -67,14 +52,14 @@ The second removes the need to use `sprintf` everytime in the subsequent loops, ### Notes: Timings -| Max | (in words) | Rate method_one | Rate method_two | %diff (2v1) | -| ----: | :---------: | --------------: | --------------: | ----------: | -| 10^3 | Thousand | 200,481.00 /s | 104,559.00 /s | -48% | -| 10^6 | Million | 6,996.00 /s | 10,311.00 /s | 47% | -| 10^9 | Billion | 343.00 /s | 500.00 /s | 46% | -| 10^12 | Trillion | 15.40 /s | 26.20 /s | 70% | -| 10^15 | Quadrillion | 0.63 /s | 1.23 /s | 94% | -| 10^18 | Quintillion | 0.03 /s | 0.06 /s | 77% | +| Max | (in words) | Rate | Count | +| ----: | :---------: | --------------: | ---------: | +| 10^3 | Thousand | 200,481.00 /s | 19 | +| 10^6 | Million | 18,214.94 /s | 399 | +| 10^9 | Billion | 971.82 /s | 7,999 | +| 10^12 | Trillion | 49.41 /s | 159,999 | +| 10^15 | Quadrillion | 2.27 /s | 3,199,999 | +| 10^18 | Quintillion | 0.10 /s | 63,999,999 | Larger values of *n* would require too much memory to compute and alternative solution would be required {using seek etc to rewind the file} -- cgit From b12a3d40f9e6482c68c30233e3bb9f27d1c6a59d Mon Sep 17 00:00:00 2001 From: drbaggy Date: Sat, 22 Jan 2022 00:44:42 +0000 Subject: any changes --- challenge-148/james-smith/perl/ch-1.pl | 43 ++++++++-------------------------- 1 file changed, 10 insertions(+), 33 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl index 653e93ed85..e903159b0c 100644 --- a/challenge-148/james-smith/perl/ch-1.pl +++ b/challenge-148/james-smith/perl/ch-1.pl @@ -8,13 +8,17 @@ use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); -my $N = @ARGV ? $ARGV[0] : 1; -$N<0?(method_one(-$N)):(method_two($N)); +unless(@ARGV) { + say for map{my$a=$_;map{10*$a+2*$_||()}(0..3)}(0,3..6); + exit; +} + +## All eban numbers less than 1000 + -sub method_zero { - my @e = map { my $a=$_; map {$a+$_}(0,2,4,6) }(0,30,40,50,60); - shift @e; - say join "\n",@e; +say for my@e=grep{$_}my@n=map{my$a=$_;map{10*$a+2*$_}(0..3)}(0,3..6); +for(2..$ARGV[0]){ + say for@e=map{my$a=$_;map{$a*1e3+$_}@n}@e; } ## works for $N up to 7 (numbers up to but not including 1 sextillion) @@ -39,23 +43,6 @@ sub method_zero { ## We only need to find 2 digit eban numbers here as there are no 3 ## digit eban numbers - hundred contains an "e"... - -sub method_one { - say for my@e=grep{$_}my@n=map{my$a=$_;map{$a+$_}(0,2,4,6)}(0,30,40,50,60); - for(2..$_[0]) { - say for @e=map{my$a=$_;map{sprintf'%s,%03d',$a,$_}@n}@e; - } -} - -## Slight optimization - we avoid sprintf which is sub-optimal -sub method_two { - say for my@e=grep{$_}map{0+$_}(my@n=map{my$a=$_;map{'0'.$a.$_}(0,2,4,6)}(0,3..6)); - #say for my@e=map{0+$_}@n[1..@n-1]; - for(2..$_[0]) { - say for @e=map{my$a=$_;map{$a.','.$_}@n}@e; - } -} - ######################################################################## ## Now we extend these by adding more digits at the end so we get those ## less than 1 million, 1 billion etc. @@ -71,13 +58,3 @@ sub method_two { ## specify where eban numbers can be negative - if this is the case any ## +ve eban number has an associated -ve eban number - and visa-versa. -# | Max | (in words) | Rate method 1 | Rate method 2 | %diff (2v1) | -# | ----: | :---------: | ------------: : ------------: : ----------: | -# | 10^3 | Thousand | 200,481 /s | 104,559 /s | -48% | -# | 10^6 | Million | 6,996 /s | 10,311 /s | 47% | -# | 10^9 | Billion | 343 /s | 500a /s | 46% | -# | 10^12 | Trillion | 15.4 /s | 26.2 /s | 70% | -# | ----: | :---------: | ------------: : ------------: : ----------: | -# | 10^15 | Quadrillion | 1.57 s | 0.811 s | 94% | -# | 10^18 | Quintillion | 29.5 s | 16.7 s | 77% | - -- cgit From 48be4622ddb810865937a2e2508631080774fcac Mon Sep 17 00:00:00 2001 From: James Smith Date: Sat, 22 Jan 2022 10:22:21 +0000 Subject: Update README.md --- challenge-148/james-smith/README.md | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/README.md b/challenge-148/james-smith/README.md index 785b3c233d..93fc54aedf 100644 --- a/challenge-148/james-smith/README.md +++ b/challenge-148/james-smith/README.md @@ -1,6 +1,6 @@ [< Previous 147](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-145/james-smith) | [Next 149 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-149/james-smith) -# Perl Weekly Challenge #147 +# Perl Weekly Challenge #148 You can find more information about this weeks, and previous weeks challenges at: @@ -61,7 +61,9 @@ The second removes the need to use `sprintf` everytime in the subsequent loops, | 10^15 | Quadrillion | 2.27 /s | 3,199,999 | | 10^18 | Quintillion | 0.10 /s | 63,999,999 | -Larger values of *n* would require too much memory to compute and alternative solution would be required {using seek etc to rewind the file} +Unable to proceed with values of n greater than 6, as we are hitting memory limits, and the size of integer perl can store by default (64-bit). + + * Would need to look at using `bigint` for working with arbitrary sized integers or reverting to a string based solution (although this uses a even more memory) # Challenge 2 - Cardano Triplets ***Write a script to generate first 5 Cardano Triplets. A triplet of positive integers (a,b,c) is called a Cardano Triplet if it satisfies the below condition.*** @@ -80,7 +82,7 @@ Which can be further parametrized as: *b^2.c = k^2 . (8.k-3)* -Where *a=3.k-1*. *k* starts at 1. +Where *a=3.k-1*. and *k* starts at 1. So the first entry *k=1*, *b^2.c=5* - so is solved by *a=2*, *b=1*, *c=5*. -- cgit From eb5634ec1dc7cfe04d1bf3c6d4168da186acc25e Mon Sep 17 00:00:00 2001 From: drbaggy Date: Sat, 22 Jan 2022 10:22:54 +0000 Subject: moved comment --- challenge-148/james-smith/perl/ch-1.pl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl index e903159b0c..e306657c65 100644 --- a/challenge-148/james-smith/perl/ch-1.pl +++ b/challenge-148/james-smith/perl/ch-1.pl @@ -8,14 +8,13 @@ use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); + unless(@ARGV) { + ## All eban numbers less than 1000 say for map{my$a=$_;map{10*$a+2*$_||()}(0..3)}(0,3..6); exit; } -## All eban numbers less than 1000 - - say for my@e=grep{$_}my@n=map{my$a=$_;map{10*$a+2*$_}(0..3)}(0,3..6); for(2..$ARGV[0]){ say for@e=map{my$a=$_;map{$a*1e3+$_}@n}@e; -- cgit From 6c82ee9e3cd56bb7870416e8aee038769ccbb949 Mon Sep 17 00:00:00 2001 From: James Smith Date: Sun, 23 Jan 2022 01:35:53 +0000 Subject: Create blog.txt --- challenge-148/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-148/james-smith/blog.txt (limited to 'challenge-148') diff --git a/challenge-148/james-smith/blog.txt b/challenge-148/james-smith/blog.txt new file mode 100644 index 0000000000..3c66e73c11 --- /dev/null +++ b/challenge-148/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-148/james-smith -- cgit From 2d0ffcddc4a2a5536a9adfa0b6230ca17e229eff Mon Sep 17 00:00:00 2001 From: James Smith Date: Sun, 23 Jan 2022 01:38:24 +0000 Subject: Update ch-1.pl --- challenge-148/james-smith/perl/ch-1.pl | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) (limited to 'challenge-148') diff --git a/challenge-148/james-smith/perl/ch-1.pl b/challenge-148/james-smith/perl/ch-1.pl index e306657c65..4a2d369429 100644 --- a/challenge-148/james-smith/perl/ch-1.pl +++ b/challenge-148/james-smith/perl/ch-1.pl @@ -8,6 +8,19 @@ use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); +## Units for which there are no "e" are used: +## 0 [ not-spelled at all except for Zero ] +## 2 two +## 4 four +## 6 six +## Tens for which there a no "e": +## 0 [ not-spelled at all except for Zero ] +## 30 thirty +## 40 forty +## 50 fifty +## 60 sixty +## We only need to find 2 digit eban numbers here as there are no 3 +## digit eban numbers - hundred contains an "e"... unless(@ARGV) { ## All eban numbers less than 1000 @@ -15,6 +28,8 @@ unless(@ARGV) { exit; } +## This is the code which generates eban numbers {up to 10^18} + say for my@e=grep{$_}my@n=map{my$a=$_;map{10*$a+2*$_}(0..3)}(0,3..6); for(2..$ARGV[0]){ say for@e=map{my$a=$_;map{$a*1e3+$_}@n}@e; @@ -28,19 +43,6 @@ for(2..$ARGV[0]){ ## as we have no solutions for numbers containing sextillion, septillion ## decillion to novemdecillion .. -## Units for which there are no "e" are used: -## 0 not-spelled at all except for Zero -## 2 -## 4 -## 6 -## Tens for which there a no "e": -## 0 not-spelled at all (except when 0) -## 30 -## 40 -## 50 -## 60 -## We only need to find 2 digit eban numbers here as there are no 3 -## digit eban numbers - hundred contains an "e"... ######################################################################## ## Now we extend these by adding more digits at the end so we get those -- cgit