106 lines
3.4 KiB
Haskell
106 lines
3.4 KiB
Haskell
|
import Control.Exception (assert)
|
||
|
|
import Data.List (elemIndices, groupBy, minimumBy, transpose)
|
||
|
|
import Data.Maybe (isJust, listToMaybe)
|
||
|
|
import Data.Ord (comparing)
|
||
|
|
import Debug.Trace (traceShowId)
|
||
|
|
|
||
|
|
main = do
|
||
|
|
bingoInput <- getContents
|
||
|
|
putStrLn (solution1 bingoInput)
|
||
|
|
|
||
|
|
solution1 :: String -> String
|
||
|
|
solution1 = show . scoreBingo . shortestBingo . parseBingos
|
||
|
|
|
||
|
|
parseBingos :: String -> ([Int], [[[Int]]])
|
||
|
|
parseBingos input = (calls, cards)
|
||
|
|
where
|
||
|
|
(callStrings, bingoStrings) = splitAt 2 (lines input)
|
||
|
|
calls :: [Int]
|
||
|
|
calls = map read ((wordsWhen (==',')) (head callStrings))
|
||
|
|
cards :: [[[Int]]]
|
||
|
|
cards = chunksToNumbers (chunkByEmpty bingoStrings)
|
||
|
|
where
|
||
|
|
lineToNumbers :: String -> [Int]
|
||
|
|
lineToNumbers = (map read) . words
|
||
|
|
linesToNumbers :: [String] -> [[Int]]
|
||
|
|
linesToNumbers = map lineToNumbers
|
||
|
|
chunksToNumbers :: [[String]] -> [[[Int]]]
|
||
|
|
chunksToNumbers = map linesToNumbers
|
||
|
|
|
||
|
|
shortestBingo :: ([Int], [[[Int]]]) -> ([Int], [Int])
|
||
|
|
shortestBingo (calls, cards) =
|
||
|
|
minimumBy (comparing bingoLength) solvedBingos
|
||
|
|
where
|
||
|
|
bingoLength :: ([Int], [Int]) -> Int
|
||
|
|
bingoLength (start, _) = length start
|
||
|
|
solvedBingos :: [([Int], [Int])]
|
||
|
|
solvedBingos = map (uncurry solveBingo) (zip (repeat calls) cards)
|
||
|
|
|
||
|
|
solveBingo :: [Int] -> [[Int]] -> ([Int], [Int])
|
||
|
|
solveBingo calls card =
|
||
|
|
(marked, unmarked)
|
||
|
|
where
|
||
|
|
unmarked = filter (\i -> isJust (elem2dIndex i card)) remaining
|
||
|
|
(marked, remaining) = splitAt (length (fst (indices calls card))+1) calls
|
||
|
|
indices :: [Int] -> [[Int]] -> ([Int], [Int])
|
||
|
|
indices calls cards =
|
||
|
|
break (\call -> isSolved (take (call+1) calls) (elem2dIndex (calls !! call) card)) [0..length(calls)-1]
|
||
|
|
isSolved :: [Int] -> Maybe (Int, Int) -> Bool
|
||
|
|
isSolved _ Nothing = False
|
||
|
|
isSolved calls (Just (y, x)) =
|
||
|
|
(isSublist (card !! x) calls)
|
||
|
|
|| (isSublist ((transpose card) !! y) calls)
|
||
|
|
|
||
|
|
scoreBingo :: ([Int], [Int]) -> Int
|
||
|
|
scoreBingo (marked, unmarked) = (last marked) * (sum unmarked)
|
||
|
|
|
||
|
|
isSublist :: (Eq a) => [a] -> [a] -> Bool
|
||
|
|
isSublist a b = all (`elem` b) a
|
||
|
|
|
||
|
|
elem2dIndex :: (Eq a) => a -> [[a]] -> Maybe (Int, Int)
|
||
|
|
elem2dIndex e m = listToMaybe [ (x,y) | (y,r) <- zip [0..] m, x <- elemIndices e r ]
|
||
|
|
|
||
|
|
wordsWhen :: (Char -> Bool) -> String -> [String]
|
||
|
|
wordsWhen p s = case dropWhile p s of
|
||
|
|
"" -> []
|
||
|
|
s' -> w : wordsWhen p s''
|
||
|
|
where (w, s'') = break p s'
|
||
|
|
|
||
|
|
chunkByEmpty :: [String] -> [[String]]
|
||
|
|
chunkByEmpty [] = []
|
||
|
|
chunkByEmpty (x:xs) = (if null x then chunk else (x:chunk)) : chunkByEmpty rest
|
||
|
|
where
|
||
|
|
(chunk,rest) = break (null) xs
|
||
|
|
|
||
|
|
-- Tests
|
||
|
|
testInput1 :: String
|
||
|
|
testInput1 = unlines [
|
||
|
|
"7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1",
|
||
|
|
"",
|
||
|
|
"22 13 17 11 0",
|
||
|
|
" 8 2 23 4 24",
|
||
|
|
"21 9 14 16 7",
|
||
|
|
" 6 10 3 18 5",
|
||
|
|
" 1 12 20 15 19",
|
||
|
|
"",
|
||
|
|
" 3 15 0 2 22",
|
||
|
|
" 9 18 13 17 5",
|
||
|
|
"19 8 7 25 23",
|
||
|
|
"20 11 10 24 4",
|
||
|
|
"14 21 16 12 6",
|
||
|
|
"",
|
||
|
|
"14 21 17 24 4",
|
||
|
|
"10 16 15 9 19",
|
||
|
|
"18 8 23 26 20",
|
||
|
|
"22 11 13 6 5",
|
||
|
|
" 2 0 12 3 7"
|
||
|
|
]
|
||
|
|
|
||
|
|
test1 :: String
|
||
|
|
test1 = assert ((solution1 testInput1) == "4512") "success"
|
||
|
|
|
||
|
|
isSublistTest1 = isSublist [0, 1, 2] [0, 1, 2, 3]
|
||
|
|
isSublistTest2 = isSublist [0, 1, 2] [0, 1, 3]
|
||
|
|
isSublistTest3 = isSublist [0, 1, 3] [0, 1, 3]
|
||
|
|
isSublistTest4 = isSublist [0, 1, 3] [0, 1, 4, 3, 2]
|