Skip to content

Instantly share code, notes, and snippets.

@edvardm
Created December 3, 2023 12:07
Show Gist options
  • Save edvardm/ffb28b05084cafec98a6d9c0e4cc75a2 to your computer and use it in GitHub Desktop.
Save edvardm/ffb28b05084cafec98a6d9c0e4cc75a2 to your computer and use it in GitHub Desktop.
aoc2023, day 2
module Main where
import Control.Applicative (liftA2)
import Data.Char (toLower, toUpper)
import Data.Function (on)
import qualified Data.Map.Strict as Map
import Text.Parsec
import Text.Parsec.String (Parser)
data Color
= Red
| Green
| Blue
deriving (Read, Show, Eq, Ord)
data Round =
Round
{ red :: Int
, green :: Int
, blue :: Int
}
deriving (Show, Eq)
data Game =
Game
{ gameId :: Int
, rounds :: [Round]
}
deriving (Show, Eq)
type BagContents = Round
ucFirst :: String -> String
ucFirst = uncurry ((:) . toUpper) . ((,) <$> head <*> tail)
digits :: Parser String
digits = many1 digit
parseRound :: Parser Round
parseRound = do
counts <- parseColor `sepBy1` char ','
let countsOf' clr = sum [count' | (clr', count') <- counts, clr' == clr]
pure $
Round {red = countsOf' Red, green = countsOf' Green, blue = countsOf' Blue}
where
parseColor =
flip (,) <$> (spaces *> (read <$> digits) <* char ' ') <*>
(read . ucFirst <$> choice (map string ["red", "green", "blue"]))
parseGame :: Parser Game
parseGame =
Game <$> (string "Game " *> (read <$> digits) <* char ':' <* spaces) <*>
(concat <$> many1 (parseRound `sepBy1` (char ';' >> spaces)))
isPossibleGame :: Game -> Bool
isPossibleGame game = all (playableRound bagContents) (rounds game)
where
playableRound :: Round -> Round -> Bool
playableRound upperBounds g =
all (\p -> p g <= p upperBounds) [red, green, blue]
parseInput :: String -> Game
parseInput s =
case parse parseGame ("in the input: \"" ++ s ++ "\"") s of
Left err -> error $ show err
Right round' -> round'
main :: IO ()
main = do
putStrLn $ "bag contents = " ++ show bagContents
interact $ show . liftA2 (,) part1 part2 . map parseInput . lines
putStrLn "\ndone."
bagContents :: Round
bagContents = Round {red = 12, green = 13, blue = 14}
part1 :: [Game] -> Int
part1 = sum . map gameId . filter isPossibleGame
part2 = sum . map (power . maxGameValues)
where
power r = product $ map ($ r) [red, blue, green]
maxGameValues game =
Round {red = maxC red, green = maxC green, blue = maxC blue}
where
maxC g = maximum $ map g (rounds game)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment