abhin4v
/
russel-norvig-ai-problems
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added comments

This commit is contained in:
Abhinav Sarkar 2012-01-10 01:25:14 +05:30
parent b8c9faf798
commit 3108bc9aad
1 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
chapter4/SlidingPuzzle.hs
View File

@ -1,3 +1,6 @@
-- Solves the sliding puzzle problem (http://en.wikipedia.org/wiki/Sliding_puzzle)
-- using A* algorithm
import Data.Ix import Data.Ix
import Data.Array import Data.Array
import Data.List import Data.List
@ -31,7 +34,7 @@ type Cost = Int
class Eq a => GameState a where class Eq a => GameState a where
succs :: a -> [(a, Cost)] succs :: a -> [(a, Cost)]
-- A* algorithm: Find a path from initialState to goalState using heuristic -- A* algorithm: Find a path from initial state to goal state using heuristic
astar :: (GameState a, Show a, Ord a) => a -> a -> (a -> a -> Cost) -> [a] astar :: (GameState a, Show a, Ord a) => a -> a -> (a -> a -> Cost) -> [a]
astar initState goalState hueristic = astar initState goalState hueristic =
astar' (PQ.singleton (hueristic initState goalState) (initState, 0)) S.empty M.empty astar' (PQ.singleton (hueristic initState goalState) (initState, 0)) S.empty M.empty
@ -163,8 +166,8 @@ puzzlePairty pz =
i = inversions pz i = inversions pz
b = fst . blankPos $ pz b = fst . blankPos $ pz
-- Solves an n sliding puzzle from initState to goalState using heuristic. -- Solves a sliding puzzle from initial state to goal state using the given heuristic.
-- Return Nothing if the goalState is not reachable from initState -- Return Nothing if the goal state is not reachable from initial state
-- else returns Just solution. -- else returns Just solution.
solvePuzzle :: (Show a, Ord a) => Puzzle a -> Puzzle a solvePuzzle :: (Show a, Ord a) => Puzzle a -> Puzzle a
-> (Puzzle a -> Puzzle a -> Cost) -> Maybe [Puzzle a] -> (Puzzle a -> Puzzle a -> Cost) -> Maybe [Puzzle a]
@ -173,7 +176,7 @@ solvePuzzle initState goalState hueristic =
then Nothing then Nothing
else Just (astar initState goalState hueristic) else Just (astar initState goalState hueristic)
-- Returns number of tiles in wrong position in givenState compared to goalState -- Returns number of tiles in wrong position in given state compared to goal state
wrongTileCount :: Eq a => Puzzle a -> Puzzle a -> Cost wrongTileCount :: Eq a => Puzzle a -> Puzzle a -> Cost
wrongTileCount givenState goalState = wrongTileCount givenState goalState =
length . filter (\(a, b) -> a /= b) length . filter (\(a, b) -> a /= b)
@ -191,19 +194,19 @@ sumManhattanDistance givenState goalState =
. assocs . pzState $ givenState . assocs . pzState $ givenState
where where
revM = M.fromList . map (\(x, y) -> (y, x)) . assocs . pzState $ goalState revM = M.fromList . map (\(x, y) -> (y, x)) . assocs . pzState $ goalState
-- The classic 15 puzzle -- The classic 15 puzzle (http://en.wikipedia.org/wiki/Fifteen_puzzle)
fifteenPuzzle :: IO () fifteenPuzzle :: IO ()
fifteenPuzzle = do fifteenPuzzle = do
-- Random generator -- Random generator
gen <- newStdGen gen <- newStdGen
-- The goal -- The goal
let goalState = fromJust $ fromList 0 4 [0..15] let goalState = fromJust $ fromList 0 4 [0..15]
-- Shuffle the goal to get a random puzzle state -- Shuffle the goal to get a random puzzle state
let initState = evalState (shufflePuzzle 50 goalState) gen let initState = evalState (shufflePuzzle 50 goalState) gen
-- Solve using sum manhattan distance heuristic -- Solve using sum manhattan distance heuristic
let solution = fromJust $ solvePuzzle initState goalState sumManhattanDistance let solution = fromJust $ solvePuzzle initState goalState sumManhattanDistance
-- Print the solution
forM_ solution $ \s -> print s forM_ solution $ \s -> print s