Solved prob 2.7 and 2.8

master
Abhinav Sarkar 2011-10-05 11:18:20 +05:30
parent 2b425ec62d
commit bfa77fc13d
3 changed files with 99 additions and 12 deletions

36
chapter2/prob27.hs Normal file
View File

@ -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)]

49
chapter2/prob28.hs Normal file
View File

@ -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

View File

@ -1,3 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
module AI.Vacuum where
import qualified Data.Map as M
@ -24,13 +26,13 @@ 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
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
@ -84,15 +86,15 @@ 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 :: (MonadState Grid m) => Cleaner -> m Cleaner
turnRight (Cleaner state cell 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) =
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
grid <- get
return $
@ -105,7 +107,7 @@ moveForward cleaner@(Cleaner state cell@(Cell _ cellType) dir ph score) = do
Dirt -> Cleaner state nextCell dir ([PhotoSensor] : 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) =
case action of
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 ->
case cellType of
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)