Skip to content
Permalink
Browse files

Use arrays!

  • Loading branch information...
jhb563 committed Apr 1, 2019
1 parent 0869a03 commit e30553f6618a3e06444ee3944a459fafb5bec719
Showing with 17 additions and 14 deletions.
  1. +1 −0 MazeGame.cabal
  2. +9 −9 src/MazeParser.hs
  3. +4 −3 src/Runner.hs
  4. +1 −1 src/Types.hs
  5. +2 −1 test/Spec.hs
@@ -68,6 +68,7 @@ test-suite MazeGame-test
build-depends:
MazeGame
, base >=4.7 && <5
, array
, containers
, hspec
, megaparsec
@@ -62,7 +62,7 @@ mazeParser (numRows, numColumns) = do
return (j, c)
M.newline
return $ map (\(col, char) -> ((col, i), char)) columns
return $ Map.fromList (cellSpecToBounds <$> (concat rows))
return $ Array.array ((0,0), (numColumns - 1, numRows - 1)) (cellSpecToBounds <$> (concat rows))
where
cellSpecToBounds :: (Location, Char) -> (Location, CellBoundaries)
cellSpecToBounds (loc@(x, y), c) =
@@ -108,10 +108,10 @@ dumpMaze :: Maze -> Text
dumpMaze maze = pack $ (unlines . reverse) (rowToString <$> cellsByRow)
where
transposedMap :: Maze
transposedMap = Map.mapKeys (\(x, y) -> (y, x)) maze
transposedMap = Array.ixmap (Array.bounds maze) (\(x, y) -> (y, x)) maze

cellsByRow :: [[(Location, CellBoundaries)]]
cellsByRow = groupBy (\((r1, _), _) ((r2, _), _) -> r1 == r2) (Map.toList transposedMap)
cellsByRow = groupBy (\((r1, _), _) ((r2, _), _) -> r1 == r2) (Array.assocs transposedMap)

rowToString :: [(Location, CellBoundaries)] -> String
rowToString = map (cellToChar . snd)
@@ -170,12 +170,12 @@ dfsSearch = do
where
findCandidates :: Location -> Maze -> Set.Set Location -> [(Location, CellBoundaries, Location, CellBoundaries)]
findCandidates currentLocation@(x, y) bounds visited =
let currentLocBounds = fromJust $ Map.lookup currentLocation bounds
let currentLocBounds = bounds Array.! currentLocation
upLoc = (x, y + 1)
maybeUpCell = case (upBoundary currentLocBounds, Set.member upLoc visited) of
(Wall, False) -> Just
( upLoc
, (fromJust $ Map.lookup upLoc bounds) {downBoundary = AdjacentCell currentLocation}
, (bounds Array.! upLoc) {downBoundary = AdjacentCell currentLocation}
, currentLocation
, currentLocBounds {upBoundary = AdjacentCell upLoc}
)
@@ -184,7 +184,7 @@ dfsSearch = do
maybeRightCell = case (rightBoundary currentLocBounds, Set.member rightLoc visited) of
(Wall, False) -> Just
( rightLoc
, (fromJust $ Map.lookup rightLoc bounds) {leftBoundary = AdjacentCell currentLocation}
, (bounds Array.! rightLoc) {leftBoundary = AdjacentCell currentLocation}
, currentLocation
, currentLocBounds {rightBoundary = AdjacentCell rightLoc}
)
@@ -193,7 +193,7 @@ dfsSearch = do
maybeDownCell = case (downBoundary currentLocBounds, Set.member downLoc visited) of
(Wall, False) -> Just
( downLoc
, (fromJust $ Map.lookup downLoc bounds) {upBoundary = AdjacentCell currentLocation}
, (bounds Array.! downLoc) {upBoundary = AdjacentCell currentLocation}
, currentLocation
, currentLocBounds {downBoundary = AdjacentCell downLoc}
)
@@ -202,7 +202,7 @@ dfsSearch = do
maybeLeftCell = case (leftBoundary currentLocBounds, Set.member leftLoc visited) of
(Wall, False) -> Just
( leftLoc
, (fromJust $ Map.lookup leftLoc bounds) {rightBoundary = AdjacentCell currentLocation}
, (bounds Array.! leftLoc) {rightBoundary = AdjacentCell currentLocation}
, currentLocation
, currentLocBounds {leftBoundary = AdjacentCell leftLoc}
)
@@ -216,6 +216,6 @@ dfsSearch = do
(SearchState gen currentLocs boundsMap visited) <- get
let (randomIndex, newGen) = randomR (0, (length candidates) - 1) gen
(chosenLocation, newChosenBounds, prevLocation, newPrevBounds) = candidates !! randomIndex
newBounds = Map.insert prevLocation newPrevBounds (Map.insert chosenLocation newChosenBounds boundsMap)
newBounds = boundsMap Array.// [(chosenLocation, newChosenBounds), (prevLocation, newPrevBounds)]
newVisited = Set.insert chosenLocation visited
put (SearchState newGen (chosenLocation : currentLocs) newBounds newVisited)
@@ -28,7 +28,8 @@ windowDisplay :: Display
windowDisplay = InWindow "Window" (625, 625) (10, 10)

boundariesMap :: (Int, Int) -> Maze
boundariesMap (numColumns, numRows) = Map.fromList
boundariesMap (numColumns, numRows) = Array.array
((0,0), (numRows - 1, numColumns - 1))
(buildBounds <$> (range ((0,0), (numColumns - 1, numRows - 1))))
where
buildBounds :: Location -> (Location, CellBoundaries)
@@ -77,7 +78,7 @@ drawingFunc (xOffset, yOffset) cellSize world = Pictures [mapGrid, startPic, end
, cellBottomLeft endCoords
])

mapGrid = Pictures $ concatMap makeWallPictures (Map.toList (worldBoundaries world))
mapGrid = Pictures $ concatMap makeWallPictures (Array.assocs (worldBoundaries world))

makeWallPictures :: (Location, CellBoundaries) -> [Picture]
makeWallPictures ((x,y), CellBoundaries up right down left) =
@@ -104,7 +105,7 @@ inputHandler event w = case event of
(EventKey (SpecialKey KeyLeft) Down _ _) -> w { playerLocation = nextLocation leftBoundary }
_ -> w
where
cellBounds = fromJust $ Map.lookup (playerLocation w) (worldBoundaries w)
cellBounds = (worldBoundaries w) Array.! (playerLocation w)

nextLocation :: (CellBoundaries -> BoundaryType) -> Location
nextLocation boundaryFunc = case boundaryFunc cellBounds of
@@ -26,7 +26,7 @@ data CellBoundaries = CellBoundaries
}
deriving (Show, Eq)

type Maze = Map.Map Location CellBoundaries
type Maze = Array.Array Location CellBoundaries

data World = World
{ playerLocation :: Location
@@ -1,3 +1,4 @@
import qualified Data.Array as Array
import qualified Data.Map as Map
import Data.Text (Text, pack)

@@ -36,7 +37,7 @@ testMazeString = pack $ unlines
]

testSolution :: Maze
testSolution = Map.fromList
testSolution = Array.array ((0,0), (4,4))
[ ((0,0), CellBoundaries (AdjacentCell (0,1)) (AdjacentCell (1,0)) WorldBoundary WorldBoundary)
, ((1,0), CellBoundaries (AdjacentCell (1,1)) (AdjacentCell (2,0)) WorldBoundary (AdjacentCell (0,0)))
, ((2,0), CellBoundaries Wall Wall WorldBoundary (AdjacentCell (1,0)))

0 comments on commit e30553f

Please sign in to comment.
You can’t perform that action at this time.