From bfa77fc13d3d6176fa8ad696a4a07fdd9806b873 Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav.sarkar@gmail.com>
Date: Wed, 5 Oct 2011 11:18:20 +0530
Subject: [PATCH] Solved prob 2.7 and 2.8

---
 chapter2/prob27.hs | 36 ++++++++++++++++++++++++++++++++++
 chapter2/prob28.hs | 49 ++++++++++++++++++++++++++++++++++++++++++++++
 chapter2/vacuum.hs | 26 ++++++++++++------------
 3 files changed, 99 insertions(+), 12 deletions(-)
 create mode 100644 chapter2/prob27.hs
 create mode 100644 chapter2/prob28.hs

diff --git a/chapter2/prob27.hs b/chapter2/prob27.hs
new file mode 100644
index 0000000..d2410d1
--- /dev/null
+++ b/chapter2/prob27.hs
@@ -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)]
+
diff --git a/chapter2/prob28.hs b/chapter2/prob28.hs
new file mode 100644
index 0000000..cc601da
--- /dev/null
+++ b/chapter2/prob28.hs
@@ -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
\ No newline at end of file
diff --git a/chapter2/vacuum.hs b/chapter2/vacuum.hs
index 7caf5e1..031e8e3 100644
--- a/chapter2/vacuum.hs
+++ b/chapter2/vacuum.hs
@@ -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)