From 5d4e23f5e58f84ff80bd3f354b21319b4964096f Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav.sarkar@gmail.com>
Date: Thu, 6 Oct 2011 23:04:12 +0530
Subject: [PATCH] Added more printing facilities. Added furniture to random
 grid.

---
 chapter2/AI/Vacuum/Cleaner.hs     | 17 +++++++++++++++--
 chapter2/AI/Vacuum/Grid.hs        | 21 +++++++++++++++++++++
 chapter2/AI/Vacuum/RandomGrid.hs  | 21 ++++++++++++---------
 chapter2/AI/Vacuum/ReflexAgent.hs | 17 +++++++++++++++--
 4 files changed, 63 insertions(+), 13 deletions(-)

diff --git a/chapter2/AI/Vacuum/Cleaner.hs b/chapter2/AI/Vacuum/Cleaner.hs
index a6ca846..0d21faf 100644
--- a/chapter2/AI/Vacuum/Cleaner.hs
+++ b/chapter2/AI/Vacuum/Cleaner.hs
@@ -6,8 +6,7 @@ import AI.Vacuum.Grid
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Control.Monad.State
-import Prelude hiding (id, (.))
-import Control.Category
+import Data.Ix (range)
 import Data.Maybe (fromJust, fromMaybe)
 import Data.Lens.Common
 import Data.Lens.Template
@@ -106,6 +105,20 @@ cleanerAtHome cleaner grid =
 actionStats :: Cleaner -> [(Action, Int)]
 actionStats = freqMap . (actionHist ^$)
 
+printPath :: Cleaner -> Grid -> IO ()
+printPath cleaner grid = do
+  let width = gridWidth grid
+  let height = gridHeight grid
+  let points = S.fromList $ cleaner^.path
+
+  forM_ (range (0, width - 1)) $ \x -> do
+    forM_ (range (0, height - 1)) $ \y -> do
+      let cell = fromJust . lookupCell (x,y) $ grid
+      if S.member (cell^.point) points
+        then putStr "- "
+        else putStr . showCell $ cell
+    putStrLn ""
+
 printRunStats :: Cleaner -> Grid -> IO ()
 printRunStats cleaner grid = do
   putStrLn ("Grid width = " ++ (show . gridWidth $ grid))
diff --git a/chapter2/AI/Vacuum/Grid.hs b/chapter2/AI/Vacuum/Grid.hs
index 0c16090..a84e25f 100644
--- a/chapter2/AI/Vacuum/Grid.hs
+++ b/chapter2/AI/Vacuum/Grid.hs
@@ -3,6 +3,9 @@
 module AI.Vacuum.Grid where
 
 import qualified Data.Map as M
+import Data.Maybe (fromJust)
+import Data.Ix (range)
+import Control.Monad (forM_)
 import Data.Lens.Common
 import Data.Lens.Template
 import System.IO.Unsafe (unsafePerformIO)
@@ -80,3 +83,21 @@ gridHeight = (+ 1) . maximum . map snd . M.keys
 
 gridStats :: Grid -> [(CellType, Int)]
 gridStats = freqMap . map (cellType ^$) . M.elems
+
+showCell :: Cell -> String
+showCell cell =
+   case cell^.cellType of
+     Dirt -> "X "
+     Empty -> "O "
+     Furniture -> "F "
+     Home -> "H "
+
+printGrid :: Grid -> IO ()
+printGrid grid = do
+  let width = gridWidth grid
+  let height = gridHeight grid
+
+  forM_ (range (0, width - 1)) $ \x -> do
+    forM_ (range (0, height - 1)) $ \y ->
+      putStr . showCell . fromJust . lookupCell (x,y) $ grid
+    putStrLn ""
diff --git a/chapter2/AI/Vacuum/RandomGrid.hs b/chapter2/AI/Vacuum/RandomGrid.hs
index 8a35067..3b76a14 100644
--- a/chapter2/AI/Vacuum/RandomGrid.hs
+++ b/chapter2/AI/Vacuum/RandomGrid.hs
@@ -1,4 +1,6 @@
-module AI.Vacuum.RandomGrid where
+module AI.Vacuum.RandomGrid 
+       (RandomState, getRandomR, makeRandomGrid)
+       where
 
 import AI.Vacuum.Grid
 import System.Random
@@ -18,18 +20,19 @@ getRandomR limits = do
   put gen'
   return val
 
-makeCell :: Point -> Float -> RandomState Cell
-makeCell point dirtProb = do
+makeCell :: Point -> Float -> Float -> RandomState Cell
+makeCell point dirtProb furnitureProb = do
   dirtR <- getRandomR (0.0, 1.0)
-  if dirtR <= dirtProb
-    then return $ Cell point Dirt
-    else return $ Cell point Empty
+  case dirtR of
+    dirtR | dirtR < dirtProb -> return $ Cell point Dirt
+    dirtR | dirtR < (dirtProb + furnitureProb) -> return $ Cell point Furniture
+    otherwise -> return $ Cell point Empty
 
-makeGrid :: (Int, Int) -> (Int, Int) -> Float -> RandomState Grid
-makeGrid minMaxWidth minMaxHeight dirtProb = do
+makeRandomGrid :: (Int, Int) -> (Int, Int) -> Float -> Float -> RandomState Grid
+makeRandomGrid minMaxWidth minMaxHeight dirtProb furnitureProb = do
   width <- getRandomR minMaxWidth
   height <- getRandomR minMaxHeight
   foldM
-    (\m p -> makeCell p dirtProb >>= \c -> return $ M.insert p c m)
+    (\m p -> makeCell p dirtProb furnitureProb >>= \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/AI/Vacuum/ReflexAgent.hs b/chapter2/AI/Vacuum/ReflexAgent.hs
index 3de2c14..2e3fb41 100644
--- a/chapter2/AI/Vacuum/ReflexAgent.hs
+++ b/chapter2/AI/Vacuum/ReflexAgent.hs
@@ -61,8 +61,21 @@ main = do
   let maxSize = (read $ args !! 1) :: Int
   let dirtProb = (read $ args !! 2) :: Float
   let maxTurns = (read $ args !! 3) :: Int
+  let toPrintGrid = (read $ args !! 4) :: Bool
 
-  let grid = evalState (makeGrid (minSize,maxSize) (minSize,maxSize) dirtProb) gen
-  let cleaner = fst $ simulateOnGrid maxTurns grid gen
+  let grid = evalState
+             (makeRandomGrid (minSize,maxSize) (minSize,maxSize) dirtProb 0.0) gen
+
+  when toPrintGrid $ do
+    putStrLn "Grid before traversal"
+    printGrid grid
+    putStrLn ""
+
+  let (cleaner, grid') = simulateOnGrid maxTurns grid gen
+
+  when toPrintGrid $ do
+    putStrLn "Grid after traversal"
+    printPath cleaner grid'
+    putStrLn ""
 
   printRunStats cleaner grid