Perl Weekly Challenge: Week 179
Challenge 1:
Ordinal Number Spelling
You are given a positive number,
$n.Write a script to spell the ordinal number.
For example,
11 => eleventh
62 => sixty-second
99 => ninety-ninth
The script for this solution is a lot longer than usual but most of it is actually data. The code is actually quite straightforward. The spec doesn't mention any limits except "positive number" but I have chosen to spell ordinal numbers from 1 to 1,000 only.
Although the spec just talks about ordinal numbers, we will also need cardinal
numbers. We define two Hashes to map numbers in digit for to their cardinal
or ordinal form e.g 1 to 'one' and 'first' and 8 to 'eight' and 'eighth'
and so one. I won't show the whole hashes here but it should be noted that
they do not need to contain 1,000 entries as most cardinal and ordinal numbers
are regularly constructed.
my %cardinals = (
...
);
%cardinals contains keys for 1-20,30,40,50,60,70,80,90 and 100.
my %ordinals = (
...
);
%ordinals contains the same keys plus 1000.
Now using %cardinals, %ordinals and $n we can make and output an ordinal.
say makeOrdinal(%cardinals, %ordinals, $n);
This is the makeOrdinal() function.
sub makeOrdinal(%cardinals, %ordinals, $n) {
If $n is 1000, we don't have to do any calculations; we can just return
the ordinal for 1000.
if ($n == 1_000) {
return %ordinals{1_000};
}
Otherwise we call another function, underThousand() with the same parameters.
return underThousand(%cardinals, %ordinals, $n);
}
This is the underThousand() finction.
sub underThousand(%cardinals, %ordinals, $n) {
Once again we have a special case; if $n is less than 100, we call
the underHundred() function which will be explained later.
if $n < 100 {
return underHundred(%cardinals, %ordinals, $n);
}
If $n is greater than 100, it is split into its constituent digits which
are then assigned to variables according to their decimal place.
my ($hundreds, $tens, $units) = $n.comb;
The first part of the ordinal for this number will be the cardinal value of
the digit at the $hundreds place.
my @parts = (%cardinals{$hundreds});
If $n was 100 or greater, if it is not evenly divisible by 100, the cardinal
value of 100, the word "and" are added to the list of parts of the ordinal.
underHundred() is called with 10 times the value of $tens plus the value
of $units replacing $n as the third parameter. The result of this function
is also added to the list of parts.
@parts.push( $n % 100
?? |(%cardinals{100}, 'and',
underHundred(%cardinals, %ordinals, $tens * 10 + $units))
If $n is evenly divisible by 100, the ordinal value of 100 is added to the
list of parts.
!! %ordinals{100}
);
The list of parts is joined together with spaces to form the ordinal for $n.
return @parts.join(q{ });
}
underHundred() takes the same parameters as the previous two functions.
sub underHundred(%cardinals, %ordinals, $n) {
$n is split into digits which are then assigned to variables according to their decimal place.
my ($tens, $units) = $n.comb;
This function also has a special case. If $n is less than 20, we just return the ordinal value of that number because these are irregular in construction.
if $n < 20 {
return %ordinals{$n};
}
If $n is 20 or greater and the value of $units is 0...
return $units == 0
...the ordinal value of $tens times 10 is returned.
?? %ordinals{$tens * 10}
Otherwise the cardinal value of $tens times 10 is joined to the ordinal value
of $units with a hyphen and that string is returned.
!! (%cardinals{$tens * 10}, %ordinals{$units}).join(q{-});
}
Here is the Perl version.
sub underHundred($cardinals, $ordinals, $n) {
my ($tens, $units) = split //, $n;
if ($n < 20) {
return $ordinals{$n};
}
return $units == 0
? $ordinals->{$tens * 10}
: join q{-}, ($cardinals->{$tens * 10}, $ordinals->{$units});
}
sub underThousand ($cardinals, $ordinals, $n) {
if ($n < 100) {
return underHundred($cardinals, $ordinals, $n);
}
my ($hundreds, $tens, $units) = split //, $n;
my @parts = ($cardinals->{$hundreds});
push (@parts, $n % 100
? ($cardinals->{100}, 'and',
underHundred($cardinals, $ordinals, $tens * 10 + $units))
: $ordinals->{100}
);
return join q{ }, @parts;
}
sub makeOrdinal($cardinals, $ordinals, $n) {
Raku has built in parameter validation so we didn't have to bother checking
if a value greater than 1000 was passed for $n but in Perl we add a check
here to be safe.
if ($n > 1_000) {
return "Too big!";
} elsif ($n == 1_000) {
return $ordinals->{1_000};
} else {
return underThousand($cardinals, $ordinals, $n);
}
}
say makeOrdinal(\%cardinals, \%ordinals, $n);
Challenge 2:
Unicode Sparkline
You are given a list of positive numbers,
@n.Write a script to print sparkline in Unicode for the given list of numbers.
We create an array of the 8 Unicode block characters.
my @bars = '▁' ... '█';
Then we find the minimum and maximum values in the input using .minmax(). This returns a Range object so we use .bounds() to extract both endpoints.
my ($min,$max) = @n.minmax.bounds;
For each number in the input...
for @n -> $n {
print $n
If the number is not 0, we normalize it to fit within the range 0-7. and print the corresponding @bars character.
?? @bars[ min(@bars * ($n - $min) / ($max - $min), @bars - 1) ]
Otherwise if the number is 0, we print an empty space. The spec only mentions positive integers so this isn't really necessary but in a real life scenario there is a good chance there are 0s in the input.
!! ' ';
}
Finally, we print a newline.
print "\n";
For the Perl version we have to provide versions of min() and max().
Also to handle utf-8 encoded unicode in our script we need this at the top.
use utf8;
And we have to use binmode() to prepare the output for utf8 characters or
else warnings will be emitted.
binmode(STDOUT, ':utf8');
I was not able to include the block characters in a range though it seems Perl should support such a thing. So instead I just included them all individually.
my @bars = qw/▁ ▂ ▃ ▄ ▅ ▆ ▇ █/;
In the absence of .minmax.bounds() I used min() and max() separately to
get the endpoints.
my $min = min(@n);
my $max = max(@n);
The rest works the same as in Raku.
for my $n (@n) {
print $n
? @bars[ min(@bars * ($n - $min) / ($max - $min), @bars - 1) ]
: ' ';
}
print "\n";