Add day 4
Diff
4.hs | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 81 insertions(+)
@@ -1,0 +1,81 @@
#!/usr/bin/env nix-shell
#!nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])"
import Data.List (intersect)
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.Combinator
import Text.Parsec.String (Parser)
main = do
cards <- readAndParseStdin []
print $ part1 cards
print $ part2 cards
part1 :: [Card] -> Int
part1 cards = sum $ map (score . length . getWinningNumbers) cards
where
score 0 = 0
score n = 2 ^ (n - 1)
part2 :: [Card] -> Int
part2 cards = sum $ calculateCardCopies $ map (length . getWinningNumbers) cards
calculateCardCopies :: [Int] -> [Int]
calculateCardCopies xs = foldl replicateSingleCardWinnings (replicate (length xs) 1) (zip [0 ..] xs)
replicateSingleCardWinnings :: [Int] -> (Int, Int) -> [Int]
replicateSingleCardWinnings cardReplicas (idx, winningNumbers) = copyCards cardReplicas (idx + 1) idx winningNumbers
copyCards :: [Int] -> Int -> Int -> Int -> [Int]
copyCards cardReplicas currIdx winningCardIdx winningNumbers
| currIdx <= length cardReplicas && winningNumbers > 0 =
let incrementedList = incrementAtIndex cardReplicas currIdx (cardReplicas !! winningCardIdx)
in copyCards incrementedList (currIdx + 1) winningCardIdx (winningNumbers - 1)
| otherwise = cardReplicas
incrementAtIndex :: [Int] -> Int -> Int -> [Int]
incrementAtIndex xs idx amount = take idx xs ++ [(xs !! idx) + amount] ++ drop (idx + 1) xs
getWinningNumbers :: Card -> [Int]
getWinningNumbers card = myNumbers card `intersect` winningNumbers card
data Card = Card
{ winningNumbers :: [Int],
myNumbers :: [Int]
}
deriving (Show)
readAndParseStdin :: [Card] -> IO [Card]
readAndParseStdin acc = do
line <- getLine
if null line
then return acc
else case parse cardParser "" line of
Left parseError -> error $ show parseError
Right card -> readAndParseStdin $ acc ++ [card]
cardParser :: Parser Card
cardParser = do
_ <- string "Card" <* spaces <* many1 digit <* char ':' <* spaces
winningNumbers <- numberParser
_ <- char '|' <* spaces
myNumbers <- numberParser
return Card {winningNumbers, myNumbers}
numberParser :: Parser [Int]
numberParser = map read <$> many1 digit `endBy` spaces