Renamed files and moved cleaner and grid codes in separate files
parent
82361f606a
commit
7b7b4f4eca
|
@ -1,7 +1,8 @@
|
||||||
{-# LANGUAGE FlexibleContexts, TemplateHaskell #-}
|
{-# LANGUAGE FlexibleContexts, TemplateHaskell #-}
|
||||||
|
|
||||||
module AI.Vacuum where
|
module AI.Vacuum.Cleaner where
|
||||||
|
|
||||||
|
import AI.Vacuum.Grid
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Prelude hiding (id, (.))
|
import Prelude hiding (id, (.))
|
||||||
|
@ -9,24 +10,11 @@ import Control.Category
|
||||||
import Data.Maybe (isJust, isNothing, fromJust)
|
import Data.Maybe (isJust, isNothing, fromJust)
|
||||||
import Data.Lens.Common
|
import Data.Lens.Common
|
||||||
import Data.Lens.Template
|
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)
|
data Percept = TouchSensor | PhotoSensor | InfraredSensor deriving (Eq, Ord, Show)
|
||||||
type Percepts = [Percept]
|
type Percepts = [Percept]
|
||||||
type PerceptsHistory = [Percepts]
|
type PerceptsHistory = [Percepts]
|
||||||
data Action = GoForward | TurnRight | TurnLeft | SuckDirt | TurnOff deriving (Eq, Show)
|
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)
|
data CleanerState = On | Off deriving (Eq, Show)
|
||||||
type Score = Int
|
type Score = Int
|
||||||
|
@ -41,55 +29,7 @@ data Cleaner =
|
||||||
_score :: Score
|
_score :: Score
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
makeLenses [''Cell, ''Cleaner]
|
makeLenses [''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
|
|
||||||
|
|
||||||
createCleaner :: Cell -> Direction -> Cleaner
|
createCleaner :: Cell -> Direction -> Cleaner
|
||||||
createCleaner cell dir = Cleaner On cell dir [cell^.point] [] [] 0
|
createCleaner cell dir = Cleaner On cell dir [cell^.point] [] [] 0
|
|
@ -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
|
|
@ -1,6 +1,6 @@
|
||||||
module AI.Vacuum.RandomGrid where
|
module AI.Vacuum.RandomGrid where
|
||||||
|
|
||||||
import AI.Vacuum
|
import AI.Vacuum.Grid
|
||||||
import System.Random
|
import System.Random
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
|
@ -1,6 +1,7 @@
|
||||||
module AI.Vacuum.ReflexAgent where
|
module AI.Vacuum.ReflexAgent where
|
||||||
|
|
||||||
import AI.Vacuum
|
import AI.Vacuum.Cleaner
|
||||||
|
import AI.Vacuum.Grid
|
||||||
import AI.Vacuum.RandomGrid
|
import AI.Vacuum.RandomGrid
|
||||||
import Data.Lens.Common
|
import Data.Lens.Common
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
|
@ -1,6 +1,7 @@
|
||||||
module AI.Vacuum.TableLookupAgent where
|
module AI.Vacuum.TableLookupAgent where
|
||||||
|
|
||||||
import AI.Vacuum
|
import AI.Vacuum.Cleaner
|
||||||
|
import AI.Vacuum.Grid
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Data.Lens.Common
|
import Data.Lens.Common
|
||||||
import Data.Maybe (isJust, isNothing, fromJust)
|
import Data.Maybe (isJust, isNothing, fromJust)
|
Loading…
Reference in New Issue