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:

▁▂▃▄▅▆▇█▇▆▅▄▃▂▁▂▃▄▅▆▇█▇▆▅▄▃▂▁
Written on August 22, 2022