Solved problem 2.6
commit
2b425ec62d
|
@ -0,0 +1,98 @@
|
||||||
|
import AI.Vacuum
|
||||||
|
import Control.Monad.State
|
||||||
|
import Data.Maybe (isJust, isNothing, fromJust)
|
||||||
|
|
||||||
|
-- Problem 2.6
|
||||||
|
|
||||||
|
possiblePerceptsHistories :: [PerceptsHistory]
|
||||||
|
possiblePerceptsHistories = takeWhile ((<= 9) . length) $
|
||||||
|
[[]] : [[PhotoSensor]] : concatMap (\s -> [[] : s, [PhotoSensor] : s]) possiblePerceptsHistories
|
||||||
|
|
||||||
|
-- 0 -> t
|
||||||
|
-- 1 -> s
|
||||||
|
-- t -> 0 -> m | 1 -> X
|
||||||
|
-- s -> 0 -> t | 1 -> X
|
||||||
|
-- m -> 0 -> t | 1 -> s
|
||||||
|
-- X -> X
|
||||||
|
|
||||||
|
chooseAction :: PerceptsHistory -> Maybe Action
|
||||||
|
chooseAction ph =
|
||||||
|
case ph of
|
||||||
|
[] -> Just GoForward
|
||||||
|
[[]] -> Just TurnRight
|
||||||
|
[[PhotoSensor]] -> Just SuckDirt
|
||||||
|
(p:ps) ->
|
||||||
|
case lookup ps perceptsHistoryToActionMap of
|
||||||
|
Just (Just prevAction) -> chooseAction' ph prevAction
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
chooseAction' :: PerceptsHistory -> Action -> Maybe Action
|
||||||
|
chooseAction' ph prevAction
|
||||||
|
| prevAction == TurnRight || prevAction == TurnLeft =
|
||||||
|
case head ph of
|
||||||
|
[] -> Just GoForward
|
||||||
|
[PhotoSensor] -> Nothing
|
||||||
|
| prevAction == SuckDirt =
|
||||||
|
case head ph of
|
||||||
|
[] -> Just TurnRight
|
||||||
|
[PhotoSensor] -> Nothing
|
||||||
|
| prevAction == GoForward =
|
||||||
|
case head ph of
|
||||||
|
[] -> Just TurnRight
|
||||||
|
[PhotoSensor] -> Just SuckDirt
|
||||||
|
| prevAction == TurnOff = error "Cannot move after turnoff"
|
||||||
|
|
||||||
|
perceptsHistoryToActionMap :: [(PerceptsHistory, Maybe Action)]
|
||||||
|
perceptsHistoryToActionMap =
|
||||||
|
map (\ph -> (ph, chooseAction ph)) possiblePerceptsHistories
|
||||||
|
|
||||||
|
grid1 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Empty,
|
||||||
|
Cell (0, 1) Empty, Cell (1, 1) Empty
|
||||||
|
]
|
||||||
|
|
||||||
|
grid2 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Dirt,
|
||||||
|
Cell (0, 1) Empty, Cell (1, 1) Empty
|
||||||
|
]
|
||||||
|
|
||||||
|
grid3 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Empty,
|
||||||
|
Cell (0, 1) Dirt, Cell (1, 1) Empty
|
||||||
|
]
|
||||||
|
|
||||||
|
grid4 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Empty,
|
||||||
|
Cell (0, 1) Empty, Cell (1, 1) Dirt
|
||||||
|
]
|
||||||
|
|
||||||
|
grid5 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Dirt,
|
||||||
|
Cell (0, 1) Dirt, Cell (1, 1) Empty
|
||||||
|
]
|
||||||
|
|
||||||
|
grid6 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Empty,
|
||||||
|
Cell (0, 1) Dirt, Cell (1, 1) Dirt
|
||||||
|
]
|
||||||
|
|
||||||
|
grid7 = gridFromCellList [
|
||||||
|
Cell (0, 0) Home, Cell (1, 0) Dirt,
|
||||||
|
Cell (0, 1) Empty, Cell (1, 1) Dirt
|
||||||
|
]
|
||||||
|
|
||||||
|
runCleaner :: Cleaner -> State Grid Cleaner
|
||||||
|
runCleaner cleaner@(Cleaner _ _ _ ph _) = do
|
||||||
|
case chooseAction ph of
|
||||||
|
Just action -> do
|
||||||
|
cleaner <- doAction action cleaner
|
||||||
|
let ph = clPrcptsHist cleaner
|
||||||
|
if InfraredSensor `elem` (head ph)
|
||||||
|
then doAction TurnOff cleaner
|
||||||
|
else runCleaner cleaner
|
||||||
|
_ -> doAction TurnOff cleaner
|
||||||
|
|
||||||
|
simulateOnGrid :: Grid -> (Cleaner, Grid)
|
||||||
|
simulateOnGrid grid =
|
||||||
|
runState (runCleaner cleaner) grid
|
||||||
|
where cleaner = createCleaner (fromJust $ cell (0, 0) grid) East
|
|
@ -0,0 +1,125 @@
|
||||||
|
module AI.Vacuum where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Control.Monad.State
|
||||||
|
import Data.Maybe (isJust, isNothing, fromJust)
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
import Debug.Trace (putTraceMsg)
|
||||||
|
|
||||||
|
trace :: String -> a -> a
|
||||||
|
trace string expr = unsafePerformIO $ do
|
||||||
|
putTraceMsg string
|
||||||
|
return expr
|
||||||
|
|
||||||
|
data Direction = North | East | South | West deriving (Eq, Show, Enum, Bounded)
|
||||||
|
data Percept = TouchSensor | PhotoSensor | InfraredSensor deriving (Eq, Ord, Show)
|
||||||
|
type Percepts = [Percept]
|
||||||
|
type PerceptsHistory = [Percepts]
|
||||||
|
data Action = GoForward | TurnRight | TurnLeft | SuckDirt | TurnOff deriving (Eq, Show)
|
||||||
|
data CellType = Empty | Furniture | Dirt | Home deriving (Eq, Show)
|
||||||
|
|
||||||
|
type Point = (Int, Int)
|
||||||
|
data Cell = Cell Point CellType deriving (Eq, Show)
|
||||||
|
type Grid = M.Map Point Cell
|
||||||
|
|
||||||
|
data CleanerState = On | Off deriving (Eq, Show)
|
||||||
|
type Score = Int
|
||||||
|
data Cleaner =
|
||||||
|
Cleaner {
|
||||||
|
clState :: CleanerState,
|
||||||
|
clCell :: Cell,
|
||||||
|
clDir :: Direction,
|
||||||
|
clPrcptsHist :: PerceptsHistory,
|
||||||
|
clScore :: Score
|
||||||
|
} deriving (Show)
|
||||||
|
|
||||||
|
class (Enum a, Eq a, Bounded a) => WrappedBoundedEnum a where
|
||||||
|
next :: a -> a
|
||||||
|
prev :: a -> a
|
||||||
|
|
||||||
|
next x = if (maxBound == x) then minBound else succ x
|
||||||
|
prev x = if (minBound == x) then maxBound else pred x
|
||||||
|
|
||||||
|
instance WrappedBoundedEnum Direction
|
||||||
|
|
||||||
|
right :: Direction -> Direction
|
||||||
|
right = next
|
||||||
|
|
||||||
|
left :: Direction -> Direction
|
||||||
|
left = prev
|
||||||
|
|
||||||
|
forwardPoint :: Point -> Direction -> Point
|
||||||
|
forwardPoint (x, y) North = (x, y - 1)
|
||||||
|
forwardPoint (x, y) East = (x + 1, y)
|
||||||
|
forwardPoint (x, y) South = (x, y + 1)
|
||||||
|
forwardPoint (x, y) West = (x - 1, y)
|
||||||
|
|
||||||
|
rightPoint :: Point -> Direction -> Point
|
||||||
|
rightPoint (x, y) North = (x + 1, y)
|
||||||
|
rightPoint (x, y) East = (x, y + 1)
|
||||||
|
rightPoint (x, y) South = (x - 1, y)
|
||||||
|
rightPoint (x, y) West = (x, y - 1)
|
||||||
|
|
||||||
|
leftPoint :: Point -> Direction -> Point
|
||||||
|
leftPoint (x, y) North = (x -1, y)
|
||||||
|
leftPoint (x, y) East = (x, y - 1)
|
||||||
|
leftPoint (x, y) South = (x + 1, y)
|
||||||
|
leftPoint (x, y) West = (x, y + 1)
|
||||||
|
|
||||||
|
cell :: Point -> Grid -> Maybe Cell
|
||||||
|
cell = M.lookup
|
||||||
|
|
||||||
|
forwardCell :: Cell -> Direction -> Grid -> Maybe Cell
|
||||||
|
forwardCell (Cell point _) dir grid = cell (forwardPoint point dir) grid
|
||||||
|
|
||||||
|
rightCell :: Cell -> Direction -> Grid -> Maybe Cell
|
||||||
|
rightCell (Cell point _) dir grid = cell (rightPoint point dir) grid
|
||||||
|
|
||||||
|
leftCell :: Cell -> Direction -> Grid -> Maybe Cell
|
||||||
|
leftCell (Cell point _) dir grid = cell (leftPoint point dir) grid
|
||||||
|
|
||||||
|
gridFromCellList :: [Cell] -> Grid
|
||||||
|
gridFromCellList = foldl (\m cell@(Cell p _) -> M.insert p cell m) M.empty
|
||||||
|
|
||||||
|
createCleaner :: Cell -> Direction -> Cleaner
|
||||||
|
createCleaner cell dir = Cleaner On cell dir [] 0
|
||||||
|
|
||||||
|
turnRight :: Cleaner -> State Grid Cleaner
|
||||||
|
turnRight (Cleaner state cell dir ph score) =
|
||||||
|
return $ Cleaner state cell (right dir) ([] : ph) score
|
||||||
|
|
||||||
|
turnLeft :: Cleaner -> State Grid Cleaner
|
||||||
|
turnLeft (Cleaner state cell dir ph score) =
|
||||||
|
return $ Cleaner state cell (left dir) ([] : ph) score
|
||||||
|
|
||||||
|
moveForward :: Cleaner -> State Grid Cleaner
|
||||||
|
moveForward cleaner@(Cleaner state cell@(Cell _ cellType) dir ph score) = do
|
||||||
|
grid <- get
|
||||||
|
return $
|
||||||
|
case forwardCell cell dir grid of
|
||||||
|
Nothing -> Cleaner state cell dir ([TouchSensor] : ph) score
|
||||||
|
Just nextCell@(Cell _ nextCellType) ->
|
||||||
|
case nextCellType of
|
||||||
|
Empty -> Cleaner state nextCell dir ([] : ph) score
|
||||||
|
Furniture -> Cleaner state cell dir ([TouchSensor] : ph) score
|
||||||
|
Dirt -> Cleaner state nextCell dir ([PhotoSensor] : ph) score
|
||||||
|
Home -> Cleaner state nextCell dir ([InfraredSensor] : ph) score
|
||||||
|
|
||||||
|
doAction :: Action -> Cleaner -> State Grid Cleaner
|
||||||
|
doAction action cleaner@(Cleaner state cell@(Cell point cellType) dir ph score) =
|
||||||
|
case action of
|
||||||
|
GoForward -> moveForward $ Cleaner state cell dir ph (score - 1)
|
||||||
|
TurnRight -> turnRight $ Cleaner state cell dir ph (score - 1)
|
||||||
|
TurnLeft -> turnLeft $ Cleaner state cell dir ph (score - 1)
|
||||||
|
SuckDirt ->
|
||||||
|
case cellType of
|
||||||
|
Dirt -> do
|
||||||
|
grid <- get
|
||||||
|
put $ M.insert point (Cell point Empty) grid
|
||||||
|
return $ Cleaner state cell dir ([] : ph) (score + 99)
|
||||||
|
otherwise -> return $ Cleaner state cell dir ([] : ph) (score - 1)
|
||||||
|
TurnOff ->
|
||||||
|
case cellType of
|
||||||
|
Home -> return $ Cleaner Off cell dir ([] : ph) score
|
||||||
|
otherwise -> return $ Cleaner state cell dir ([] : ph) (score - 1000)
|
||||||
|
|
Loading…
Reference in New Issue