From: Neil Smith Date: Tue, 5 Jan 2021 11:19:13 +0000 (+0000) Subject: Now with hashes to speed up duplicate game detection X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=facb3213b69e61e75fbde2abcb1c4ba11297f2c9;p=advent-of-code-20.git Now with hashes to speed up duplicate game detection --- diff --git a/advent22/package.yaml b/advent22/package.yaml index fcd8854..e0d40a8 100644 --- a/advent22/package.yaml +++ b/advent22/package.yaml @@ -59,3 +59,4 @@ executables: - text - attoparsec - containers + - hashable diff --git a/advent22/src/advent22.hs b/advent22/src/advent22.hs index 96ec70b..ac5162d 100644 --- a/advent22/src/advent22.hs +++ b/advent22/src/advent22.hs @@ -10,26 +10,33 @@ import Control.Applicative -- import Control.Applicative.Combinators import qualified Data.Set as S +import qualified Data.IntMap.Strict as M import qualified Data.Sequence as Q import Data.Sequence (Seq (Empty, (:<|), (:|>)), (<|), (|>)) +import Data.Foldable (toList) +import Data.Hashable (hash) + + type Deck = Q.Seq Int type Game = (Deck, Deck) data Player = P1 | P2 deriving (Show, Eq) +type Cache = M.IntMap (S.Set Game) + main :: IO () main = do text <- TIO.readFile "data/advent22.txt" let decks = successfulParse text - print decks - print $ play decks + -- print decks + -- print $ play decks print $ part1 decks print $ part2 decks part1 decks = score $ winningDeck $ play decks -part2 decks = score $ snd $ playRecursive decks S.empty +part2 decks = score $ snd $ playRecursive decks M.empty play = until finished playRound @@ -43,26 +50,22 @@ playRound ((x :<| xs), (y :<| ys)) | x < y = (xs, ys |> y |> x) | otherwise = (xs |> x |> y, ys) -winningDeck game = case (winner game) of - P1 -> fst game - P2 -> snd game +winningDeck (Empty, ys) = ys +winningDeck (xs, _) = xs -winner :: Game -> Player -winner (Empty, ys) = P2 -winner (xs, _) = P1 score :: Deck -> Int score = Q.foldrWithIndex (\i c s -> s + (i + 1) * c) 0 . Q.reverse -playRecursive :: Game -> (S.Set Game) -> (Player, Deck) +playRecursive :: Game -> Cache -> (Player, Deck) playRecursive (Empty, ys) _ = (P2, ys) playRecursive (xs, Empty) _ = (P1, xs) playRecursive g@(x :<| xs, y :<| ys) seen - | g `S.member` seen = (P1, x :<| xs) + | g `inCache` seen = (P1, x :<| xs) | (lengthAtLeast x xs) && (lengthAtLeast y ys) = playRecursive subG seen' | otherwise = playRecursive compareG seen' - where seen' = S.insert g seen + where seen' = enCache g seen (subWinner, _) = playRecursive (Q.take x xs, Q.take y ys) seen' subG = updateDecks subWinner g compareWinner = if x < y then P2 else P1 @@ -75,6 +78,24 @@ updateDecks P2 (x :<| xs, y :<| ys) = (xs, ys |> y |> x) lengthAtLeast n s = Q.length s >= n +hashGame (xs, ys) = + hash ( toList $ Q.take 2 xs + , toList $ Q.take 2 ys + -- , Q.length xs + -- , Q.length ys + ) + +inCache :: Game -> Cache -> Bool +inCache game cache = case (M.lookup h cache) of + Just games -> game `S.member` games + Nothing -> False + where h = hashGame game + +enCache :: Game -> Cache -> Cache +enCache game cache = case (M.lookup h cache) of + Just games -> M.insert h (S.insert game games) cache + Nothing -> M.insert h (S.singleton game) cache + where h = hashGame game -- Parse the input file