Day 3

advent-of-code2023.cabal

@@ -22,8 +22,10 @@ library
   exposed-modules:
       Solutions.Day01
       Solutions.Day02
+      Solutions.Day03
   other-modules:
       Lib.AOC
+      Lib.Matrix
       Lib.Parsing
       Main
       Paths_advent_of_code2023
@@ -58,17 +60,21 @@ library
   build-depends:
       attoparsec
     , base >=4.7 && <5
+    , containers
     , regex-tdfa
     , text
+    , vector
   default-language: Haskell2010
 
 executable advent-of-code2023
   main-is: Main.hs
   other-modules:
       Lib.AOC
+      Lib.Matrix
       Lib.Parsing
       Solutions.Day01
       Solutions.Day02
+      Solutions.Day03
       Paths_advent_of_code2023
   autogen-modules:
       Paths_advent_of_code2023
@@ -101,8 +107,10 @@ executable advent-of-code2023
   build-depends:
       attoparsec
     , base >=4.7 && <5
+    , containers
     , regex-tdfa
     , text
+    , vector
   default-language: Haskell2010
 
 test-suite unit-test
@@ -111,6 +119,7 @@ test-suite unit-test
   other-modules:
       Day01
       Day02
+      Day03
       Paths_advent_of_code2023
   autogen-modules:
       Paths_advent_of_code2023
@@ -146,8 +155,10 @@ test-suite unit-test
       advent-of-code2023
     , attoparsec
     , base >=4.7 && <5
+    , containers
     , regex-tdfa
     , tasty
     , tasty-hunit
     , text
+    , vector
   default-language: Haskell2010

package.yaml

@@ -39,8 +39,10 @@ default-extensions:
 dependencies:
   - base >= 4.7 && < 5
   - attoparsec
+  - containers
   - regex-tdfa
   - text
+  - vector
 
 ghc-options:
 - -Wall
@@ -63,6 +65,7 @@ library:
   exposed-modules:
     - Solutions.Day01
     - Solutions.Day02
+    - Solutions.Day03
 
 tests:
   unit-test:

src/Lib/Matrix.hs

@@ -0,0 +1,21 @@
+module Lib.Matrix (Matrix, (!), (!?), height, width) where
+
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+import Prelude hiding (elem)
+
+type Matrix a = Vector (Vector a)
+
+type Position = (Int, Int) -- x, y
+
+(!) :: Position -> Matrix a -> a
+(!) (x, y) mat = mat V.! y V.! x
+
+(!?) :: Position -> Matrix a -> Maybe a
+(!?) (x, y) mat = mat V.!? y >>= (V.!? x)
+
+height :: Matrix a -> Int
+height = V.length
+
+width :: Matrix a -> Int
+width = V.length . V.head

src/Main.hs

@@ -1,8 +1,10 @@
 module Main (main) where
 import Solutions.Day01 (day01)
 import Solutions.Day02 (day02)
+import Solutions.Day03 (day03)
 
 main :: IO ()
 main = do
   day01
   day02
+  day03

src/Solutions/Day03.hs

@@ -0,0 +1,108 @@
+module Solutions.Day03 (day03, parser, part1, part2) where
+
+import Control.Applicative
+import qualified Data.Attoparsec.Text as P
+import Data.Char (digitToInt)
+import Data.Functor (($>))
+import Data.Maybe (catMaybes, fromJust, fromMaybe)
+import qualified Data.Text as T
+import Data.Vector (Vector)
+import qualified Data.Vector as V
+import Lib.AOC (runSolution)
+import qualified Lib.Matrix as Matrix
+import Lib.Parsing (linesOf)
+
+data SchematicItem = Number Int | Symbol Char deriving (Eq, Show)
+
+isSymbol :: SchematicItem -> Bool
+isSymbol (Symbol _) = True
+isSymbol _ = False
+
+isNumber :: SchematicItem -> Bool
+isNumber (Number _) = True
+isNumber _ = False
+
+getNumberVal :: SchematicItem -> Int
+getNumberVal (Number x) = x
+getNumberVal _ = error "Tried to extract number from non-Number SchematicItem"
+
+type Matrix a = Vector (Vector a)
+
+type Input = Matrix (Maybe SchematicItem)
+
+day03 :: IO ()
+day03 = runSolution "03" parser (fmap part1) (fmap part2)
+
+parser :: String -> Either String Input
+parser = fmap (V.map combineNumbers) . P.parseOnly (V.fromList <$> linesOf (V.fromList <$> P.many1 schematicItemParser)) . T.pack
+
+part1 :: Input -> Int
+part1 input =
+  sum $
+    map (\(Number x) -> x) $
+      catMaybes $
+        removeConseqDups $
+          map (Matrix.! input) $
+            getPartNumberPositions input
+
+schematicItemParser :: P.Parser (Maybe SchematicItem)
+schematicItemParser =
+  (P.char '.' $> Nothing)
+    <|> (Just . Number . digitToInt <$> P.digit)
+    <|> (Just . Symbol <$> P.notChar '\n')
+
+-- Combines the individual digits into larger numbers
+combineNumbers :: Vector (Maybe SchematicItem) -> Vector (Maybe SchematicItem)
+combineNumbers = V.fromList . combineNumbers' . V.toList
+  where
+    isNumber' (Just x) = isNumber x
+    isNumber' _ = False
+
+    combineNumbers' [] = []
+    combineNumbers' ((Just (Number x1)) : xs) =
+      let conseqNums = map (getNumberVal . fromJust) $ takeWhile isNumber' xs
+          combinedNum = read $ concatMap show (x1 : conseqNums)
+       in replicate (length conseqNums + 1) (Just (Number combinedNum)) <> combineNumbers' (drop (length conseqNums) xs)
+    combineNumbers' (x : xs) = x : combineNumbers' xs
+
+getSymbolPositions :: Input -> [(Int, Int)]
+getSymbolPositions mat = do
+  yPosition <- [0 .. Matrix.height mat - 1]
+  xPosition <- V.toList $ V.findIndices (fromMaybe False . (Just isSymbol <*>)) (mat V.! yPosition)
+  return (xPosition, yPosition)
+
+getPartNumberPositions :: Input -> [(Int, Int)]
+getPartNumberPositions = concatMap neighborPositions . getSymbolPositions
+
+neighborPositions :: (Int, Int) -> [(Int, Int)]
+neighborPositions (x, y) =
+  [ (x + 1, y),
+    (x + 1, y - 1),
+    (x, y - 1),
+    (x - 1, y - 1),
+    (x - 1, y),
+    (x - 1, y + 1),
+    (x, y + 1),
+    (x + 1, y + 1)
+  ]
+
+removeConseqDups :: (Eq a) => [a] -> [a]
+removeConseqDups [] = []
+removeConseqDups (x1 : x2 : xs) = if x1 == x2 then removeConseqDups (x2 : xs) else x1 : removeConseqDups (x2 : xs)
+removeConseqDups (x : xs) = x : removeConseqDups xs
+
+part2 :: Input -> Int
+part2 input = sum gearRatios
+  where
+    gearRatios :: [Int]
+    gearRatios = map (product . getGearAdjacentNums) $ filter isGear potentialGearPositions
+
+    potentialGearPositions = do
+      yPosition <- [0 .. Matrix.height input - 1]
+      xPosition <- V.toList $ V.findIndices (== Just (Symbol '*')) (input V.! yPosition)
+      return (xPosition, yPosition)
+
+    getGearAdjacentNums = map getNumberVal . filter isNumber . catMaybes . removeConseqDups . map (Matrix.! input) . neighborPositions
+
+    isGear :: (Int, Int) -> Bool
+    isGear gearPos = length (getGearAdjacentNums gearPos) == 2

test/Day03.hs

@@ -0,0 +1,37 @@
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+module Day03 where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Solutions.Day03 (parser, part1, part2)
+
+exampleInput :: String
+exampleInput = "467..114..\n\
+               \...*......\n\
+               \..35..633.\n\
+               \......#...\n\
+               \617*......\n\
+               \.....+.58.\n\
+               \..592.....\n\
+               \......755.\n\
+               \...$.*....\n\
+               \.664.598.."
+
+test_day03 :: TestTree
+test_day03 = testGroup "Day03"
+  [
+    testCase "part 1 - example input" $ do
+      part1 <$> parser exampleInput @?= Right 4361,
+
+    -- testCase "part 1" $ do
+    --   input <- parser <$> readFile "data/day02.txt"
+    --   part1 <$> input @?= Right 2632,
+
+    testCase "part 2 - example input" $ do
+      part2 <$> parser exampleInput @?= Right 467835
+
+    -- testCase "part 2" $ do
+    --   input <- parser <$> readFile "data/day02.txt"
+    --   part2 <$> input @?= Right 69629
+  ]
+