aoc-2021/day4/first.hs

58 lines
1.6 KiB
Haskell

import Data.List (transpose)
type Board = [[Integer]]
wordsWhen :: (a -> Bool) -> [a] -> [[a]]
wordsWhen pred s =
case dropWhile pred s of
[] -> []
s' -> w : wordsWhen pred s''
where (w, s'') = break pred s'
unjust :: Maybe a -> a
unjust (Just x) = x
parseSeq :: String -> [Integer]
parseSeq = map read . wordsWhen (==',') . head . words
parseBoards :: String -> [Board]
parseBoards = map (map (map $ read))
. map (map words)
. wordsWhen (=="")
. tail
. lines
checkWinner :: Board -> Maybe Board
checkWinner board
| oneFullColumn board || oneFullRow board = Just board
| otherwise = Nothing
where oneFullRow [] = False
oneFullRow (row:rows) = all (<0) row || oneFullRow rows
oneFullColumn = oneFullRow . transpose
finalSum :: Board -> Integer
finalSum = aux 0
where aux :: Integer -> Board -> Integer
aux acc [] = acc
aux acc (row:rows) = aux (acc + (foldr (+) 0 $ excludeMarked row)) rows
excludeMarked = filter (>=0)
mark :: Integer -> Board -> Board
mark n = map $ map conditionalMark
where conditionalMark x
| x == n = -1
| otherwise = x
simulate :: Integer -> [Integer] -> [Board] -> Integer
simulate prev (n:ns) boards
| winnerBoard /= Nothing = prev * (finalSum $ unjust winnerBoard)
| otherwise = simulate n ns $ map (mark n) boards
where winnerBoard =
let possibleWinners = filter (/=Nothing) $ map checkWinner boards
in if possibleWinners /= []
then head possibleWinners
else Nothing
main = interact $ show . solution
where solution input = simulate 1 (parseSeq input) (parseBoards input)