75 lines
2.1 KiB
Haskell
75 lines
2.1 KiB
Haskell
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"
|