blob: 1904c8852788a7f1c492f64bad75fdfd3117f792 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
module Main where
import Data.Foldable (find)
import Data.Maybe (fromJust, isJust)
import Debug.Trace (trace, traceShow)
import Utils
type Board = [[Int]]
toGroupsOfN :: Int -> [a] -> [[a]]
toGroupsOfN n [] = []
toGroupsOfN n lst = take n lst : toGroupsOfN n (drop n lst)
rowBingo :: [Int] -> Board -> Bool
rowBingo draws = any (all (`elem` draws))
findBingo :: [Int] -> Board -> Maybe Int
findBingo draws board =
let horizFound = rowBingo draws board
vertFound = rowBingo draws (transpose board)
in if horizFound || vertFound
then Just $ sumUnmarked draws board
else Nothing
sumUnmarked :: [Int] -> Board -> Int
sumUnmarked draws board =
let sumRowUnmarked row = filter (`notElem` draws) row $> sum
in board $> map sumRowUnmarked .> sum
recur :: [Int] -> Int -> [Board] -> ()
recur draws n boards
| n > length draws = ()
| otherwise =
let drawn = take n draws
notDrawn = drop n draws
bingoResults = boards $> mapWithIndex (findBingo drawn) .> filter (\(_, m) -> isJust m)
winningBoards = map (\(i, m) -> (i, last drawn * fromJust m)) bingoResults
nWinning = length winningBoards
indicesToRemove = map fst winningBoards
winningScores = map snd winningBoards
restBoards = removeAt indicesToRemove boards
in trace ("Found " ++ show nWinning ++ " results at " ++ show n ++ ": " ++ show winningScores ++ ", boards left: " ++ show (length restBoards)) $
recur draws (n + 1) restBoards
run :: [Int] -> [Board] -> ()
run draws = recur draws 1
main :: IO ()
main =
do
contents <- getContents
let input =
contents
$> lines
.> filter (not . null)
let draws = head input $> splitOn (== ',') .> map read :: [Int]
let boards = tail input $> map (words .> map read) .> toGroupsOfN 5 :: [Board]
run draws boards $> print
|
