diff --git a/chapter2/.gitignore b/chapter2/.gitignore new file mode 100644 index 0000000..5992318 --- /dev/null +++ b/chapter2/.gitignore @@ -0,0 +1,2 @@ +build +ReflexAgent diff --git a/chapter2/AI/Vacuum/Cleaner.hs b/chapter2/AI/Vacuum/Cleaner.hs index de2f3b2..a6ca846 100644 --- a/chapter2/AI/Vacuum/Cleaner.hs +++ b/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 -performance cleaner grid = - 100 * fromIntegral (cleaner^.score) +efficiency :: Cleaner -> Grid -> Float +efficiency 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) +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)) diff --git a/chapter2/AI/Vacuum/Grid.hs b/chapter2/AI/Vacuum/Grid.hs index 560ba00..0c16090 100644 --- a/chapter2/AI/Vacuum/Grid.hs +++ b/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 = - M.toList . foldl (\m t -> M.insertWith (+) t 1 m) M.empty . map (cellType ^$) . M.elems \ No newline at end of file +gridStats = freqMap . map (cellType ^$) . M.elems diff --git a/chapter2/AI/Vacuum/ReflexAgent.hs b/chapter2/AI/Vacuum/ReflexAgent.hs index 20634bb..3de2c14 100644 --- a/chapter2/AI/Vacuum/ReflexAgent.hs +++ b/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 - 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)) - \ No newline at end of file + args <- getArgs + let minSize = (read $ args !! 0) :: Int + let maxSize = (read $ args !! 1) :: Int + let dirtProb = (read $ args !! 2) :: Float + let maxTurns = (read $ args !! 3) :: Int + + let grid = evalState (makeGrid (minSize,maxSize) (minSize,maxSize) dirtProb) gen + let cleaner = fst $ simulateOnGrid maxTurns grid gen + + printRunStats cleaner grid diff --git a/chapter2/build-reflex-agent b/chapter2/build-reflex-agent new file mode 100755 index 0000000..0d1c01a --- /dev/null +++ b/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