[Haskell-cafe] combinatorial search with running bound
Michael Mossey
mpm at alumni.caltech.edu
Sat Sep 26 16:42:36 EDT 2009
I have a combinatorial search problem that requires a
running lower bound to be tracked in order to prune the search. I have enough
Haskell experience to know how to do a combinatorial search, for example with
list compresions or the list monad, but I don't know how to keep a running
lower bound.
The problem is: I have two groups of boxes, and need to figure out how
closely the centers of the groups can be brought left-right.
For example,
55
11111 55
11111
44
22 44
22 + <- how close? -> +
33333 6666
33333 6666
33333
The left group consists of boxes 1, 2, and 3, which have both a size and
a position (the position is relative to the center of the group,
represented with the +). The right group has boxes 4, 5, and 6.
The problem is to determine how closely the groups can be brought together
without any boxes intersection.
The basic algorithm is to consider each pair of boxes and ask if they
have any "vertical overlap"---if so, figure out how closely they can be
brought together without intersecting, otherwise ignore them. Then take
the maximum of those numbers.
-- (Here assume lrSeparation returns minBound for boxes that don't have
-- vertical intersection.)
boxesSep :: [Box] -> [Box] -> Int
boxesSep lefts rights =
maximum [ lrSeparation l r | l <- lefts, r <- rights ]
However, this algorithm can be improved by pruning.
- Define the 'left extent' of a box by how far its left edge sticks out to
the left of the group center. Similarly the 'right extent'.
- Sort the list of left boxes in the order of decreasing right extent.
Sort the list of right boxes in order of decreasing left extent.
- Consider pairs of boxes as a kind of outer loop on the left boxes, and
inner loop on the right boxes.
- Track the current maximum required separation, which is a lower bound
on the final answer.
- If at any point in the inner loop, the right extent has gotten so small
that there's no way you could find a new maximum, skip the rest of the
inner loop (skip the remainder of the right boxes).
Here's my attempt to write this using a state monad. There's probably a more
idiomatic way to do it.
-- This is state used in the state monad.
data SearchState = SearchState { -- running maximum:
ssMaximum :: Int
-- remember the full list of right boxes
-- so we can initiate a new outer loop
, ssRights :: [Box]
}
boxesSep2 :: [Box] -> [Box] -> Int
boxesSep2 lefts rights =
let ls = sortBy ((flip compare) `on` rightExtent) lefts
rs = sortBy ((flip compare) `on` leftExtent) rights
in fst $ runState (boxesSep2' ls rs) (SearchState minBound rs)
boxesSep2' :: [BoxBounds] -> [BoxBounds] -> State SearchState Int
-- Termination of algorithm:
boxesSep2' [] _ = gets ssMaximum
-- Initiate a new inner loop:
boxesSep2' (l:ls) [] = do
rights <- gets ssRights
boxesSep' ls rights
-- Common case:
boxesSep2' lss@(l:ls) (r:rs) = do
-- In this way of writing the code, we distinguish between the
-- left/right separation which is the sum of the extents, and the
-- question of whether there is vertical overlap.
let v = isVerticalOverlap l r
sep = lrSeparation l r
ss <- get
let max = ssMaximum ss
if sep <= max
then boxesSep' ls (ssRights ss) --Here we "prune" (initiate new inner
loop)
else do
-- Update max is needed:
when v (put ss { ssMaximum = sep })
boxesSep' lss rs
So if there is a better way to do this, I'm all ears.
More information about the Haskell-Cafe
mailing list