diff options
| -rw-r--r-- | challenge-179/james-smith/README.md | 190 |
1 files changed, 101 insertions, 89 deletions
diff --git a/challenge-179/james-smith/README.md b/challenge-179/james-smith/README.md index 7ddb0cf9ce..7ddde258cb 100644 --- a/challenge-179/james-smith/README.md +++ b/challenge-179/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 176](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-176/james-smith) | -[Next 178 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-178/james-smith) +[< Previous 178](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-178/james-smith) | +[Next 180 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-180/james-smith) -# The Weekly Challenge 177 +# The Weekly Challenge 179 You can find more information about this weeks, and previous weeks challenges at: @@ -13,120 +13,132 @@ 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-177/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-179/james-smith -# Task 1 - Damm Algorithm +# Task 1 - Ordinal Number Spelling -***You are given a positive number, `$n`. Write a script to validate the given number against the included check digit.*** - -The wikipedia page outlines the algoritm: https://en.wikipedia.org/wiki/Damm_algorithm - -## Algorithm - -We have a 10x10 lookup table - each row contains the numbers 0..9 permuted. - -We break the numbers up in to digits, and loop through them one at a time computing the subsequent check digit. We start with a check digit of `$d=0`. -For each digit `$n` we take the value of the `$d` row and `$n` column and assign this to `$d`. - -If we are checking a contained check digit then at the end of the loop the value should be `0`. If not then we have just computed the check digit. +***You are given a positive number, `$n`. Write a script to spell the ordinal number.*** ## Solution -```perl -const my @M => ( - [0,3,1,7,5,9,8,6,4,2], - [7,0,9,2,1,5,4,8,6,3], - [4,2,0,6,8,7,1,3,5,9], - [1,7,5,0,9,8,3,4,2,6], - [6,1,2,3,0,4,5,9,7,8], - [3,6,7,4,2,0,9,5,8,1], - [5,8,6,9,7,2,0,1,3,4], - [8,9,4,5,3,6,2,0,1,7], - [9,4,3,8,6,1,7,2,0,5], - [2,5,8,1,4,3,6,7,9,0], -); - -sub check_damm { my $i=0; $i=$M[$i][$_] for split//,pop; $i?0:1; } -sub damm_digit { my $i=0; $i=$M[$i][$_] for split//,pop; $i; } -``` +To support `$n` greater than 999 we have to split the number into chunks - much like the classic +`commify` function does. -# Task 2 - Palindromic Prime Cyclops +We use a regex to split into 3 number chunks (but we reverse the number and resultant strings) so +the regex returns a list where the first chunk is either 1, 2 or 3 digits long and the rest are +3 digits long. -***Write a script to generate palindromic cyclops primes*** +To get the ordinal of any number we look for the last chunk that is not `000`. - * Palindromic - reads the same forward and back - * Cyclops - odd number of digits - central digit is 0 - * Prime - only factors are 1 and itself. +If this is the first one we need to start by computing the ordinal of that block. If not we +ignore it and find the natural number of the block and add thousandth, millionth etc. -## Solution +For values > 999, we just stitch together the numbers for each block. -There are two approaches: +We have 6 list of number words: - * Generate a list of palindromic cyclops numbers, check if any are prime - * Generate a list of prime numbers, and check if any are palindromic cyclops numbers. + * 1-19 + * 20, 30, ..., 90 + * thousand, million, billion, ... novemnonagintillion - powers of 1000... -But which one is best. Now say we have to generate the list of these numbers up 1 billion. So these are numbers of the form: +and then the same as ordinals... +```perl +my @ord = qw(x first second third fourth fifth sixth seventh eighth ninth tenth eleventh twelfth thirteenth + forteenth fifteenth sixteenth seventeenth eighteeinth nineteenth); +my @ord_10 = qw(z tenth twentieth thirtieth fortieth fiftieth sixtieth seventiet eightieth ninetieth hundredth); +my @power = map { [$_,$_.'th'] } qw(x thousand), map { $_.'illion' } qw(m b tr quad quin sext sept oct nov), + ( map { $a=$_, map { $_.$a } qw(un duo tre quattuor quin sex sept octo novem) } + qw(dec vigint trigint quardagint quinquagint sexagint septuagint octagint nonagint) ); +my @nat = qw(a one two three four five six seven eight nine ten eleven twelve thirteen forteen fifteen + sixteen seventeen eighteen nineteen); +my @nat_10 = qw(b ten twenty thirty fourty fifty sixty seventy eighty ninety); ``` - a b c, d 0 d, c b a -``` - -So if we generate the list of palindromic cyclops numbers we just need to generate all numbers from `1..9,999`, if we generate all primes in this range there are `50,847,534`, this is `5,085x` factor more. +with these phrases we can create all ordinals. -Which suggest the first algorithm will be faster - to make this generic we change include a variable count `$K` for the number of entries to return. +We have 2 support functions - `_natural` which gets the text version of a natural number between 1 +and 999; and `_ordinal` which gets the text version of the an ordinal number between 1st and 999th. ```perl -my($i,$t)=0; +sub ordinal { + my ($ptr,$last,@parts,@result) = (0, map { scalar reverse } ((reverse pop) =~ m{(\d{1,3})}g)); + @result = _ordinal($last, !@parts ) if -$last; + $ptr++, -$_ && (unshift @result, _natural($_).' '.$power[$ptr][ @result ? 0 : 1 ] ) for @parts; + "@result" =~ s/\s+/ /gr +} + +## Create a natural triple of 1s, 10, 100s +sub _natural { + my $v = pop; + join ' and ', + ($v > 99) ? $nat[$v/100].'-hundred' : (), ## Hundred part + $v%100 ? ( $v%100 > 19 ? $nat_10[($v%100)/10].( $v%10 ? '-'.$nat[$v%10] : '' ) ## 20+ tens-units + : $v%100 > 0 ? $nat[$v%100] : () ) : () ## "units" +} -for(1..$K) { - ($++$i)!~/0/ && is_prime( $t = $i.'0'.reverse$i ) ? say $t : redo; +## Create an ordinal triple +sub _ordinal { + my($v,$flag) = @_; + + join ' and ', + (!$flag && $v < 100) ? '' : (), + ($v > 99) ? $nat[$v/100].($v%100?'-hundred':'-hundredth') : (), + $v%100 ? ( $v%100 > 19 ? ( $v%10 ? $nat_10[($v%100)/10].'-'.$ord[$v%10] : $ord_10[($v%100)/10] ) + : $v%100 > 0 ? $ord[$v%100] : () ) : () } ``` -In fact this is efficient enough to get the first 1,000,000 such numbers back in slightly under 10 seconds. The millionth one being the 17 digit number: `76,276,363,036,367,267`. +# Task 2 - Unicode Sparkline -But we can get better performance as we are currently scanning all numbers which start with 2,4,5,6,8 which we know are not prime {first digit -> last digit!} - this leads us to a slightly more complex but faster piece of code: +***You are given a list of positive numbers, `@n`. Write a script to print sparkline in Unicode for the given list of numbers.*** -Reducing to numbers that start in 1,3,5,7 reduces the search space by a factor of 4/9. +## Note -By removing those that line between say 100... and 111... which must contain at least one zero further reduces this by 8/9 - giving us a reduction of 32/81 numbers or roughly 39.5%. +There is no "clear-unique" definition of a sparkline - it can take many forms - as we are using unicode we will stick with the vertical line design. -```perl -my( $magnitude, $ones, $start, $count, $result ) = - ( 1, 0, time, $ARGV[0]//20, '-' ); -O: while(1) { - for my $first (1,3,7,9) { - !/0/ && is_prime( $_ .= '0' . reverse $_ ) && - say && ( --$count || ( $result = $_ ) && last O ) - for $first * $magnitude + $ones .. ( $first + 1 ) * $magnitude - 1; - } - $magnitude *= 10; - $ones *= 10; - $ones++; -} -warn time-$start, "\t", $result, "\n"; -``` +## Solution -Where we scan from 111.. to 199.., 311.. to 399.., 711.. to 799.., 911.. to 999... +For any row - it consists of a series of points and a series of gaps between them. +Between a point at position `$n` and `$m` the gap is size `$m-$n-1`. We then use +a loop over all the points to generate the line.. -With this new version of the code we get this 1,000,000 entry coming back in around 10 seconds. Running a bit longer gives the 10,000,000th entry in a little over 2 minutes. +As we are using nested maps, we occassionally have entries (*e.g.* updating `$k` where +we need to hide the value we created - you can use the array version of multiply (`x`) +for this - by multiplying by `0`, e.g. `($k=$_)x 0`.... -| $K | Time v1 | Time v2 | $Kth value | -| ----------: | ---------: | ---------: | ------------------------: | -| 1 | 0.000018 | 0.000018 | 101 | -| 10 | 0.000056 | 0.000039 | 1,120,211 | -| 100 | 0.000498 | 0.000309 | 146,505,641 | -| 1,000 | 0.006829 | 0.004846 | 19,178,087,191 | -| 10,000 | 0.114116 | 0.064679 | 3,446,840,486,443 | -| 100,000 | 1.286905 | 0.787072 | 387,695,909,596,783 | -| 1,000,000 | 23.104720 | 9.993216 | 76,276,363,036,367,267 | -| 10,000,000 | 250.055394 | 124.405436 | 9,523,518,610,168,153,259 | +If we wished to limit the vertical height we could apply scaling to limit to 2 or 3 lines. -Flipping to use `Math::Perl::Util::GMP` and `is_provable_prime` we can get a "guess" at even longer entries. "Guess" because the `is_provable_prime` can return NO, YES or probably, as there is compromise between accuracy and performance when it comes to checking these large primes. So for 100 million and 1 billion we get the following -answers and timings. The latter being a smidge under 21 hours. +```perl -| $K | Time v1 | Time v2 | $Kth value | Time | -| ------------: | ---------: | ---------: | --------------------------------: | ------------------: | -| 100,000,000 | - | 6370.062 | 11,459,314,276,067,241,395,411 | 1 hr 46 min 10 sec | -| 1,000,000,000 | - | 75584.858 | 1,255,854,925,630,365,294,585,521 | 20 hr 59 min 45 sec | +binmode STDOUT, ':utf8'; ## Set output to UTF + +const my $LINE => "\x{2500}"; ## Horizontal line +const my $START => "\x{2534}"; ## Inverted T +const my $FULL => "\x{2577}"; ## Full-height line +const my $HALF => "\x{2502}"; ## Half-height line + +sub spark_line { + my($mx,$k,$l,%x)=0 + $x{$_}++ for @{$_}; ## Create an array of values with counts + ($_>$mx) && ($mx=$_) for values %x; ## Find max count.. + ## We could apply scaling here to keep sparkline + ## a max-height but results would not be as tood + + ## We layout the sparks over multiple lines - to + ## accodomate height {see note on scaling to keep + ## height to a given value} + ## If mx > 1 we need to use multiple lines - foreach + ## of these we either have a full height "|" or + ## a half-height line "|" or nothing " "... + map( { + ($l,$k) = ($_<<1,-1); join '', + map { ' ' x ($_-$k-1).( $x{$_}<$l ? ' ' : $x{$_} == $l ? $FULL : $HALF ), ($k=$_)x 0 } + sort { $a <=> $b } + keys %x + } + reverse 1 .. $mx / 2 + ), + ($k=-1)x 0,join( '', map { $LINE x ($_-$k-1) . $START, ($k=$_)x 0 } sort {$a<=>$b} keys %x ) +} +``` |