import AoC
import Data.List
-import qualified Data.Map.Strict as Map
+import qualified Data.Map.Strict as M
import qualified Data.Array.Unboxed as U
-import qualified Data.Array.ST as M
+import qualified Data.Array.ST as A
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Data.Ix
-
-
import Linear (V2(..), (^+^))
import qualified Data.Sequence as Q
import Data.Sequence (Seq( (:|>), (:<|) ) )
-data Element = Empty | Cube | Round deriving (Show, Eq, Ord)
-
type Position = V2 Int
type Grid = U.UArray Position Bool
-type MGrid s = M.STUArray s Position Bool
-
+type MGrid s = A.STUArray s Position Bool
type Gaps s = STRef s (Q.Seq Position)
-
-type Cache = Map.Map Grid Int
-
+type Cache = M.Map Grid Int
main :: IO ()
main =
print $ part2 rGrid cGrid
-part1 :: Grid -> Grid -> Int
+part1, part2 :: Grid -> Grid -> Int
part1 rGrid cGrid = getLoad $ rollNorth rGrid cGrid
-
part2 rGrid cGrid = getLoad finalGrid
where (grid', cache, repeatEnd) = findRepeat rGrid cGrid
- repeatStart = cache Map.! grid'
+ repeatStart = cache M.! grid'
repeatLen = repeatEnd - repeatStart
finalIndex = ((1e9 - repeatStart) `mod` repeatLen) + repeatStart
- (finalGrid, _) = Map.findMin $ Map.filter (== finalIndex) cache
+ (finalGrid, _) = M.findMin $ M.filter (== finalIndex) cache
findRepeat :: Grid -> Grid -> (Grid, Cache, Int)
-findRepeat rGrid cGrid = head $ dropWhile test $ iterate go (rGrid, Map.empty, 0)
- where test (g, c, _) = g `Map.notMember` c
- go (g, c, i) = (rollCycle g cGrid, Map.insert g i c, (i + 1))
+findRepeat rGrid cGrid = head $ dropWhile test $ iterate go (rGrid, M.empty, 0)
+ where test (g, c, _) = g `M.notMember` c
+ go (g, c, i) = (rollCycle g cGrid, M.insert g i c, (i + 1))
rollNorth, rollCycle :: Grid -> Grid -> Grid
rollNorth rGrid cGrid = roll (V2 0 0) (V2 0 1) (V2 1 0) cGrid rGrid
roll :: Position -> Position -> Position -> Grid -> Grid -> Grid
roll start majorStep minorStep cGrid rGrid =
- M.runSTUArray $
- do grid <- M.thaw rGrid
+ A.runSTUArray $
+ do grid <- A.thaw rGrid
holes <- newSTRef Q.Empty
forM_ (takeWhile (inBounds rGrid) $ iterate (^+^ majorStep) start) $ \maj ->
do writeSTRef holes Q.Empty
forM_ (takeWhile (inBounds rGrid) $ iterate (^+^ minorStep) maj) $ \here ->
- do rollPosition grid cGrid holes here
+ rollPosition grid cGrid holes here
return grid
rollPosition :: (MGrid s) -> Grid -> (Gaps s) -> Position -> ST s ()
rollPosition grid cGrid holes here
| cGrid U.! here = writeSTRef holes Q.Empty
- | otherwise = do roundHere <- M.readArray grid here
+ | otherwise = do roundHere <- A.readArray grid here
holesVal <- readSTRef holes
if roundHere then
case holesVal of
Q.Empty -> return ()
- (h :<| hs) -> do M.writeArray grid h True
- M.writeArray grid here False
+ (h :<| hs) -> do A.writeArray grid h True
+ A.writeArray grid here False
writeSTRef holes (hs :|> here)
else modifySTRef holes (:|> here)
where rows = lines text
r = length rows - 1
c = (length $ head rows) - 1
- rGrid = U.listArray ((V2 0 0), (V2 r c)) $ map ((== Round) . readElem) $ concat rows
- cGrid = U.listArray ((V2 0 0), (V2 r c)) $ map ((== Cube ) . readElem) $ concat rows
+ rGrid = U.listArray ((V2 0 0), (V2 r c)) $ fmap (== 'O') $ concat rows
+ cGrid = U.listArray ((V2 0 0), (V2 r c)) $ fmap (== '#') $ concat rows
-readElem :: Char -> Element
-readElem '.' = Empty
-readElem '#' = Cube
-readElem 'O' = Round
+-- readElem :: Char -> Element
+-- readElem '.' = Empty
+-- readElem '#' = Cube
+-- readElem 'O' = Round
showGrid :: Grid -> Grid -> String
showGrid rGrid cGrid = unlines rows