{-------------------------------------------------------------------------
This module contains the implementation of different search strategies.

All these strategies assume a description of the search problem
using the "Incremental Solution" pattern, i.e., it is specified
how a partial solution can be extended in one step to a more
complete solution. Thus, a search problem is specified by the
following parameters:

* partsol:
  the type of all partial solutions

* extend :: partsol -> partsol :
  a (typically non-deterministic) function assigning to a partial solution
  all more complete solutions

* initial :: partsol :
  an initial partial solution to start the search

* solved :: partsol -> Bool :
  a predicate specifying whether a partial solution is a complete solution

-------------------------------------------------------------------------}

--import SetRBT

-------------------------------------------------------------------------
-- Non-deterministic search strategy:
-- a solution is computed in a don't-know nondeterministic way

searchNonDet :: (partsol->partsol) -> partsol -> (partsol->Bool) -> partsol
searchNonDet extend initial solved = solve initial
 where
   solve psol = if solved psol then psol
                               else solve (extend psol)


------------------------------------------------------------------------
-- Depth-first search strategy:
-- based on a depth-first traversal of the tree of all partial solutions

searchDepthFirst :: (partsol->partsol) -> partsol -> (partsol->Bool) -> [partsol]
searchDepthFirst extend initial solved = solve [initial]
 where

   solve []       = []
   solve (st:sts) = if solved st
                      then st : solve sts
                      else solve (expand (st:sts))

   nextstates st = findall \x -> extend st =:= x

   expand (st:sts) = nextstates st ++ sts


------------------------------------------------------------------------
-- Depth-first search strategy without searching equivalent solutions:
--
-- Similar to depth-first search but with an additional argument:
-- a predicate (equiv :: partsol -> partsol -> Bool)
-- where (equiv s1 s2) is true if s1 is equivalent to s2 so that
-- one of the partial solutions need not to be considered in the
-- further search.
--
-- This strategy is useful if the search space might contain cycles.

searchDepthFirstNoEquiv :: (partsol->partsol) -> partsol -> (partsol->Bool)
                             -> (partsol->partsol->Bool) -> [partsol]
searchDepthFirstNoEquiv extend initial solved equiv = solve ([initial],[])
 where

   solve ([],_) = []
   solve (st:sts,old) = if solved st
                          then st : solve (sts,old)
                          else solve (expand (st:sts) old)

   nextstates st old = findall \x -> extend st =:= x
                                     & (any (equiv x) old) =:= False

   expand (st:sts) old = (nextstates st old ++ sts, st:old)


------------------------------------------------------------------------
-- Breadth-first search strategy:
-- based on a breadth-first traversal of the tree of all partial solutions

searchBreadthFirst :: (partsol->partsol) -> partsol -> (partsol->Bool) -> [partsol]
searchBreadthFirst extend initial solved = solve [initial]
 where

   solve []       = []
   solve (st:sts) = if solved st
                      then st : solve sts
                      else solve (expand (st:sts))

   nextstates st = findall \x -> extend st =:= x

   expand (st:sts) = sts ++ nextstates st


------------------------------------------------------------------------
-- Best-first search strategy:
--
-- Based on the traversal of the tree of all partial solutions in a
-- best-first manner. This requires an additional argument:
-- a predicate (betterThan :: partsol -> partsol -> Bool)
-- where (betterThan s1 s2) is true if s1 is a better solution than s2

-- The difference to depth-first or breadth-first is that all
-- elements examined so far are kept in order so that the first one
-- is the currently best one.

-- main function for best-first search:
searchBestFirst :: (partsol->partsol) -> partsol ->
                   (partsol->Bool) -> (partsol->partsol->Bool) -> [partsol]
searchBestFirst extend initial solved betterThan = solve [initial]
 where

   solve []       = []
   solve (st:sts) = if solved st
                      then st : solve sts
                      else solve (expand (st:sts))

   nextstates st = findall \x -> extend st =:= x

   expand (st:sts) = merge (sort (nextstates st)) sts
     where sort = sortRBT betterThan

   merge []         sts        = sts
   merge (st:sts)   []         = st:sts
   merge (st1:sts1) (st2:sts2) =
     if betterThan st1 st2 then st1 : merge sts1 (st2:sts2)
                           else st2 : merge (st1:sts1) sts2


------------------------------------------------------------------------
-- Best-first search strategy without redundancies:
--
-- Similar to best-first search but with an additional argument:
-- a predicate (equiv :: partsol -> partsol -> Bool)
-- where (equiv s1 s2) is true if s1 is equivalent to s2 so that
-- one of the partial solutions need not to be considered in the
-- further search

-- As an auxiliary data structure we use the frontier of the
-- search tree and all old partial solutions examined so far.
-- All the states in the Frontier are sorted so that the first one
-- is the currently best one
data FrontierOld partsol = FrontierOld [partsol] [partsol]

-- main function for best-first search without redundancies:
searchBestFirstNoEquiv :: (partsol->partsol) -> partsol -> (partsol->Bool) ->
                          (partsol->partsol->Bool) ->
                          (partsol->partsol->Bool) -> [partsol]
searchBestFirstNoEquiv extend initial solved betterThan equiv =
   solve (FrontierOld [initial] [])
 where

   solve (FrontierOld [] _) = []
   solve (FrontierOld (st:sts) old) =
        if solved st then st : solve (FrontierOld sts old)
                     else solve (expand (FrontierOld (st:sts) old))

   nextstates st old = findall \x -> extend st =:= x
                                     & (any (equiv x) old) =:= False

   expand (FrontierOld (st:sts) old) =
       FrontierOld (merge (sort (nextstates st old)) sts) (st:old)
     where sort = sortRBT betterThan

   merge []         sts        = sts
   merge (st:sts)   []         = st:sts
   merge (st1:sts1) (st2:sts2) =
     if betterThan st1 st2 then st1 : merge sts1 (st2:sts2)
                           else st2 : merge (st1:sts1) sts2


-- end of search strategies for incremental solution pattern