projects
/
advent-of-code-23.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
ac1cb7b
)
Tweaking and tidying
author
Neil Smith
<NeilNjae@users.noreply.github.com>
Mon, 22 Jan 2024 15:45:49 +0000
(15:45 +0000)
committer
Neil Smith
<NeilNjae@users.noreply.github.com>
Mon, 22 Jan 2024 15:45:49 +0000
(15:45 +0000)
advent14/Main.hs
patch
|
blob
|
history
diff --git
a/advent14/Main.hs
b/advent14/Main.hs
index d3b0c621feaeedc80e070b07b2237d36aa7fbe5b..e7e8d5b53173018faff8bde55d43e6a625d30c2a 100644
(file)
--- a/
advent14/Main.hs
+++ b/
advent14/Main.hs
@@
-2,29
+2,22
@@
import AoC
import Data.List
import AoC
import Data.List
-import qualified Data.Map.Strict as M
ap
+import qualified Data.Map.Strict as M
import qualified Data.Array.Unboxed as U
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 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( (:|>), (:<|) ) )
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 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 Gaps s = STRef s (Q.Seq Position)
-
-type Cache = Map.Map Grid Int
-
+type Cache = M.Map Grid Int
main :: IO ()
main =
main :: IO ()
main =
@@
-44,21
+37,20
@@
main =
print $ part2 rGrid cGrid
print $ part2 rGrid cGrid
-part1 :: Grid -> Grid -> Int
+part1
, part2
:: Grid -> Grid -> Int
part1 rGrid cGrid = getLoad $ rollNorth rGrid cGrid
part1 rGrid cGrid = getLoad $ rollNorth rGrid cGrid
-
part2 rGrid cGrid = getLoad finalGrid
where (grid', cache, repeatEnd) = findRepeat rGrid cGrid
part2 rGrid cGrid = getLoad finalGrid
where (grid', cache, repeatEnd) = findRepeat rGrid cGrid
- repeatStart = cache M
ap
.! grid'
+ repeatStart = cache M.! grid'
repeatLen = repeatEnd - repeatStart
finalIndex = ((1e9 - repeatStart) `mod` repeatLen) + repeatStart
repeatLen = repeatEnd - repeatStart
finalIndex = ((1e9 - repeatStart) `mod` repeatLen) + repeatStart
- (finalGrid, _) = M
ap.findMin $ Map
.filter (== finalIndex) cache
+ (finalGrid, _) = M
.findMin $ M
.filter (== finalIndex) cache
findRepeat :: Grid -> Grid -> (Grid, Cache, Int)
findRepeat :: Grid -> Grid -> (Grid, Cache, Int)
-findRepeat rGrid cGrid = head $ dropWhile test $ iterate go (rGrid, M
ap
.empty, 0)
- where test (g, c, _) = g `M
ap
.notMember` c
- go (g, c, i) = (rollCycle g cGrid, M
ap
.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
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 =
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 ->
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
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 ()
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)
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
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
showGrid :: Grid -> Grid -> String
showGrid rGrid cGrid = unlines rows