From 46154a9a1b04b89ba633286adfd9209c6976e77d Mon Sep 17 00:00:00 2001 From: Quinten Kock Date: Tue, 21 Dec 2021 10:03:39 +0100 Subject: [PATCH] day 21 --- 2021/day21.hs | 74 +++++++++++++++++++++++++++++++ 2021/day21p2.hs | 113 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 187 insertions(+) create mode 100644 2021/day21.hs create mode 100644 2021/day21p2.hs diff --git a/2021/day21.hs b/2021/day21.hs new file mode 100644 index 0000000..454979c --- /dev/null +++ b/2021/day21.hs @@ -0,0 +1,74 @@ +module Day21 where +import Control.Monad.Trans.State.Lazy +import Debug.Trace (traceShow) + +data DiceState = DS { count :: Integer, lastValue :: Int} deriving Show +type Dice = State DiceState + +data PlayerState = PS {score :: Integer, field :: Int} deriving Show +data GameState = P1 PlayerState PlayerState | P2 PlayerState PlayerState deriving Show +type Game = State (GameState, DiceState) + +data GameResult = Win1 | Win2 deriving Show + +roll :: Game Int +roll = do + (gs, x) <- get + put (gs, DS (count x + 1) ((lastValue x `mod` 100) + 1)) + traceShow (gs,x) $ return $ lastValue x + +fieldNormalize :: Int -> Int +fieldNormalize x + | x > 10 = fieldNormalize (x-10) + | otherwise = x + +roll3 :: Game Int +roll3 = do + x <- roll + y <- roll + z <- roll + return (x+y+z) + +updatePS :: Int -> PlayerState -> PlayerState +updatePS x (PS score field) = PS (score + fromIntegral nf) nf where nf = fieldNormalize $ field + x + +scores :: GameState -> (Integer,Integer) +scores (P1 x y) = (score x, score y) +scores (P2 x y) = (score x, score y) + +move :: Game (Maybe GameResult) +move = do + rolls <- roll3 + (gs, ds) <- get + let newgame = (case gs of + (P1 p1 p2) -> P2 (updatePS rolls p1) p2 + (P2 p1 p2) -> P1 p1 (updatePS rolls p2)) + put (newgame, ds) + return $ case scores newgame of + (x,_) | x >= 1000 -> Just Win1 + (_,y) | y >= 1000 -> Just Win2 + (_,_) -> Nothing + +runGame :: (GameState, DiceState) -> (GameResult, GameState, DiceState) +runGame gs = case runState move gs of + (Nothing, gs') -> runGame gs' + (Just winner, (gs', ds')) -> (winner, gs', ds') + +part1 :: Int -> Int -> Integer +part1 p1pos p2pos = traceShow (runGame initState) $ case runGame initState of + (Win1, gs, ds) -> let (_, score) = scores gs in score * count ds + (Win2, gs, ds) -> let (score, _) = scores gs in score * count ds + where + initState = (P1 (PS 0 p1pos) (PS 0 p2pos), DS 0 1) + + +main :: IO () +main = do + input <- map (last . words) . lines <$> getContents + let p1pos = read (input !! 0) :: Int + let p2pos = read (input !! 1) :: Int + + let final = part1 p1pos p2pos + + + print "Bye" diff --git a/2021/day21p2.hs b/2021/day21p2.hs new file mode 100644 index 0000000..29b0955 --- /dev/null +++ b/2021/day21p2.hs @@ -0,0 +1,113 @@ +module Day21 where +import Control.Monad +import Debug.Trace (traceShow, trace) +import Data.Array + +data NdState s a = NdState (s -> [(a,s)]) +instance Functor (NdState s) where + fmap = liftM + +instance Applicative (NdState s) where + pure = return + (<*>) = ap + +instance Monad (NdState s) where + return x = NdState (\s -> [(x,s)]) + (NdState f) >>= g = NdState $ \s0 -> + let xs = f s0 in + concatMap (\(x,s) -> let (NdState g') = g x in g' s) xs + +runState :: NdState a b -> a -> [(b,a)] +runState (NdState f) = f + +put :: a -> NdState a () +put x = NdState $ const [((), x)] + +get :: NdState a a +get = NdState (\s -> [(s,s)]) + +putMany :: [a] -> NdState a () +putMany xs = NdState $ const $ map (\x -> ((), x)) xs + +returnMany :: [b] -> NdState a b +returnMany xs = NdState (\s -> map (\x -> (x,s)) xs) + +data PlayerState = PS {score :: Integer, field :: Int} deriving Show +data GameState = P1 PlayerState PlayerState | P2 PlayerState PlayerState deriving Show +-- type Game = State (GameState, DiceState) + + +type Game = NdState GameState + +data GameResult = Win1 | Win2 deriving Show + +gsTuple :: GameState -> (Bool,Int,Int, Int,Int) +gsTuple (P1 (PS s1 f1) (PS s2 f2)) = (False, fromIntegral s1, f1, fromIntegral s2, f2) +gsTuple (P2 (PS s1 f1) (PS s2 f2)) = (True, fromIntegral s1, f1, fromIntegral s2, f2) + +tupleGs :: (Bool,Int,Int,Int,Int) -> GameState +tupleGs (False, s1, f1, s2, f2) = P1 (PS (fromIntegral s1) f1) (PS (fromIntegral s2) f2) +tupleGs (True, s1, f1, s2, f2) = P2 (PS (fromIntegral s1) f1) (PS (fromIntegral s2) f2) + +roll :: Game Int +roll = returnMany [1,2,3] + +fieldNormalize :: Int -> Int +fieldNormalize x + | x > 10 = fieldNormalize (x-10) + | otherwise = x + +roll3 :: Game Int +roll3 = do + x <- roll + y <- roll + z <- roll + return (x+y+z) + +updatePS :: Int -> PlayerState -> PlayerState +updatePS x (PS score field) = PS (score + fromIntegral nf) nf where nf = fieldNormalize $ field + x + +scores :: GameState -> (Integer,Integer) +scores (P1 x y) = (score x, score y) +scores (P2 x y) = (score x, score y) + +move :: Game (Maybe GameResult) +move = do + rolls <- roll3 + gs <- get + let newgame = (case gs of + (P1 p1 p2) -> P2 (updatePS rolls p1) p2 + (P2 p1 p2) -> P1 p1 (updatePS rolls p2)) + put newgame + return $ case scores newgame of + (x,_) | x >= 21 -> Just Win1 + (_,y) | y >= 21 -> Just Win2 + (_,_) -> Nothing + +runGame :: GameState -> (Integer, Integer) +runGame gs = rgA ! (gsTuple gs) where + rgA = array ((False,0,1,0,1), (True,30,10,30,10)) + [let key = (p,s1,f1,s2,f2) in (key, runGame' $ tupleGs key) | + p <- [False, True], s1 <- [0..30], s2 <- [0..30], f1 <- [1..10], f2 <- [1..10]] + runGame' gs = foldr (sumTup . go) (0,0) (runState move gs) where + go (Nothing, gs) = rgA ! gsTuple gs + go (Just Win1, gs) = (1,0) + go (Just Win2, gs) = (0,1) + sumTup (a,b) (x,y) = (a+x, b+y) + + +part2 :: Int -> Int -> (Integer, Integer) +part2 p1 p2 = runGame (P1 (PS 0 p1) (PS 0 p2)) + +main :: IO () +main = do + input <- map (last . words) . lines <$> getContents + let p1pos = read (input !! 0) :: Int + let p2pos = read (input !! 1) :: Int + + print (p1pos, p2pos) + + print $ part2 p1pos p2pos + + + print "Bye"