Perl Weekly Challenge: Week 206

Challenge 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

Sometimes I get to clever for my own good. Case in point, I read the description for this problem and thought "it involves times so I need a proper time-parsing module" because it has been my bitter experience that dates and times are weird and have all sorts of edge cases which make it better to use tried and tested libraries rather than rolling their own. But actually this challenge is very simple and once I stopped messing around trying to make a module bend to my will, I got this done in short time.

First we take the input as command line arguments and split each argument at the colon into hours and minutes. Then we replace the arguments with the sum of the hours multiplied by 60 and the minutes. A special case is if the time is 00:00 because that actually indicates 24 hours or 1440 minutes.

@args
    .map({
        my ($h, $m) = $_.split(/\:/);
        ($h == 0 && $m == 0 ?? 1440 !! $h * 60) + $m; 
    })

Now we have a list of minute values. For each combination of two of these... .combinations(2)

... we find the difference. Because we don't know which of the pair is greater, we take the absolute value of the difference to avoid negative numbers. The differences replaces the numbers of minutes.

    .map({ (@$_[0] - @$_[1]).abs })

So now we have a list of differences so all that remains is to sort that list so that the shortest difference is first and then print it.

    .sort({ $^a <=> $^b })
    .first
    .say;

(Full code on Github.)

The Perl version requires a combinations() function which I copied from previous challenges. Unfortunately this required splitting the code into two statements because including the map() inline in the call to combinations() would have made it completely unreadable. I miss the ease with which you can chain operations in Raku.

my @times = map {
        my ($h, $m) = split /\:/, $_;
        ($h == 0 && $m == 0 ? 1440 : $h * 60) + $m; 
    } @ARGV;

say 0+(sort { $a <=> $b } map { abs (@$_[0] - @$_[1]) } combinations(\@times, 2))[0];

(Full code on Github.)

Challenge 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.

I mentioned that you can easily chain together operations in Raku. Well in challenge 2, I may have gone overboard with this concept.

First we take the command-line arguments and find every permutation of them. .permutations() doesn't filter out duplicates so we reduce the number by only considering the permutations which beging with the first argument.

@args
    .permutations
    .grep({ @$_[0] == @args[0]; })

Then we split each of those permutations into lists of pairs of elements.

    .map({ $_.batch(2); })

Some of these lists of pairs may be identical except the order of the elements is different i.e. ((1, 2), (3, 4)) and ((2, 1), (4, 2)). We can filter those out by sorting each pair within the list ...

    .map({ $_.map({ $_.sort({ $^a <=> $^b }); }) })

... and finding the unique values. But oh dear, .unique() only works on strings so first we have to convert the lists back into strings ("flattening" the pairs in the process with |.)

    .map({ join(q{}, | @$_); })
    .unique

Once we've gotten rid of the duplicates, we can convert back to lists of pairs again.

    .map({ $_.comb; })
    .map({ $_.batch(2); })

Finally we can find the minimum value of each pair and sum all the minimums together. (I used [+] but we could also have used .sum().)

    .map({ [+] $_.map({ $_.min; }) })

.max() finds the maximum sum and then .say() prints it.

    .max
    .say;

(Full code on Github.)

The Perl version required adding a lot of supporting code to make up for deficiencies of Perls builtin functions such as replacements for batch(), permute(), unique(), min() and sum().

The rest of the code lookd like this:

my @permutations;
permute { push @permutations, \@_; } @ARGV;

say [
    sort { $b <=> $a }
    map { sum([map { min(@{$_}) } @{$_}]) }
    map { [batch($_, 2)] }
    map { [ split // ] }
    unique(
        map { join q{}, @{$_} }
        map { [map { sort { $a <=> $b } @{$_} } @{$_}] }
        map { [batch($_, 2)] }
        grep { $_->[0] == $ARGV[0] }
        @permutations
    )
]->[0];

(Full code on Github.)