laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days (December 22, 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.

Task # 1: Guest House

A guest house had a policy that the light remain ON as long as the at least one guest is in the house. There is guest book which tracks all guest in/out time. Write a script to find out how long in minutes the light were ON.

The guest book looks as follows:

1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00

First, although the input data provided with the task spans over only 2 hours, I’ll make the computation over a full day, from 00:00 to 23:59. One of the reasons for doing so is that I wanted to add a guest staying over more than two hours, in order to test the case where someone is in the guest house for more than two adjacent hours. Also, I did not want the guests to be male only. So, I added one female guest:

10) Liz    IN: 12:07 OUT: 17:05

I can think of several ways to solve this task. I decided to create a hash of arrays covering every minute in the 00:00-23:59 range. It could have been an array of arrays, but I started with 09:00-11:00 range provided in the task, and that led to an array with empty slots, which I did not like too much because this is likely to generate warnings or require some special care to avoid such warnings (or runtime errors). The program then parses the input data and sets each minute in the presence ranges with 1. Populating the whole range with zeros before starting isn’t strictly necessary, but it makes other things easier, as it is possible at the end to just add values without having to first check for definedness.

We don’t care about the guests’ names, so when reading the input data, we only look at the time intervals.

Note that there is a slight ambiguity in the task description. If one guest arrives at 10:10 and leaves at 10:11, I consider that the light has to be on for 2 minutes, even though it may be argued that, by a simple subtraction, the guest staid only 1 minute.

Guest House in Perl 5

In Perl 5, we just put the input data in the DATAsection.

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

my %hm;
for my $hour (0..23) {
    $hm{$hour}[$_] = 0 for 0..59;
}
while (<DATA>) {
    next unless /\S/;
    my ($in_h, $in_m, $out_h, $out_m) = /(\d\d):(\d\d)\D+(\d\d):(\d\d)/;
    if ($out_h eq $in_h) {
        $hm{0+$in_h}[$_] = 1 for $in_m..$out_m;
    } else {
        $hm{0+$in_h}[$_]  = 1 for $in_m..59; # end the first hour
        for my $hour ($in_h + 1 .. $out_h -1) {
            $hm{$hour}[$_] = 1 for 0..59;    # If several hours
        }
        $hm{0+$out_h}[$_] = 1 for 0..$out_m; # Complete last hour
    }
}
my $total_on = 0;
for my $hour (keys %hm) {
        $total_on += $hm{$hour}[$_] for 0..59;
}
say "Total time on: $total_on minutes.";

__DATA__
1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00
10) Liz    IN: 12:07 OUT: 17:05

With the original input data set, the result was 111 seconds. With my modified data set, I obtain the following output:

$ perl  guesthouse.pl
Total time on: 410 minutes.

Guest House in Raku (formerly known as Perl 6)

There is no DATA section in Raku. Raku should have much more feature-rich capabilities using pod (plain old documentation) sections, but these are not implemented yet. We could use the heredocs feature, but since TIMTOWTDI, we will simply use a multi-line string variable within standard double quote marks.

use v6;

my $input = 
   "1) Alex    IN: 09:10 OUT: 09:45
    2) Arnold  IN: 09:15 OUT: 09:33
    3) Bob     IN: 09:22 OUT: 09:55
    4) Charlie IN: 09:25 OUT: 10:05
    5) Steve   IN: 09:33 OUT: 10:01
    6) Roger   IN: 09:44 OUT: 10:12
    7) David   IN: 09:57 OUT: 10:23
    8) Neil    IN: 10:01 OUT: 10:19
    9) Chris   IN: 10:10 OUT: 11:00
    10) Liz    IN: 12:07 OUT: 17:05";

my %hm;
for 0..23 -> $hour {
    %hm{$hour}[$_] = 0 for 0..59;
}
for $input.lines {
    next unless /\S/;
    my ($in_h, $in_m, $out_h, $out_m) = map { +$_}, $/[0..3] if /(\d\d)':'(\d\d)\D+(\d\d)':'(\d\d)/;
    if ($out_h == $in_h) {
        %hm{$in_h}[$_] = 1 for $in_m..$out_m;
    } else {
        %hm{$in_h}[$_]  = 1 for $in_m..59; # end the first hour
        for $in_h + 1 .. $out_h -1 -> $hour {
            %hm{$hour}[$_] = 1 for 0..59; # If several hours
        }
        %hm{$out_h}[$_] = 1 for 0..$out_m; # Complete last hour
    }
}

my $total_on = 0;
for keys %hm -> $hour {
    $total_on += sum %hm{$hour};
}
say "Total time on: $total_on minutes.";

This program produces the same result as the P5 program:

$ perl6 guesthouse.p6
Total time on: 410 minutes.

Task # 2: Reverse Polish Notation

Write a script to demonstrate Reverse Polish notation (RPN). Checkout the wiki page for more information about RPN.

This task reminds me of the Hewlett-Packard pocket calculators during my teen years in the 1970’s. To tell the truth, I had bought at the time a Texas Instruments programmable calculator using standard infix notation, but a friend of mine has a much more powerful HP hand-held calculator. The most important difference was that my friend’s HP calculator could save programs for later use, while my more basic (and much cheaper) TI calculator would lose everything when switched off. So we worked quite a bit on his calculator for studying assignments and, although I never became as fluent as my friend with RPN, I understood quite well at the time how to use it.

Anyway, the point about RPN, which is also known as postfix notation, is that you first state the operands and then only the operators. If it is a binary operator (the most common case), you just pick up the last two previous operands. For example, to add numbers 7 and 11, instead of typing something like 7 + 11, you would type 7, 11 +. RPN is a bit counter-intuitive at first, but it is quite efficient because it avoids using parentheses for specifying operation precedence. As a result, RPN supposedly requires less typing than usual infix notation. The following Wikipedia example shows the difference. The following inxix notation expression:

((15 ÷ (7 − (1 + 1))) × 3) − (2 + (1 + 1))

can be written as follows in RPN:

15 7 1 1 + − ÷ 3 × 2 1 1 + + − =

The essential idea for processing RPN notation is a stack (a last-in first-out data or LIFO structure): when you read an operand, you just push it onto a stack. And when you read a binary operator, you just pop two values from the stack, apply the operator to them and push the result back onto the stack. We need to be cautious about something for operators which are not commutative such as subtraction or division: the first operand that we pop from the stack has to be the second operand in the operation, and the second popped operand will be the the first one in the operation.

The code for the operations is stored in a dispatch table, i.e. a hash where the keys are the operators and the values are code references to short subroutines performing the arithmetic operations. Note that I encountered unexpected difficulties because some of the RPN expressions that I copied from the Wikipedia page contain special Unicode characters for subtraction, multiplication and division. This was especially tricky for the subtraction operator, since the common ASCII dash or hyphen and the Unicode minus sign really look similar. To fix this, I only needed to add entries with those special characters in the dispatch table (and the use utf8; pragma).

Reverse Polish Notation in Perl 5

I have included five test cases using the Test::More module. For a real life program, we would probably want more tests

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Test::More tests => 5;

my %operations = (
    '+' => sub { return $_[0] + $_[1]; },
    '-' => sub { return $_[0] - $_[1]; }, # hyphen
    '−' => sub { return $_[0] - $_[1]; }, # minus
    'x' => sub { return $_[0] * $_[1]; },
    '*' => sub { return $_[0] * $_[1]; },
    '×' => sub { return $_[0] * $_[1]; },
    '/' => sub { return $_[0] / $_[1]; },
    '÷' => sub { return $_[0] / $_[1]; },
);

sub parse_operation {
    my @stack;
    for my $token (split /\s+/, shift) {
        if ($token =~ /^\d+$/) {
            push @stack, $token ;
        } elsif (exists $operations{$token}) {
            return "Invalid RPN expression" if @stack < 2;
            my $op2 = pop @stack;
            my $op1 = pop @stack;
            push @stack, $operations{$token}->($op1, $op2);
        } else {
            die "Invalid token $token.";
        }
    }
    return $stack[0]
}
is parse_operation("1 2 +"), 3, "2 operands";
is parse_operation("1 2 + 4 ×"), 12, "3 operands, a Unicode multiplication operator";
is parse_operation("1 2 + 4 * 5 + 3 -"), 14, "5 operands";
is parse_operation("3 4 5 x -"), -17, "Start with 3 operands and then two operators";
is parse_operation("15 7 1 1 + − ÷ 3 × 2 1 1 + + −"), 5, "8 operands, 4 Unicode operators";

Running the program shows that all tests pass correctly:

$ perl rpn.pl
1..5
ok 1 - 2 operands
ok 2 - 3 operands, unicode multiplication operator
ok 3 - 5 operands
ok 4 - Start with 3 operands and then two operators
ok 5 - 8 operands, 4 Unicode operators

Note that this program does only minimal RPN validity check (only that we get valid tokens and that the stack has at least two values when we want to process an operator). Otherwise, we basically assume the RPN expression is correct. In a real-life program, more validity checks would probably be necessary (for example that the stack has only one value left at the end of the parsing).

Reverse Polish Notation in Raku

Although I have been thinking of various ways of doing it in Raku, notably using a grammar, I think the simplest is to use a stack as in Perl 5. Only a few minor changes are required to have a working Raku program:

use v6;
use Test;

my %operations = (
    '+' => { $^a + $^b; },
    '-' => { $^a - $^b; }, # hyphen
    '−' => { $^a - $^b; }, # dash
    'x' => { $^a * $^b; },
    '*' => { $^a * $^b; },
    '×' => { $^a * $^b; },
    '/' => { $^a / $^b; },
    '÷' => { $^a / $^b; },
);

sub parse_operation (Str $expr) {
    my @stack;
    for $expr.split(/\s+/) -> $token {
        if $token ~~ /^ \d+ $/ {
            push @stack, $token ;
        } elsif (%operations{$token}:exists) {
            return "Invalid RPN expression" if @stack.elems < 2;
            my $op2 = pop @stack;
            my $op1 = pop @stack;
            push @stack, %operations{$token}($op1, $op2);
        } else {
            die "Invalid token $token.";
        }
    }
    return @stack[0]
}
plan 5;
is parse_operation("1 2 +"), 3, "2 operands";
is parse_operation("1 2 + 4 ×"), 12, "3 operands, a Unicode multiplication operator";
is parse_operation("1 2 + 4 * 5 + 3 -"), 14, "5 operands";
is parse_operation("3 4 5 x -"), -17, "Start with 3 operands and then two operators";
is parse_operation("15 7 1 1 + − ÷ 3 × 2 1 1 + + −"), 5, "8 operands, 4 Unicode operators";

Running this program produces the same output as the P5 program:

$ perl6 rpn.p6
1..5
ok 1 - 2 operands
ok 2 - 3 operands, a Unicode multiplication operator
ok 3 - 5 operands
ok 4 - Start with 3 operands and then two operators
ok 5 - 8 operands, 4 Unicode operators

Using the when “switch” statement provided by Raku, we can get rid of the dispatch table and make our code slightly more concise as follows:

use v6;
use Test;

sub perform-op (&op) {
    push @*stack, @*stack.pop R[&op] @*stack.pop;
}
sub parse_operation (Str $expr) {
    my @*stack;
    for $expr.split(/\s+/) {
        when /^ \d+ $/       { @*stack.push($_)}
        when '+'             { perform-op &[+] }
        when '*' | 'x' | '×' { perform-op &[*] }
        when '/' | '÷'       { perform-op &[/] }
        when '-' | '−'       { perform-op &[-] }
        default { die "Invalid token $_."; }
    }
    return @*stack[0]
}
plan 5;
is parse_operation("1 2 +"), 3, "2 operands";
is parse_operation("1 2 + 4 ×"), 12, "3 operands, a Unicode multiplication operator";
is parse_operation("1 2 + 4 * 5 + 3 -"), 14, "5 operands";
is parse_operation("3 4 5 x -"), -17, "Start with 3 operands and then two operators";
is parse_operation("15 7 1 1 + − ÷ 3 × 2 1 1 + + −"), 5, "8 operands, 4 Unicode operators";

This passes all the tests correctly as before.

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