laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few days (November 17, 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.

This week, both tasks were contributed by Dave Cross.

Task # 1: Array and Hash Slices

Write a program that demonstrates using hash slices and/or array slices.

Slices are a way to access several values of an array or of a hash in one statement, by using multiple subscripts or keys.

Array and Hash Slices in Perl 5

If you have an @array containing for example some successive integers, you can obtain several values from it with the following syntax: @array[3, 7, 2] or even @array[2..7].

If you try to do the same with a %hash and use %hash{'a', 'c'} you’ll get key/value pairs, which may or may not be what you want. If you want only the values, you need to change the sigil like so: @hash{'a', 'c'}. Array and hash slices may also be used as l-values, i.e. on the left-hand side of an assignment, to populate a new array or a new hash.

This short program illustrates all this:

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

my @array = (0..10);
my $count = 0;
my %hash  = map {$_ => ++$count} 'a'..'j';

say "Array slice :  @array[3..7]";
say "Hash slice 1: ", join ' ', %hash{'b', 'd', 'c'};
say "Hash slice 2: ", join ' ', %hash{'b'..'d'};
say "Hash slice 3: ", join ' ', @hash{'b'..'d'};
say "Hash slice 4: ", join ' ', @hash{qw/c b c d/};

# Array slice a l-value
my @new_array = (1, 2);
@new_array[2, 3] = @array[6, 7];
say "New array: ";
say Dumper \@new_array;    

# Hash slice as l-value:
my @keys = qw/c d e/;
my %new_hash = %hash{@keys}; # Perl 5.20 and above
say "New hash: ";
say Dumper \%new_hash;
my %new_hash2;
@new_hash2{@keys} = @hash{@keys};
say "New hash2: ";
say Dumper \%new_hash2;

This displays the following output:

$ perl hash_slices.pl
Array slice :  3 4 5 6 7
Hash slice 1: b 2 d 4 c 3
Hash slice 2: b 2 c 3 d 4
Hash slice 3: 2 3 4
Hash slice 4: 3 2 3 4
New array:
$VAR1 = [
          1,
          2,
          6,
          7
        ];

New hash:
$VAR1 = {
          'd' => 4,
          'c' => 3,
          'e' => 5
        };

New hash2:
$VAR1 = {
          'e' => 5,
          'c' => 3,
          'd' => 4
        };

Array and Hash Slices in Raku (formerly known as Perl 6)

Like in Perl 5, if you have an @array containing for example some successive integers, you can obtain several values from it with the following syntax: @array[3, 7, 2] or even @array[2..7].

And you can do the same with a hash to obtain a bunch of values. Array and hash slices may also be used as l-values, i.e. on the left-hand side of an assignment, to populate a new array or a new hash.

use v6;

my @array = 0..10;
my $count = 0;
my %hash  = map {$_ => ++$count}, 'a'..'j';

say "Array slice :  @array[3..7]";
say "Hash slice 1: ", join ' ', %hash{'b', 'd', 'c'};
say "Hash slice 2: ", join ' ', %hash{'b'..'d'};
say "Hash slice 3: ", join ' ', %hash<b c d>;

# Array slice a l-value
my @new-array = (1, 2);
@new-array[2, 3] = @array[6, 7];
say "New array: ", @new-array;
# Hash slice as l-value:
my @keys = qw/c d e/;
my %new-hash;
%new-hash{@keys} = %hash{@keys};
say "New hash: ", %new-hash;

This program produces the following output:

$ perl6 hash_slices.p6
Array slice :  3 4 5 6 7
Hash slice 1: 2 4 3
Hash slice 2: 2 3 4
Hash slice 3: 2 3 4
New array: [1 2 6 7]
New hash: {c => 3, d => 4, e => 5}

Task # 2: Dispatch Tables

Write a program that demonstrates a dispatch table.

A dispatch table is a table or more commonly hash of subroutine references.

For this task, we won’t simply demonstrate the syntax, but will try to do something (moderately) useful with it.

Suppose we have a text file and want to feed each word from the file into 26 files (one per letter of the alphabet) depending on the first letter of the word. This could be done with a monstrous if ... elsif ... else (or, in Raku, given ... when) construct, or we could use a dispatch table, in this case a hash containing for each letter a code reference printing the word into the proper file. As we will see, this produces much shorter and simpler code. We will even use a dynamic dispatch table, i.e. only create the hash entries (and files) that are needed with the input file.

Dispatch Tables in Perl 5

We first write a function_builder subroutine that acts as a function factory. It receives a letter as a parameter, creates a file name for that letter, opens the corresponding file in write mode, and it returns an anonymous subroutine (actually a closure) that writes its argument to the file handle. This anonymous subroutine will then be stored into the dispatch table.

In the main loop, the program reads the lines of the input file, fold them to lower case, splits the lines into words, and finds the first character of each such word. To avoid problems with special characters, we only keep words starting with a letter. If the dispatch table has no entry yet for this letter, the program calls function_builder subroutine to open the proper file and stores the code reference returned by that subroutine in the dispatch table. Finally, the program calls the code reference stored in the dispatch table for word’s first letter.

Note that Perl automatically closes files upon exiting.

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

my %dispatch;

sub function_builder {
    my $letter = shift;
    my $file_name = "${letter}_letter.txt";
    open my $FH, ">", $file_name or die "Could not open $file_name $!";
    return sub { say $FH shift }
}

while (<>) {
    chomp;
    for my $word (split / /, lc $_) {
        my $letter = substr $word, 0, 1;
        next if $letter !~ /^[a-z]/; 
        $dispatch{$letter} = function_builder($letter) unless defined $dispatch{$letter};
        $dispatch{$letter}->($word);
    }
}

Running the program and passing it the hash_slices.pl file (the script of task # 1 of this week) produced the following files in the default directory:

-rw-r--r--  1 Laurent Aucun      25 11 nov.  17:48  m_letter.txt
-rw-r--r--  1 Laurent Aucun      20 11 nov.  17:48  j_letter.txt
-rw-r--r--  1 Laurent Aucun      42 11 nov.  17:48  d_letter.txt
-rw-r--r--  1 Laurent Aucun       2 11 nov.  17:48  c_letter.txt
-rw-r--r--  1 Laurent Aucun      28 11 nov.  17:48  a_letter.txt
-rw-r--r--  1 Laurent Aucun      16 11 nov.  17:48  u_letter.txt
-rw-r--r--  1 Laurent Aucun       5 11 nov.  17:48  p_letter.txt
-rw-r--r--  1 Laurent Aucun       4 11 nov.  17:48  e_letter.txt
-rw-r--r--  1 Laurent Aucun      94 11 nov.  17:48  s_letter.txt
-rw-r--r--  1 Laurent Aucun      17 11 nov.  17:48  l_letter.txt
-rw-r--r--  1 Laurent Aucun      18 11 nov.  17:48  h_letter.txt
-rw-r--r--  1 Laurent Aucun      10 11 nov.  17:48  w_letter.txt
-rw-r--r--  1 Laurent Aucun       3 11 nov.  17:48  o_letter.txt
-rw-r--r--  1 Laurent Aucun      13 11 nov.  17:48  f_letter.txt
-rw-r--r--  1 Laurent Aucun       8 11 nov.  17:48  v_letter.txt
-rw-r--r--  1 Laurent Aucun       8 11 nov.  17:48  q_letter.txt
-rw-r--r--  1 Laurent Aucun       2 11 nov.  17:48  b_letter.txt

This is the file generated for letter “a”:

$ cat a_letter.txt
array
a
array:
as
available

Dispatch Tables in Raku

We do more or less the same thing as in P5: we first write a function_builder subroutine that acts as a function factory. It receives a letter as a parameter, creates a file name for that letter, opens the corresponding file in write mode, and it returns an anonymous code block (actually a closure) that writes its argument to the file handle. This anonymous code block will be stored into the dispatch table.

In the MAIN subroutine , the program reads the words of the input file, fold them to lower case, and finds the first character of each such word. To avoid problems with special characters, we only keep words starting with a letter. If the dispatch table has no entry yet for this letter, the program calls function_builder subroutine to open the proper file and stores the code reference returned by that subroutine in the dispatch table. Finally, the program calls the code reference stored in the dispatch table for word’s first letter.

use v6;

sub function_builder (Str $letter) {
    my $file_name = "letter_$letter.txt";
    my $fh = open "./$file_name", :w;
    return { $fh.say($^a) }
}

multi sub MAIN (Str $file where *.IO.f) {
    my %dispatch;
    for $file.IO.words.map({.lc}) -> $word {
        my $letter = substr $word, 0, 1;
        next if $letter !~~ /^<[a..z]>/; 
        %dispatch{$letter} = function_builder $letter unless defined %dispatch{$letter};
        %dispatch{$letter}($word);
    }
}

Running the program and passing it the hash_slices.p6 file (the script of task # 1 of this week) produced the following files in the default directory:

-rwxr-xr-x  1 Laurent Aucun       5 11 nov.  18:26  letter_u.txt
-rwxr-xr-x  1 Laurent Aucun       5 11 nov.  18:26  letter_v.txt
-rwxr-xr-x  1 Laurent Aucun       3 11 nov.  18:26  letter_c.txt
-rwxr-xr-x  1 Laurent Aucun       6 11 nov.  18:26  letter_q.txt
-rwxr-xr-x  1 Laurent Aucun       5 11 nov.  18:26  letter_e.txt
-rwxr-xr-x  1 Laurent Aucun      72 11 nov.  18:26  letter_s.txt
-rwxr-xr-x  1 Laurent Aucun      29 11 nov.  18:26  letter_m.txt
-rwxr-xr-x  1 Laurent Aucun      18 11 nov.  18:26  letter_j.txt
-rwxr-xr-x  1 Laurent Aucun      19 11 nov.  18:26  letter_l.txt
-rwxr-xr-x  1 Laurent Aucun      13 11 nov.  18:26  letter_h.txt
-rwxr-xr-x  1 Laurent Aucun       8 11 nov.  18:26  letter_d.txt
-rwxr-xr-x  1 Laurent Aucun      22 11 nov.  18:26  letter_a.txt

This is the file generated for letter “a”:

$ cat letter_a.txt
array
a
array:
as

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, 24. And, please, also spread the word about the Perl Weekly Challenge if you can.