feat: finished day 3

2023/aoc2023.cabal

@@ -59,7 +59,7 @@ library
     import:           warnings
 
     -- Modules exported by the library.
-    exposed-modules:  Day01, Day02
+    exposed-modules:  Day01, Day02, Day03
 
     -- Modules included in this library but not exported.
     -- other-modules:
@@ -68,7 +68,7 @@ library
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:    base ^>=4.19.2.0
+    build-depends:    base ^>=4.19.2.0, containers
 
     -- Directories containing source files.
     hs-source-dirs:   src
@@ -90,8 +90,7 @@ executable aoc2023
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:
-        base ^>=4.19.2.0,
+    build-depends: base ^>=4.19.2.0,
         aoc2023
 
     -- Directories containing source files.
@@ -108,7 +107,7 @@ test-suite aoc2023-test
     default-language: Haskell2010
 
     -- Modules included in this executable, other than Main.
-    other-modules:	  Common.Tests, Day01Spec, Day02Spec
+    other-modules:	  Common.Tests, Day01Spec, Day02Spec, Day03Spec
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

2023/app/Main.hs

@@ -2,6 +2,7 @@ module Main where
 
 import qualified Day01
 import qualified Day02
+import qualified Day03
 import System.Console.GetOpt
 import System.Environment (getArgs)
 import System.Exit (exitFailure)
@@ -32,6 +33,9 @@ runDay 1 filename = do
 runDay 2 filename = do
   (a, b) <- Day02.run filename
   return (show a, show b)
+runDay 3 filename = do
+  (a, b) <- Day03.run filename
+  return (show a, show b)
 runDay _ _ = return ("Not implemented", "Not implemented")
 
 defaultFilename :: Int -> FilePath

2023/inputs/day03/example.txt

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

2023/src/Day03.hs

@@ -0,0 +1,91 @@
+module Day03 (part1, part2, run) where
+
+import Data.Char (isDigit)
+import Data.Maybe (mapMaybe)
+import qualified Data.Set as Set
+
+part1 :: Grid -> Int
+part1 grid =
+  sum . map (read . digits) . filter (numberHasAdjacentSymbol grid) $ extractNumbers grid
+
+part2 :: Grid -> Int
+part2 grid =
+  let numbers = extractNumbers grid
+      gears = extractGears grid
+      validGears = filter (\g -> length (findAdjacentNumbersToGear numbers g) == 2) gears
+      gearRatios = [product (map (read . digits) (findAdjacentNumbersToGear numbers g)) | g <- validGears]
+   in sum gearRatios
+
+run :: FilePath -> IO (Int, Int)
+run filename = do
+  input <- readFile filename
+  let grid = mkGrid input
+  return (part1 grid, part2 grid)
+
+newtype Grid = Grid [[Char]]
+  deriving (Show, Eq)
+
+data Number = Number {digits :: String, positions :: [(Int, Int)]}
+  deriving (Show, Eq, Ord)
+
+mkGrid :: String -> Grid
+mkGrid = Grid . lines
+
+neighbors :: [(Int, Int)]
+neighbors = [(-1, -1), (-1, 0), (-1, 1), (0, -1), (0, 1), (1, -1), (1, 0), (1, 1)]
+
+getCharAt :: Grid -> (Int, Int) -> Maybe Char
+getCharAt (Grid rows) (r, c) =
+  if r >= 0 && r < length rows && c >= 0 && c < length (rows !! r)
+    then Just ((rows !! r) !! c)
+    else Nothing
+
+isSymbol :: Char -> Bool
+isSymbol c = not (isDigit c) && c /= '.'
+
+extractNumbers :: Grid -> [Number]
+extractNumbers (Grid rows) = concatMap extractRowNumbers (zip [0 ..] rows)
+  where
+    extractRowNumbers (r, row) = go 0 row []
+      where
+        go _ [] acc = reverse acc
+        go c xs acc =
+          case span isDigit xs of
+            ("", _ : rest) -> go (c + 1) rest acc
+            (num, rest) ->
+              let len = length num
+                  pos = [(r, c + i) | i <- [0 .. len - 1]]
+               in go (c + len) rest (Number num pos : acc)
+
+extractGears :: Grid -> [(Int, Int)]
+extractGears (Grid rows) =
+  [ (r, c)
+    | r <- [0 .. length rows - 1],
+      c <- [0 .. length (rows !! r) - 1],
+      getCharAt (Grid rows) (r, c) == Just '*'
+  ]
+
+findNumberAtPosition :: [Number] -> (Int, Int) -> Maybe Number
+findNumberAtPosition numbers pos =
+  let filtered = filter (\n -> pos `elem` positions n) numbers
+   in case filtered of
+        (x : _) -> Just x
+        [] -> Nothing
+
+findAdjacentNumbersToGear :: [Number] -> (Int, Int) -> [Number]
+findAdjacentNumbersToGear numbers gearPos =
+  let adjPos = adjacentPositions gearPos
+      adjacentNums = mapMaybe (findNumberAtPosition numbers) adjPos
+   in Set.toList (Set.fromList adjacentNums)
+
+numberHasAdjacentSymbol :: Grid -> Number -> Bool
+numberHasAdjacentSymbol grid (Number _ pos) = any (hasSymbolAdjacentToPosition grid) pos
+
+hasSymbolAdjacentToPosition :: Grid -> (Int, Int) -> Bool
+hasSymbolAdjacentToPosition grid (r, c) =
+  any
+    (maybe False isSymbol . getCharAt grid)
+    (adjacentPositions (r, c))
+
+adjacentPositions :: (Int, Int) -> [(Int, Int)]
+adjacentPositions (r, c) = [(r + dr, c + dc) | (dr, dc) <- neighbors]

2023/test/Day03Spec.hs

@@ -0,0 +1,22 @@
+module Day03Spec (spec) where
+
+import Common.Tests (TestCase (..), mkPartSpec)
+import Day03 (run)
+import Test.Hspec
+
+part1TestCases :: [TestCase Int]
+part1TestCases =
+  [ TestCase "inputs/day03/example.txt" 4361,
+    TestCase "inputs/day03/input.txt" 520019
+  ]
+
+part2TestCases :: [TestCase Int]
+part2TestCases =
+  [ TestCase "inputs/day03/example.txt" 467835,
+    TestCase "inputs/day03/input.txt" 75519888
+  ]
+
+spec :: Spec
+spec = do
+  mkPartSpec "Day 3/1 tests" fst run part1TestCases
+  mkPartSpec "Day 3/2 tests" snd run part2TestCases

2023/test/Spec.hs

@@ -2,9 +2,11 @@ module Main (main) where
 
 import qualified Day01Spec
 import qualified Day02Spec
+import qualified Day03Spec
 import Test.Hspec
 
 main :: IO ()
 main = hspec $ do
   Day01Spec.spec
   Day02Spec.spec
+  Day03Spec.spec