Initial version

[advent-of-code-23.git] / advent03 / Main.hs

diff --git a/advent03/Main.hs b/advent03/Main.hs
new file mode 100644 (file)
index 0000000..f164bad
--- /dev/null
+++ b/advent03/Main.hs
@@ -0,0 +1,103 @@
+-- Writeup at https://work.njae.me.uk/2022/12/14/advent-of-code-2022-day-12/
+
+import AoC
+
+
+import Data.Char
+import Data.List
+import Linear (V2(..), (^+^))
+import Data.Array.IArray
+
+type Position = V2 Int -- r, c
+type Engine = Array Position Char
+type NumPos = [Position]
+
+data NumberSeek = 
+  NumberSeek { inNumber :: Bool
+             , positions :: NumPos
+             , foundNumbers :: [NumPos]
+             } deriving (Show)
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let engine = mkEngine text
+      let allNums = findNumbers engine
+      let partNums = filter (numTouchingSymbols engine) allNums
+      -- print engine
+      -- print $ findNumbers engine
+      print $ part1 engine partNums
+      print $ part2 engine partNums
+
+
+part1, part2 :: Engine -> [NumPos] -> Int
+part1 engine partNums = sum partNumValues
+  where partNumValues = map (readNumber engine) partNums
+
+part2 engine partNums = sum $ fmap product gearRatios
+  where sts = stars engine
+        touchingStars = fmap (adjacentNumbers partNums) sts
+        gears = filter ((==) 2 . length) touchingStars
+        gearRatios = [[readNumber engine n | n <- pNs] | pNs <- gears]
+
+mkEngine :: String -> Engine
+mkEngine text = grid
+  where rows = lines text
+        r = length rows - 1
+        c = (length $ head rows) - 1
+        grid = listArray ((V2 0 0), (V2 r c)) $ concat rows
+
+isEngineSymbol :: Char -> Bool
+isEngineSymbol c = (not $ isDigit c) && (c /= '.')
+
+findNumbers :: Engine -> [NumPos]
+findNumbers engine = numbers
+  where ((V2 r1 _), (V2 r2 _)) = bounds engine
+        rows = [r1..r2]
+        numbers = concatMap (foundNumbers . (findNumbersInRow engine)) rows
+
+findNumbersInRow :: Engine -> Int -> NumberSeek
+findNumbersInRow engine r
+  | inNumber finalSeek = NumberSeek False [] ((reverse $ positions finalSeek):foundNumbers finalSeek)
+  | otherwise = finalSeek
+  where finalSeek = foldl' (buildNumber engine) 
+                           (NumberSeek False [] []) 
+                           $ range $ rowBounds engine r
+  
+buildNumber :: Engine -> NumberSeek -> Position -> NumberSeek
+buildNumber engine NumberSeek{..} p 
+  | inNumber && isDigit c = NumberSeek True (p:positions) foundNumbers
+  | inNumber && not (isDigit c) = NumberSeek False [] ((reverse positions):foundNumbers)
+  | not inNumber && isDigit c = NumberSeek True [p] foundNumbers
+  | otherwise = NumberSeek False [] foundNumbers
+  where c = engine ! p
+
+rowBounds :: Engine -> Int -> (V2 Int, V2 Int)
+rowBounds engine r = (V2 r c1, V2 r c2)
+  where ((V2 _ c1), (V2 _ c2)) = bounds engine
+
+neighbours :: Position -> [Position]
+neighbours p = [p ^+^ V2 dr dc | dr <- [-1..1], dc <- [-1..1]
+                               , (dr, dc) /= (0, 0) ]
+
+touchingSymbol :: Engine -> Position -> Bool
+touchingSymbol engine p = any (isEngineSymbol . (engine !)) nbrs
+  where nbrs = filter (inRange (bounds engine)) $ neighbours p
+
+numTouchingSymbols :: Engine -> NumPos -> Bool
+numTouchingSymbols engine ps = any (touchingSymbol engine) ps
+
+readNumber :: Engine -> NumPos -> Int
+readNumber engine ps = read $ map (engine !) ps
+
+stars :: Engine -> [Position]
+stars engine = filter ((==) '*' . (engine !)) $ indices engine
+
+starTouchesNumber :: Position -> NumPos -> Bool
+starTouchesNumber star ps = not $ null $ intersect ps halo
+  where halo = neighbours star
+
+adjacentNumbers :: [NumPos] -> Position -> [NumPos]
+adjacentNumbers nums star = filter (starTouchesNumber star) nums