2023 day 3 in Haskell

2023/03/day3.hs

@@ -0,0 +1,55 @@
+import Data.Char (digitToInt, isDigit)
+import Data.List (nub, span)
+import Data.Map.Strict qualified as Map
+import Data.Maybe (isJust)
+
+type Point = (Int, Int)
+type Range = (Point, Point)
+type IntRange = (Int, Range)
+type NumMap = Map.Map Point IntRange
+type Input = ([String], NumMap)
+
+main :: IO ()
+main = do
+  input <- parseInput <$> getContents
+  putStrLn ("Part 1: " <> show (part1 input))
+  putStrLn ("Part 2: " <> show (part2 input))
+
+parseInput :: String -> Input
+parseInput s = (lines s, parseNumberMap s)
+
+part1 :: Input -> Int
+part1 (s, npos) = sum $ [fst ir | p <- symbolPositions (\c -> not (isDigit c || c == '.')) s, ir <- numbersAdjacentTo p npos]
+
+part2 :: Input -> Int
+part2 (s, npos) = sum $ [product $ map fst irs | p <- symbolPositions (== '*') s, let irs = numbersAdjacentTo p npos, length irs == 2]
+
+parseNumberMap :: String -> NumMap
+parseNumberMap = Map.fromList . foldMap (foldMap expandRange . uncurry parseNumLine) . withIndex . lines
+
+parseNumLine :: Int -> String -> [IntRange]
+parseNumLine x s = parseNumLine' (withIndex s) []
+  where
+    parseNumLine' [] acc = acc
+    parseNumLine' xs acc =
+      case span (isDigit . snd) xs of
+        ([], rest) -> parseNumLine' (dropWhile (not . isDigit . snd) rest) acc
+        (nums, rest) -> parseNumLine' rest $ parseNums x nums : acc
+
+parseNums :: Int -> [(Int, Char)] -> IntRange
+parseNums x s = (value, ((x, fst $ head s), (x, fst $ last s)))
+  where value = read $ map snd s
+
+expandRange :: IntRange -> [(Point, IntRange)]
+expandRange ir@(i, ((sx, sy), (ex, ey))) = [((sx, y), ir) | y <- [sy..ey]]
+
+symbolPositions :: (Char -> Bool) -> [String] -> [Point]
+symbolPositions p ss = [(x, y) | (x, line) <- withIndex ss, (y, c) <- withIndex line, p c]
+
+withIndex :: [a] -> [(Int, a)]
+withIndex = zip [0..]
+
+numbersAdjacentTo :: Point -> NumMap -> [IntRange]
+numbersAdjacentTo (x, y) m = nub [ir | (x, y) <- adjacentPoints, let e = Map.lookup (x, y) m, isJust e, let (Just ir) = e]
+  where adjacentPoints = [(x + dx, y + dy) | dx <- [-1, 0, 1], dy <- [-1, 0, 1], dx /= 0 || dy /= 0]
+

2023/03/example

@@ -0,0 +1,10 @@
+467..114..
+...*......
+..35..633.
+......#...
+617*......
+.....+.58.
+..592.....
+......755.
+...$.*....
+.664.598..