-- |
-- 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.
-- 
-- The implementation is inspired by Mike Spivey and Silvija Seres:
-- cf. Chapter 9 of the book 'The Fun of Programming'. The
-- implementation of iterative deepening depth-first is, however,
-- significantly simpler thanks to the use of a continuation monad.
-- 
-- Warning: @Levels@ is only a monad when the results of the
-- enumeration functions are interpreted as a multiset, i.e., a valid
-- transformation according to the monad laws may change the order of
-- the results.

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 in breadth-first order.
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. 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.
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)))