diff options
Diffstat (limited to 'day21')
| -rw-r--r-- | day21/input.txt | 2 | ||||
| -rw-r--r-- | day21/main.hs | 20 | ||||
| -rw-r--r-- | day21/part1.hs | 54 | ||||
| -rw-r--r-- | day21/part2.hs | 48 | ||||
| -rw-r--r-- | day21/test.txt | 2 |
5 files changed, 126 insertions, 0 deletions
diff --git a/day21/input.txt b/day21/input.txt new file mode 100644 index 0000000..bfb2937 --- /dev/null +++ b/day21/input.txt @@ -0,0 +1,2 @@ +Player 1 starting position: 7 +Player 2 starting position: 5 diff --git a/day21/main.hs b/day21/main.hs new file mode 100644 index 0000000..fa6926b --- /dev/null +++ b/day21/main.hs @@ -0,0 +1,20 @@ +module Main where + +import Debug.Trace (traceShow) +import Part1 +import Part2 +import Utils + +main :: IO () +main = do + contents <- getContents + let initialPositions@[p1Pos, p2Pos] = contents $> lines .> map (drop 28) .> map read :: [Int] + let initialState = makeState1 initialPositions [0, 0] 1 0 + print initialState + let (_, loserScore, dieRolledN) = simulate1 initialState 0 + print $ loserScore * dieRolledN + + let part2State = makeState2 (p1Pos, 0) (p2Pos, 0) + + -- this has a 50% chance of giving the right answer :D + print $ simulate2 0 part2State
\ No newline at end of file diff --git a/day21/part1.hs b/day21/part1.hs new file mode 100644 index 0000000..2c60e49 --- /dev/null +++ b/day21/part1.hs @@ -0,0 +1,54 @@ +module Part1 (simulate1, makeState1) where + +import Debug.Trace (traceShow) +import Utils + +data State = State + { positions :: [Int], + scores :: [Int], + die :: Int, + dieRolledTotal :: Int + } + deriving (Show) + +makeState1 = State + +rollDie :: State -> (Int, State) +rollDie prevState = (die prevState, prevState {die = die prevState `mod` 100 + 1}) + +setAtIndex :: Int -> b -> [b] -> [b] +setAtIndex i value lst = zip [0 ..] lst $> map (\(i', value') -> if i == i' then value else value') + +position player state = positions state !! player + +score player state = scores state !! player + +move player prevState = + let (dieRoll1, state1) = rollDie prevState + (dieRoll2, state2) = rollDie state1 + (dieRoll3, state3) = rollDie state2 + state = state3 {dieRolledTotal = dieRolledTotal state3 + 3} + + newPos = (position player state + dieRoll1 + dieRoll2 + dieRoll3 - 1) `mod` 10 + 1 + newScore = score player state + newPos + in state + { positions = setAtIndex player newPos (positions state), + scores = setAtIndex player newScore (scores state) + } + +checkWinCondition state + | (scores state !! 0) >= 1000 = Left (1, scores state !! 1, dieRolledTotal state) + | (scores state !! 1) >= 1000 = Left (0, scores state !! 0, dieRolledTotal state) + | otherwise = Right state + +takeTurn :: Int -> State -> Either (Int, Int, Int) State +takeTurn player state = do + let movedState = move player state + checkWinCondition movedState + +simulate1 state player = + let turnTaken = takeTurn player state + nextPlayer = (player + 1) `mod` 2 + in case turnTaken of + Right newState -> simulate1 newState nextPlayer + Left result -> result diff --git a/day21/part2.hs b/day21/part2.hs new file mode 100644 index 0000000..926e1e5 --- /dev/null +++ b/day21/part2.hs @@ -0,0 +1,48 @@ +module Part2 (makeState2, simulate2) where + +import Debug.Trace (traceShow) +import Utils + +-- (position, score) +type Player = (Int, Int) + +type State = (Player, Player) + +makeState2 :: Player -> Player -> State +makeState2 p1 p2 = (p1, p2) + +win player state = snd (pick player state) >= 21 + +pick :: Int -> State -> Player +pick 0 = fst +pick 1 = snd + +move :: Int -> Int -> (Player, Player) -> State +move delta player state = + let (oldPos, oldScore) = pick player state + newPos = (oldPos + delta - 1) `mod` 10 + 1 + newScore = oldScore + newPos + newState = updatePlayer player (newPos, newScore) state + in newState + +updatePlayer :: Int -> Player -> State -> State +updatePlayer 0 value (_, other) = (value, other) +updatePlayer 1 value (other, _) = (other, value) + +die = [1, 2, 3] + +possible3RollSums = [3 .. 9] + +coeffs = [1, 3, 6, 7, 6, 3, 1] + +simulate2 :: Int -> ((Int, Int), (Int, Int)) -> Integer +simulate2 player state + | win 0 state = 1 + | win 1 state = 0 + | otherwise = + let (pos, score) = pick player state + nextStates = possible3RollSums $> map (\roll -> move roll player state) + nextStatesWithC = zip coeffs nextStates + nextPlayer = (player + 1) `mod` 2 + wins = nextStatesWithC $> map (\(c, nextState) -> c * simulate2 nextPlayer nextState) .> sum + in wins diff --git a/day21/test.txt b/day21/test.txt new file mode 100644 index 0000000..3f69194 --- /dev/null +++ b/day21/test.txt @@ -0,0 +1,2 @@ +Player 1 starting position: 4 +Player 2 starting position: 8 |
