[Haskell-cafe] ANN: ListTree 0.1

yairchu at gmail.com yairchu at gmail.com
Sun Sep 27 14:12:42 EDT 2009


Hi,
I am pleased to announce the release of ListTree.
ListTree is a package for combinatorial search and pruning of trees,
and should be useful for problems such as those in Google Code Jam
(where I, and possibly others* could make use of it), but possibly
could even be useful for real applications!

It offers BFS, DFS, Best-First-Search, Branch-And-Bound pruning, and
more.

The trees it works on are not those from Data.Tree, but rather monadic
lists of a list monad (ListT []), which is an alternative that has the
advantages of working with standard MonadPlus or List operations like
takeWhile etc, and where consumption is a monadic action, which allows
keeping state required for branch-and-bound (the bound) etc.

This would be best explained with an example.
Google Code Jam 2009 Round 2 Problem C:
Given the prices at 25 time points for 16 stocks (in the small input),
split the stocks into several groups, where in each group, the line-
plots of its stocks' prices do not intersect or touch.
Your mission is to find the minimum number of groups necessary.

I will present an inefficient (best one I could come up with during
the compo) solution that can solve their small input (it cannot solve
the large input of a 100 stocks):
* Search the space of all possible splits into groups of the stocks
* Prune this search by cutting branches where the plots of two stocks
in the same group intersect
* Use "Branch and Bound". For each node, calculate a lower and upper
bound. Lower bound is number of groups so far, and large bound is
number of groups plus number of remaining items to place in group
(each one may require a new group). Keep the lowest upper bound
encountered, and prune all subtrees
with a lower bound larger or equal to it.
Code for this solution below.

Using ListTree, the code is as modular as the algorithm description
above, and there's a function to perform branch-and-bound.

One problem with my package (which I'll attempt fixing), however, is
speed. I haven't used it during the competition, and the quick and
dirty, less modular code, that I coded in the competition, which
performs exactly the same algorithm, runs a 100 times faster! Both are
fast enough, but this is still troubling.
I guess I should look into "Stream Fusion" to try and make my package
faster.

And the example's code below:

import Control.Monad.Identity
import Control.Monad.ListT -- from "List", not mtl
import Control.Monad.State
import Control.Monad.Trans
import Data.Array
import Data.List.Class (cons, execute)
import Data.List.Tree
import Data.Maybe

-- search tree for all possible splits to separate groups
-- each node has the same groups of its parent with a new element
added to a group
-- or as the sole element of a new group
-- the new element is the first element of the first group
searchTree :: [a] -> [[a]] -> ListT [] [[a]]
searchTree [] groups = return groups
searchTree (x : xs) groups = do
  i <- lift [0 .. length groups]
  let
    (pre, group : post) = splitAt i ([] : groups)
    cur = (x : group) : dropWhile null (pre ++ post)
  cons groups $ searchTree xs cur

getWords :: Read a => IO [a]
getWords = fmap (map read . words) getLine

main :: IO ()
main = do
  numCases <- readLn :: IO Int
  forM_ [1..numCases] $ \i -> do
    [n, _] <- getWords
    stocks <- replicateM n getWords :: IO [[Int]]
    let
      friends = listArray rng . map isFriends . range $ rng
      rng = ((0, 0), (n-1, n-1))
      isFriends (a, b) = f (>) a b || f (<) a b
      f op a b = and $ zipWith op (stocks !! a) (stocks !! b)
      res =
        fromJust . snd . runIdentity .
        (`runStateT` Nothing) .
        execute . execute .
        branchAndBound bnds .
        prune p $
        searchTree [0 .. n-1] []
      p ((x : xs) : _) = all ((friends !) . ((,) x)) xs
      p _ = True
      bnds [] = (Just 0, Just n)
      bnds groups =
        ( Just (length groups)
        , Just (length groups + n - 1 - head (head groups))
        )
    putStrLn $ "Case #" ++ show i ++ ": " ++ show res

* possibly others - currently only 2 out of the 500 "surviving"
contestants of codejam use Haskell (http://www.go-hero.net/jam/09/lang/
Haskell). so by others I mean Reid from the US. Good luck Reid!


More information about the Haskell-Cafe mailing list