aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLuis Mochan <mochan@fis.unam.mx>2022-08-22 19:19:25 -0500
committerLuis Mochan <mochan@fis.unam.mx>2022-08-22 19:19:25 -0500
commitd505d30e15a258804f3dd5e8b0baa48ace7376f7 (patch)
tree488b0e64002c2648e7b0a8ff9250c2244642bf57
parent6a2bfb87f57ececed07aaff17064d862f22b5ec1 (diff)
downloadperlweeklychallenge-club-d505d30e15a258804f3dd5e8b0baa48ace7376f7.tar.gz
perlweeklychallenge-club-d505d30e15a258804f3dd5e8b0baa48ace7376f7.tar.bz2
perlweeklychallenge-club-d505d30e15a258804f3dd5e8b0baa48ace7376f7.zip
Solve PWC179
-rw-r--r--challenge-179/wlmb/blog.txt1
-rwxr-xr-xchallenge-179/wlmb/perl/ch-1.pl70
-rwxr-xr-xchallenge-179/wlmb/perl/ch-2.pl17
3 files changed, 88 insertions, 0 deletions
diff --git a/challenge-179/wlmb/blog.txt b/challenge-179/wlmb/blog.txt
new file mode 100644
index 0000000000..cdb9bbef07
--- /dev/null
+++ b/challenge-179/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/08/22/PWC179/
diff --git a/challenge-179/wlmb/perl/ch-1.pl b/challenge-179/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..d1b7380ce2
--- /dev/null
+++ b/challenge-179/wlmb/perl/ch-1.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 179
+# Task 1: Ordinal number spelling
+#
+# See https://wlmb.github.io/2022/08/22/PWC179/#task-1-ordinal-number-spelling
+use v5.36;
+use experimental qw(try);
+use POSIX qw(floor);
+my (%ordinals, %cardinals);
+@ordinals{0..19}=
+ qw(zeroth first second third fourth fifth sixth seventh eighth ninth tenth
+ eleventh twelfth thirteenth fourteenth fifteenth sixteenth seventeenth eighteenth
+ nineteenth);
+@ordinals{qw(20 30 40 50 60 70 80 90)}=
+ qw(twentieth thirtieth fortieth fiftieth
+ sixtieth seventieth eightieth ninetieth);
+@cardinals{0..19}=qw(
+ zero one two three four five six seven eight nine ten eleven twelve
+ thirteen fourteen fifteen sixteen seventeen eighteen nineteen);
+@cardinals{qw(20 30 40 50 60 70 80 90)}=qw(
+ twenty thirty forty fifty sixty seventy eighty ninety);
+for(@ARGV){
+ try {say "$_-th=", ordinal($_);}
+ catch($n){say $n;};
+}
+
+sub ordinal($n){
+ die "$n is too large" if $n>=1000000000;
+ die "$n is not a positive integer" unless $n=~/^\s*\+?\d+\.?\s*$/;
+ my $millions=floor($n/1000000);
+ my $rest=$n%1000000;
+ return cardinal($millions)
+ . ($rest ? " million " . ordinal($rest)
+ : " millionth") if $millions;
+ my $thousands=floor($rest/1000);
+ $rest %= 1000;
+ return cardinal($thousands)
+ . ($rest ? " thousand " . ordinal($rest)
+ : " thousandth") if $thousands;
+ my $hundreds=floor($rest/100);
+ $rest%=100;
+ return cardinal($hundreds)
+ . ($rest ? " hundred and " . ordinal($rest)
+ : " hundredth") if $hundreds;
+ my $tens = floor($rest/10);
+ $rest %= 10;
+ return $cardinals{10*$tens} ."-". ordinal($rest) if $tens >=2 && $rest;
+ return $ordinals{10*$tens} if $tens >=2;
+ return $ordinals{10*$tens+$rest} if $tens==1;
+ return $ordinals{$rest} if $tens==0;
+}
+sub cardinal($n){
+ die "$n is too large" if $n>=1000000000;
+ die "$n is not a positive integer" unless $n=~/^\s*\+?\d+\.?\s*$/;
+ my $millions=floor($n/1000000);
+ my $rest=$n%1000000;
+ return cardinal($millions). " million " . cardinal($rest) if $millions;
+ my $thousands=floor($rest/1000);
+ $rest%=1000;
+ return cardinal($thousands) . " thousand " . cardinal($rest) if $thousands;
+ my $hundreds=floor($rest/100);
+ $rest%=100;
+ return cardinal($hundreds) . " hundred" . ($rest? " and ". cardinal($rest) : "") if $hundreds;
+ my $tens=floor($rest/10);
+ $rest%=10;
+ return $cardinals{10*$tens}. " " . cardinal($rest) if $tens>=2;
+ return $cardinals{10*$tens+$rest} if $tens==1;
+ return $cardinals{$rest} if $rest>0;
+ return "";
+}
diff --git a/challenge-179/wlmb/perl/ch-2.pl b/challenge-179/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..2a5ed0f03e
--- /dev/null
+++ b/challenge-179/wlmb/perl/ch-2.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+# 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