day 3 done

README.md

@@ -11,7 +11,7 @@ Solutions, scripting, and templates - all in one repo.
 
 | `<++++++++>` | `<++++++++>` | `<++++++++>` | `<++++++++>` | `<++++++++>` |
 | :-: | :-: | :-: | :-: | :-: |
-| ☑ [Day 1](src/Javran/AdventOfCode/Y2023/Day1.hs) | ☑ [Day 2](src/Javran/AdventOfCode/Y2023/Day2.hs) | ☐ [Day 3](src/Javran/AdventOfCode/Y2023/Day3.hs) |  |  |
+| ☑ [Day 1](src/Javran/AdventOfCode/Y2023/Day1.hs) | ☑ [Day 2](src/Javran/AdventOfCode/Y2023/Day2.hs) | ☑ [Day 3](src/Javran/AdventOfCode/Y2023/Day3.hs) |  |  |
 
 ### 2022
 

data/testdata/2023/day/3/example.expect.txt

@@ -0,0 +1,2 @@
+4361
+467835

src/Javran/AdventOfCode/Y2023/Day3.hs

@@ -34,22 +34,56 @@ data Day3 deriving (Generic)
 type ASym = Char -- a symbol
 type ANum = (Int, Int) -- a number: (value, length)
 
+type Schematic = (M.Map Coord ASym, [(Coord, ANum)])
+
 parseLine :: String -> [(Int, Either ASym ANum)]
 parseLine = go . zip [0 ..]
   where
-    go xs0
-      | null xs0 = []
-      | (_, '.') : xs1 <- xs0 = go xs1
-      | (ds, xs1) <- span (isDigit . snd) xs0 =
-          case ds of
-            ((r0, _) : _) ->
-              ((r0, Right (read (fmap snd ds), length ds)) :: (Int, Either ASym ANum)) : go xs1
-            [] -> case xs1 of
-              (r0, hd) : tl | hd /= '.' -> (r0, Left hd) : go tl
-              _ -> go xs1
+    go xs0 = case span (isDigit . snd) xs0 of
+      (ds@((r0, _) : _), xs1) -> (r0, Right (read (fmap snd ds), length ds)) : go xs1
+      ([], []) -> []
+      ([], (_, '.') : xs1) -> go xs1
+      ([], (r0, ch) : xs1) -> (r0, Left ch) : go xs1
+
+parseSchematic :: [String] -> Schematic
+parseSchematic inp = (M.fromList syms, nums)
+  where
+    tokens :: [(Coord, Either ASym ANum)]
+    tokens = do
+      (r, rawLine) <- zip [0 ..] inp
+      let parsed = parseLine rawLine
+      (fmap . first) (r,) parsed
+
+    (syms, nums) =
+      partitionEithers $
+        fmap (\(coord, e) -> bimap (coord,) (coord,) e) tokens
+
+isAdjacent :: (Coord, ANum) -> Coord -> Bool
+isAdjacent ((nr, nc), (_, nl)) (sr, sc) =
+  nr - 1 <= sr && sr <= nr + 1 && nc - 1 <= sc && sc <= nc + nl
 
 instance Solution Day3 where
-  solutionSolved _ = False
+  solutionSolved _ = True
   solutionRun _ SolutionContext {getInputS, answerShow} = do
-    xs <- fmap id . lines <$> getInputS
-    mapM_ (print . parseLine) xs
+    xs <- lines <$> getInputS
+    let (syms, nums) = parseSchematic xs
+    do
+      let rs = filter (\n -> any (isAdjacent n) $ M.keys syms) nums
+      answerShow $ sum $ fmap (fst . snd) rs
+    let mayGearCoords :: [Coord]
+        mayGearCoords = M.keys $ M.filter (== '*') syms
+        adjacentCounts :: M.Map Coord [Int]
+        adjacentCounts = M.fromListWith (<>) do
+          n@(_, (v, _)) <- nums
+          g <- mayGearCoords
+          guard $ isAdjacent n g
+          pure (g, [v])
+    answerShow
+      . getSum
+      . foldMap
+        ( \case
+            [a, b] -> Sum $ a * b
+            _ -> 0
+        )
+      $ M.elems
+        adjacentCounts