Day 18

[advent-of-code-18.git] / src / advent18 / advent18.hs

diff --git a/src/advent18/advent18.hs b/src/advent18/advent18.hs
new file mode 100644 (file)
index 0000000..39da4c5
--- /dev/null
+++ b/src/advent18/advent18.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- import Debug.Trace
+
+import Data.Text (Text)
+-- import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import Data.Void (Void)
+
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+import qualified Control.Applicative as CA
+
+import Data.List
+-- import qualified Data.Set as S
+
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+-- import Data.Tuple (swap)
+
+type Coord = (Int, Int) -- row, col
+data Cell = Open | Trees | Lumberyard deriving (Eq, Enum, Bounded, Ord)
+type World = M.Map Coord Cell
+type Cache = M.Map World Int
+
+instance Show Cell where
+    show Open = "."
+    show Trees = "|"
+    show Lumberyard = "#"
+
+main :: IO ()
+main = do 
+    text <- TIO.readFile "data/advent18.txt"
+    let worldSpec = successfulParse text
+    let world = makeWorld worldSpec
+    -- print $ neighbours (1, 1) world
+    -- putStrLn $ showWorld world
+    -- putStrLn $ showWorld $ generation world
+    -- putStrLn $ showWorld $ (iterate generation world)!!10
+    print $ part1 world
+    print $ part2 world
+
+part1 :: World -> Int
+part1 world = score ((iterate generation world)!!10)
+
+part2 :: World -> Int
+part2 world = score usedWorld
+    where (worlds, repeated) = cacheWorlds world
+          lastMinute = M.size worlds
+          prevMinute = worlds!repeated
+          final = 1000000000
+          cycleLength = lastMinute - prevMinute
+          nCycles = (final - lastMinute) `div` cycleLength
+          usedIteration = final - (lastMinute + nCycles * cycleLength) + prevMinute
+          usedWorld = head $ M.keys $ M.filter (== usedIteration) worlds
+
+
+score :: World -> Int
+score world = nTrees * nLumber
+    where nTrees = M.size $ M.filter (== Trees) world
+          nLumber = M.size $ M.filter (== Lumberyard) world
+
+makeWorld :: [[Cell]] -> World
+makeWorld rows = M.unions $ [makeWorldRow r row | (r, row) <- zip [1..] rows]
+
+makeWorldRow :: Int -> [Cell] -> World
+makeWorldRow r row = M.fromList [((r, c), cell) | (c, cell) <- zip [1..] row]
+
+neighbours :: Coord -> World -> World
+neighbours here world = M.filterWithKey isNeighbour world
+    where isNeighbour c _ = c `elem` neighbourCoords here
+
+neighbourCoords :: Coord -> [Coord]
+neighbourCoords (r, c) = [(r', c') | r' <- [(r - 1)..(r + 1)]
+                                   , c' <- [(c - 1)..(c + 1)]
+                                   , ((r' /= r) || (c' /= c))
+                                   ]
+
+showWorld world = unlines $ [showWorldRow r world | r <-[minR..maxR]]
+    where ((minR, _), _) = M.findMin world
+          ((maxR, _), _) = M.findMax world
+
+showWorldRow r world = concat [show (lookupCell (r, c) world) | c <- [minC..maxC]]
+    where ((_, minC), _) = M.findMin world
+          ((_, maxC), _) = M.findMax world
+
+
+lookupCell :: Coord -> World -> Cell
+lookupCell coord world = M.findWithDefault Open coord world
+
+generation :: World -> World
+generation world = M.mapWithKey generationCell world
+    where generationCell here _ = propogateCell here world
+
+propogateCell :: Coord -> World -> Cell
+propogateCell here world = propogateCell' (world!here)
+    where propogateCell' Open = if nTrees >= 3 then Trees else Open
+          propogateCell' Trees = if nLumber >= 3 then Lumberyard else Trees
+          propogateCell' Lumberyard = if (nLumber >= 1) && (nTrees >= 1) then Lumberyard else Open
+          ns = neighbours here world
+          nTrees = M.size $ M.filter (== Trees) ns
+          nLumber = M.size $ M.filter (== Lumberyard) ns
+
+cacheWorlds :: World -> (Cache, World)
+cacheWorlds world = go (M.empty, world, 0) (drop 1 $ iterate generation world)
+    where go (cache, prev, minute) [] = (cache, prev)
+          go (cache, prev, minute) (w:ws) = 
+            if w `M.member` cache
+            then (cache', w)
+            else go (cache', w, minute + 1) ws
+            where cache' = M.insert prev minute cache
+
+-- Parse the input file
+
+type Parser = Parsec Void Text
+
+sc :: Parser ()
+sc = L.space (skipSome (char ' ')) CA.empty CA.empty
+
+-- lexeme  = L.lexeme sc
+-- integer = lexeme L.decimal
+symb = L.symbol sc
+
+openP = (symb "." *> pure Open)
+treesP = (symb "|" *> pure Trees)
+lumberP = (symb "#" *> pure Lumberyard)
+cellP = openP <|> treesP <|> lumberP
+
+fileP =  rowP `sepEndBy` (char '\n')
+
+rowP = many cellP
+
+successfulParse :: Text -> [[Cell]]
+successfulParse input = 
+        case parse fileP "input" input of
+                Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+                Right world -> world
\ No newline at end of file