61 lines
1.9 KiB
Haskell
61 lines
1.9 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 -> Either Board Board
|
|
checkWinner' board
|
|
| oneFullColumn board || oneFullRow board = Right board
|
|
| otherwise = Left board
|
|
where oneFullRow [] = False
|
|
oneFullRow (row:rows) = all (<0) row || oneFullRow rows
|
|
oneFullColumn = oneFullRow . transpose
|
|
|
|
checkLoser :: Board -> Maybe Board
|
|
checkLoser = aux . checkWinner'
|
|
where aux (Right b) = Nothing
|
|
aux (Left b) = Just b
|
|
|
|
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
|
|
| length possibleLosers == 1 = simulateUntilWinner prev (n:ns) $ Left $ unjust $ head possibleLosers
|
|
| otherwise = simulate n ns $ map (mark n) (map unjust possibleLosers)
|
|
where possibleLosers = filter (/=Nothing) $ map checkLoser boards
|
|
simulateUntilWinner prev (n:ns) (Left b) = simulateUntilWinner n ns $ checkWinner' $ mark n b
|
|
simulateUntilWinner prev _ (Right b) = prev * (finalSum b)
|
|
|
|
main = interact $ show . solution
|
|
where solution input = simulate 1 (parseSeq input) (parseBoards input)
|