Moved files to proper directory structure, added some stats functions

chapter2/AI/Vacuum/Cleaner.hs

@@ -4,10 +4,11 @@ module AI.Vacuum.Cleaner where
 
 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.Maybe (isJust, isNothing, fromJust)
+import Data.Maybe (fromJust)
 import Data.Lens.Common
 import Data.Lens.Template
 
@@ -15,19 +16,17 @@ data Percept = TouchSensor | PhotoSensor | InfraredSensor deriving (Eq, Ord, Sho
 type Percepts = [Percept]
 type PerceptsHistory = [Percepts]
 data Action = GoForward | TurnRight | TurnLeft | SuckDirt | TurnOff deriving (Eq, Show)
-
 data CleanerState = On | Off deriving (Eq, Show)
 type Score = Int
-data Cleaner =
-  Cleaner {
-    _state :: CleanerState,
-    _cell :: Cell,
-    _direction :: Direction,
-    _path :: [Point],
-    _perceptsHist :: PerceptsHistory,
-    _actionHist :: [Action],
-    _score :: Score
-    } deriving (Show)
+data Cleaner = Cleaner {
+  _state :: CleanerState,
+  _cell :: Cell,
+  _direction :: Direction,
+  _path :: [Point],
+  _perceptsHist :: PerceptsHistory,
+  _actionHist :: [Action],
+  _score :: Score
+  } deriving (Show)
 
 makeLenses [''Cleaner]
 
@@ -81,3 +80,21 @@ doAction action cleaner = do
   $ cleaner
   where
     cellType' = (cleaner^.cell)^.cellType
+
+performance :: Cleaner -> Grid -> Float
+performance cleaner grid =
+  100 * fromIntegral (cleaner^.score) 
+  / fromIntegral (99 * dirtCellCount grid - cellCount grid)
+  where
+    dirtCellCount = M.size . M.filter ((== Dirt) . (cellType ^$))
+    cellCount = M.size
+    
+coverage :: Cleaner -> Grid -> Float
+coverage cleaner grid =
+  100 * fromIntegral (S.size . S.fromList $ cleaner^.path)
+  / fromIntegral (M.size grid)
+
+cleanerAtHome :: Cleaner -> Grid -> Bool
+cleanerAtHome cleaner grid = 
+  (== Home) . (cellType ^$) . fromJust . (flip lookupCell $ grid) . head $ cleaner^.path
+

chapter2/AI/Vacuum/Grid.hs

@@ -3,6 +3,7 @@
 module AI.Vacuum.Grid where
 
 import qualified Data.Map as M
+import Data.Lens.Common
 import Data.Lens.Template
 import System.IO.Unsafe (unsafePerformIO)
 import Debug.Trace (putTraceMsg)
@@ -13,7 +14,7 @@ trace string expr = unsafePerformIO $ do
     return expr
 
 data Direction = North | East | South | West deriving (Eq, Show, Enum, Bounded)
-data CellType = Empty | Furniture | Dirt | Home deriving (Eq, Show)
+data CellType = Empty | Furniture | Dirt | Home deriving (Eq, Show, Ord)
 type Point = (Int, Int)
 data Cell = Cell { _point :: Point, _cellType :: CellType } deriving (Eq, Show)
 type Grid = M.Map Point Cell
@@ -67,3 +68,13 @@ leftCell (Cell point _) = lookupCell . (leftPoint point)
 
 gridFromCellList :: [Cell] -> Grid
 gridFromCellList = foldl (\m cell@(Cell p _) -> M.insert p cell m) M.empty
+
+gridWidth :: Grid -> Int
+gridWidth = (+ 1) . maximum . map fst . M.keys
+
+gridHeight :: Grid -> Int
+gridHeight = (+ 1) . maximum . map snd . M.keys
+
+gridStats :: Grid -> [(CellType, Int)]
+gridStats = 
+  M.toList . foldl (\m t -> M.insertWith (+) t 1 m) M.empty . map (cellType ^$) . M.elems

chapter2/AI/Vacuum/ReflexAgent.hs

@@ -5,9 +5,8 @@ import AI.Vacuum.Grid
 import AI.Vacuum.RandomGrid
 import Data.Lens.Common
 import Control.Monad.State
-import Control.Monad.Identity
 import System.Random
-import Data.Maybe (isJust, isNothing, fromJust)
+import Data.Maybe (fromJust)
 
 chooseAction :: Percepts -> RandomState Action
 chooseAction percepts
@@ -52,3 +51,23 @@ simulateOnGrid :: Int -> Grid -> StdGen -> (Cleaner, Grid)
 simulateOnGrid maxTurns grid gen =
   evalState (runStateT (runCleaner maxTurns cleaner) grid) gen
   where cleaner = createCleaner (fromJust $ lookupCell (0,0) grid) East
+
+main :: IO()
+main = do
+  gen <- newStdGen
+  let grid = evalState (makeGrid (20,25) (10,15) 0.15) gen
+  putStrLn ("Grid width = " ++ (show . gridWidth $ grid))
+  putStrLn ("Grid height = " ++ (show . gridHeight $ grid))
+  putStrLn ("Grid stats = " ++ (show . gridStats $ grid))
+  let cleaner = fst $ simulateOnGrid 10000 grid gen
+  putStrLn ("Cleaner finished at home = " 
+            ++ (show $ cleanerAtHome cleaner grid))
+  putStrLn ("Cleaner performance = " 
+            ++ (show $ performance cleaner grid))
+  putStrLn ("Cleaner coverage = " 
+            ++ (show $ coverage cleaner grid))
+  putStrLn ("Cleaner action count = "
+            ++ (show . length $ cleaner^.actionHist))
+  putStrLn ("Cleaner move count = "
+            ++ (show . length $ cleaner^.path))
+    

chapter2/AI/Vacuum/TableLookupAgent.hs

@@ -4,7 +4,7 @@ import AI.Vacuum.Cleaner
 import AI.Vacuum.Grid
 import Control.Monad.State
 import Data.Lens.Common
-import Data.Maybe (isJust, isNothing, fromJust)
+import Data.Maybe (fromJust)
 
 -- Problem 2.6
 
@@ -25,7 +25,7 @@ chooseAction ph =
     [] -> Just GoForward
     [[]] -> Just TurnRight
     [[PhotoSensor]] -> Just SuckDirt
-    (p:ps) ->
+    (_:ps) ->
       case lookup ps perceptsHistoryToActionMap of
         Just (Just prevAction) -> chooseAction' ph prevAction
         _ -> Nothing