145 lines
2.9 KiB
Haskell
145 lines
2.9 KiB
Haskell
module AoC.Day2 where
|
|
|
|
import Control.Applicative ((<|>))
|
|
import Data.Attoparsec.Text
|
|
import Data.Monoid
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
|
|
type Game = [Turn]
|
|
|
|
data Turn = Turn Move Move
|
|
deriving Show
|
|
|
|
data Move = Rock | Paper | Scissors
|
|
deriving (Show, Eq, Enum)
|
|
|
|
instance Ord Move where
|
|
Paper `compare` Rock = GT
|
|
Rock `compare` Paper = LT
|
|
|
|
Paper `compare` Scissors = LT
|
|
Scissors `compare` Paper = GT
|
|
|
|
Rock `compare` Scissors = GT
|
|
Scissors `compare` Rock = LT
|
|
|
|
Paper `compare` Paper = EQ
|
|
Rock `compare` Rock = EQ
|
|
Scissors `compare` Scissors = EQ
|
|
|
|
toMove :: Char -> Move
|
|
toMove 'A' = Rock
|
|
toMove 'B' = Paper
|
|
toMove 'C' = Scissors
|
|
toMove 'X' = Rock
|
|
toMove 'Y' = Paper
|
|
toMove 'Z' = Scissors
|
|
toMove _ = undefined
|
|
|
|
parseGame :: Text -> Either String Turn
|
|
parseGame = parseOnly parseTurn
|
|
|
|
parseTurn :: Parser Turn
|
|
parseTurn = do
|
|
move1 <- parseABC
|
|
_ <- space
|
|
move2 <- parseXYZ
|
|
pure $ Turn move1 move2
|
|
|
|
parseABC :: Parser Move
|
|
parseABC = do
|
|
c <- char 'A' <|> char 'B' <|> char 'C'
|
|
pure $ toMove c
|
|
|
|
parseXYZ :: Parser Move
|
|
parseXYZ = do
|
|
c <- char 'X' <|> char 'Y' <|> char 'Z'
|
|
pure $ toMove c
|
|
|
|
parseInput :: Text -> Either String Game
|
|
parseInput = sequenceA . fmap parseGame . T.lines
|
|
|
|
moveValue :: Move -> Int
|
|
moveValue Rock = 1
|
|
moveValue Paper = 2
|
|
moveValue Scissors = 3
|
|
|
|
turnValue :: Turn -> Int
|
|
turnValue (Turn a b) = case compare a b of
|
|
LT -> 6
|
|
EQ -> 3
|
|
GT -> 0
|
|
|
|
gradeTurn :: Turn -> Int
|
|
gradeTurn t@(Turn _ m2) = turnValue t + moveValue m2
|
|
|
|
solveA :: Text -> Either String Int
|
|
solveA input = do
|
|
pInput <- parseInput input
|
|
pure $ getSum $ mconcat $ map (Sum . gradeTurn) pInput
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Part 2
|
|
|
|
type Game2 = [Turn2]
|
|
|
|
data Turn2 = Turn2 Move Outcome
|
|
deriving Show
|
|
|
|
data Outcome = Lose | Draw | Win
|
|
deriving Show
|
|
|
|
toOutcome :: Char -> Outcome
|
|
toOutcome 'X' = Lose
|
|
toOutcome 'Y' = Draw
|
|
toOutcome 'Z' = Win
|
|
toOutcome _ = undefined
|
|
|
|
outcomeValue :: Outcome -> Int
|
|
outcomeValue Lose = 0
|
|
outcomeValue Draw = 3
|
|
outcomeValue Win = 6
|
|
|
|
next :: Move -> Move
|
|
next Rock = Paper
|
|
next Paper = Scissors
|
|
next Scissors = Rock
|
|
|
|
prev :: Move -> Move
|
|
prev Rock = Scissors
|
|
prev Paper = Rock
|
|
prev Scissors = Paper
|
|
|
|
findMove :: Turn2 -> Move
|
|
findMove (Turn2 m Win) = next m
|
|
findMove (Turn2 m Draw) = m
|
|
findMove (Turn2 m Lose) = prev m
|
|
|
|
turnValue2 :: Turn2 -> Int
|
|
turnValue2 t@(Turn2 _ o) = outcomeValue o + moveValue (findMove t)
|
|
|
|
parseInput2 :: Text -> Either String Game2
|
|
parseInput2 = sequenceA . fmap parseGame2 . T.lines
|
|
|
|
parseGame2 :: Text -> Either String Turn2
|
|
parseGame2 = parseOnly parseTurn2
|
|
|
|
parseTurn2 :: Parser Turn2
|
|
parseTurn2 = do
|
|
move <- parseABC
|
|
_ <- space
|
|
outcome <- parseOutcome
|
|
pure $ Turn2 move outcome
|
|
|
|
parseOutcome :: Parser Outcome
|
|
parseOutcome = do
|
|
c <- char 'X' <|> char 'Y' <|> char 'Z'
|
|
pure $ toOutcome c
|
|
|
|
solveB :: Text -> Either String Int
|
|
solveB input = do
|
|
pInput <- parseInput2 input
|
|
pure $ getSum $ mconcat $ map (Sum . turnValue2) pInput
|
|
|