PWC 296 Matchstick Square

The Task

Perl Weekly Challenge 296 Task 2 asks us to imagine if sticks of various lengths can be manipulated so that they form a square.

You are given an array of integers, @ints.
Write a script to find if it is possible to make
one square using the sticks as in the given array
@ints where $ints[ì] is the length of ith stick.

• Example 1

  • Input: @ints = (1, 2, 2, 2, 1)
  • Output: true
    • Top: $ints[1] = 2
    • Bottom: $ints[2] = 2
    • Left: $ints[3] = 2
    • Right: $ints[0] and $ints[4] = 2

• Example 2

  • Input: @ints = (2, 2, 2, 4)
  • Output: false

• Example 3

  • Input: @ints = (2, 2, 2, 2, 4)
  • Output: false

• Example 4

  • Input: @ints = (3, 4, 1, 4, 3, 1)
  • Output: true

The Plan

A few things immediately jump out.

• There must be at least four sticks.
• To have four sides of equal length, the perimeter (which is the sum of the array) must be a multiple of four.
• Once we know the length of a side (perimeter/4, call it $s), all the sticks must be no longer than that.

That will weed out many piles of matchsticks.

What's left must somehow be able to make groups, each of which adds up to $s. One approach would be to find a group of $s, remove those, find another group, remove those, and so on, four times (although the fourth time should be really easy). Creating all possible partitions of the @ints array seems daunting.

Another way of looking at the problem is that we want to find a path through the possible connections of sticks that adds up to the perimeter, but along the way we need to pass through points where the distance is $s, then through 2*$s, then through 3*$s, and finally to 4*$s. Whether we can reach 4*$s will be the answer to whether we can form a square.

This is a classic computer science problem: find a path to a given endpoint in a graph. The classic computer science solution is a depth-first search. The twist is that the end-point keeps moving.

The Code

Since we'll be implementing a depth-first search, I suggest that our musical accompaniment should be How Far We've Come by Matchbox 20.

Let's begin by discarding any sets of integers that can't possibly work.

sub canSquare(@ints)
{
    return false if @ints < 4;
    my $perimeter = sum0(@ints);
    return false unless $perimeter && ($perimeter % 4) == 0;
    my $side = $perimeter / 4;

    # If any piece is too long, can't make a square of it.
    return false if any { $_ > $side } @ints;
  [ . . . ]

For depth-first search, we'll need a stack. Each time we try something, we'll add up the distance traveled so far, remove that stick from the possibilities, and put the rest on the stack to come back to.

Our search also requires a target for an end-point. There'll be a current target for intermediate points, and a list of such points. Here's the search setup.

    my $currentTarget = $side;
    my @target = ( 2*$side, 3*$side, 4*$side );

    my $isSquare = false;
    my @stack = ( [ 0, [ @ints ] ] );
    SIDE: while ( my $next = pop @stack )
    {
        my ($len, $avail) = $next->@*;

        if ( not defined $currentTarget )
        {
            $isSquare = true if @$avail == 0;
            last SIDE;
        }

The elements on the stack are a pair of things: the length we've reached so far, and the set of sticks available to choose from (as an array reference). The first thing on the stack is that we've done nothing: the length is 0, the available set is all of @ints.

Every time we reach our current target, we'll take the next target out of the @target array. When we've reached all the targets, then we're done, so that's a condition for ending the search. I've used a statement label (SIDE:) to be cute for readability. Don't worry, no goto lurking here.

What's left is to try each one of our possible sticks from the $avail array. If it makes the side too long, we can discard it; otherwise, we'll take the stick out of the available set and push the remaining possibilities onto the stack. If it completes a side, we'll update the target.

    while ( . . . ) {
        [ . . . from above . . . ]
        for my ($i, $m) ( indexed $avail->@* )
        {
            my $length = $len + $m;
            next if $length > $currentTarget;

            my @copy = $avail->@*;
            splice(@copy, $i, 1);
            push @stack, [ $length, [ @copy ] ];

            if ( $length == $currentTarget )
            {
                # Completed a side
                $currentTarget = shift @target;
                last;
            }
        }
    }
    return $isSquare;

Perl notes:

• indexed $avail->@* -- indexed conveniently gives both the index and the array element at the same time.
• my @copy = $avail->@* -- Each time we put a set of available sticks on the stack, we have to be careful that we operate on a different set.
• splice(@copy, $i, 1) -- Removes the stick we already added to length so that we stop considering it.
• push @stack, [ $length, [ @copy ] ] -- Placing @copy inside square brackets makes the thing on the stack an array reference, and keeps the contents of @copy around after it goes out of scope at the end of the for block.

One thing that worried me a bit about this is that I'm not doing a complete depth-first search. After I reach $side, there will be no back-tracking to see if there are other ways to reach that sum. I believe it works anyway because, if we really have a square, when we find any $side, that must be one of the partitions of the square -- backtracking would just find a different partition, that we would hit in a subsequent target.

Complete code is in GitHub.