Moved files to proper directory structure, added some stats functions

master
Abhinav Sarkar 2011-10-05 23:46:36 +05:30
parent 7b7b4f4eca
commit 77c1e67932
5 changed files with 64 additions and 17 deletions

View File

@ -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

View File

@ -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

View File

@ -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))

View File

@ -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