src/advent18/advent18.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 -- import Debug.Trace
   4
   5 import Data.Text (Text)
   6 -- import qualified Data.Text as T
   7 import qualified Data.Text.IO as TIO
   8
   9 import Data.Void (Void)
  10
  11 import Text.Megaparsec
  12 import Text.Megaparsec.Char
  13 import qualified Text.Megaparsec.Char.Lexer as L
  14 import qualified Control.Applicative as CA
  15
  16 import Data.List
  17 -- import qualified Data.Set as S
  18
  19 import qualified Data.Map.Strict as M
  20 import Data.Map.Strict ((!))
  21 -- import Data.Tuple (swap)
  22
  23 type Coord = (Int, Int) -- row, col
  24 data Cell = Open | Trees | Lumberyard deriving (Eq, Enum, Bounded, Ord)
  25 type World = M.Map Coord Cell
  26 type Cache = M.Map World Int
  27
  28 instance Show Cell where
  29     show Open = "."
  30     show Trees = "|"
  31     show Lumberyard = "#"
  32
  33 main :: IO ()
  34 main = do
  35     text <- TIO.readFile "data/advent18.txt"
  36     let worldSpec = successfulParse text
  37     let world = makeWorld worldSpec
  38     -- print $ neighbours (1, 1) world
  39     -- putStrLn $ showWorld world
  40     -- putStrLn $ showWorld $ generation world
  41     -- putStrLn $ showWorld $ (iterate generation world)!!10
  42     print $ part1 world
  43     print $ part2 world
  44
  45 part1 :: World -> Int
  46 part1 world = score ((iterate generation world)!!10)
  47
  48 part2 :: World -> Int
  49 part2 world = score usedWorld
  50     where (worlds, repeated) = cacheWorlds world
  51           lastMinute = M.size worlds
  52           prevMinute = worlds!repeated
  53           final = 1000000000
  54           cycleLength = lastMinute - prevMinute
  55           nCycles = (final - lastMinute) `div` cycleLength
  56           usedIteration = final - (lastMinute + nCycles * cycleLength) + prevMinute
  57           usedWorld = head $ M.keys $ M.filter (== usedIteration) worlds
  58
  59
  60 score :: World -> Int
  61 score world = nTrees * nLumber
  62     where nTrees = M.size $ M.filter (== Trees) world
  63           nLumber = M.size $ M.filter (== Lumberyard) world
  64
  65 makeWorld :: [[Cell]] -> World
  66 makeWorld rows = M.unions $ [makeWorldRow r row | (r, row) <- zip [1..] rows]
  67
  68 makeWorldRow :: Int -> [Cell] -> World
  69 makeWorldRow r row = M.fromList [((r, c), cell) | (c, cell) <- zip [1..] row]
  70
  71 neighbours :: Coord -> World -> World
  72 neighbours here world = M.filterWithKey isNeighbour world
  73     where isNeighbour c _ = c `elem` neighbourCoords here
  74
  75 neighbourCoords :: Coord -> [Coord]
  76 neighbourCoords (r, c) = [(r', c') | r' <- [(r - 1)..(r + 1)]
  77                                    , c' <- [(c - 1)..(c + 1)]
  78                                    , ((r' /= r) || (c' /= c))
  79                                    ]
  80
  81 showWorld world = unlines $ [showWorldRow r world | r <-[minR..maxR]]
  82     where ((minR, _), _) = M.findMin world
  83           ((maxR, _), _) = M.findMax world
  84
  85 showWorldRow r world = concat [show (lookupCell (r, c) world) | c <- [minC..maxC]]
  86     where ((_, minC), _) = M.findMin world
  87           ((_, maxC), _) = M.findMax world
  88
  89
  90 lookupCell :: Coord -> World -> Cell
  91 lookupCell coord world = M.findWithDefault Open coord world
  92
  93 generation :: World -> World
  94 generation world = M.mapWithKey generationCell world
  95     where generationCell here _ = propogateCell here world
  96
  97 propogateCell :: Coord -> World -> Cell
  98 propogateCell here world = propogateCell' (world!here)
  99     where propogateCell' Open = if nTrees >= 3 then Trees else Open
 100           propogateCell' Trees = if nLumber >= 3 then Lumberyard else Trees
 101           propogateCell' Lumberyard = if (nLumber >= 1) && (nTrees >= 1) then Lumberyard else Open
 102           ns = neighbours here world
 103           nTrees = M.size $ M.filter (== Trees) ns
 104           nLumber = M.size $ M.filter (== Lumberyard) ns
 105
 106 cacheWorlds :: World -> (Cache, World)
 107 cacheWorlds world = go (M.empty, world, 0) (drop 1 $ iterate generation world)
 108     where go (cache, prev, minute) [] = (cache, prev)
 109           go (cache, prev, minute) (w:ws) =
 110             if w `M.member` cache
 111             then (cache', w)
 112             else go (cache', w, minute + 1) ws
 113             where cache' = M.insert prev minute cache
 114
 115 -- Parse the input file
 116
 117 type Parser = Parsec Void Text
 118
 119 sc :: Parser ()
 120 sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 121
 122 -- lexeme  = L.lexeme sc
 123 -- integer = lexeme L.decimal
 124 symb = L.symbol sc
 125
 126 openP = (symb "." *> pure Open)
 127 treesP = (symb "|" *> pure Trees)
 128 lumberP = (symb "#" *> pure Lumberyard)
 129 cellP = openP <|> treesP <|> lumberP
 130
 131 fileP =  rowP `sepEndBy` (char '\n')
 132
 133 rowP = many cellP
 134
 135 successfulParse :: Text -> [[Cell]]
 136 successfulParse input =
 137         case parse fileP "input" input of
 138                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 139                 Right world -> world