Solve 2023-03

src/AoC.hs

@@ -29,4 +29,4 @@ handleError e = do
   hPutStrLn stderr $ "I ran into an issue: " <> show e
 
 defaultMain :: IO ()
-defaultMain = Exception.catch (runAoC Y2023 D01 >>= print) handleError
+defaultMain = Exception.catch (runAoC Y2023 D03 >>= print) handleError

src/AoC/Y2023/D03.hs

@@ -1,6 +1,93 @@
-module AoC.Y2023.D03 (solve) where
+module AoC.Y2023.D03 where
 
 import AoC.Riddle
+import Data.Array
+import Data.Char (isDigit)
+import Relude (catMaybes, fromIntegral, readMaybe)
+import System.Posix.Internals (const_fd_cloexec)
+
+type Pos = (Int, Int)
+type Item = (Pos, Char)
+type Puzzle = Array Pos Char
+
+toArray :: [[Char]] -> Puzzle
+toArray xxs =
+  array
+    ((1, 1), (h, w))
+    [ ((y, x), c)
+    | (y, xs) <- zip [1 ..] xxs
+    , (x, c) <- zip [1 ..] xs
+    ]
+ where
+  w = case xxs of
+    [] -> 0
+    xs : _ -> length xs
+  h = length xxs
+
+parse :: Text -> Puzzle
+parse = toArray . fmap toString . lines
+
+symbols :: Puzzle -> [Item]
+symbols = filter (isSymbol <$> snd) . assocs
+ where
+  isSymbol :: Char -> Bool
+  isSymbol c = not (isDigit c || c == '.')
+
+neighborDeltas :: [Pos]
+neighborDeltas =
+  [ (-1, -1)
+  , (-1, 0)
+  , (-1, 1)
+  , (0, -1)
+  , (0, 1)
+  , (1, -1)
+  , (1, 0)
+  , (1, 1)
+  ]
+
+move :: Pos -> Pos -> Pos
+move (x, y) (dx, dy) = (x + dx, y + dy)
+
+item :: Puzzle -> Pos -> Maybe Item
+item arr p =
+  if inRange grid p
+    then Just (p, arr ! p)
+    else Nothing
+ where
+  grid = bounds arr
+
+neighbors :: Puzzle -> Pos -> [Item]
+neighbors arr pos = filter isPartNumber ns
+ where
+  ns = mapMaybe (item arr . move pos) neighborDeltas
+
+  isPartNumber :: Item -> Bool
+  isPartNumber (_, c) = isDigit c
+
+expand :: Puzzle -> (Char -> Bool) -> Pos -> [Item]
+expand arr f pos = ls <> rs
+ where
+  ls = reverse . drop 1 $ go pos (0, -1)
+  rs = go pos (0, 1)
+  go p dt = case item arr p of
+    Nothing -> []
+    Just i@(_, x) ->
+      if f x
+        then i : go (move p dt) dt
+        else []
+
+toPartNumber :: [Item] -> Maybe Integer
+toPartNumber = readMaybe . fmap snd
+
+part1 :: Puzzle -> Integer
+part1 puzzle = sum partNumbers
+ where
+  partNumbers = mapMaybe toPartNumber (ordNub (concatMap (fmap (expand puzzle isDigit . fst) . neighbors puzzle . fst) syms))
+  syms = symbols puzzle
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve _ = pure $ Left "not yet implemented"
+solve input = do
+  let
+    puzzle = parse input
+    p1 = part1 puzzle
+  pure $ Right [part1 puzzle]