Solved prob 2.7 and 2.8
parent
2b425ec62d
commit
bfa77fc13d
|
@ -0,0 +1,36 @@
|
||||||
|
module AI.Vacuum.RandomGrid where
|
||||||
|
|
||||||
|
import AI.Vacuum
|
||||||
|
import System.Random
|
||||||
|
import Control.Monad.State
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Ix (range)
|
||||||
|
|
||||||
|
-- Implement an environment for a n X m rectangular room, where each square has a 5% chance
|
||||||
|
-- of containing dirt, and n and m are chosen at random from the range 8 to 15, inclusive.
|
||||||
|
|
||||||
|
type RandomState = State StdGen
|
||||||
|
|
||||||
|
getRandomR :: Random a => (a, a) -> RandomState a
|
||||||
|
getRandomR limits = do
|
||||||
|
gen <- get
|
||||||
|
let (val, gen') = randomR limits gen
|
||||||
|
put gen'
|
||||||
|
return val
|
||||||
|
|
||||||
|
makeCell :: Point -> Float -> RandomState Cell
|
||||||
|
makeCell point dirtProb = do
|
||||||
|
dirtR <- getRandomR (0.0, 1.0)
|
||||||
|
if dirtR <= dirtProb
|
||||||
|
then return $ Cell point Dirt
|
||||||
|
else return $ Cell point Empty
|
||||||
|
|
||||||
|
makeGrid :: (Int, Int) -> (Int, Int) -> Float -> RandomState Grid
|
||||||
|
makeGrid minMaxWidth minMaxHeight dirtProb = do
|
||||||
|
width <- getRandomR minMaxWidth
|
||||||
|
height <- getRandomR minMaxHeight
|
||||||
|
foldM
|
||||||
|
(\m p -> makeCell p dirtProb >>= \c -> return $ M.insert p c m)
|
||||||
|
(M.singleton (0,0) (Cell (0,0) Home))
|
||||||
|
[(x,y) | x <- range (0, width - 1), y <- range (0, height -1), (x,y) /= (0,0)]
|
||||||
|
|
|
@ -0,0 +1,49 @@
|
||||||
|
import AI.Vacuum
|
||||||
|
import AI.Vacuum.RandomGrid
|
||||||
|
import Control.Monad.State
|
||||||
|
import Control.Monad.Identity
|
||||||
|
import System.Random
|
||||||
|
import Data.Maybe (isJust, isNothing, fromJust)
|
||||||
|
|
||||||
|
chooseAction :: Percepts -> RandomState Action
|
||||||
|
chooseAction percepts
|
||||||
|
| PhotoSensor `elem` percepts = return SuckDirt
|
||||||
|
| InfraredSensor `elem` percepts = return TurnOff
|
||||||
|
| TouchSensor `elem` percepts = do
|
||||||
|
r <- getRandomR (True, False)
|
||||||
|
if r
|
||||||
|
then return TurnLeft
|
||||||
|
else return TurnRight
|
||||||
|
| otherwise = do
|
||||||
|
r <- getRandomR ((0.0, 1.0) :: (Float, Float))
|
||||||
|
chooseRandom r
|
||||||
|
where
|
||||||
|
chooseRandom r
|
||||||
|
| r < 0.1 = return TurnRight
|
||||||
|
| r < 0.2 = return TurnLeft
|
||||||
|
| otherwise = return GoForward
|
||||||
|
|
||||||
|
runCleaner :: Int -> Cleaner -> StateT Grid RandomState Cleaner
|
||||||
|
runCleaner turnsLeft cleaner@(Cleaner _ _ _ ph _) =
|
||||||
|
if turnsLeft == 1
|
||||||
|
then do
|
||||||
|
cleaner' <- doAction TurnOff cleaner
|
||||||
|
return cleaner'
|
||||||
|
else do
|
||||||
|
cleaner'' <- case ph of
|
||||||
|
[] -> do
|
||||||
|
cleaner' <- doAction GoForward cleaner
|
||||||
|
return cleaner'
|
||||||
|
_ -> do
|
||||||
|
action <- lift $ chooseAction (head ph)
|
||||||
|
cleaner' <- doAction action cleaner
|
||||||
|
return cleaner'
|
||||||
|
|
||||||
|
case clState cleaner'' of
|
||||||
|
Off -> return cleaner''
|
||||||
|
On -> runCleaner (turnsLeft - 1) cleaner''
|
||||||
|
|
||||||
|
simulateOnGrid :: Int -> Grid -> StdGen -> (Cleaner, Grid)
|
||||||
|
simulateOnGrid maxTurns grid gen =
|
||||||
|
evalState (runStateT (runCleaner maxTurns cleaner) grid) gen
|
||||||
|
where cleaner = createCleaner (fromJust $ cell (0,0) grid) East
|
|
@ -1,3 +1,5 @@
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
|
||||||
module AI.Vacuum where
|
module AI.Vacuum where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
@ -84,15 +86,15 @@ gridFromCellList = foldl (\m cell@(Cell p _) -> M.insert p cell m) M.empty
|
||||||
createCleaner :: Cell -> Direction -> Cleaner
|
createCleaner :: Cell -> Direction -> Cleaner
|
||||||
createCleaner cell dir = Cleaner On cell dir [] 0
|
createCleaner cell dir = Cleaner On cell dir [] 0
|
||||||
|
|
||||||
turnRight :: Cleaner -> State Grid Cleaner
|
turnRight :: (MonadState Grid m) => Cleaner -> m Cleaner
|
||||||
turnRight (Cleaner state cell dir ph score) =
|
turnRight (Cleaner state cell dir ph score) =
|
||||||
return $ Cleaner state cell (right dir) ([] : ph) score
|
return $ Cleaner state cell (right dir) ([] : ph) score
|
||||||
|
|
||||||
turnLeft :: Cleaner -> State Grid Cleaner
|
turnLeft :: (MonadState Grid m) => Cleaner -> m Cleaner
|
||||||
turnLeft (Cleaner state cell dir ph score) =
|
turnLeft (Cleaner state cell dir ph score) =
|
||||||
return $ Cleaner state cell (left dir) ([] : ph) score
|
return $ Cleaner state cell (left dir) ([] : ph) score
|
||||||
|
|
||||||
moveForward :: Cleaner -> State Grid Cleaner
|
moveForward :: (MonadState Grid m) => Cleaner -> m Cleaner
|
||||||
moveForward cleaner@(Cleaner state cell@(Cell _ cellType) dir ph score) = do
|
moveForward cleaner@(Cleaner state cell@(Cell _ cellType) dir ph score) = do
|
||||||
grid <- get
|
grid <- get
|
||||||
return $
|
return $
|
||||||
|
@ -105,7 +107,7 @@ moveForward cleaner@(Cleaner state cell@(Cell _ cellType) dir ph score) = do
|
||||||
Dirt -> Cleaner state nextCell dir ([PhotoSensor] : ph) score
|
Dirt -> Cleaner state nextCell dir ([PhotoSensor] : ph) score
|
||||||
Home -> Cleaner state nextCell dir ([InfraredSensor] : ph) score
|
Home -> Cleaner state nextCell dir ([InfraredSensor] : ph) score
|
||||||
|
|
||||||
doAction :: Action -> Cleaner -> State Grid Cleaner
|
doAction :: (MonadState Grid m) => Action -> Cleaner -> m Cleaner
|
||||||
doAction action cleaner@(Cleaner state cell@(Cell point cellType) dir ph score) =
|
doAction action cleaner@(Cleaner state cell@(Cell point cellType) dir ph score) =
|
||||||
case action of
|
case action of
|
||||||
GoForward -> moveForward $ Cleaner state cell dir ph (score - 1)
|
GoForward -> moveForward $ Cleaner state cell dir ph (score - 1)
|
||||||
|
@ -121,5 +123,5 @@ doAction action cleaner@(Cleaner state cell@(Cell point cellType) dir ph score)
|
||||||
TurnOff ->
|
TurnOff ->
|
||||||
case cellType of
|
case cellType of
|
||||||
Home -> return $ Cleaner Off cell dir ([] : ph) score
|
Home -> return $ Cleaner Off cell dir ([] : ph) score
|
||||||
otherwise -> return $ Cleaner state cell dir ([] : ph) (score - 1000)
|
otherwise -> return $ Cleaner Off cell dir ([] : ph) (score - 1000)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue