September 2021 Archives

Perl Weekly Challenge 131: Consecutive Arrays

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on September 26, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

You are given a sorted list of unique positive integers.

Write a script to return list of arrays where the arrays are consecutive integers.

Example 1:

Input:  (1, 2, 3, 6, 7, 8, 9)
Output: ([1, 2, 3], [6, 7, 8, 9])

Example 2:

Input:  (11, 12, 14, 17, 18, 19)
Output: ([11, 12], [14], [17, 18, 19])

Example 3:

Input:  (2, 4, 6, 8)
Output: ([2], [4], [6], [8])

Example 4:

Input:  (1, 2, 3, 4, 5)
Output: ([1, 2, 3, 4, 5])

Consecutive Arrays in Raku

We implement the four example arrays provided as an array of arrays (AoA) for our tests. For each input test array, we simply loop over the values. If a value is the integer next to the previous one ($prev), we add it to a @tmp-res temporary array. If not (i.e. there is a gap), we push @tmp-res to the @result array, and reset @tmp-res to an array containing only the current value. At the end, we push the last @tmp-res to the result.

use v6;

my @tests = [1, 2, 3, 6, 7, 8, 9],
            [11, 12, 14, 17, 18, 19],
            [2, 4, 6, 8],
            [1, 2, 3, 4, 5];
for @tests -> @input {
    my $prev = shift @input;
    my @result;
    my @tmp-res = $prev;
    for @input -> $i {
        if $i == $prev + 1 {
            push @tmp-res, $i;
        } else {
            push @result, [@tmp-res];
            @tmp-res = $i;
        }
        $prev = $i;
    }
    push @result, @tmp-res;
    say @result;
}

This script displays the following output:

raku ./main.raku
[[1 2 3] [6 7 8 9]]
[[11 12] [14] [17 18 19]]
[[2] [4] [6] [8]]
[[1 2 3 4 5]]

Consecutive Arrays in Perl

The Perl solution is essentially a port to Perl of the Raku script above. The only significant difference is that it is slightly less easy to print out the contents of an array of arrays, as we need to dereference the sub-array references.

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

my @tests = ( [1, 2, 3, 6, 7, 8, 9],
              [11, 12, 14, 17, 18, 19],
              [2, 4, 6, 8],
              [1, 2, 3, 4, 5]
            );
for my $test (@tests) {
    my @input = @$test;
    my $prev = shift @input;
    my @result;
    my @tmp_res = ($prev);
    for my $i (@input) {
        if ($i == $prev + 1) {
            push @tmp_res, $i;
        } else {
            push @result, [@tmp_res];
            @tmp_res = ($i);
        }
        $prev = $i;
        # say "tmp ",  @tmp-res;
    }
    push @result, [@tmp_res];
    say "( ", (map "[@$_] ", @result), ")";
}

This script displays the following output:

$ perl  ./consec_arrays.pl
( [1 2 3] [6 7 8 9] )
( [11 12] [14] [17 18 19] )
( [2] [4] [6] [8] )
( [1 2 3 4 5] )

Wrapping up

The next week Perl Weekly Challenge will 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 October 3, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 130: Odd Number and Binary Search Tree

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

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on September 19, 2021 at 24:00). 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: Odd Number

You are given an array of positive integers, such that all the numbers appear even number of times except one number.

Write a script to find that integer.

Example 1:

Input: @N = (2, 5, 4, 4, 5, 5, 2)
Output: 5 as it appears 3 times in the array where as all other numbers 2 and 4 appears exactly twice.

Example 2:

Input: @N = (1, 2, 3, 4, 3, 2, 1, 4, 4)
Output: 4

Even though I have duly noted that the task specification states that only one number appears an odd number of time, I’ll expand slightly the task to find all the integers appearing an odd number of times, in the event that there is more than one.

Odd Number in Raku

In Raku, a Bag is a built-in immutable collection of distinct elements in no particular order that each have an integer weight assigned to them signifying how many copies of that element are considered “in the bag”. This is the perfect data structure to implement an histogram from a list of input values: just converting the input list into a bag, i.e. a list of unique key-values with the value being the frequency of the key. We then just need to filter out keys whose values are even to obtain the desired result.

my $bag = (2, 5, 4, 4, 5, 5, 2).Bag;
say grep { $bag{$_} % 2 }, $bag.keys;

This script displays the following output:

raku ./odd_number.raku
(5)

Adding a 2 to the input list will make the 2-count odd:

$ raku ./odd_number.raku
(5 2)

Odd Number in Perl

Perl doesn’t have a built-in Bag type, but it is almost as easy to implement an histogram using a hash. The algorithm is otherwise essentially the same:

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

my %histo;
$histo{$_}++ for (2, 5, 4, 4, 5, 5, 2);
say join " ", grep { $histo{$_} % 2 } keys %histo;

This script displays the following output:

$ perl odd_number.pl
5

Adding a 2 to the input list will make the 2-count odd:

$ perl odd_number.pl
2 5

Task 2: Binary Search Tree

You are given a tree.

Write a script to find out if the given tree is Binary Search Tree (BST).

According to Wikipedia, the definition of BST:

A binary search tree is a rooted binary tree, whose internal nodes each store a key (and optionally, an associated value), and each has two distinguished sub-trees, commonly denoted left and right. The tree additionally satisfies the binary search property: the key in each node is greater than or equal to any key stored in the left sub-tree, and less than or equal to any key stored in the right sub-tree. The leaves (final nodes) of the tree contain no key and have no structure to distinguish them from one another.

Example 1:

Input:
        8
       / \
      5   9
     / \
    4   6

Output: 1 as the given tree is a BST.

Example 2:

Input:
        5
       / \
      4   7
     / \
    3   6

Output: 0 as the given tree is a not BST.

We’ll implement the binary tree as a nested hash of hashes, in which the keys are val (the current node value), lc (left child node), and rc (right child node).

Binary Search Tree in Raku

we implement a recursive dft (depth-first traversal) subroutine to explore the tree. We return 0 when any value is larger than any previous value, except that a right child is larger than its immediate parent node.

use v6;

sub dft (%t, $min) {
    my $value = %t<val>;
    my $new-min = $value < $min ?? $value !! $min ;
    # say "$max $min $value $new-max $new-min";    
    if %t<lc>:exists {
        # say "%t<lc><val> $min";
        return 0 if %t<lc><val> > $value;
        return 0 if %t<lc><val> > $min;
        return 0 unless dft %t<lc>, $new-min;
    }
    if %t<rc>:exists {
        # say "%t<rc><val> $min";
        return 0 if %t<rc><val> < $value;
        return 0 if %t<rc><val> > $min;
        return 0 unless dft %t<rc>, $new-min;
    }
    return 1;
}
my %tree1 = (
    val => 8, 
    lc => { val => 5, 
            lc => {val => 4}, 
            rc => {val => 6}
          },
    rc => {val => 9}
);
#       8
#      / \
#     5   9
#    / \
#   4   6
say (dft %tree1, Inf), "\n";

my %tree2 = (val => 5, 
    lc => { val => 4, 
            lc => {val => 3}, 
            rc => {val => 6}
           },
    rc => {val => 7});
#       5
#      / \
#     4   7
#    / \
#   3   6
say dft %tree2, Inf;

This displays the following output:

$ raku ./bst.raku
1

0

Binary Search Tree in Perl

We also use a recursive dft (depth-first traversal) subroutine, with the same rules as above.

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

sub dft {
    my ($t, $min) = @_;
    my $value = $t->{val};
    my $new_min = $value < $min ? $value : $min ;
    # say " $min $value $new_min";    
    if (exists $t->{lc}) {
        # say "%t<lc><val> $min";
        return 0 if $t->{lc}{val} > $value;
        return 0 if $t->{lc}{val} > $min;
        return 0 unless dft($t->{lc}, $new_min);
    }
    if (exists $t->{rc}) {
        # say "%t<rc><val> $max $min";
        return 0 if $t->{rc}{val} < $value;
        return 0 if $t->{rc}{val} > $min;
        return 0 unless dft($t->{rc}, $new_min);
    }
    return 1;
}
my %tree1 = (
    val => 8, 
    lc => { val => 5, 
            lc => {val => 4}, 
            rc => {val => 6}
          },
    rc => {val => 9}
);
#       8
#      / \
#     5   9
#    / \
#   4   6
say "tree1: ", dft(\%tree1, 1e9), "\n";

my %tree2 = (val => 5, 
    lc => { val => 4, 
            lc => {val => 3}, 
            rc => {val => 6}
           },
    rc => {val => 7});
#       5
#      / \
#     4   7
#    / \
#   3   6
say "tree2: ", dft \%tree2, 1e9;

This displays the following output:

$ perl  bst.pl
tree1: 1

tree2: 0

Wrapping up

The next week Perl Weekly Challenge will 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 September 26, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Perl Weekly Challenge 128: Minimum Platforms

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

Note: very little time this week, so I only completed task 2.

You are given two arrays of arrival and departure times of trains at a railway station.

Write a script to find out the minimum number of platforms needed so that no train needs to wait.

Example 1:

Input: @arrivals   = (11:20, 14:30)
       @departures = (11:50, 15:00)
Output: 1

    The 1st arrival of train is at 11:20 and this is the only train at the station, so you need 1 platform.
    Before the second arrival at 14:30, the first train left the station at 11:50, so you still need only 1 platform.

Example 2:

Input: @arrivals   = (10:20, 11:00, 11:10, 12:20, 16:20, 19:00)
       @departures = (10:30, 13:20, 12:40, 12:50, 20:20, 21:20)
Output: 3

    Between 12:20 and 12:40, there would be at least 3 trains at the station, so we need minimum 3 platforms.

UPDATED [2021-08-30 23:30 UK TIME]: Corrected the between time description of the example 2. Thanks Peter Campbell Smith.

We need to perform a number of comparisons between arrival and departure times. We could write a dedicated compare subroutine (which would be quite simple). I decided however that I prefer to convert all the times into time stamps, namely the number of seconds elapsed since 00:00 a.m. that day, for which we can simply perform a numerical comparison. Our program then reads both arrays in parallel, always picking the smallest value. A size counter keeps track of the number of trains in the station at any given time, and $max-size keeps track of the maximum value reached by $size.

Minimum Platforms in Raku

Our program reads both arrays in parallel, always picking the smallest value. A size counter keeps track of the number of trains in the station at any given time, and $max-size keeps track of the largest size reached. When reading to sets of values in parallel, there are usually two edge cases when we reach the end of any of the datasets. If we reach the end of the arrival times, we can just exit the loop, since we will not increase the $size value beyond the maximum value so far. If we reach the end of the departure time array, then we need to increment the $max-size by one for any value left in the arrival time array.

my @arrivals   = <10:20 11:00 11:10 12:20 16:20 19:00>;
my @departures = <10:30 13:20 12:40 12:50 20:20 21:20>;
my @ts-arr = map { my ($m, $s) = split /\:/, $_; $m * 60 + $s;}, @arrivals;
my @ts-dep = map { my ($m, $s) = split /\:/, $_; $m * 60 + $s;}, @departures;
my $size = 0;
my $max-size = 0;
while @ts-arr.end != 0 {
    if @ts-dep.end == 0 {
        $max-size++;
    } elsif @ts-arr[0] <= @ts-dep[0] {
        shift @ts-arr;
        $size++;
        $max-size = $size if $size > $max-size;
        # say "$size $max-size";
    } else {
        shift @ts-dep;
        $size--;
    }
}
say $max-size;

With the built-in sample input data, the program displays the following output:

$ raku ./min-platforms.raku
3

Minimum Platforms in Perl

We’re basically porting the Raku program to Perl. Please refer to the above if you need explanations.

use strict;
use warnings;
use feature qw/say/;

my @arrivals   = qw<10:20 11:00 11:10 12:20 16:20 19:00>;
my @departures = qw<10:30 13:20 12:40 12:50 20:20 21:20>;
my @ts_arr = map { my ($m, $s) = split /:/, $_; $m * 60 + $s;} @arrivals;
my @ts_dep = map { my ($m, $s) = split /:/, $_; $m * 60 + $s;} @departures;
my $size = 0;
my $max_size = 0;
while (@ts_arr) {
    if ($#ts_dep == 0) {
        $max_size++;
    } elsif ($ts_arr[0] <= $ts_dep[0]) {
        shift @ts_arr;
        $size++;
        $max_size = $size if $size > $max_size;
        # say "$size $max-size";
    } else {
        shift @ts_dep;
        $size--;
    }
}
say $max_size;

Output:

$ perl min-platforms.pl
3

Wrapping up

The next week Perl Weekly Challenge will 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 September 12, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

About laurent_r

user-pic I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.