-
Notifications
You must be signed in to change notification settings - Fork 0
/
Solution.hs
85 lines (69 loc) · 2.59 KB
/
Solution.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
module Day22.Solution
( Player (..),
parseDecks,
part1,
part2,
playGameWith,
recursiveCombat,
simpleCombat,
winningScore,
)
where
import Advent.Parser (intParser)
import Advent.Utils (fromRightOrShowError)
import Control.Monad (guard)
import Data.Foldable (Foldable (..))
import Data.Function ((&))
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Text.Parsec hiding (Empty)
part1 :: String -> String
part1 = show . winningScore . uncurry (playGameWith simpleCombat) . fromRightOrShowError . parseDecks
part2 :: String -> String
part2 = show . winningScore . uncurry (playGameWith recursiveCombat) . fromRightOrShowError . parseDecks
parseDecks :: String -> Either ParseError (Deck, Deck)
parseDecks = parse gameParser ""
where
gameParser :: Parsec String () (Deck, Deck)
gameParser = (,) <$> playerParser "1" <*> (newline *> playerParser "2" <* eof)
playerParser :: String -> Parsec String () Deck
playerParser n = string ("Player " ++ n ++ ":") *> newline *> deckParser
deckParser :: Parsec String () Deck
deckParser = Seq.fromList <$> intParser `sepEndBy1` newline
type Deck = Seq Int
data Player = Player1 | Player2 deriving (Show, Eq)
type History = Set (Deck, Deck)
type CombatHandler = (Deck -> Deck -> Maybe Player)
simpleCombat :: CombatHandler
simpleCombat = const . const Nothing
recursiveCombat :: CombatHandler
recursiveCombat (x :<| xs) (y :<| ys) = do
xs' <- takeExactly x xs
ys' <- takeExactly y ys
pure . fst $ playGameWith recursiveCombat xs' ys'
recursiveCombat _ _ = undefined
takeExactly :: Int -> Seq Int -> Maybe Deck
takeExactly n xs = Seq.take n xs <$ guard (Seq.length xs >= n)
playGameWith :: CombatHandler -> Deck -> Deck -> (Player, Deck)
playGameWith fn = go Set.empty
where
go :: History -> Deck -> Deck -> (Player, Deck)
go history xs ys
| (xs, ys) `Set.member` history = (Player1, xs)
| otherwise = switch history xs ys
switch :: History -> Deck -> Deck -> (Player, Deck)
switch _ d Empty = (Player1, d)
switch _ Empty d = (Player2, d)
switch history xss@(x :<| xs) yss@(y :<| ys) =
let winner = case fn xss yss of
Nothing -> if x > y then Player1 else Player2
Just p -> p
in case winner of
Player1 -> go nextHistory (xs :|> x :|> y) ys
Player2 -> go nextHistory xs (ys :|> y :|> x)
where
nextHistory = Set.insert (xss, yss) history
winningScore :: (a, Deck) -> Int
winningScore (_, deck) = deck & Seq.reverse & toList & zipWith (*) [1 ..] & sum