diff options
| -rw-r--r-- | challenge-148/james-smith/perl/ch-1.pl | 45 | ||||
| -rw-r--r-- | challenge-148/james-smith/perl/ch-2.pl | 57 |
2 files changed, 96 insertions, 6 deletions
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); +} |