
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.