93 lines
2.4 KiB
Haskell
93 lines
2.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
|
|
|
|
module Day4 where
|
|
|
|
import Data.Attoparsec.ByteString.Char8
|
|
import qualified Data.ByteString as BS
|
|
import Data.List (unfoldr)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
pile <- pileFromFile
|
|
putStrLn "Part 1 result:"
|
|
print $ part1 pile
|
|
putStrLn "Part 2 result:"
|
|
print $ part2 pile
|
|
|
|
pileFromFile :: IO [Scratchcard]
|
|
pileFromFile = do
|
|
Right pile <- parseOnly parsePile <$> BS.readFile "inputs/day4.input"
|
|
pure pile
|
|
|
|
pileFromTestFile :: IO [Scratchcard]
|
|
pileFromTestFile = do
|
|
Right pile <- parseOnly parsePile <$> BS.readFile "inputs/day4-test.input"
|
|
pure pile
|
|
|
|
data Scratchcard = Scratchcard
|
|
{ scratchCardNumber :: Int
|
|
, scratchCardWinning :: [Int]
|
|
, scratchCardOther :: [Int]
|
|
}
|
|
deriving Show
|
|
|
|
type Pile = [Scratchcard]
|
|
|
|
parsePile :: Parser Pile
|
|
parsePile = scratchcard `sepBy` endOfLine
|
|
|
|
-- Card 169: 3 47 80 78 17 68 20 36 54 87 | 75 52 73 43 45 29 53 10 65 89 84 37 90 13 15 40 76 91 88 74 9 7 4 22 1
|
|
scratchcard :: Parser Scratchcard
|
|
scratchcard = do
|
|
cardNb <- "Card" *> many1 space *> decimal
|
|
":" *> many1 space
|
|
win <- decimal `sepBy` many1 space
|
|
many1 space *> "|" *> many1 space
|
|
othr <- decimal `sepBy` many1 space
|
|
pure $ Scratchcard cardNb win othr
|
|
|
|
score :: Scratchcard -> Int
|
|
score (Scratchcard _ wx ox) = points $ map (`elem` wx) ox
|
|
where
|
|
points xs = case length (filter id xs) of
|
|
0 -> 0
|
|
n -> 2^(n-1)
|
|
|
|
part1 :: [Scratchcard] -> Int
|
|
part1 = sum . map score
|
|
|
|
score2 :: Scratchcard -> Int
|
|
score2 (Scratchcard _ wx ox) = points $ map (`elem` wx) ox
|
|
where
|
|
points xs = length (filter id xs)
|
|
|
|
data CardState = CardState
|
|
{ number :: Int
|
|
, matchingNb :: Int
|
|
, occurences :: Int
|
|
}
|
|
deriving Show
|
|
|
|
mkCardState :: Scratchcard -> CardState
|
|
mkCardState s@(Scratchcard n _ _) = CardState n (score2 s) 1
|
|
|
|
part2 :: [Scratchcard] -> Int
|
|
part2 sx = sum . map occurences $ unfoldr f initialState
|
|
where
|
|
initialState = map mkCardState sx
|
|
f :: [CardState] -> Maybe (CardState, [CardState])
|
|
-- No new cards, just update the state
|
|
f (c@(CardState _ 0 _):cs) = Just (c,cs)
|
|
f (c@(CardState n m o):cs) = do
|
|
-- add duplicates
|
|
let cs' = map (\ e@(CardState n' m' o') ->
|
|
if n' `elem` [n+1..n+m]
|
|
then CardState n' m' (o + o')
|
|
else e
|
|
) cs
|
|
-- return updated state
|
|
Just (c,cs')
|
|
f [] = Nothing
|