From 6c801843a2c8978cf3ba8616e1949144f5e5f361 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Mon, 18 Dec 2023 09:43:21 +0000 Subject: [PATCH] Day 14 part 1 done, day 2 mostly --- advent-of-code23.cabal | 5 +++ advent14/Main.hs | 92 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 97 insertions(+) create mode 100644 advent14/Main.hs diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal index 0470023..5af0b4b 100644 --- a/advent-of-code23.cabal +++ b/advent-of-code23.cabal @@ -181,3 +181,8 @@ executable advent13 import: common-extensions, build-directives main-is: advent13/Main.hs build-depends: split + +executable advent14 + import: common-extensions, build-directives + main-is: advent14/Main.hs + build-depends: containers diff --git a/advent14/Main.hs b/advent14/Main.hs new file mode 100644 index 0000000..efd4db6 --- /dev/null +++ b/advent14/Main.hs @@ -0,0 +1,92 @@ +-- Writeup at https://work.njae.me.uk/2023/12/15/advent-of-code-2023-day-13/ + +import AoC +import Data.List +import Data.Semigroup +import Data.Monoid +import qualified Data.Map.Strict as M + +data Element = Empty | Cube | Round deriving (Show, Eq, Ord) +type Grid = [[Element]] + +type Cache = M.Map Grid Int + + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + let grid = transpose $ fmap (fmap readElem) $ lines text + -- print grid + -- print $ rollGrid $ transpose grid + -- let r1 = rollToCompletion grid + -- print r1 + -- putStrLn $ showGrid r1 + -- print $ transpose $ fmap reverse r1 + print $ part1 grid + -- print $ rollCycle grid + -- putStrLn $ showGrid $ rollCycle grid + -- putStrLn $ showGrid $ rollCycle $ rollCycle grid + -- putStrLn $ showGrid $ rollCycle $ rollCycle $ rollCycle grid + -- print $ findRepeat grid + + + + print $ part2 grid + -- print $ part2 patts + +part1 :: Grid -> Int +part1 grid = scoreGrid grid' + where grid' = rollToCompletion grid + +part2 grid = scoreGrid finalGrid + where (grid', cache, i) = findRepeat grid + repeatStart = cache M.! grid' + repeatLen = i - repeatStart + finalIndex = (1e9 - repeatStart - 1) `mod` repeatLen + (finalGrid, _) = M.findMin $ M.filter (== finalIndex) cache + +readElem :: Char -> Element +readElem '.' = Empty +readElem '#' = Cube +readElem 'O' = Round + +rollToCompletion :: Grid -> Grid +rollToCompletion grid = fst $ head $ dropWhile (uncurry (/=)) $ zip states $ tail states + where states = iterate rollGrid grid + +rollGrid :: Grid -> Grid +rollGrid = fmap roll + +roll :: [Element] -> [Element] +roll [] = [] +roll (l:ls) = rs ++ [r] + where (rs, r) = foldl' rollStep ([], l) ls + +rollStep :: ([Element], Element) -> Element -> ([Element], Element) +rollStep (handled, Empty) Round = (handled ++ [Round], Empty) +rollStep (handled, target) source = (handled ++ [target], source) + +scoreGrid :: Grid -> Int +scoreGrid grid = sum $ fmap scoreRow indexedGrid + where indexedGrid = zip [1..] $ reverse $ transpose grid + scoreRow (i, r) = i * (length $ filter (== Round) r) + +rotate1 :: Grid -> Grid +rotate1 = transpose . fmap reverse + +rollCycle :: Grid -> Grid +rollCycle = appEndo (stimes 4 (Endo rotate1 <> Endo rollToCompletion)) + +showGrid :: Grid -> String +showGrid grid = unlines $ fmap (fmap showElem) $ transpose grid + where showElem Empty = '.' + showElem Cube = '#' + showElem Round = 'O' + + +rollCycleWithCache (grid, cache, index) = (rollCycle grid, M.insert grid index cache, (index + 1)) + +findRepeat grid = head $ dropWhile test $ iterate rollCycleWithCache (grid, M.empty, 0) + where test (g, c, i) = g `M.notMember` c + -- 2.34.1