search-algorithms-0.3.2: Common graph search algorithms
Safe HaskellSafe-Inferred
LanguageHaskell2010

Algorithm.Search

Description

This module contains a collection of generalized graph search algorithms, for when you don't want to explicitly represent your data as a graph. The general idea is to provide these algorithms with a way of generating "next" states, a way of generating associated information, a way of determining when you have found a solution, and an initial state.

Synopsis

Searches

bfs Source #

Arguments

:: (Foldable f, Ord state) 
=> (state -> f state)

Function to generate "next" states given a current state

-> (state -> Bool)

Predicate to determine if solution found. bfs returns a path to the first state for which this predicate returns True.

-> state

Initial state

-> Maybe [state]

First path found to a state matching the predicate, or Nothing if no such path exists.

bfs next found initial performs a breadth-first search over a set of states, starting with initial, and generating neighboring states with next. It returns a path to a state for which found returns True. Returns Nothing if no path is possible.

Example: Making change problem

>>> :{
countChange target = bfs (add_one_coin `pruning` (> target)) (== target) 0
  where
    add_one_coin amt = map (+ amt) coins
    coins = [25, 10, 5, 1]
:}
>>> countChange 67
Just [25,50,60,65,66,67]

dfs Source #

Arguments

:: (Foldable f, Ord state) 
=> (state -> f state)

Function to generate "next" states given a current state. These should be given in the order in which states should be pushed onto the stack, i.e. the "last" state in the Foldable will be the first one visited.

-> (state -> Bool)

Predicate to determine if solution found. dfs returns a path to the first state for which this predicate returns True.

-> state

Initial state

-> Maybe [state]

First path found to a state matching the predicate, or Nothing if no such path exists.

dfs next found initial performs a depth-first search over a set of states, starting with initial and generating neighboring states with next. It returns a depth-first path to a state for which found returns True. Returns Nothing if no path is possible.

Example: Simple directed graph search

>>> import qualified Data.Map as Map
>>> graph = Map.fromList [(1, [2, 3]), (2, [4]), (3, [4]), (4, [])]
>>> dfs (graph Map.!) (== 4) 1
Just [3,4]

dijkstra Source #

Arguments

:: (Foldable f, Num cost, Ord cost, Ord state) 
=> (state -> f state)

Function to generate list of neighboring states given the current state

-> (state -> state -> cost)

Function to generate transition costs between neighboring states. This is only called for adjacent states, so it is safe to have this function be partial for non-neighboring states.

-> (state -> Bool)

Predicate to determine if solution found. dijkstra returns the shortest path to the first state for which this predicate returns True.

-> state

Initial state

-> Maybe (cost, [state])

(Total cost, list of steps) for the first path found which satisfies the given predicate

dijkstra next cost found initial performs a shortest-path search over a set of states using Dijkstra's algorithm, starting with initial, generating neighboring states with next, and their incremental costs with costs. This will find the least-costly path from an initial state to a state for which found returns True. Returns Nothing if no path to a solved state is possible.

Example: Making change problem, with a twist

>>> :{
-- Twist: dimes have a face value of 10 cents, but are actually rare
-- misprints which are worth 10 dollars
countChange target =
  dijkstra (add_coin `pruning` (> target)) true_cost  (== target) 0
  where
    coin_values = [(25, 25), (10, 1000), (5, 5), (1, 1)]
    add_coin amt = map ((+ amt) . snd) coin_values
    true_cost low high =
      case lookup (high - low) coin_values of
        Just val -> val
        Nothing -> error $ "invalid costs: " ++ show high ++ ", " ++ show low
:}
>>> countChange 67
Just (67,[1,2,7,12,17,42,67])

dijkstraAssoc Source #

Arguments

:: (Num cost, Ord cost, Ord state) 
=> (state -> [(state, cost)])

function to generate list of neighboring states with associated transition costs given the current state

-> (state -> Bool)

Predicate to determine if solution found. dijkstraAssoc returns the shortest path to the first state for which this predicate returns True.

-> state

Initial state

-> Maybe (cost, [state])

(Total cost, list of steps) for the first path found which satisfies the given predicate

dijkstraAssoc next found initial performs a shortest-path search over a set of states using Dijkstra's algorithm, starting with initial, generating neighboring states with associated incremenal costs with next. This will find the least-costly path from an initial state to a state for which found returns True. Returns Nothing if no path to a solved state is possible.

aStar Source #

Arguments

:: (Foldable f, Num cost, Ord cost, Ord state) 
=> (state -> f state)

Function to generate list of neighboring states given the current state

-> (state -> state -> cost)

Function to generate transition costs between neighboring states. This is only called for adjacent states, so it is safe to have this function be partial for non-neighboring states.

-> (state -> cost)

Estimate on remaining cost given a state

-> (state -> Bool)

Predicate to determine if solution found. aStar returns the shortest path to the first state for which this predicate returns True.

-> state

Initial state

-> Maybe (cost, [state])

(Total cost, list of steps) for the first path found which satisfies the given predicate

aStar next cost remaining found initial performs a best-first search using the A* search algorithm, starting with the state initial, generating neighboring states with next, their cost with cost, and an estimate of the remaining cost with remaining. This returns a path to a state for which found returns True. If remaining is strictly a lower bound on the remaining cost to reach a solved state, then the returned path is the shortest path. Returns Nothing if no path to a solved state is possible.

Example: Path finding in taxicab geometry

>>> :{
neighbors (x, y) = [(x, y + 1), (x - 1, y), (x + 1, y), (x, y - 1)]
dist (x1, y1) (x2, y2) = abs (y2 - y1) + abs (x2 - x1)
start = (0, 0)
end = (0, 2)
isWall = (== (0, 1))
:}
>>> aStar (neighbors `pruning` isWall) dist (dist end) (== end) start
Just (4,[(1,0),(1,1),(1,2),(0,2)])

aStarAssoc Source #

Arguments

:: (Num cost, Ord cost, Ord state) 
=> (state -> [(state, cost)])

function to generate list of neighboring states with associated transition costs given the current state

-> (state -> cost)

Estimate on remaining cost given a state

-> (state -> Bool)

Predicate to determine if solution found. aStar returns the shortest path to the first state for which this predicate returns True.

-> state

Initial state

-> Maybe (cost, [state])

(Total cost, list of steps) for the first path found which satisfies the given predicate

aStarAssoc next remaining found initial performs a best-first search using the A* search algorithm, starting with the state initial, generating neighboring states and their associated costs with next, and an estimate of the remaining cost with remaining. This returns a path to a state for which found returns True. If remaining is strictly a lower bound on the remaining cost to reach a solved state, then the returned path is the shortest path. Returns Nothing if no path to a solved state is possible.

Monadic Searches

Note that for all monadic searches, it is up to the user to ensure that side-effecting monads do not logically change the structure of the graph. For example, if the list of neighbors is being read from a file, the user must ensure that those values do not change between reads.

bfsM Source #

Arguments

:: (Monad m, Foldable f, Ord state) 
=> (state -> m (f state))

Function to generate "next" states given a current state

-> (state -> m Bool)

Predicate to determine if solution found. bfsM returns a path to the first state for which this predicate returns True.

-> state

Initial state

-> m (Maybe [state])

First path found to a state matching the predicate, or Nothing if no such path exists.

bfsM is a monadic version of bfs: it has support for monadic next and found parameters.

dfsM Source #

Arguments

:: (Monad m, Foldable f, Ord state) 
=> (state -> m (f state))

Function to generate "next" states given a current state

-> (state -> m Bool)

Predicate to determine if solution found. dfsM returns a path to the first state for which this predicate returns True.

-> state

Initial state

-> m (Maybe [state])

First path found to a state matching the predicate, or Nothing if no such path exists.

dfsM is a monadic version of dfs: it has support for monadic next and found parameters.

dijkstraM Source #

Arguments

:: (Monad m, Foldable f, Num cost, Ord cost, Ord state) 
=> (state -> m (f state))

Function to generate list of neighboring states given the current state

-> (state -> state -> m cost)

Function to generate list of costs between neighboring states. This is only called for adjacent states, so it is safe to have this function be partial for non-neighboring states.

-> (state -> m Bool)

Predicate to determine if solution found. dijkstraM returns the shortest path to the first state for which this predicate returns True.

-> state

Initial state

-> m (Maybe (cost, [state]))

(Total cost, list of steps) for the first path found which satisfies the given predicate

dijkstraM is a monadic version of dijkstra: it has support for monadic next, cost, and found parameters.

aStarM Source #

Arguments

:: (Monad m, Foldable f, Num cost, Ord cost, Ord state) 
=> (state -> m (f state))

Function which, when given the current state, produces a list whose elements are (incremental cost to reach neighboring state, estimate on remaining cost from said state, said state).

-> (state -> state -> m cost)

Function to generate list of costs between neighboring states. This is only called for adjacent states, so it is safe to have this function be partial for non-neighboring states.

-> (state -> m cost)

Estimate on remaining cost given a state

-> (state -> m Bool)

Predicate to determine if solution found. aStarM returns the shortest path to the first state for which this predicate returns True.

-> state

Initial state

-> m (Maybe (cost, [state]))

(Total cost, list of steps) for the first path found which satisfies the given predicate

aStarM is a monadic version of aStar: it has support for monadic next, cost, remaining, and found parameters.

Utility

incrementalCosts Source #

Arguments

:: (state -> state -> cost)

Function to generate list of costs between neighboring states. This is only called for adjacent states in the states list, so it is safe to have this function be partial for non-neighboring states.

-> [state]

A path, given as a list of adjacent states, along which to find the incremental costs

-> [cost]

List of incremental costs along given path

incrementalCosts cost_fn states gives a list of the incremental costs going from state to state along the path given in states, using the cost function given by cost_fn. Note that the paths returned by the searches in this module do not include the initial state, so if you want the incremental costs along a path returned by one of these searches, you want to use incrementalCosts cost_fn (initial : path).

Example: Getting incremental costs from dijkstra

>>> import Data.Maybe (fromJust)
>>> :{
cyclicWeightedGraph :: Map.Map Char [(Char, Int)]
cyclicWeightedGraph = Map.fromList [
  ('a', [('b', 1), ('c', 2)]),
  ('b', [('a', 1), ('c', 2), ('d', 5)]),
  ('c', [('a', 1), ('d', 2)]),
  ('d', [])
  ]
start = (0, 0)
end = (0, 2)
cost a b = fromJust . lookup b $ cyclicWeightedGraph Map.! a
:}
>>> incrementalCosts cost ['a', 'b', 'd']
[1,5]

incrementalCostsM Source #

Arguments

:: Monad m 
=> (state -> state -> m cost)

Function to generate list of costs between neighboring states. This is only called for adjacent states in the states list, so it is safe to have this function be partial for non-neighboring states.

-> [state]

A path, given as a list of adjacent states, along which to find the incremental costs

-> m [cost]

List of incremental costs along given path

incrementalCostsM is a monadic version of incrementalCosts: it has support for a monadic const_fn parameter.

pruning Source #

Arguments

:: Foldable f 
=> (a -> f a)

Function to generate next states

-> (a -> Bool)

Predicate to prune on

-> a -> [a]

Version of next which excludes elements satisfying predicate

next `pruning` predicate streams the elements generate by next into a list, removing elements which satisfy predicate. This is useful for the common case when you want to logically separate your search's next function from some way of determining when you've reached a dead end.

Example: Pruning a Set

>>> import qualified Data.Set as Set
>>> ((\x -> Set.fromList [0..x]) `pruning` even) 10
[1,3,5,7,9]

Example: depth-first search, avoiding certain nodes

>>> import qualified Data.Map as Map
>>> :{
graph = Map.fromList [
  ('a', ['b', 'c', 'd']),
  ('b', [undefined]),
  ('c', ['e']),
  ('d', [undefined]),
  ('e', [])
  ]
:}
>>> dfs ((graph Map.!) `pruning` (`elem` "bd")) (== 'e') 'a'
Just "ce"

pruningM Source #

Arguments

:: (Monad m, Foldable f) 
=> (a -> m (f a))

Function to generate next states

-> (a -> m Bool)

Predicate to prune on

-> a -> m [a]

Version of next which excludes elements satisfying predicate

pruningM is a monadic version of pruning: it has support for monadic next and predicate parameters