X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent14%2FMain.hs;h=e7e8d5b53173018faff8bde55d43e6a625d30c2a;hb=dd72089097a0df4238584f21a8078248bcf30117;hp=d3b0c621feaeedc80e070b07b2237d36aa7fbe5b;hpb=ac1cb7b87194225d518bae8e5a9d9efe7d27220a;p=advent-of-code-23.git diff --git a/advent14/Main.hs b/advent14/Main.hs index d3b0c62..e7e8d5b 100644 --- a/advent14/Main.hs +++ b/advent14/Main.hs @@ -2,29 +2,22 @@ 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 = @@ -44,21 +37,20 @@ 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 @@ -74,25 +66,25 @@ rollCycle rGrid cGrid = foldl' go rGrid [ (V2 0 0, V2 0 1, V2 1 0) 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) @@ -110,13 +102,13 @@ readGrids text = (rGrid, cGrid) 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