Overengineered Day2

This commit is contained in:
Martin Potier 2022-12-13 17:39:09 +02:00
parent b252ad75ed
commit 6807ab3133
No known key found for this signature in database
GPG Key ID: D4DD957DBA4AD89E
7 changed files with 2671 additions and 7 deletions

View File

@ -13,13 +13,15 @@ build-type: Simple
library
exposed-modules:
AoC.Day1
AoC.Day2
other-modules:
Paths_adventofcode
hs-source-dirs:
src
ghc-options: -Wall
build-depends:
base ==4.*
attoparsec
, base ==4.*
, text
default-language: Haskell2010
@ -32,6 +34,7 @@ executable adventofcode
ghc-options: -Wall
build-depends:
adventofcode
, attoparsec
, base ==4.*
, text
default-language: Haskell2010

View File

@ -1,8 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
import AoC.Day1 as Day1
import AoC.Day2 as Day2
import qualified Data.Text.IO as T (readFile)
main :: IO ()
main = do
putStrLn "Hello World!"
input <- readFile "./input/day1.txt"
putStrLn $ show $ Day1.solveA input
putStrLn $ show $ Day1.solveB input
input1 <- readFile "./input/day1.txt"
putStrLn $ show $ Day1.solveA input1
putStrLn $ show $ Day1.solveB input1
input2 <- T.readFile "./input/day2.txt"
putStrLn $ show $ Day2.solveA "A Y\nB X\nC Z"
putStrLn $ show $ Day2.solveA input2
putStrLn $ show $ Day2.solveB "A Y\nB X\nC Z"
putStrLn $ show $ Day2.solveB input2

View File

@ -32,6 +32,7 @@
packages = h: [h.adventofcode];
withHoogle = true;
buildInputs = with pkgs; [
haskell-language-server
cabal-install
entr
ghcid
@ -40,7 +41,7 @@
stylish-haskell
];
shellHook = ''
hpack
${pkgs.hpack}/bin/hpack
'';
};
}

2500
input/day2.txt Normal file

File diff suppressed because it is too large Load Diff

View File

@ -5,11 +5,13 @@ ghc-options: -Wall
dependencies:
- base == 4.*
- text
- attoparsec
library:
source-dirs: src
exposed-modules:
- AoC.Day1
- AoC.Day2
executable:
source-dirs: executable

View File

@ -1,10 +1,13 @@
module AoC.Day1 where
import Data.List (groupBy,null,sort)
import Data.List (groupBy,sort)
parseInput :: String -> [[Int]]
parseInput = map (map read) . map tail . groupBy (\l r -> (not $ null r)) . lines
parseInput = map (map read) . map tail . groupBy (\_l r -> (not $ null r)) . lines
solveA :: String -> Int
solveA = maximum . map sum . parseInput
solveB :: String -> Int
solveB = sum . take 3 . reverse . sort . map sum . parseInput

144
src/AoC/Day2.hs Normal file
View File

@ -0,0 +1,144 @@
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