Perl Weekly Challenge 179.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 179.
Task 1: Ordinal Number Spelling
Submitted by: Mohammad S Anwar
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
I made a couple of routines, one to spell ordinal and the other to spell cardinal numbers. I allow numbers up to but excluding a billion, although it would be easy to go further. Using integer and modular arithmetic I find the millions, thousands, hundreds, tens and units and I use recursion to simplify the logic. I stick in an and after the hundreds part.
1 # Perl weekly challenge 179
2 # Task 1: Ordinal number spelling
3 #
4 # See https://wlmb.github.io/2022/08/22/PWC179/#task-1-ordinal-number-spelling
5 use v5.36;
6 use experimental qw(try);
7 use POSIX qw(floor);
8 my (%ordinals, %cardinals);
9 @ordinals{0..19}=
10 qw(zeroth first second third fourth fifth sixth seventh eighth ninth tenth
11 eleventh twelfth thirteenth fourteenth fifteenth sixteenth seventeenth eighteenth
12 nineteenth);
13 @ordinals{qw(20 30 40 50 60 70 80 90)}=
14 qw(twentieth thirtieth fortieth fiftieth
15 sixtieth seventieth eightieth ninetieth);
16 @cardinals{0..19}=qw(
17 zero one two three four five six seven eight nine ten eleven twelve
18 thirteen fourteen fifteen sixteen seventeen eighteen nineteen);
19 @cardinals{qw(20 30 40 50 60 70 80 90)}=qw(
20 twenty thirty forty fifty sixty seventy eighty ninety);
21 for(@ARGV){
22 try {say "$_-th=", ordinal($_);}
23 catch($n){say $n;};
24 }
25
26 sub ordinal($n){
27 die "$n is too large" if $n>=1000000000;
28 die "$n is not a positive integer" unless $n=~/^\s*\+?\d+\.?\s*$/;
29 my $millions=floor($n/1000000);
30 my $rest=$n%1000000;
31 return cardinal($millions)
32 . ($rest ? " million " . ordinal($rest)
33 : " millionth") if $millions;
34 my $thousands=floor($rest/1000);
35 $rest %= 1000;
36 return cardinal($thousands)
37 . ($rest ? " thousand " . ordinal($rest)
38 : " thousandth") if $thousands;
39 my $hundreds=floor($rest/100);
40 $rest%=100;
41 return cardinal($hundreds)
42 . ($rest ? " hundred and " . ordinal($rest)
43 : " hundredth") if $hundreds;
44 my $tens = floor($rest/10);
45 $rest %= 10;
46 return $cardinals{10*$tens} ."-". ordinal($rest) if $tens >=2 && $rest;
47 return $ordinals{10*$tens} if $tens >=2;
48 return $ordinals{10*$tens+$rest} if $tens==1;
49 return $ordinals{$rest} if $tens==0;
50 }
51 sub cardinal($n){
52 die "$n is too large" if $n>=1000000000;
53 die "$n is not a positive integer" unless $n=~/^\s*\+?\d+\.?\s*$/;
54 my $millions=floor($n/1000000);
55 my $rest=$n%1000000;
56 return cardinal($millions). " million " . cardinal($rest) if $millions;
57 my $thousands=floor($rest/1000);
58 $rest%=1000;
59 return cardinal($thousands) . " thousand " . cardinal($rest) if $thousands;
60 my $hundreds=floor($rest/100);
61 $rest%=100;
62 return cardinal($hundreds) . " hundred" . ($rest? " and ". cardinal($rest) : "") if $hundreds;
63 my $tens=floor($rest/10);
64 $rest%=10;
65 return $cardinals{10*$tens}. " " . cardinal($rest) if $tens>=2;
66 return $cardinals{10*$tens+$rest} if $tens==1;
67 return $cardinals{$rest} if $rest>0;
68 return "";
69 }
70
Example:
./ch-1.pl `seq 21` 32 123 1234 12345 123456 1234567
Results:
1-th=first
2-th=second
3-th=third
4-th=fourth
5-th=fifth
6-th=sixth
7-th=seventh
8-th=eighth
9-th=ninth
10-th=tenth
11-th=eleventh
12-th=twelfth
13-th=thirteenth
14-th=fourteenth
15-th=fifteenth
16-th=sixteenth
17-th=seventeenth
18-th=eighteenth
19-th=nineteenth
20-th=twentieth
21-th=twenty-first
32-th=thirty-second
123-th=one hundred and twenty-third
1234-th=one thousand two hundred and thirty-fourth
12345-th=twelve thousand three hundred and forty-fifth
123456-th=one hundred and twenty three thousand four hundred and fifty-sixth
1234567-th=one million two hundred and thirty four thousand five hundred and sixty-seventh
Task 2: Unicode Sparkline
Submitted by: Mohammad S Anwar
You are given a list of positive numbers, @n.
Write a script to print sparkline in Unicode for the given list of
numbers.
Unicode has a set of block characters of different heights, with code points 0x2581 upto 0x2588. I can map a set of values to a set of indices into an array of such characters, producing a simple plot. This may be coded in a oneliner, using PDL to simplify the manipulation of the data.
perl -Mutf8 -CO -MPDL -E ' @a=split "", "▁▂▃▄▅▆▇█"; $i=pdl([@ARGV]); $i-=$i->min;
$i*=@a/($i->max+1e-7); say join "", map {$a[$_]} $i->list;
' 0 1 2 3 4 5 6 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 6 5 4 3 2 1 0
Results:
▁▂▃▄▅▆▇█▇▆▅▄▃▂▁▂▃▄▅▆▇█▇▆▅▄▃▂▁
The full code follows:
# Perl weekly challenge 179
# Task 2: Unicode sparkline
#
# See https://wlmb.github.io/2022/08/22/PWC179/#task-2-unicode-sparkline
use v5.36;
use PDL;
use utf8;
binmode STDOUT, ':utf8';
my @blocks=split "", "▁▂▃▄▅▆▇█"; # Array of blocks of different heights
die "Usage: $0 N1 [N2...]\nto make a sparkline with the data N1 N2...\n"
unless @ARGV;
my $small=1e-7;
my $indices=pdl([@ARGV]); # slurp data into ndarray
$indices-=$indices->min; # start at 0
$indices*=@blocks/($indices->max+$small); # Normalize to 0..number of blocks-1
say join "", map {$blocks[$_]} $indices->list; # Use as indices into block array
./ch-2.pl 0 1 2 3 4 5 6 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 6 5 4 3 2 1 0
Results:
▁▂▃▄▅▆▇█▇▆▅▄▃▂▁▂▃▄▅▆▇█▇▆▅▄▃▂▁