E. Choroba

Array Median

We are given two sorted arrays, our task is to merge them and return the median. Let’s start with the naive approach: just let Perl sort the list and select the median.

#!/usr/bin/perl
use warnings;
use strict;
use experimental qw( signatures );

sub array_median_naive($arr1, $arr2) {
    my @m = sort { $a <=> $b } @$arr1, @$arr2;
    return unless @m;

    return @m % 2 ? $m[ $#m / 2 ]
                  : ($m[ $#m / 2 ] + $m[ @m / 2 ]) / 2
}

My initial idea was to create a sliding window of size 2. Let the window slide over the merging arrays, stop at the middle and report the median. Unfortunately, the code doesn’t stay elegant. We only populate the @m array when at the right position, before reaching the middle we just adjust the indices into the two merging arrays.

use POSIX qw{ ceil };

sub array_median_sliding($arr1, $arr2) {
    my $pos = (@$arr1 + @$arr2 - 1) / 2;
    return if $pos < 0;

    my $size = 2 - (@$arr1 + @$arr2) % 2;

    my @indices = (0, 0);
    my @m;
    for my $step (0 .. ceil($pos)) {
        if ($indices[0] > $#$arr1) {
            push @m, $arr2->[ $indices[1] ]
                if $step >= ceil($pos) - 2;
            ++$indices[1];
        } elsif ($indices[1] > $#$arr2
                 || $arr1->[ $indices[0] ] <= $arr2->[ $indices[1] ]
        ) {
            push @m, $arr1->[ $indices[0] ]
                if $step >= ceil($pos) - 2;
            ++$indices[0];
        } else {
            push @m, $arr2->[ $indices[1] ]
                if $step >= ceil($pos) - 2;
            ++$indices[1];
        }
    }
    return $size == 1 ? $m[-1] : ($m[-1] + $m[-2]) / 2
}

Optimisation usually complicates code. What’s surprising here is that the sliding window is more than twice slower than the naive implementation! On the other hand, it’s memory efficient: it only needs to store two elements from the array, and a couple variables to handle the sliding window. If the two arrays are really large and merging them into memory isn’t possible, this is the algorithm to reach for.

After some attempts, I was able to optimise the naive approach, though. The trick is not to store the sorted list in an array, but instead just use a list slice to select the needed elements:

sub array_median_opt($arr1, $arr2) {
    my $size = @$arr1 + @$arr2;
    return if 0 == $size;

    my @m = (sort { $a <=> $b } @$arr1, @$arr2)
            [ $size % 2 ? $size / 2
                        : $size / 2 - 1, $size / 2 ];
    return @m == 1 ? $m[0] : ($m[0] + $m[1]) / 2
}

You can see the actual benchmark code in my GitHub repository.

         Rate sliding   naive     opt
sliding 111/s      --    -62%    -87%
naive   292/s    163%      --    -66%
opt     869/s    684%    198%      --

Arrange Box

We are given an array of boxes, each box is represented by an anonymous array with two elements, representing the box’s width and depth. Our task is to find the maximum number of boxes that we can stack into each other: a box must be smaller in both dimensions to fit into another box.

Here, the examples are too simple. Let’s have a look at one of them:

Sort by width ascending: ([10, 20], [12, 18], [15, 10], [16, 25], [20, 30])
Extract depths: (20, 18, 10, 25, 30)
[15, 10] -> [16, 25] -> [20, 30]

The result is just the last three elements of the sorted list of the boxes. But in a general case, we can have boxes in between. Once we select a box, we rule out boxes with a greater width but smaller depth.

Let’s modify the input slightly:

[10, 20], [15, 10], [16, 18], [17, 25], [20, 30]

We can’t use the first box, because it rules out boxes number two and three, leading to only 3 boxes stacked in each other. Starting from the second box, though, allows us to stack 4 boxes. And you can imagine this can happen many times in the sequence. In fact, this seems almost like a longest common subsequence problem, which is NP-hard.

Fortunately, it’s not that bad. I proceeded in steps: in each step, I took all the possible sequences of a given length, and tried to extend them by one box.

sub arrange_box(@boxes) {
    my @s = map $_->[1],
        sort { $a->[0] <=> $b->[0] || $b->[1] <=> $a->[1] }
        @boxes;
    my %paths;
    @paths{0 .. $#s} = ();
    my $max_length = 0;
    my $length = 0;
    my $change = 1;
    while ($change) {
        ++$length;
        undef $change;
        for my $path (keys %paths) {
            delete $paths{$path};
            $max_length = $length if $length > $max_length;
            my $last = (split ' ', $path)[-1];
            for my $next ($last + 1 .. $#s) {
                next if exists $paths{"$path $next"}
                     || $s[$next] <= $s[$last];

                undef $paths{"$path $next"};
                $change = 1;
            }
        }
    }
    return $max_length
}

Note that we only work with the depths (see the map at the beginning of the subroutine). We know that widths are already sorted, and if there are several boxes of the same width, they are sorted by their depth in descending order, so we’ll never try two boxes of the same width in the same sequence: $s[$following] is never greater than $s[$box] for the boxes of the same $width.

For a randomly generated list of 100 boxes, the number of possible sequences of length 8 can easily reach 2.5×10⁶ (try adding warn scalar keys %path; at the beginning of the while loop). It’s slow and consumes a lot of memory.

Fortunately, we don’t really need to remember the whole sequences. We are interested in their lengths—and in each step, we build all the sequences of the same length. The only information we actually need is the last element of each sequence. This leads to the following code:

sub arrange_box(@boxes) {
    my @s = map $_->[1],
        sort { $a->[0] <=> $b->[0] || $b->[1] <=> $a->[1] }
        @boxes;
    my %last;
    @last{0 .. $#s} = ();
    my $length = 0;
    while (keys %last) {
        my %next;
        ++$length;
        for my $box (keys %last) {
            for my $following ($box + 1 .. $#s) {
                undef $next{$following} if $s[$box] < $s[$following];
            }
        }
        %last = %next;
    }
    return $length
}

There’s never more last elements of all the sequences than the number of boxes. Finding the solution for a list of 1000 boxes takes about a second on my old machine.