laurent_r

These are some answers to the Week 206 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 March 5, 2023 at 23:59). 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: Shortest Time

You are given a list of time points, at least 2, in the 24-hour clock format HH:MM.

Write a script to find out the shortest time in minutes between any two time points.

Example 1

Input: @time = ("00:00", "23:55", "20:00")
Output: 5

Since the difference between "00:00" and "23:55" is the shortest (5 minutes).

Example 2

Input: @array = ("01:01", "00:50", "00:57")
Output: 4

Example 3

Input: @array = ("10:10", "09:30", "09:00", "09:55")
Output: 15

Shortest Time in Raku

If the hour parts of the time stamps are equal, then the shortest subroutine simply compares the minute parts (and returns the absolute value of the difference). Otherwise, it transforms the time stamps into minutes and compares the minutes values. If the difference found is larger than half a day, then it is subtracted from a full day to obtain a difference less than 12 hours.

In the main code, the program tests the time stamp against each other to find the smallest time duration.

sub shortest ($t1, $t2) { 
    my $mod = 60 * 12;    # half a day
    my ($h1, $m1) = split /\:/, $t1;
    my ($h2, $m2) = split /\:/, $t2;
    return abs ($m1 - $m2) if $h1 == $h2;
    my $delta = abs(($h1 * 60 + $m1) - ($h2 * 60 + $m2));
    $delta = $mod * 2 - $delta if $delta > $mod;
}

for ("00:00", "23:55", "20:00"), 
    ("01:01", "00:50", "00:57"), 
    ("10:10", "09:30", "09:00", "09:55") -> @test {
    my $min = Inf;
    for @test.combinations(2) -> @comb {
        my $diff = shortest @comb[0], @comb[1];
        $min = $diff if $diff < $min;
    }
    say "@test[]".fmt("%-25s => "), $min;
}

This program displays the following output:

$ raku ./shortest-time.raku
00:00 23:55 20:00         => 5
01:01 00:50 00:57         => 4
10:10 09:30 09:00 09:55   => 15

Shortest Time in Perl

This is a port to Perl of the Raku program just above. Please refer to the explanations in the above section if needed.

use strict;
use warnings;
use feature "say";

sub shortest { 
    my $mod = 60 * 12;
    my ($h1, $m1) = split /:/, $_[0];
    my ($h2, $m2) = split /:/, $_[1];
    return abs ($m1 - $m2) if $h1 == $h2;
    my $delta = abs(($h1 * 60 + $m1) - ($h2 * 60 + $m2));
    $delta = $mod * 2 - $delta if $delta > $mod;
    return $delta
}

for my $test (["00:00", "23:55", "20:00"], 
              ["01:01", "00:50", "00:57"], 
              ["10:10", "09:30", "09:00", "09:55"]) {
    my $min = 10000;   # larger than any HH:MM time diff
    my @t = @$test;
    for my $i (0..$#t) {
        for my $j ($i+1..$#t) {
            my $diff = shortest $t[$i], $t[$j];
            $min = $diff if $diff < $min;
        }
    }
    printf "%-25s => %d\n", "@t", $min;
}

This program displays the following output:

$ perl  ./shortest-time.pl
00:00 23:55 20:00         => 5
01:01 00:50 00:57         => 4
10:10 09:30 09:00 09:55   => 15

Task 2: Array Pairings

You are given an array of integers having even number of elements.

Write a script to find the maximum sum of the minimum of each pairs.

Example 1

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

Possible Pairings are as below:
a) (1,2) and (3,4). So min(1,2) + min(3,4) => 1 + 3 => 4
b) (1,3) and (2,4). So min(1,3) + min(2,4) => 1 + 2 => 3
c) (1,4) and (2,3). So min(1,4) + min(2,3) => 2 + 1 => 3

So the maxium sum is 4.

Example 2

Input: @array = (0,2,1,3)
Output: 2

Possible Pairings are as below:
a) (0,2) and (1,3). So min(0,2) + min(1,3) => 0 + 1 => 1
b) (0,1) and (2,3). So min(0,1) + min(2,3) => 0 + 2 => 2
c) (0,3) and (2,1). So min(0,3) + min(2,1) => 0 + 1 => 1

So the maximum sum is 2.

Array Pairings in Raku

Brute-Force Raku Solution

Our first implementation will just blindly follow the specifications: find all pairs, combine them 2 by 2 and find the largest sum of smaller items. To find all pairs, the pairings subroutine uses a combination of the permutationand rotor built-in methods. It then uses the combinations method to build the pairs of pairs and find the largest sum of mins.

sub pairings (@in) {
    my $max = - Inf;
    my @perms = @in.permutations;
    for @perms -> $perm {
        for $perm.rotor(2).combinations(2) -> $comb {
            my $sum = $comb[0].min + $comb[1].min;
            $max = $sum if $sum > $max
        }
    }
    return $max;
}
for <1 2 3 4>, <6 5 4 3 2 1>, <0 2 1 3> -> @test {
    say "@test[]".fmt("%-15s => "), pairings @test;
}

This program displays the following output:

$ raku ./pairings.raku
1 2 3 4         => 4
6 5 4 3 2 1     => 8
0 2 1 3         => 2

Improved Raku Solution

This is, however, quite inefficient, both from a coding perspective and from a performance standpoint. As soon as the input list grows a bit, the number of permutations will explode and the number of combinations of pairs generated from the permutations even more so. Since we are looking for maximum sums, we can look at the largest numbers. More specifically, since the numbers we will add have to be the minimum of a pair, we basically need the second and fourth largest integers of the input array. So, we simply sort the input and add the second and fourth integers of the sorted list.

This leads to a much simpler and much more efficient solution:

sub pairings (@in) {
    my @sorted = @in.sort.reverse;
    return @sorted[1] + @sorted[3];
}
for <1 2 3 4>, <6 5 4 3 2 1>, <0 2 1 3> -> @test {
    say "@test[]".fmt("%-15s => "), pairings @test;
}

This program displays the same output as the previous program.

Array Pairings in Perl

Porting the first (“brute-force”) Raku solution to Perl would have been a bit painful, because Perl doesn’t have built-in permutations, rotor, and combinations functions, so that they would have to be hand-rolled (since I usually eschew using CPAN modules in programming challenges). But, fortunately, it is quite easy to port the second (“improved”) solution to Perl:

use strict;
use warnings;
use feature "say";

sub pairings {
    my @sorted = sort { $b <=> $a } @_;
    return $sorted[1] + $sorted[3];
}

for my $test ([<1 2 3 4>], [<6 5 4 3 2 1>],
              [<0 2 1 3>], [<34 12 1 11>]) {
     printf "%-15s => %d\n", "@$test", pairings @$test;
}

This program displays the following output:

$ perl  ./pairings.pl
1 2 3 4         => 4
6 5 4 3 2 1     => 8
0 2 1 3         => 2
34 12 1 11      => 13

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 ans

wer the challenge before 23:59 BST (British summer time) on March 12, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.