Arrange box

You are given an array of 2-dimensional 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.

Examples

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]

Analysis

There are (at least) two ways to solve this challenge, one using recursion to build the compliant sets of boxes, and one using an optimised search through all possible sets. I chose the latter.

My first operation is to sort the boxes by increasing area. This ensures that a box can only fit into one that follows in the sequence, thus reducing the search area by 50%.

My next step is to create the hash %fits such that $fits{$i} =~ m|:$j:| if box $i fits in box $j.

I then generate every possible subsequence of boxes using a decreasing binary number to define the subsets. For example, if there are 4 boxes I start with 1111 to test all 4 boxes, then decrement the sequence to 1110 to test the sequence 1 -> 2 -> 3, and so on.

For each sequence, I can then use %fits to abandon the sequence immediately if any of its components cannot follow (ie is not larger in both dimensions than) its predecessor.

If a sequence survives all that, then it is the current winner and I save its length and make-up if its length is the longest seen so far.

Finally I report the overall winner.

Inevitably, this solution - and maybe any solution - will increase in execution time by about O(n²), and my 20 box example takes 28sec on my little Raspberry Pi. But in my defence, who has ever stacked more than 20 boxes?

Try it 

Your input:

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2026-09-14
use utf8;     # Week 391 - task 2 - Arrange box
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

arrange_box([1, 3], [3, 5], [6, 8], [2, 4]);
arrange_box([4, 5], [4, 6], [6, 7], [2, 3], [4, 3]);
arrange_box([5, 5], [5, 5], [5, 5]);
arrange_box([2, 100], [3, 200], [4, 300], [5, 50], [5, 400]);
arrange_box([10, 20], [15, 10], [20, 30], [12, 18], [16, 25]);
arrange_box([1, 3], [3, 5], [6, 8], [2, 4], [4, 5], 
    [4, 6], [6, 7], [2, 3], [4, 3], [8, 14],
    [2, 100], [3, 200], [4, 300], [5, 50], [5, 400],
    [10, 20], [15, 10], [20, 30], [12, 18], [16, 25]);

sub arrange_box {
    
    my ($input, @boxes, $i, $j, $z, %fits, $max_length, $mask, @path, 
        $best, $length);
    
    # report input
    @boxes = @_;
    $input .= qq{[$boxes[$_]->[0], $boxes[$_]->[1]], } 
        for 0 .. scalar $#boxes;
    say qq[\nInput: (] . substr($input, 0, -2) . ')';

    # sort boxes by increasing area
    @boxes = sort { ($a->[0] * $a->[1]) <=> ($b->[0] * $b->[1]) } @_;
    
    # box i fits into box j if $fits{$i} =~ m|:$j:|
    for $i (0 .. $#boxes - 1) {
        for $j ($i + 1 .. $#boxes) {
            if ($boxes[$i]->[0] < $boxes[$j]->[0] and 
                $boxes[$i]->[1] < $boxes[$j]->[1]) {
                $fits{$i} .= ":$j:";
            }
        }
    }
    
    # loop over possible paths
    $max_length = 0;
    M: for ($mask = (2 ** scalar @boxes) - 1; $mask > 0; $mask --) {
        
        # get one path
        @path = ();
        for $i (0 .. $#boxes) {
            push @path, $i if $mask & (2 ** $i);
        }
        
        # loop over boxes in path, quitting if one won't fit in next
        for $j (1 .. $#path) {
            next M unless defined $fits{$path[$j - 1]} and 
                $fits{$path[$j - 1]} =~ m|:$path[$j]:|;
        }

        # found a good path - but it is the best?
        $length = scalar @path;
        if ($length > $max_length) {
            $max_length = $length;
            $best = '';
            $best .= qq{[$boxes[$_]->[0], $boxes[$_]->[1]] -> } 
                for @path;
            $best = substr($best, 0, -4);
        }
    }

    # report
    say qq[Output: largest set = $max_length] . 
        ($max_length > 1 ? qq[: $best] : '');
}

30 lines of code

Output from script

Input: ([1, 3], [3, 5], [6, 8], [2, 4])
Output: largest set = 4: [1, 3] -> [2, 4] -> [3, 5] -> [6, 8]

Input: ([4, 5], [4, 6], [6, 7], [2, 3], [4, 3])
Output: largest set = 3: [2, 3] -> [4, 6] -> [6, 7]

Input: ([5, 5], [5, 5], [5, 5])
Output: largest set = 1

Input: ([2, 100], [3, 200], [4, 300], [5, 50], [5, 400])
Output: largest set = 4: [2, 100] -> [3, 200] -> [4, 300] -> [5, 400]

Input: ([10, 20], [15, 10], [20, 30], [12, 18], [16, 25])
Output: largest set = 3: [12, 18] -> [16, 25] -> [20, 30]

Input: ([1, 3], [3, 5], [6, 8], [2, 4], [4, 5], [4, 6], [6, 7], [2,
   3], [4, 3], [8, 14], [2, 100], [3, 200], [4, 300], [5, 50], [5,
   400], [10, 20], [15, 10], [20, 30], [12, 18], [16, 25])
Output: largest set = 9: [1, 3] -> [2, 4] -> [3, 5] -> [4, 6] -> [6,
   8] -> [8, 14] -> [12, 18] -> [16, 25] -> [20, 30]