Changes in runner

chapter2/.gitignore

@@ -0,0 +1,2 @@
+build
+ReflexAgent

chapter2/AI/Vacuum/Cleaner.hs

@@ -8,14 +8,14 @@ import qualified Data.Set as S
 import Control.Monad.State
 import Prelude hiding (id, (.))
 import Control.Category
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 import Data.Lens.Common
 import Data.Lens.Template
 
 data Percept = TouchSensor | PhotoSensor | InfraredSensor deriving (Eq, Ord, Show)
 type Percepts = [Percept]
 type PerceptsHistory = [Percepts]
-data Action = GoForward | TurnRight | TurnLeft | SuckDirt | TurnOff deriving (Eq, Show)
+data Action = GoForward | TurnRight | TurnLeft | SuckDirt | TurnOff deriving (Eq, Ord, Show)
 data CleanerState = On | Off deriving (Eq, Show)
 type Score = Int
 data Cleaner = Cleaner {
@@ -81,20 +81,51 @@ doAction action cleaner = do
   where
     cellType' = (cleaner^.cell)^.cellType
 
-performance :: Cleaner -> Grid -> Float
+efficiency :: Cleaner -> Grid -> Float
-performance cleaner grid =
+efficiency cleaner grid =
-  100 * fromIntegral (cleaner^.score) 
+  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)
 
+dirtCoverage :: Cleaner -> Grid -> Float
+dirtCoverage cleaner grid =
+  100 * fromIntegral (fromMaybe 0 . lookup SuckDirt . actionStats $ cleaner)
+  / fromIntegral (M.size . M.filter ((== Dirt) . (cellType ^$)) $ grid)
+
 cleanerAtHome :: Cleaner -> Grid -> Bool
-cleanerAtHome cleaner grid = 
+cleanerAtHome cleaner grid =
   (== Home) . (cellType ^$) . fromJust . (flip lookupCell $ grid) . head $ cleaner^.path
 
+actionStats :: Cleaner -> [(Action, Int)]
+actionStats = freqMap . (actionHist ^$)
+
+printRunStats :: Cleaner -> Grid -> IO ()
+printRunStats cleaner grid = do
+  putStrLn ("Grid width = " ++ (show . gridWidth $ grid))
+  putStrLn ("Grid height = " ++ (show . gridHeight $ grid))
+  putStrLn ("Grid size = " ++ (show (gridHeight grid * gridWidth grid)))
+  putStrLn ("Grid stats = " ++ (show . gridStats $ grid))
+
+  putStrLn ("Cleaner score = "
+            ++ (show $ cleaner^.score))
+  putStrLn ("Cleaner finished at home = "
+            ++ (show $ cleanerAtHome cleaner grid))
+  putStrLn ("Cleaner move count = "
+            ++ (show . length $ cleaner^.path))
+  putStrLn ("Cleaner efficiency = "
+            ++ (show $ efficiency cleaner grid))
+  putStrLn ("Cleaner coverage = "
+            ++ (show $ coverage cleaner grid))
+  putStrLn ("Cleaner dirt coverage = "
+            ++ (show $ dirtCoverage cleaner grid))
+  putStrLn ("Cleaner action count = "
+            ++ (show . length $ cleaner^.actionHist))
+  putStrLn ("Cleaner action stats = "
+            ++ (show . actionStats $ cleaner))

chapter2/AI/Vacuum/Grid.hs

@@ -69,6 +69,9 @@ leftCell (Cell point _) = lookupCell . (leftPoint point)
 gridFromCellList :: [Cell] -> Grid
 gridFromCellList = foldl (\m cell@(Cell p _) -> M.insert p cell m) M.empty
 
+freqMap :: (Ord a) => [a] -> [(a, Int)]
+freqMap = M.toList . foldl (\m t -> M.insertWith (+) t 1 m) M.empty
+
 gridWidth :: Grid -> Int
 gridWidth = (+ 1) . maximum . map fst . M.keys
 
@@ -76,5 +79,4 @@ gridHeight :: Grid -> Int
 gridHeight = (+ 1) . maximum . map snd . M.keys
 
 gridStats :: Grid -> [(CellType, Int)]
-gridStats = 
+gridStats = freqMap . map (cellType ^$) . M.elems
-  M.toList . foldl (\m t -> M.insertWith (+) t 1 m) M.empty . map (cellType ^$) . M.elems

chapter2/AI/Vacuum/ReflexAgent.hs

@@ -6,6 +6,7 @@ import AI.Vacuum.RandomGrid
 import Data.Lens.Common
 import Control.Monad.State
 import System.Random
+import System (getArgs)
 import Data.Maybe (fromJust)
 
 chooseAction :: Percepts -> RandomState Action
@@ -52,22 +53,16 @@ simulateOnGrid maxTurns grid gen =
   evalState (runStateT (runCleaner maxTurns cleaner) grid) gen
   where cleaner = createCleaner (fromJust $ lookupCell (0,0) grid) East
 
-main :: IO()
+main :: IO ()
 main = do
   gen <- newStdGen
-  let grid = evalState (makeGrid (20,25) (10,15) 0.15) gen
+  args <- getArgs
-  putStrLn ("Grid width = " ++ (show . gridWidth $ grid))
+  let minSize = (read $ args !! 0) :: Int
-  putStrLn ("Grid height = " ++ (show . gridHeight $ grid))
+  let maxSize = (read $ args !! 1) :: Int
-  putStrLn ("Grid stats = " ++ (show . gridStats $ grid))
+  let dirtProb = (read $ args !! 2) :: Float
-  let cleaner = fst $ simulateOnGrid 10000 grid gen
+  let maxTurns = (read $ args !! 3) :: Int
-  putStrLn ("Cleaner finished at home = " 
+
-            ++ (show $ cleanerAtHome cleaner grid))
+  let grid = evalState (makeGrid (minSize,maxSize) (minSize,maxSize) dirtProb) gen
-  putStrLn ("Cleaner performance = " 
+  let cleaner = fst $ simulateOnGrid maxTurns grid gen
-            ++ (show $ performance cleaner grid))
+
-  putStrLn ("Cleaner coverage = " 
+  printRunStats cleaner grid
-            ++ (show $ coverage cleaner grid))
-  putStrLn ("Cleaner action count = "
-            ++ (show . length $ cleaner^.actionHist))
-  putStrLn ("Cleaner move count = "
-            ++ (show . length $ cleaner^.path))
-    

chapter2/build-reflex-agent

@@ -0,0 +1 @@
+ghc -O2 -o ReflexAgent --make -hidir build -odir build -main-is AI.Vacuum.ReflexAgent AI/Vacuum/ReflexAgent.hs AI/Vacuum/RandomGrid.hs AI/Vacuum/Cleaner.hs AI/Vacuum/Grid.hs