DEV Community

Bob Lied
Bob Lied

Posted on

PWC 391 Median Boxes

The first task asks us to combine sorted arrays and find the median, and the second asks us to combine boxes by stacking them inside each other. I feel the urge to merge.

Task 1: Array Median

The median is the middle point in a sorted list. Our musical selection should a couple of songs titled 'The Middle', one by Jimmy Eat World (warning, the video features a lot of people in underwear, probably NSFW), and the other by Zedd, Maren Morris, and Grey.

Task Description

You are given two sorted arrays. Write a script to merge the two given sorted arrays and return the median of the merged array.

  • Example 1: Input: @arr1 = (2), @arr2 = (4) Output: 3.0
  • Example 2: Input: @arr1 = (1,2,3), @arr2 = (7,8,9,10) Output: 7.0
  • Example 3: Input: @arr1 = (), @arr2 = (10,20,30,40) Output: 25.0
  • Example 4: Input: @arr1 = (100), @arr2 = (1,2,3,4,5,6,7) Output: 4.5
  • Example 5: Input: @arr1 = (1,2,2), @arr2 = (2,2,3) Output: 2.0

Task Solution

The obvious thing to do here is to sort the two arrays together and index into the middle of the combined array.

sub task1($arr1, $arr2)
{
    my @all = sort { $a <=> $b } $arr1->@*, $arr2->@*;
    if ( @all >= 1 )
    {
        if ( @all % 2 ) # Odd number of elements
        {
            return $all[ floor(@all/2) ];
        }
        else # Even number of elements
        {
            my $mid = @all / 2;
            return ($all[$mid] + $all[$mid-1]) / 2;
        }
    }
    else # No elements, two empty lists were given
    {
        return undef;
    }
}
Enter fullscreen mode Exit fullscreen mode

Another obvious thing to do is to use any of several modules that do statistics. Here are three possibilities. Each of them follows the pattern of loading the data into the module, and then invoking a median function on the loaded data.

sub task2($arr1, $arr2)
{
    return undef unless @$arr1 || @$arr2;
    use Statistics::Basic::Median;
    return 0+ Statistics::Basic::Median->new( sort { $arr1->@*, $arr2->@* );
}

sub task3($arr1, $arr2)
{
    return undef unless @$arr1 || @$arr2;
    use Statistics::Descriptive;
    my $stat = Statistics::Descriptive::Full->new;
    $stat->add_data( $arr1->@*, $arr2->@* );
    return $stat->median;
}

sub task4($arr1, $arr2)
{
    return undef unless @$arr1 || @$arr2;
    use PDL;
    my $data = pdl ( $arr1->@*, $arr2->@* );
    return median($data);
}
Enter fullscreen mode Exit fullscreen mode

All of these solutions have quite a bit of overhead because they require sorting the data. We are given that the arrays are already sorted individually, so there's a much more efficient solution: merge the arrays in one pass. And because we only want the midpoint, we don't even have to merge completely -- we can stop after we've reached the midpoint.

sub task($arr1, $arr2)
{
    return undef unless @$arr1 || @$arr2;

    # Make copies of arr1 and arr2 because we're going to destroy them
    my @a1 = $arr1->@*;
    my @a2 = $arr2->@*;

    my $length = @a1 + @a2;
    my $mid = floor($length / 2);
    my $isOdd = $length % 2;

    my @merged;

    while ( @a1 && @a2 && @merged <= $mid )
    {
        push @merged, ( $a1[0] < $a2[0] ? shift(@a1) : shift(@a2) );
    }

    # At this point, if we haven't merged enough elements to reach
    # the midpoint, then we've exhausted either a1 or a2. Add enough
    # elements to reach the midpoint.
    if ( @merged <= $mid )
    {
        my $toMidPoint = $mid - @merged;
        if   ( @a1 ) { push @merged, @a1[0 .. $toMidPoint] }
        else         { push @merged, @a2[0 .. $toMidPoint] }
    }

    return $isOdd ? $merged[$mid] : ( ($merged[$mid] + $merged[$mid-1]) / 2);
}
Enter fullscreen mode Exit fullscreen mode

Task Comparison

Are any of these significantly more efficient? Here's a benchmark result for the median of two 100-element arrays:

          Rate descr merge basic   diy
descr  38567/s    --  -49%  -54%  -83%
merge  75269/s   95%    --  -10%  -66%
basic  83832/s  117%   11%    --  -62%
diy   222222/s  476%  195%  165%    --
Enter fullscreen mode Exit fullscreen mode

Although I would have thought the merge would be quite good, the fastest solution appears to be the do-it-yourself sort. This is probably because, even though it starts with a sort, the underlying algorithm is merge sort. Because the individual arrays are already sorted, the merge sort will converge quickly, and in optimized compiled code instead of interpreted Perl.

Task 2: Arrange Boxes

Task Description

You are given an array of box dimensions. Write a script to determine the maximum number of these boxes that can fit inside each other in a single stack. For a box to fit inside another, it must be smaller in both dimensions.

  • Example 1:

    • Input: @boxes = ([1, 3], [3, 5], [6, 8], [2, 4])
    • Output: 4
    • Sort by width ascending: ([1, 3], [2, 4], [3, 5], [6, 8])
    • Extract heights: [3, 4, 5, 8]
    • [1, 3] -> [2, 4] -> [3, 5] -> [6, 8]
  • Example 2:

    • Input: @boxes = ([4, 5], [4, 6], [6, 7], [2, 3], [4, 3])
    • Output: 3
    • Sort by width ascending: ([2, 3], [4, 6], [4, 5], [4, 3], [6, 7])
    • Extract heights: (3, 6, 5, 3, 7)
    • [2, 3] -> [4, 5] -> [6, 7]
  • Example 3:

    • Input: @boxes = ([5, 5], [5, 5], [5, 5])
    • Output: 1
    • Sort by width ascending: ([5, 5], [5, 5], [5, 5])
    • Extract heights: (5, 5, 5)
    • [5, 5]
  • Example 4:

    • Input: @boxes = ([2, 100], [3, 200], [4, 300], [5, 50], [5, 400])
    • Output: 4
    • Sort by width ascending: ([2, 100], [3, 200], [4, 300], [5, 400], [5, 50])
    • Extract heights: (100, 200, 300, 400, 50)
    • [2, 100] -> [3, 200] -> [4, 300] -> [5, 400]
  • Example 5:

    • Input: @boxes = ([10, 20], [15, 10], [20, 30], [12, 18], [16, 25])
    • Output: 3
    • Sort by width ascending: ([10, 20], [12, 18], [15, 10], [16, 25], [20, 30])
    • Extract heights: (20, 18, 10, 25, 30)
    • [15, 10] -> [16, 25] -> [20, 30]

Task Solution

The examples hint very strongly that sorting by width and height could solve the problem, and indeed, for the examples, it does. I can't convince myself that my stacks won't be thwarted by long skinny boxes that sort into an inconvenient position. So I'm going to treat it as another search problem.

The task doesn't mention the possibilities of rotating boxes, nor of putting small boxes side-by-side in bigger boxes. So I'm not going to consider those possibilities.

Side Quest: A Box Class

I'm going to develop a small class around boxes, instead of depending on the convention of indexes 0 and 1 for width and height. It will add some readability to whether one box can be contained in another.

use feature 'class'; no warnings "experimental::class";

class Box {
    field $w : param(width)  :reader;
    field $h : param(height) :reader;

    method show() { "[$w x $h]" }
    use overload '""' => sub { $_[0]->show() };

    method canHold($other)
    {
        return $other->w < $w && $other->h < $h;
    }

}
Enter fullscreen mode Exit fullscreen mode

Notes:

  • I'm using Perl 5.44, so the class feature is available, but experimental. I don't want to see those warnings, thanks anyway.
  • The constructor will get height and width parameters, and the :reader attribute will create accessors.
  • For convenience in debugging, I want to be able to print a Box object easily. Overloading the string ("") operator will make a textual representation of the object whenever I interpolate a Box object reference in a string.
  • The most important method I need is to test whether one Box can contain another.

The Main Quest

Similar to last week, there'll be queue of possibilities to look at, and we'll try to extend each stack as far as we can.

I'll work from the outside in, starting with the biggest containers, and considering all the rest that might fit inside.

sub task(@boxes)
{
    return 0 unless @boxes;

    # Turn given size pairs into Box objects.
    my @box = map { Box->new(width => $_->[0], height => $_->[1]) } @boxes;

    my $biggest = 1;

    # Set up a todo list, where each item contains
    # the stack so far, and the possible boxes that
    # could still fit inside. To begin, any box can
    # potentially be the biggest container.
    my @todo = ();
    for my $b ( @box )
    {
        my $stack     = [ $b ]; # The outside container
        # Choose boxes that could fit inside
        my $available = [ grep { $b->canHold($_) } @box ];
        push @todo, [ $stack, $available ];
    }

    # Process the todo list, FIFO breadth-first
    while ( my $x = shift @todo )
    {
        my ($stack, $available) = $x->@*;

        $biggest = @$stack if ( @$stack > $biggest );

        # We can stop working on this stack if there
        # aren't enough boxes to improve on biggest
        next if ( @$available == 0 || @$stack + @$available) <= $biggest;

        for my $nextSmallerBox ( $available->@* )
        {
            push @todo, [ [ $stack->@*, $nextSmallerBox ],
                        [ grep { $nextSmallerBox->canHold($_) } $available->@* ],
                        ];
        }
    }
    return $biggest;
}
Enter fullscreen mode Exit fullscreen mode

Top comments (0)