diff --git a/chapter2/vacuum.hs b/chapter2/cleaner.hs similarity index 57% rename from chapter2/vacuum.hs rename to chapter2/cleaner.hs index c14762d..8508b97 100644 --- a/chapter2/vacuum.hs +++ b/chapter2/cleaner.hs @@ -1,7 +1,8 @@ {-# LANGUAGE FlexibleContexts, TemplateHaskell #-} -module AI.Vacuum where +module AI.Vacuum.Cleaner where +import AI.Vacuum.Grid import qualified Data.Map as M import Control.Monad.State import Prelude hiding (id, (.)) @@ -9,24 +10,11 @@ import Control.Category import Data.Maybe (isJust, isNothing, fromJust) import Data.Lens.Common import Data.Lens.Template -import System.IO.Unsafe (unsafePerformIO) -import Debug.Trace (putTraceMsg) -trace :: String -> a -> a -trace string expr = unsafePerformIO $ do - putTraceMsg string - return expr - -data Direction = North | East | South | West deriving (Eq, Show, Enum, Bounded) 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 CellType = Empty | Furniture | Dirt | Home deriving (Eq, Show) - -type Point = (Int, Int) -data Cell = Cell { _point :: Point, _cellType :: CellType } deriving (Eq, Show) -type Grid = M.Map Point Cell data CleanerState = On | Off deriving (Eq, Show) type Score = Int @@ -41,55 +29,7 @@ data Cleaner = _score :: Score } deriving (Show) -makeLenses [''Cell, ''Cleaner] - -class (Enum a, Eq a, Bounded a) => WrappedBoundedEnum a where - next :: a -> a - prev :: a -> a - - next x = if (maxBound == x) then minBound else succ x - prev x = if (minBound == x) then maxBound else pred x - -instance WrappedBoundedEnum Direction - -right :: Direction -> Direction -right = next - -left :: Direction -> Direction -left = prev - -forwardPoint :: Point -> Direction -> Point -forwardPoint (x, y) North = (x, y - 1) -forwardPoint (x, y) East = (x + 1, y) -forwardPoint (x, y) South = (x, y + 1) -forwardPoint (x, y) West = (x - 1, y) - -rightPoint :: Point -> Direction -> Point -rightPoint (x, y) North = (x + 1, y) -rightPoint (x, y) East = (x, y + 1) -rightPoint (x, y) South = (x - 1, y) -rightPoint (x, y) West = (x, y - 1) - -leftPoint :: Point -> Direction -> Point -leftPoint (x, y) North = (x -1, y) -leftPoint (x, y) East = (x, y - 1) -leftPoint (x, y) South = (x + 1, y) -leftPoint (x, y) West = (x, y + 1) - -lookupCell :: Point -> Grid -> Maybe Cell -lookupCell = M.lookup - -forwardCell :: Cell -> Direction -> Grid -> Maybe Cell -forwardCell (Cell point _) = lookupCell . (forwardPoint point) - -rightCell :: Cell -> Direction -> Grid -> Maybe Cell -rightCell (Cell point _) = lookupCell . (rightPoint point) - -leftCell :: Cell -> Direction -> Grid -> Maybe Cell -leftCell (Cell point _) = lookupCell . (leftPoint point) - -gridFromCellList :: [Cell] -> Grid -gridFromCellList = foldl (\m cell@(Cell p _) -> M.insert p cell m) M.empty +makeLenses [''Cleaner] createCleaner :: Cell -> Direction -> Cleaner createCleaner cell dir = Cleaner On cell dir [cell^.point] [] [] 0 diff --git a/chapter2/grid.hs b/chapter2/grid.hs new file mode 100644 index 0000000..ca105ea --- /dev/null +++ b/chapter2/grid.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE TemplateHaskell #-} + +module AI.Vacuum.Grid where + +import qualified Data.Map as M +import Data.Lens.Template +import System.IO.Unsafe (unsafePerformIO) +import Debug.Trace (putTraceMsg) + +trace :: String -> a -> a +trace string expr = unsafePerformIO $ do + putTraceMsg string + return expr + +data Direction = North | East | South | West deriving (Eq, Show, Enum, Bounded) +data CellType = Empty | Furniture | Dirt | Home deriving (Eq, Show) +type Point = (Int, Int) +data Cell = Cell { _point :: Point, _cellType :: CellType } deriving (Eq, Show) +type Grid = M.Map Point Cell + +makeLenses [''Cell] + +class (Enum a, Eq a, Bounded a) => WrappedBoundedEnum a where + next :: a -> a + prev :: a -> a + + next x = if (maxBound == x) then minBound else succ x + prev x = if (minBound == x) then maxBound else pred x + +instance WrappedBoundedEnum Direction + +right :: Direction -> Direction +right = next + +left :: Direction -> Direction +left = prev + +forwardPoint :: Point -> Direction -> Point +forwardPoint (x, y) North = (x, y - 1) +forwardPoint (x, y) East = (x + 1, y) +forwardPoint (x, y) South = (x, y + 1) +forwardPoint (x, y) West = (x - 1, y) + +rightPoint :: Point -> Direction -> Point +rightPoint (x, y) North = (x + 1, y) +rightPoint (x, y) East = (x, y + 1) +rightPoint (x, y) South = (x - 1, y) +rightPoint (x, y) West = (x, y - 1) + +leftPoint :: Point -> Direction -> Point +leftPoint (x, y) North = (x -1, y) +leftPoint (x, y) East = (x, y - 1) +leftPoint (x, y) South = (x + 1, y) +leftPoint (x, y) West = (x, y + 1) + +lookupCell :: Point -> Grid -> Maybe Cell +lookupCell = M.lookup + +forwardCell :: Cell -> Direction -> Grid -> Maybe Cell +forwardCell (Cell point _) = lookupCell . (forwardPoint point) + +rightCell :: Cell -> Direction -> Grid -> Maybe Cell +rightCell (Cell point _) = lookupCell . (rightPoint point) + +leftCell :: Cell -> Direction -> Grid -> Maybe Cell +leftCell (Cell point _) = lookupCell . (leftPoint point) + +gridFromCellList :: [Cell] -> Grid +gridFromCellList = foldl (\m cell@(Cell p _) -> M.insert p cell m) M.empty diff --git a/chapter2/prob27.hs b/chapter2/random-grid.hs similarity index 98% rename from chapter2/prob27.hs rename to chapter2/random-grid.hs index 496881a..8a35067 100644 --- a/chapter2/prob27.hs +++ b/chapter2/random-grid.hs @@ -1,6 +1,6 @@ module AI.Vacuum.RandomGrid where -import AI.Vacuum +import AI.Vacuum.Grid import System.Random import Control.Monad.State import qualified Data.Map as M diff --git a/chapter2/prob28.hs b/chapter2/reflex-agent.hs similarity index 97% rename from chapter2/prob28.hs rename to chapter2/reflex-agent.hs index db6c03e..7c160ea 100644 --- a/chapter2/prob28.hs +++ b/chapter2/reflex-agent.hs @@ -1,6 +1,7 @@ module AI.Vacuum.ReflexAgent where -import AI.Vacuum +import AI.Vacuum.Cleaner +import AI.Vacuum.Grid import AI.Vacuum.RandomGrid import Data.Lens.Common import Control.Monad.State diff --git a/chapter2/prob26.hs b/chapter2/table-lookup-agent.hs similarity index 98% rename from chapter2/prob26.hs rename to chapter2/table-lookup-agent.hs index 3cb32d6..cf8e23d 100644 --- a/chapter2/prob26.hs +++ b/chapter2/table-lookup-agent.hs @@ -1,6 +1,7 @@ module AI.Vacuum.TableLookupAgent where -import AI.Vacuum +import AI.Vacuum.Cleaner +import AI.Vacuum.Grid import Control.Monad.State import Data.Lens.Common import Data.Maybe (isJust, isNothing, fromJust)