diff --git a/2023/aoc2023.cabal b/2023/aoc2023.cabal index 1748b5a..7c67a37 100644 --- a/2023/aoc2023.cabal +++ b/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: diff --git a/2023/app/Main.hs b/2023/app/Main.hs index 369f1cf..c347ad8 100644 --- a/2023/app/Main.hs +++ b/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 diff --git a/2023/inputs/day03/example.txt b/2023/inputs/day03/example.txt new file mode 100644 index 0000000..b20187f --- /dev/null +++ b/2023/inputs/day03/example.txt @@ -0,0 +1,10 @@ +467..114.. +...*...... +..35..633. +......#... +617*...... +.....+.58. +..592..... +......755. +...$.*.... +.664.598.. diff --git a/2023/src/Day03.hs b/2023/src/Day03.hs new file mode 100644 index 0000000..2b5cde3 --- /dev/null +++ b/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] diff --git a/2023/test/Day03Spec.hs b/2023/test/Day03Spec.hs new file mode 100644 index 0000000..cee5517 --- /dev/null +++ b/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 diff --git a/2023/test/Spec.hs b/2023/test/Spec.hs index ebe4bc1..09d5ec7 100644 --- a/2023/test/Spec.hs +++ b/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