diff options
| author | drbaggy <js5@sanger.ac.uk> | 2022-01-24 09:39:43 +0000 |
|---|---|---|
| committer | drbaggy <js5@sanger.ac.uk> | 2022-01-24 09:39:43 +0000 |
| commit | 004ffc8ebf81ea5b8525e88c1e0a81a007537579 (patch) | |
| tree | 521650a94111ad987b9132c3a6c539667c3fc69f | |
| parent | 58fe0dd310fd5641512650fa783103ddbb5fc384 (diff) | |
| download | perlweeklychallenge-club-004ffc8ebf81ea5b8525e88c1e0a81a007537579.tar.gz perlweeklychallenge-club-004ffc8ebf81ea5b8525e88c1e0a81a007537579.tar.bz2 perlweeklychallenge-club-004ffc8ebf81ea5b8525e88c1e0a81a007537579.zip | |
first pass
| -rw-r--r-- | challenge-149/james-smith/README.md | 101 | ||||
| -rw-r--r-- | challenge-149/james-smith/perl/ch-1.pl | 30 | ||||
| -rw-r--r-- | challenge-149/james-smith/perl/ch-2.pl | 47 |
3 files changed, 85 insertions, 93 deletions
diff --git a/challenge-149/james-smith/README.md b/challenge-149/james-smith/README.md index 93fc54aedf..a755db373e 100644 --- a/challenge-149/james-smith/README.md +++ b/challenge-149/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 #148 +[< Previous 148](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-148/james-smith) | +[Next 150 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-150/james-smith) +# Perl Weekly Challenge #149 You can find more information about this weeks, and previous weeks challenges at: @@ -12,103 +12,18 @@ 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-148/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-149/james-smith -# Challenge 1 - Eban Numbers +# Challenge 1 - Fibonacci Digit Sum -***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).*** +***Given an input $N, generate the first $N numbers for which the sum of their digits is a Fibonacci number.*** ## 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: +# Challenge 2 - Largest Square -* 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 -say for map{my$a=$_;map{10*$a+2*$_||()}(0..3)}(0,3..6); -``` - -The `||()` 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 -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; -} -``` - -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 | 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 | - -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.*** - -*(a+b.sqrt(c))^(1/3) + (a-b.sqrt(c))^(1/3) = 1* +***Given a number base, derive the largest perfect square with no repeated digits and return it as a string. (For base>10, use ‘A’..‘Z’.)*** ## The solution -There is a very naive solution which tries all combinations of *a*,*b*,*c*. But there is a more performant solution. - -You can rewrite the equation in the form: - -*8.a^3 + 15.a^2 + 6.a - 27.b^2.c = 1* - -Which can be further parametrized as: - -*b^2.c = k^2 . (8.k-3)* - -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*. - -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 calculate these **32,235** cardano triplets is **78.5sec**. - -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). diff --git a/challenge-149/james-smith/perl/ch-1.pl b/challenge-149/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..16f8bbb711 --- /dev/null +++ b/challenge-149/james-smith/perl/ch-1.pl @@ -0,0 +1,30 @@ +#!/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] : 20; + +my @fib = (0,1,1); +my %fib = (0,1,1,1); + +for(my $i=0; $n; $i++ ) { + my $ds = 0; + $ds+=$_ foreach split //,$i; + if($ds>$fib[-1]) { + ## If we dont have a large enough fib add the next one... + ## Digit sum can only be 1 larger than current maximum + ## fibonacci. + push @fib, $fib[-2]+$fib[-1]; + $fib{$fib[-1]}=1; + } + next unless exists $fib{$ds}; + say $i; + $n--; +} + diff --git a/challenge-149/james-smith/perl/ch-2.pl b/challenge-149/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..06fb45a17d --- /dev/null +++ b/challenge-149/james-smith/perl/ch-2.pl @@ -0,0 +1,47 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Time::HiRes qw(time); + +my @MAP = ( 0..9,'A'..'Z' ); + +for my $N (2..15) { + my $time = time; + my $v = biggest_perfect_square($N); + say sprintf '%2d v = %10d v^2 = %20d = %16s; TIME = %10.6f', + $N, $v, $v*$v, baseN($v*$v,$N), time-$time; +} + +## We brute force this - we start at the largest possible square. +## and work backwards - our guess at the largest is the square +## root of the largest possible value with $N digits or roughty +## $N**($N/2); + +## Rather than generating a representation of the number we +## just look for repeated digits - if we find one we test the +## next number - note here we use the "next LABEL" to break +## out of both the while and the for loop + +sub biggest_perfect_square { + my $n = shift; + O: for( my $t = int($n**($n/2)); $t; $t -- ) { + my ($q,%seen) = $t**2; + $seen{$q%$n}++?(next O):($q=int($q/$n)) while $q; + return $t; + } +} + +## As we didn't generate earlier - to prove we have a +## candidate we convert the number into base $N... +## We use the same while loop as above to return the +## string. + +sub baseN { + my($o,$v,$n) = ('',@_); + ($o,$v) = ( $MAP[$v%$n].$o, int ($v/$n) ) while $v; + $o; +} |
