Added more printing facilities. Added furniture to random grid.
parent
b19bd37aa8
commit
5d4e23f5e5
|
@ -6,8 +6,7 @@ import AI.Vacuum.Grid
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Prelude hiding (id, (.))
|
import Data.Ix (range)
|
||||||
import Control.Category
|
|
||||||
import Data.Maybe (fromJust, fromMaybe)
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
import Data.Lens.Common
|
import Data.Lens.Common
|
||||||
import Data.Lens.Template
|
import Data.Lens.Template
|
||||||
|
@ -106,6 +105,20 @@ cleanerAtHome cleaner grid =
|
||||||
actionStats :: Cleaner -> [(Action, Int)]
|
actionStats :: Cleaner -> [(Action, Int)]
|
||||||
actionStats = freqMap . (actionHist ^$)
|
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 -> IO ()
|
||||||
printRunStats cleaner grid = do
|
printRunStats cleaner grid = do
|
||||||
putStrLn ("Grid width = " ++ (show . gridWidth $ grid))
|
putStrLn ("Grid width = " ++ (show . gridWidth $ grid))
|
||||||
|
|
|
@ -3,6 +3,9 @@
|
||||||
module AI.Vacuum.Grid where
|
module AI.Vacuum.Grid where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
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.Common
|
||||||
import Data.Lens.Template
|
import Data.Lens.Template
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
@ -80,3 +83,21 @@ gridHeight = (+ 1) . maximum . map snd . M.keys
|
||||||
|
|
||||||
gridStats :: Grid -> [(CellType, Int)]
|
gridStats :: Grid -> [(CellType, Int)]
|
||||||
gridStats = freqMap . map (cellType ^$) . M.elems
|
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 ""
|
||||||
|
|
|
@ -1,4 +1,6 @@
|
||||||
module AI.Vacuum.RandomGrid where
|
module AI.Vacuum.RandomGrid
|
||||||
|
(RandomState, getRandomR, makeRandomGrid)
|
||||||
|
where
|
||||||
|
|
||||||
import AI.Vacuum.Grid
|
import AI.Vacuum.Grid
|
||||||
import System.Random
|
import System.Random
|
||||||
|
@ -18,18 +20,19 @@ getRandomR limits = do
|
||||||
put gen'
|
put gen'
|
||||||
return val
|
return val
|
||||||
|
|
||||||
makeCell :: Point -> Float -> RandomState Cell
|
makeCell :: Point -> Float -> Float -> RandomState Cell
|
||||||
makeCell point dirtProb = do
|
makeCell point dirtProb furnitureProb = do
|
||||||
dirtR <- getRandomR (0.0, 1.0)
|
dirtR <- getRandomR (0.0, 1.0)
|
||||||
if dirtR <= dirtProb
|
case dirtR of
|
||||||
then return $ Cell point Dirt
|
dirtR | dirtR < dirtProb -> return $ Cell point Dirt
|
||||||
else return $ Cell point Empty
|
dirtR | dirtR < (dirtProb + furnitureProb) -> return $ Cell point Furniture
|
||||||
|
otherwise -> return $ Cell point Empty
|
||||||
|
|
||||||
makeGrid :: (Int, Int) -> (Int, Int) -> Float -> RandomState Grid
|
makeRandomGrid :: (Int, Int) -> (Int, Int) -> Float -> Float -> RandomState Grid
|
||||||
makeGrid minMaxWidth minMaxHeight dirtProb = do
|
makeRandomGrid minMaxWidth minMaxHeight dirtProb furnitureProb = do
|
||||||
width <- getRandomR minMaxWidth
|
width <- getRandomR minMaxWidth
|
||||||
height <- getRandomR minMaxHeight
|
height <- getRandomR minMaxHeight
|
||||||
foldM
|
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))
|
(M.singleton (0,0) (Cell (0,0) Home))
|
||||||
[(x,y) | x <- range (0, width - 1), y <- range (0, height -1), (x,y) /= (0,0)]
|
[(x,y) | x <- range (0, width - 1), y <- range (0, height -1), (x,y) /= (0,0)]
|
||||||
|
|
|
@ -61,8 +61,21 @@ main = do
|
||||||
let maxSize = (read $ args !! 1) :: Int
|
let maxSize = (read $ args !! 1) :: Int
|
||||||
let dirtProb = (read $ args !! 2) :: Float
|
let dirtProb = (read $ args !! 2) :: Float
|
||||||
let maxTurns = (read $ args !! 3) :: Int
|
let maxTurns = (read $ args !! 3) :: Int
|
||||||
|
let toPrintGrid = (read $ args !! 4) :: Bool
|
||||||
|
|
||||||
let grid = evalState (makeGrid (minSize,maxSize) (minSize,maxSize) dirtProb) gen
|
let grid = evalState
|
||||||
let cleaner = fst $ simulateOnGrid maxTurns grid gen
|
(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
|
printRunStats cleaner grid
|
||||||
|
|
Loading…
Reference in New Issue