1 files changed, 28 insertions, 0 deletions
diff --git a/2021/4.hs b/2021/4.hs
new file mode 100644
index 0000000..bee4780
--- /dev/null
+++ b/2021/4.hs
@@ -0,0 +1,28 @@
+module Main where
+
+import Data.Foldable
+import Data.List
+import Data.Maybe
+import Data.Ord
+
+import Input
+import Util
+
+
+data Board = Board [[Maybe Int]]
+  deriving (Show)
+
+main :: IO ()
+main = do
+    inp <- getInput 4
+    let order = read <$> splitOn (== ',') (head inp)
+        boards = Board . map (map (Just . read) . words) <$> splitOn null (drop 2 inp)
+        won (Board l) = any (all isNothing) l || any (all isNothing) (transpose l)
+        cross (Board bd) n = Board (map (map (>>= \x -> if x == n then Nothing else Just x)) bd)
+        timetowin bd = find (won . snd) . zip [0::Int ..] $ scanl cross bd (toList order)
+        wins = catMaybes . toList $ timetowin <$> boards
+        score idx (Board l) = (toList order !! (idx - 1)) * sum (catMaybes (concat l))
+        wonboard = minimumBy (comparing fst) wins
+        lostboard = maximumBy (comparing fst) wins
+    print (uncurry score wonboard)
+    print (uncurry score lostboard)