abhin4v/rubyquiz
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Modified AStar to take a nextNode function instead of using a typeclass

Browse Source
This commit is contained in:
Abhinav Sarkar 2012-08-31 13:30:28 +05:30
parent 42c8b7db80
commit c8eaa78c82
2 changed files with 23 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
AStar.hs
View File

@ -8,15 +8,10 @@ import qualified Data.Map as M
import Data.List (foldl') import Data.List (foldl')
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
-- A node in the search
class (Ord a, Ord b, Num b, Bounded b) => SearchNode a b where
-- get the next search node and the cost to reach to it from the current node
nextNode :: a -> [(a, b)]
-- A* algorithm: Find a path from initial node to goal node using a heuristic function. -- A* algorithm: Find a path from initial node to goal node using a heuristic function.
-- Returns Nothing if no path found. Else returns Just (path cost, path). -- Returns Nothing if no path found. Else returns Just (path cost, path).
astar :: SearchNode a b => a -> a -> (a -> a -> b) -> Maybe (b, [a]) astar :: (Ord a, Ord b, Num b) => a -> a -> (a -> [(a, b)]) -> (a -> a -> b) -> Maybe (b, [a])
astar initNode goalNode hueristic = astar initNode goalNode nextNode hueristic =
astar' (PQ.singleton (hueristic initNode goalNode) (initNode, 0)) astar' (PQ.singleton (hueristic initNode goalNode) (initNode, 0))
S.empty (M.singleton initNode 0) M.empty S.empty (M.singleton initNode 0) M.empty
where where
@ -42,9 +37,11 @@ astar initNode goalNode hueristic =
-- Find the successors (with their g and h costs) of the node -- Find the successors (with their g and h costs) of the node
-- which have not been seen yet -- which have not been seen yet
successors = filter (\(s, g, _) -> successors =
filter (\(s, g, _) ->
not (S.member s seen') && not (S.member s seen') &&
g < M.findWithDefault maxBound s gscore) (not (s `M.member` gscore)
|| g < (fromJust . M.lookup s $ gscore)))
$ successorsAndCosts node gcost $ successorsAndCosts node gcost
-- Insert the successors in the open set -- Insert the successors in the open set

11
KnightsTravails.hs
View File

@ -50,11 +50,9 @@ isValidNotation notation =
head notation `elem` ['a'..'h'], head notation `elem` ['a'..'h'],
last notation `elem` ['1'..'8']] last notation `elem` ['1'..'8']]
-- Makes Board an instance of SearchNode for astar to work -- Finds the next possible board configurations for one knight's move.
instance SearchNode Board Int where -- Move cost is one.
-- Finds the next possible board configurations for one knight's move. nextKnightPos board@(Board {..}) =
-- Move cost is one.
nextNode board@(Board {..}) =
zip zip
(map (\pos -> board { knightPos = pos }) (map (\pos -> board { knightPos = pos })
. filter isValidMove . filter isValidMove
@ -68,7 +66,8 @@ instance SearchNode Board Int where
knightAstar heuristic blockedSquares start target = knightAstar heuristic blockedSquares start target =
fmap (second (map knightPos)) fmap (second (map knightPos))
$ astar (Board start blockedSquares) (Board target blockedSquares) heuristic $ astar (Board start blockedSquares) (Board target blockedSquares)
nextKnightPos heuristic
-- Finds a path from a start square to an end square using BFS -- Finds a path from a start square to an end square using BFS
bfsSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square]) bfsSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square])