More day 4 improvements

This commit is contained in:
Riley Apeldoorn 2021-12-04 13:09:47 +01:00
parent 70bd51277e
commit ff171b3e02

View file

@ -15,40 +15,29 @@ parseBoards :: [String] -> [Board]
parseBoards [] = [] parseBoards [] = []
parseBoards l = parse a : parseBoards b parseBoards l = parse a : parseBoards b
where (a,b) = splitAt 5 l where (a,b) = splitAt 5 l
parse = map $ map (Unmarked . read) . words parse = map $ map ((,False) . read) . words
type Board = [[Cell]] type Board = [[Cell]]
rows :: Board -> [[Cell]]
rows = id
cols :: Board -> [[Cell]]
cols = transpose
hasWon :: Board -> Bool hasWon :: Board -> Bool
hasWon b = check (rows b) || check (cols b) hasWon b = check b || check (transpose b)
where check = any $ all marked where check = any $ all marked
score :: Int -> Board -> Int score :: Int -> Board -> Int
score n b = n * sum [ x | c <- b, Unmarked x <- c ] score n b = n * sum [ x | c <- b, (x, False) <- c ]
call :: Int -> Board -> Board call :: Int -> Board -> Board
call n = map (map mark) call n = map (map mark)
where mark (Unmarked x) | x == n = Marked x where mark (x,s) = (x, s || x == n)
mark x = x
data Cell = Unmarked Int type Cell = (Int, Bool)
| Marked Int
marked :: Cell -> Bool marked :: Cell -> Bool
marked (Marked _) = True marked = snd
marked _ = False
solve :: Input -> (Int, Int) solve :: Input -> (Int, Int)
solve input = (f input, g input) solve (n, b) = (head r, last r)
where wins extr (n,b) = uncurry score $ extr $ bingo n b where r = map (uncurry score) $ bingo n b
f = wins head
g = wins last
bingo :: [Int] -> [Board] -> [(Int, Board)] bingo :: [Int] -> [Board] -> [(Int, Board)]
bingo _ [] = [] bingo _ [] = []