Day 05

1 files changed, 81 insertions, 0 deletions

diff --git a/day05/main.hs b/day05/main.hs
new file mode 100644
index 0000000..a954d8e
--- /dev/null
+++ b/day05/main.hs
@@ -0,0 +1,81 @@
+module Main where
+
+import qualified Data.Map as Map
+import Data.Text (pack, replace, split, unpack)
+import Debug.Trace (trace, traceShow)
+import Utils
+
+data Line = Line
+  { start :: (Int, Int),
+    end :: (Int, Int)
+  }
+  deriving (Show)
+
+line :: (Int, Int) -> (Int, Int) -> Line
+line start end = Line {start = start, end = end}
+
+rowToLine :: String -> Line
+rowToLine row =
+  pack row
+    $> replace (pack " -> ") (pack ",")
+    .> split (== ',')
+    .> map unpack
+    .> map read
+    .> (\[a, b, c, d] -> line (a, b) (c, d))
+
+markCovered :: (Int, Int) -> Map.Map (Int, Int) Int -> Map.Map (Int, Int) Int
+markCovered p = Map.insertWith (+) p 1
+
+range :: Int -> Int -> [Int]
+range x y
+  | x < y = [x .. y]
+  | x > y = reverse [y .. x]
+  | x == y = [x]
+  | otherwise = error "unreachable"
+
+lineToPoints1 :: Line -> [(Int, Int)]
+lineToPoints1 l@(Line (x1, y1) (x2, y2))
+  | isHorizOrVert l =
+    let xs = range x1 x2
+        ys = range y1 y2
+     in [(x, y) | x <- xs, y <- ys]
+  | otherwise = []
+
+isHorizOrVert :: Line -> Bool
+isHorizOrVert (Line (x1, y1) (x2, y2)) =
+  x1 == x2 || y1 == y2
+
+e1 ls =
+  let hmap = Map.empty
+      processed = processLines lineToPoints1 ls hmap
+      nDangerous = Map.elems processed $> filter (>= 2) .> length
+   in nDangerous
+
+lineToPoints2 :: Line -> [(Int, Int)]
+lineToPoints2 l@(Line (x1, y1) (x2, y2))
+  | isHorizOrVert l = lineToPoints1 l
+  | otherwise =
+    let xs = range x1 x2
+        ys = range y1 y2
+     in zip xs ys
+
+processLines :: (Line -> [(Int, Int)]) -> [Line] -> Map.Map (Int, Int) Int -> Map.Map (Int, Int) Int
+processLines _ [] hmap = hmap
+processLines lineToPointsFn (l : ls) hmap =
+  let points = lineToPointsFn l
+      updatedHmap = foldr markCovered hmap points
+   in processLines lineToPointsFn ls updatedHmap
+
+e2 ls =
+  let hmap = Map.empty
+      processed = processLines lineToPoints2 ls hmap
+   in Map.elems processed $> filter (>= 2) .> length
+
+main :: IO ()
+main =
+  do
+    contents <- getContents
+    let ls = contents $> lines .> map rowToLine
+
+    e1 ls $> print
+    e2 ls $> print