1 files changed, 49 insertions, 0 deletions
diff --git a/2021/13.hs b/2021/13.hs
new file mode 100644
index 0000000..8e6c664
--- /dev/null
+++ b/2021/13.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE TupleSections #-}
+module Main where
+
+import qualified Data.Array as A
+import Data.List
+
+import Input
+import Util
+
+
+uniq :: Eq a => [a] -> [a]
+uniq (x : y : xs) | x == y = uniq (y : xs)
+                  | otherwise = x : uniq (y : xs)
+uniq l = l
+
+generate :: A.Ix i => (i, i) -> (i -> a) -> A.Array i a
+generate bounds f = A.listArray bounds (map f (A.range bounds))
+
+main :: IO ()
+main = do
+    inp <- getInput 13
+    let pointstrs :| foldstrs:_ = splitOn null inp
+        points :: [(Int, Int)]
+        points = map (\s -> let [a,b] = toList (splitOn (== ',') s) in (read a, read b)) pointstrs
+        folds :: [(Char, Int)]
+        folds = map (\s -> let [a,b] = toList (splitOn (== '=') s) in (last a, read b)) foldstrs
+        minmax = (,) <$> minimum <*> maximum
+        arr0 = let (x1, x2) = minmax (map fst points)
+                   (y1, y2) = minmax (map snd points)
+               in A.accumArray (+) 0 ((x1, y1), (x2, y2)) (map (,1::Int) points)
+        at arr idx | A.inRange (A.bounds arr) idx = arr A.! idx
+                   | otherwise = 0
+        doFold 'x' lim arr =
+            let ((x1, y1), (x2, y2)) = A.bounds arr
+            in generate ((min x1 (lim - (x2 - lim)), y1), (lim - 1, y2)) $ \(x, y) ->
+                 arr `at` (x, y) + arr `at` (lim + (lim - x), y)
+        doFold 'y' lim arr =
+            let ((x1, y1), (x2, y2)) = A.bounds arr
+            in generate ((x1, min y1 (lim - (y2 - lim))), (x2, lim - 1)) $ \(x, y) ->
+                 arr `at` (x, y) + arr `at` (x, lim + (lim - y))
+        doFold _ _ _ = error "rip"
+        nvisible = length . filter (>0) . A.elems
+        draw arr =
+            let ((x1, y1), (x2, y2)) = A.bounds arr
+            in unlines [concat [if arr A.! (x, y) > 0 then "█" else "·"
+                               | x <- [x1..x2]]
+                       | y <- [y1..y2]]
+    print (nvisible (let (dir, lim) = head folds in doFold dir lim arr0))
+    putStr (draw (foldl' (\arr (dir, lim) -> doFold dir lim arr) arr0 folds))