diff options
| -rw-r--r-- | challenge-178/james-smith/README.md | 111 | ||||
| -rw-r--r-- | challenge-178/james-smith/perl/ch-1.pl | 1 | ||||
| -rw-r--r-- | challenge-178/james-smith/perl/ch-2.pl | 30 | ||||
| -rw-r--r-- | challenge-179/james-smith/perl/ch-1.pl | 70 | ||||
| -rw-r--r-- | challenge-179/james-smith/perl/ch-2.pl | 47 |
5 files changed, 251 insertions, 8 deletions
diff --git a/challenge-178/james-smith/README.md b/challenge-178/james-smith/README.md index 3b736748ea..9872683018 100644 --- a/challenge-178/james-smith/README.md +++ b/challenge-178/james-smith/README.md @@ -1 +1,110 @@ -Solutions by James Smith. +[< Previous 177](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-177/james-smith) | +[Next 179 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-179/james-smith) + +# The Weekly Challenge 178 + +You can find more information about this weeks, and previous weeks challenges at: + + https://theweeklychallenge.org/ + +If you are not already doing the challenge - it is a good place to practise your +**perl** or **raku**. If it is not **perl** or **raku** you develop in - you can +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-178/james-smith + +### Note + +Have had a busy week (Coldplay concert and a few days away) - so have concentrated on task 1 this week. + +# Task 1 - Damm Algorithm + +***Write a script to convert a given number (base 10) to quater-imaginary base number and vice-versa.*** + +## Solution + +Our first task is to write two packages one to represent both a complex number and one to create a QIB number. + +### Complex numbers + +This is fairly self-explanatory. We have standard methods, real, imaginary, is_real alons with new and +the overloaded "stringify" function. + +A complex number is represented by a 2 element array. +```perl +package Complex; + +sub new { bless [@_[1,2]], shift } +use overload '""' => sub { "$_[0][0] + $_[0][1] i" }; +sub real { $_[0][0] } +sub imaginary { $_[0][1] } +sub is_real { !$_[0][1] } +sub toQIB { QIB->new_from_Complex( $_[0] ); } + +sub new_from_QIB { + my( $class, $r, $i, $f, @v ) = + ( $_[0], 0, 0, 1, split //, pop->[0] ); + + ## Creates a new complex number from a QIB, computing + ## the real and imaginary parts of the number, which are + ## stored in alterating elements of the string. + $r += $f*pop @v, @v && ($i += $f*pop @v), $f*=-4 while @v; + + ## Create the new object.... + $class->new( $r, $i ); +} +```` + +```perl +use strict; +use warnings; +use feature qw(say state); + +foreach ( -10000 .. 10000 ) { + my $t = Complex->new($_,0); + my $q = $t->toQIB; + my $c = $q->toComplex; + say "$t -> $q -> $c -> ",$c->toQIB if "$t" ne "$c"; +} +```` + +```perl +package QIB; + +sub new { bless [pop], shift } +use overload '""' => sub { $_[0][0] }; +sub value { $_[0][0] } +sub toComplex { Complex->new_from_QIB( $_[0] ) } + +sub new_from_Real { + my $class = shift; + ## Special case where r=0 - value is 0... + return $class->new(0) unless $_[0]; ## Null case! + + ## Lookup (saves a bit of nasty mathes later + state @LOOK = qw(0000 0103 0102 0101 0100 0203 0202 0201 0200 0303 0302 0301 0300 0003 0002 0001); + + ## If +ve we have to remove the last to digits (0) from the end of the string we generate + ## Initial value is -v if v is less than 0 or 4v if v>0; + my ( $re, $n, @Q ) = ( $_[0]>0 ? '..$' : '$', $_[0]<0 ? -shift : 4*shift ); + + ## Strip off all the digit pairs {the reason for the *4 is that the last 2-digits in +ve values + ## become 4 digits... + (push @Q,$n%16), $n>>=4 while $n; ## Now we strip off the digit pairs + + ## We have the values now apply some carries... + for( my $j = my $l = 0; $l < @Q; $j = ++$l ) { ## Now we sort out carries + $Q[$j]-=16, $Q[++$j]++ while $Q[$j]>12; + } + ## And return the string... + return $class->new( join( '', map {$LOOK[$_]} reverse @Q ) =~ s/^0+//r =~ s/$re//r ); +} + +sub new_from_Complex { + my( $class, $c ) = @_; + $class->new( $class->new_from_Real( $c->real )->value + + 10 * $class->new_from_Real( $c->imaginary )->value ); +} +``` diff --git a/challenge-178/james-smith/perl/ch-1.pl b/challenge-178/james-smith/perl/ch-1.pl index 7d236b8e7d..1a8ac55305 100644 --- a/challenge-178/james-smith/perl/ch-1.pl +++ b/challenge-178/james-smith/perl/ch-1.pl @@ -45,6 +45,7 @@ sub toComplex { Complex->new_from_QIB( $_[0] ) } sub new_from_Real { my $class = shift; return $class->new(0) unless $_[0]; ## Null case! + ## state @LOOK = qw(0000 0103 0102 0101 0100 0203 0202 0201 0200 0303 0302 0301 0300 0003 0002 0001); my ( $re, $n, @Q ) = ( $_[0]>0 ? '..$' : '$', $_[0]<0 ? -shift : 4*shift ); diff --git a/challenge-178/james-smith/perl/ch-2.pl b/challenge-178/james-smith/perl/ch-2.pl index 2348c8b946..6e171222c1 100644 --- a/challenge-178/james-smith/perl/ch-2.pl +++ b/challenge-178/james-smith/perl/ch-2.pl @@ -7,16 +7,32 @@ use feature qw(say); use Test::More; use Benchmark qw(cmpthese timethis); use Data::Dumper qw(Dumper); +use Time::Local; -my @TESTS = ( - [ 0, 1 ], -); +add_date( '2022-08-16 04:30', 45*3 + 2*9 + 1.25 ); -is( my_function($_->[0]), $_->[1] ) foreach @TESTS; +my @months = (31,31,28,31,30,31,30,31,31,30,31,30,31); -done_testing(); +my @L = (31,31,28,31,30,31,30,31,31,30,31,30,31); -sub my_function { - return 1; +sub add_date { + my ($dur,$yr,$mth, $day,$hr,$min) = (pop,shift =~ m{(\d+)}g); + my $time = timelocal( 0,$min,$hr,$day,$mth-1,$yr); + my $dow = [localtime( $time )]->[6]; + my $weeks = int( $dur / 45 ); + my $days = int( ($dur%45) / 9 ); + my $hours = $dur - $weeks * 45 - $days * 9; + $hr = 9, $min = 0 if $hr < 9; + $hr = 18, $min = 0 if $hr > 18; + if( $hours + $hr > 18 ) { + $hr += int($hours); + $min += 60 * ( $hours - int($hours) ); + $min -= 60, $hr++ if $min > 60; + $min = ` + } + if( $days > 5 - $dow ) { + $dow = $days - 5; $weeks ++; + $row + } } diff --git a/challenge-179/james-smith/perl/ch-1.pl b/challenge-179/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..720b65b5f5 --- /dev/null +++ b/challenge-179/james-smith/perl/ch-1.pl @@ -0,0 +1,70 @@ +#!/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 @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); + +my @tests = qw(1 6 10 19 21 45 90 100 101 152 160 300 999 1000 1001 1095 1999 2000 10000 10001 1000000 1000001 1999999 10000000 10000001 +99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999); + +my @TESTS = ( + [ 11, 'eleventh' ], + [ 62, 'sixty-second' ], + [ 99, 'ninety-ninth' ], + [ 999, 'nine-hundred and ninety-ninth' ], + [ 1_099, 'one thousand and ninety-ninth' ], + [ 999_999, 'nine-hundred and ninety-nine thousand nine-hundred and ninety-ninth' ], + [ 1_000_000, 'one millionth' ], + [ 1_000_001, 'one million and first' ], + [ '99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999', + 'ninety-nine novemnonagintillion nine-hundred and ninety-nine octononagintillion nine-hundred and ninety-nine septnonagintillion nine-hundred and ninety-nine sexnonagintillion nine-hundred and ninety-nine quinnonagintillion nine-hundred and ninety-nine quattuornonagintillion nine-hundred and ninety-nine trenonagintillion nine-hundred and ninety-nine duononagintillion nine-hundred and ninety-nine unnonagintillion nine-hundred and ninety-nine nonagintillion nine-hundred and ninety-nine novemoctagintillion nine-hundred and ninety-nine octooctagintillion nine-hundred and ninety-nine septoctagintillion nine-hundred and ninety-nine sexoctagintillion nine-hundred and ninety-nine quinoctagintillion nine-hundred and ninety-nine quattuoroctagintillion nine-hundred and ninety-nine treoctagintillion nine-hundred and ninety-nine duooctagintillion nine-hundred and ninety-nine unoctagintillion nine-hundred and ninety-nine octagintillion nine-hundred and ninety-nine novemseptuagintillion nine-hundred and ninety-nine octoseptuagintillion nine-hundred and ninety-nine septseptuagintillion nine-hundred and ninety-nine sexseptuagintillion nine-hundred and ninety-nine quinseptuagintillion nine-hundred and ninety-nine quattuorseptuagintillion nine-hundred and ninety-nine treseptuagintillion nine-hundred and ninety-nine duoseptuagintillion nine-hundred and ninety-nine unseptuagintillion nine-hundred and ninety-nine septuagintillion nine-hundred and ninety-nine novemsexagintillion nine-hundred and ninety-nine octosexagintillion nine-hundred and ninety-nine septsexagintillion nine-hundred and ninety-nine sexsexagintillion nine-hundred and ninety-nine quinsexagintillion nine-hundred and ninety-nine quattuorsexagintillion nine-hundred and ninety-nine tresexagintillion nine-hundred and ninety-nine duosexagintillion nine-hundred and ninety-nine unsexagintillion nine-hundred and ninety-nine sexagintillion nine-hundred and ninety-nine novemquinquagintillion nine-hundred and ninety-nine octoquinquagintillion nine-hundred and ninety-nine septquinquagintillion nine-hundred and ninety-nine sexquinquagintillion nine-hundred and ninety-nine quinquinquagintillion nine-hundred and ninety-nine quattuorquinquagintillion nine-hundred and ninety-nine trequinquagintillion nine-hundred and ninety-nine duoquinquagintillion nine-hundred and ninety-nine unquinquagintillion nine-hundred and ninety-nine quinquagintillion nine-hundred and ninety-nine novemquardagintillion nine-hundred and ninety-nine octoquardagintillion nine-hundred and ninety-nine septquardagintillion nine-hundred and ninety-nine sexquardagintillion nine-hundred and ninety-nine quinquardagintillion nine-hundred and ninety-nine quattuorquardagintillion nine-hundred and ninety-nine trequardagintillion nine-hundred and ninety-nine duoquardagintillion nine-hundred and ninety-nine unquardagintillion nine-hundred and ninety-nine quardagintillion nine-hundred and ninety-nine novemtrigintillion nine-hundred and ninety-nine octotrigintillion nine-hundred and ninety-nine septtrigintillion nine-hundred and ninety-nine sextrigintillion nine-hundred and ninety-nine quintrigintillion nine-hundred and ninety-nine quattuortrigintillion nine-hundred and ninety-nine tretrigintillion nine-hundred and ninety-nine duotrigintillion nine-hundred and ninety-nine untrigintillion nine-hundred and ninety-nine trigintillion nine-hundred and ninety-nine novemvigintillion nine-hundred and ninety-nine octovigintillion nine-hundred and ninety-nine septvigintillion nine-hundred and ninety-nine sexvigintillion nine-hundred and ninety-nine quinvigintillion nine-hundred and ninety-nine quattuorvigintillion nine-hundred and ninety-nine trevigintillion nine-hundred and ninety-nine duovigintillion nine-hundred and ninety-nine unvigintillion nine-hundred and ninety-nine vigintillion nine-hundred and ninety-nine novemdecillion nine-hundred and ninety-nine octodecillion nine-hundred and ninety-nine septdecillion nine-hundred and ninety-nine sexdecillion nine-hundred and ninety-nine quindecillion nine-hundred and ninety-nine quattuordecillion nine-hundred and ninety-nine tredecillion nine-hundred and ninety-nine duodecillion nine-hundred and ninety-nine undecillion nine-hundred and ninety-nine decillion nine-hundred and ninety-nine novillion nine-hundred and ninety-nine octillion nine-hundred and ninety-nine septillion nine-hundred and ninety-nine sextillion nine-hundred and ninety-nine quinillion nine-hundred and ninety-nine quadillion nine-hundred and ninety-nine trillion nine-hundred and ninety-nine billion nine-hundred and ninety-nine million nine-hundred and ninety-nine thousand nine-hundred and ninety-ninth' ] +); + +is( ordinal($_->[0]), $_->[1] ) foreach @TESTS; + +done_testing(); + +say "$_ -> ",ordinal($_) foreach @tests; + +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' : (), + $v%100 ? ( $v%100 > 19 ? $nat_10[($v%100)/10].( $v%10 ? '-'.$nat[$v%10] : '' ) + : $v%100 > 0 ? $nat[$v%100] : () ) : (); +} + +## 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] : () ) : (); +} + + diff --git a/challenge-179/james-smith/perl/ch-2.pl b/challenge-179/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..f982dc1714 --- /dev/null +++ b/challenge-179/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 Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); +use Const::Fast qw(const); + +binmode STDOUT, ':utf8'; + +const my $LINE => "\x{2500}"; +const my $START => "\x{2534}"; +const my $FULL => "\x{2577}"; +const my $HALF => "\x{2502}"; + +my @sets = ( + [200,199,198,3,4,4,10,8,7,199,10,24,10,7,10,11,20,25,3,3,3,3,3,3,3,3,3,3], + [1,2,3,4,100,101,102], +); + +say ''; +for ( @sets ) { + say for spark_line($_),'-'x 210,''; + say for count_line($_),'='x 210,''; +} + +sub spark_line { + my($mx,$k,$l,%x)=0; $x{$_}++ for @{$_}; ($_>$mx) && ($mx=$_) for values %x; + ## Top of lines if 2 or more matching values.... + 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 ), + ## Base line ... + ($k=-1)x 0,join( '', map { $LINE x ($_-$k-1) . $START,($k=$_)x 0 } sort {$a<=>$b} keys %x ) +} + +sub count_line { ## Render the counts for the spark-line (for testing). if any value >= 10 we include a second + ## row for the tens... + my($mx,$k,$l,%x)=0; $x{$_}++ for @{$_}; ($_>$mx) && ($mx=$_) for values %x; + $mx>9 ? (($k=-1)x 0,(join '', map { " " x ($_-$k-1).(int($x{$k=$_}/10)||' ') } sort {$a<=>$b} keys %x )) : (), + ($k=-1)x 0,(join '', map { " " x ($_-$k-1).$x{$k=$_}%10 } sort {$a<=>$b} keys %x ) +} |