laurent_r

These are some answers to the Week 33 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (November 10,, 2019). This blog post offers some solutions to this challenge, please don't read on if you intend to complete the challenge on your own.

Challenge # 1: Count Letters (A..Z)

Create a script that accepts one or more files specified on the command-line and count the number of times letters appeared in the files.

So with the following input file sample.txt:

The quick brown fox jumps over the lazy dog.

the script would display something like:

a: 1
b: 1
c: 1
d: 1
e: 3
f: 1
g: 1
h: 2
i: 1
j: 1
k: 1
l: 1
m: 1
n: 1
o: 4
p: 1
q: 1
r: 2
s: 1
t: 2
u: 2
v: 1
w: 1
x: 1
y: 1
z: 1

This is not specified explicitly, but from the example, we gather that what is desired here is a case-insensitive letter count (in the example, both "T" and "t" count as "t"). So we will apply the lc (lower case) built-in function to the input.

Letter Histogram in Perl 5

We will start with a Perl 5 one-liner with one intersection.pl file as input:

$ perl -nE 'for my $l (split //, lc) { $h{$l}++}; END{say "$_: ", $h{$_}//0 for ("a".."z");}' intersection.pl
a: 96
b: 46
c: 25
d: 22
e: 72
f: 19
g: 20
h: 4
i: 77
j: 0
k: 0
l: 21
m: 16
n: 59
o: 32
p: 12
q: 1
r: 52
s: 77
t: 49
u: 9
v: 19
w: 3
x: 15
y: 31
z: 0

The -n command line option will loop over the lines of the input file. The program uses a %h hash to store the letter count. Note that, at the end, the hash will contain counts for characters other than the 'a'..'z' range, but we don't really care, since we will print out only the letters of that range. Note that some letters (j, k, and z) weren't seen in the process, but the $h{$_}//0 syntax ensures that the value 0 will be printed for letters where the hash isn't defined. Also note that the (split //, lc) syntax makes it possible to fold each line to lowercase (lc defaults on $_ when there are no arguments), and split works on the lower-cased line, so that $l will take in turn each character of the input line, folded to lowercase when needed.

This is now the output for the same one-liner with several input files (the same intersection.pl file plus several histo* files):

$ perl -nE 'for my $l (split //, lc) { $h{$l}++}; END{say "$_: ", $h{$_}//0 for ("a".."z");}' intersection.pl histo*
a: 199
b: 154
c: 123
d: 111
e: 271
f: 99
g: 37
h: 49
i: 170
(... some output lines omitted for brevity ...)
u: 42
v: 26
w: 22
x: 20
y: 68
z: 9

If you prefer a real full-fledged Perl script, this may look like this:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

my %histo;

while (<>) {
    chomp;
    my $line = lc;
    for my $letter (split //, $line) {
        $histo{$letter}++ if $letter =~ /[a-z]/;
    }
}
for my $key ("a".."z") {
    say "$key: ", $histo{$key} // 0;
}

This script outputs the same result as the one-liner above when given the same input (be it only one or several files).

Note that, here, the program filters the input characters and stores only letters in the %histo hash. This is just to make this filtering more explicit (and self-documenting), but this is not necessary for the program to work the same way.

Letter Histogram in Raku (formerly known as Perl 6)

Perl 6 has been renamed "Raku" in October 2019, so we will use that name from now on.

In Raku, we can use a Bag, named $histo, rather than a hash to easily implement an histogram. With just a little bit of work, we're able to populate the bag in just one statement, without any explicit loop. Also, if a letter does not exist in the $histo bag, the bag will report 0, so that we don't need any special code to avoid an undefined warning for such an edge case. All this makes the code much more concise than the Perl 5 counterpart.

use v6;

sub MAIN (*@files) {
    my $histo = (map {.IO.comb».lc}, @files).Bag;
    say "$_ : ", $histo{$_} for 'a'..'z';
}

Used with one input file, the program displays the following:

$ perl6 histo_let.p6 intersection.pl
a : 96
b : 46
c : 25
d : 22
e : 72
f : 19
g : 20
h : 4
i : 77
j : 0
k : 0
[... Lines omitted for brevity ...]
y : 31
z : 0

And it works similarly with several input files:

$ ./perl6 histo_let.p6 intersection.pl histo*
a : 199
b : 154
c : 123
d : 111
e : 271
f : 99
g : 37
h : 49
i : 170
j : 4
k : 11
[... Lines omitted for brevity ...]
y : 68
z : 9

Challenge # 2: Formatted Multiplication Table

Write a script to print 11x11 multiplication table, only the top half triangle.

x|   1   2   3   4   5   6   7   8   9  10  11
---+--------------------------------------------
1|   1   2   3   4   5   6   7   8   9  10  11
2|       4   6   8  10  12  14  16  18  20  22
3|           9  12  15  18  21  24  27  30  33
4|              16  20  24  28  32  36  40  44
5|                  25  30  35  40  45  50  55
6|                      36  42  48  54  60  66
7|                          49  56  63  70  77
8|                              64  72  80  88
9|                                  81  90  99
10|                                     100 110
11|                                         121

Formatted Multiplication Table in Perl 5

It might make sense to write separate subroutines for headers and for lines of the multiplication table, but this is so simple that I tend to consider this overkill. I will rather print the header and then print the table lines. Perl has a format feature that I have used so rarely that I hardly remember how to use it. Besides, as far as I can say, it would not be very practical for such output. Even though I haven't written any large amount of C code for more than 15 years, I still like quite a lot the possibilities offered by the standard C printf function. For a nice formatted output, the simplest will be to use when needed the built-in Perl printf subroutine, which is almost the same as its C counterpart.

#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';

sub print_table {
    my $max = shift;
    # Print header
    printf "%2s |", "x";
    printf "%4d", $_ for 1..$max;
    say "\n---|", "-" x (4 * $max);
    # Print table lines
    for my $i (1..$max) {
        printf "%2d |%s", $i, ' ' x (4 * ($i - 1));
        for my $j ($i..$max) {
            printf "%4d", $i * $j;
        }
        say "";
    }
}
print_table shift//11;

Running this program with the default 11 value produces the following output:

$ perl mult-table.pl
 x |   1   2   3   4   5   6   7   8   9  10  11
---|--------------------------------------------
 1 |   1   2   3   4   5   6   7   8   9  10  11
 2 |       4   6   8  10  12  14  16  18  20  22
 3 |           9  12  15  18  21  24  27  30  33
 4 |              16  20  24  28  32  36  40  44
 5 |                  25  30  35  40  45  50  55
 6 |                      36  42  48  54  60  66
 7 |                          49  56  63  70  77
 8 |                              64  72  80  88
 9 |                                  81  90  99
10 |                                     100 110
11 |                                         121

You can also pass a larger value:

$ perl mult-table.pl 15
 x |   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
---|------------------------------------------------------------
 1 |   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
 2 |       4   6   8  10  12  14  16  18  20  22  24  26  28  30
 3 |           9  12  15  18  21  24  27  30  33  36  39  42  45
 4 |              16  20  24  28  32  36  40  44  48  52  56  60
 5 |                  25  30  35  40  45  50  55  60  65  70  75
 6 |                      36  42  48  54  60  66  72  78  84  90
 7 |                          49  56  63  70  77  84  91  98 105
 8 |                              64  72  80  88  96 104 112 120
 9 |                                  81  90  99 108 117 126 135
10 |                                     100 110 120 130 140 150
11 |                                         121 132 143 154 165
12 |                                             144 156 168 180
13 |                                                 169 182 195
14 |                                                     196 210
15 |                                                         225

Note that this is not exactly the output shown in the task description, but this is deliberately so, I think this looks slightly better.

Formatted Multiplication Table in Raku (Perl 6)

Just as in Perl 5, the simplest is to use the printf subroutine when needed (I actually wrote the Raku version before the P5 one, but that's not important). The Raku program is very similar to the Perl 5 program:

use v6;
sub MAIN (UInt $max = 11) {
    print-table($max);
}
sub print-table ($max) {
    # Print header
    printf "%2s |", "x";
    printf "%4d", $_ for 1..$max;
    say "\n---|", "-" x 4 * ($max);
    # Print table lines
    for 1..$max -> $i {
        printf "%2d |%s", $i, ' ' x 4 * ($i - 1);
        for $i..$max -> $j {
            printf "%4d", $i * $j;
        }
        say "";
    }
}

This script prints out the following:

$ perl6 mult-table.p6
 x |   1   2   3   4   5   6   7   8   9  10  11
---|--------------------------------------------
 1 |   1   2   3   4   5   6   7   8   9  10  11
 2 |       4   6   8  10  12  14  16  18  20  22
 3 |           9  12  15  18  21  24  27  30  33
 4 |              16  20  24  28  32  36  40  44
 5 |                  25  30  35  40  45  50  55
 6 |                      36  42  48  54  60  66
 7 |                          49  56  63  70  77
 8 |                              64  72  80  88
 9 |                                  81  90  99
10 |                                     100 110
11 |                                         121

As for the P5 implementation, this is not exactly the output shown in the task description, but, as said before, I think this looks slightly better.

Just in case you want to know, this works equally well when passing a parameter other than 11. For example with an argument of 15, this prints the same as the P5 version.

Of course, the nice formatting starts to break when passing a parameter higher than 31, but the initial requirement was just an 11*11 multiplication table. It would not be difficult to change the script to make it work with larger values (we could even dynamically adapt the formatting strings to the maximal output number), but nobody needs commonly a larger multiplication table. Besides, it would print very badly with the width limit imposed by this site.

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, November, 17. And, please, also spread the word about the Perl Weekly Challenge if you can.