Levels.hs

-- |
-- Module      : Control.Monad.Levels
-- Copyright   : Sebastian Fischer
-- License     : PublicDomain
-- 
-- Maintainer  : Sebastian Fischer (sebf@informatik.uni-kiel.de)
-- Stability   : experimental
-- Portability : portable
-- 
-- This library provides an implementation of the MonadPlus type class
-- that enumerates the levels of the search space and allows to
-- implement breadth-first search and iterative deepening depth-first
-- search.
-- 
-- The implementation is inspired by Mike Spivey and Silvija Seres:
-- see Chapter 9 of the book 'The Fun of Programming' and the paper
-- 'Algebras for Combinatorial Search'.
-- 
-- The implementation of breadth-first search is similar to the
-- inspiring implementation but uses lists with constant-time
-- concatenation to represent levels. The implementation of iterative
-- deepening depth-first is simpler than the inspiring implementation
-- thanks to the use of a continuation monad.
module Control.Monad.Levels ( bfs, idfs, idfsBy ) where

import Data.Monoid
import Data.FMList


-- | The function @bfs@ enumerates the results of a non-deterministic
-- computation using breadth-first search. The implementation does not
-- guarantee that results are returned in any specific order but it
-- does guarantee that every result is eventually enumerated. Due to
-- the large memory requirements of breadth-first search you should
-- use @idfs@ for expensive search.
bfs :: FMList a -> [a]
bfs a = runLevels (unFM a yield)
 where yield x = Levels [singleton x]

-- Non-Deterministic computations of type @Levels a@ can be searched
-- level-wise.
newtype Levels a = Levels { levels :: [FMList a] }

-- Concatenates levels amd yields result as list. 
runLevels :: Levels a -> [a]
runLevels = toList . foldr append empty . levels

instance Monoid (Levels a) where
  mempty        = Levels []
  a `mappend` b = Levels (empty : merge (levels a) (levels b))

-- like 'zipWith append' without cutting the longer list
merge :: [FMList a] -> [FMList a] -> [FMList a]
merge []      ys    = ys
merge xs      []    = xs
merge (x:xs) (y:ys) = append x y : merge xs ys

-- | The function @idfs@ computes the levels of a depth bound
-- computation using iterative deepening depth-first search. Unlike
-- breadth-first search it runs in constant space but usually takes a
-- bit longer, depending on how the depth limit is increased. Use
-- @idfsBy@ to control this. Don't use this algorithm if you know that
-- there is only a finite number of results because it will continue
-- trying larger depth limits without recognizing that there are no
-- more solutions.  It can, however, produce results lazily: calling
-- @take n . idfs@ terminates if the number of results is larger than
-- @n@.
idfs :: FMList a -> [a]
idfs = idfsBy 100

-- | The function @idfsBy@ computes the levels of a depth bound
-- computation using iterative deepening depth-first search
-- incrementing the depth limit between searches using the given
-- number of steps.
idfsBy :: Int -> FMList a -> [a]
idfsBy n a = toList $ foldr append empty [ unFM a yield ! d | d <- [0,n..] ]
 where yield x = DepthBound (\d -> if d<n then singleton x else empty)

-- The type @DepthBound@ represents computations with a bounded depth
-- to iterative deepening search.
newtype DepthBound a = DepthBound { (!) :: Int -> FMList a }

instance Monoid (DepthBound a) where
  mempty        = DepthBound (const empty)
  a `mappend` b = DepthBound (\d -> if d==0 then empty
                                    else append (a!(d-1)) (b!(d-1)))