Week 179 Task 2

2 files changed, 125 insertions, 0 deletions

diff --git a/challenge-179/bob-lied/perl/ch-1.pl b/challenge-179/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..2db9c74966
--- /dev/null
+++ b/challenge-179/bob-lied/perl/ch-1.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 179 Task 1 Ordinal Number Spelling
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a positive number, $n.
+# Write a script to spell the ordinal number.
+# Examples
+#   11 => eleventh
+#   62 => sixty-second
+#   99 => ninety-ninth
+#=============================================================================
+
+use v5.36;
+
+my @Ones = qw( zeroth first second  third  fourth
+               fifth  sixth seventh eighth ninth
+               tenth eleventh twelfth thirteenth fourteenth
+               fifteenth sixteenth seventeenth eighteenth nineteenth );
+
+my %Extra = ( 1 => "first", 2 => "second", 3 => "third", 5 => "fifth" );
+
+my @Tens = qw( zero teen twenty thirty forty
+               fifty sixty seventy eighty ninety );
+
+my @BigName = qw(none thousand million billion trillion quatrillion quintillion
+             sextillion septillion octillion nonillion decillion );
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub runTest
+{
+    use Test2::V0;
+
+    is(0, 1, "FAIL");
+
+    done_testing;
+}
+
diff --git a/challenge-179/bob-lied/perl/ch-2.pl b/challenge-179/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..168bb2c396
--- /dev/null
+++ b/challenge-179/bob-lied/perl/ch-2.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 179 Task 2 Unicode Sparkline
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of positive numbers, @n.
+# Write a script to print sparkline in Unicode for the given list of numbers.
+#
+# This seems to be a very brief description of the challenge from RosettaCode
+# https://rosettacode.org/wiki/Sparkline_in_unicode
+# Use the following series of Unicode characters to create a program that
+# takes a series of numbers separated by one or more whitespace or comma
+# characters and generates a sparkline-type bar graph of the values on a
+# single line of output.
+# The eight characters: '▁▂▃▄▅▆▇█' (Unicode values U+2581 through U+2588).
+# Use your program to show sparklines for the following input, here on this page:
+# 1 2 3 4 5 6 7 8 7 6 5 4 3 2 1 ▁▂▃▄▅▆▇█▇▆▅▄▃▂▁
+# 1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5 ▂▁▄▃▆▅█▇
+# (note the mix of separators in this second case)!
+# Notes
+#   A space is not part of the generated sparkline.
+#   The sparkline may be accompanied by simple statistics of the data such as
+#   its range.
+#   A suggestion emerging in later discussion (see Discussion page) is that
+#   the bounds between bins should ideally be set to yield the following
+#   results for two particular edge cases:
+#   0, 1, 19, 20 -> ▁▁██ (Aiming to use just two spark levels)
+#   0, 999, 4000, 4999, 7000, 7999 -> ▁▁▅▅██ (Aiming for three spark levels)
+#=============================================================================
+
+use v5.36;
+binmode(STDOUT, ":encoding(UTF-8)");
+
+use List::SomeUtils qw/minmax/;
+
+my @Level = ( "\N{LOWER ONE EIGHTH BLOCK}",
+              "\N{LOWER ONE QUARTER BLOCK}",
+              "\N{LOWER THREE EIGHTHS BLOCK}",
+              "\N{LOWER HALF BLOCK}",
+              "\N{LOWER FIVE EIGHTHS BLOCK}",
+              "\N{LOWER THREE QUARTERS BLOCK}",
+              "\N{LOWER SEVEN EIGHTHS BLOCK}",
+              "\N{FULL BLOCK}" );
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say sparkLine(\@ARGV);
+
+sub sparkLine($list)
+{
+    my ($min, $max) = minmax $list->@*;
+    my $range = $max - $min+1;
+
+    my @bucket = map { int( ($_-$min) / ($range/@Level) ) } $list->@*;
+
+    my @histogram = map { $Level[$_] } @bucket;
+
+    return join("", @histogram);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( sparkLine([1,2,3,4,5,6,7,8,7,6,5,4,3,2,1]),   "▁▂▃▄▅▆▇█▇▆▅▄▃▂▁", "Example 1");
+    is( sparkLine([1.5,0.5,3.5,2.5,5.5,4.5,7.5,6.5]), "▂▁▄▃▆▅█▇",        "Example 2");
+    is( sparkLine([0,1,19,20]),                       "▁▁██",            "Two levels");
+    is( sparkLine([0,999,4000,4999,7000,7999]),       "▁▁▅▅██",          "Three levels");
+
+    done_testing;
+}
+