9.7 A circus is designing a tower routine consisting of people
standing atop one another's shoulders. For practical and aesthetic
reasons, each person must be both shorter and lighter than the person
below him or her. Given the heights and weights of each person in
the circus, write a method to compute the largest possible number of
people in such a tower.
EXAMPLE:
Input (ht, wt): (65, 100) (70, 150) (56, 90) (75, 190) (60, 95)
(68, 110)
Output: The longest tower is length 6 and includes from top to bottom:
(56, 90) (60,95) (65,100) (68,110) (70,150) (75,190)

The provided solution is written in Java and seems far too verbose for such a simple problem.

For contrast, here’s one way to solve it in Haskell:

Model a person by an algebraic data type. The compiler is smart enough to work out the instances for Eq, Ord, and Show for us. The Ord instance works as if we had defined the person as a tuple of ints.

> data Person = Person Int Int deriving (Eq, Ord, Show)

A valid list of people must satisfy the property that each person is strictly less than the person next in the list. We can check this by pattern matching on the list. If there are two people p1, p2, then the list is valid if p1 < p2 and the remaining list is also valid. Other cases (the empty list or a list with a single person) are valid by definition.

*Circus> validSeries [Person 100 65, Person 150 80]
True
*Circus> validSeries [Person 100 65, Person 150 80, Person 140 70]
False

Given a sorted list of people, we are interested in the longest valid sequence from the start of the list. The inits function provides all initial lists:

*Circus> inits [Person 100 65, Person 150 80, Person 140 70]
[
[],
[Person 100 65],
[Person 100 65, Person 150 80],
[Person 100 65, Person 150 80, Person 140 70]
]

So we want to keep taking elements from inits of our list of people, while the list is a valid series. The takeWhile function does, taking a boolean predicate as its first argument. Finally, we want the longest such list, so we take the last element which is the longest one.

To me this is easier to read than the rough equivalent in Java, which involves some gnarly loops and a return value that encodes detail by returning the value of startFrom when the loop doesn’t have enough items to consume:

int fillNextSeq(int startFrom, ArrayList seq) {
int firstUnfitItem = startFrom;
if (startFrom < items.size()) {
for (int i = 0; i < items.size(); i++) {
HtWt item = items.get(i);
if (i == 0 || items.get(i-1).isBefore(item)) {
seq.add(item);
} else {
firstUnfitItem = i;
}
}
}
return firstUnfitItem;
}

Not my cup of tea!

Finally, to find the solution we find the longest sequence by sorting the input and looking for the longest sequence from the initial sequence and those in any later lists:

But soln0 has a bug – an unhandled case. Can you spot it?

Let’s write an instance for Arbitrary so that we can use QuickCheck.

> instance Arbitrary Person where
> arbitrary = Person pos1 pos2
> where pos1 = getPositive arbitrary
> pos2 = getPositive arbitrary

We have used getPositive from Test.QuickCheck.Modifiers because a person cannot have negative height or weight.

One property that we can check is that the solution does not change even if we reverse the input list. (We’d expect this to hold because we sort the list before looking for longest strictly increasing sequences.) Here is a function to check this property:

Perhaps we should have used a Safe variant of maximumBy. In any case, we have to handle the situation where the result is an empty list:

> soln :: [Person] -> [Person]
> soln px = if result == [] then [] else maximumBy (compare `on` length) result
> where
> result = findLongestSeq $ sort px

This definition appears to be correct, and passes all of the following tests:

> -- No change if we reverse the input list:
> qc_soln_1 = quickCheck (pl -> soln pl == soln (reverse pl))
>
> -- Computing the solution of the solution is identical to the solution:
> qc_soln_2 = quickCheck (pl -> soln pl == (soln . soln) pl)
>
> -- Computing the solution of the solution of the solution is idential to the original solution:
> qc_soln_3 = quickCheck (pl -> soln pl == (soln . soln . soln) pl)
>
> -- The length of the solution is not longer than the input:
> qc_soln_4 = quickCheck (pl -> length (soln pl)
> -- A solution can be extended in a valid way, and solving on that input gives an
> -- answer of length (original solution) + 1:
> qc_soln_5 = quickCheck (pl -> let pl' = extendByOne (soln pl) in length pl' == length (soln pl) + 1)
> where
> extendByOne :: [Person] -> [Person]
> extendByOne [] = [Person 1 1]
> extendByOne ps = ps ++ [Person (h + 1) (w + 1)]
> where
> Person h w = last ps
>
> -- Extending the input with a duplicate value gives a solution that is never longer
> -- than the original solution:
> qc_soln_6 = quickCheck (pl -> length (soln pl) >= length (soln $ extendWithDup pl))
> where
> extendWithDup :: [Person] -> [Person]
> extendWithDup [] = []
> extendWithDup ps = ps ++ [last ps]

This is a fairly basic use of QuickCheck. For more detail about its background and some examples from the Erlang version of the library, check out this talk by John Hughes: