X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent03%2FMain.hs;h=01df0bb9d957bcf1244ce1a70bb0247a78166bf0;hb=dd72089097a0df4238584f21a8078248bcf30117;hp=f164bada484ca5084e075663a0977862b6617053;hpb=b3a89bb2f720c65da9c9866219a47914c2e3dd06;p=advent-of-code-23.git

diff --git a/advent03/Main.hs b/advent03/Main.hs
index f164bad..01df0bb 100644
--- a/advent03/Main.hs
+++ b/advent03/Main.hs
@@ -1,8 +1,6 @@
--- Writeup at https://work.njae.me.uk/2022/12/14/advent-of-code-2022-day-12/
-
+-- Writeup at https://work.njae.me.uk/2023/12/03/advent-of-code-2023-day-03/
 import AoC
 
-
 import Data.Char
 import Data.List
 import Linear (V2(..), (^+^))
@@ -10,12 +8,11 @@ import Data.Array.IArray
 
 type Position = V2 Int -- r, c
 type Engine = Array Position Char
-type NumPos = [Position]
+type Region = [Position]
 
 data NumberSeek = 
-  NumberSeek { inNumber :: Bool
-             , positions :: NumPos
-             , foundNumbers :: [NumPos]
+  NumberSeek { positions :: Region
+             , foundNumbers :: [Region]
              } deriving (Show)
 
 
@@ -25,22 +22,24 @@ main =
       text <- readFile dataFileName
       let engine = mkEngine text
       let allNums = findNumbers engine
-      let partNums = filter (numTouchingSymbols engine) allNums
+      let symbols = findSymbols engine
+      let partNums = filter (touchRegion symbols) allNums
+      -- print partNums
       -- print engine
       -- print $ findNumbers engine
       print $ part1 engine partNums
       print $ part2 engine partNums
 
 
-part1, part2 :: Engine -> [NumPos] -> Int
+part1, part2 :: Engine -> [Region] -> 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
+  where stars = findStars engine
+        touchingStars = fmap (possibleGears partNums) stars
         gears = filter ((==) 2 . length) touchingStars
-        gearRatios = [[readNumber engine n | n <- pNs] | pNs <- gears]
+        gearRatios = fmap (fmap (readNumber engine)) gears
 
 mkEngine :: String -> Engine
 mkEngine text = grid
@@ -52,7 +51,7 @@ mkEngine text = grid
 isEngineSymbol :: Char -> Bool
 isEngineSymbol c = (not $ isDigit c) && (c /= '.')
 
-findNumbers :: Engine -> [NumPos]
+findNumbers :: Engine -> [Region]
 findNumbers engine = numbers
   where ((V2 r1 _), (V2 r2 _)) = bounds engine
         rows = [r1..r2]
@@ -60,44 +59,46 @@ findNumbers engine = numbers
 
 findNumbersInRow :: Engine -> Int -> NumberSeek
 findNumbersInRow engine r
-  | inNumber finalSeek = NumberSeek False [] ((reverse $ positions finalSeek):foundNumbers finalSeek)
+  | not $ null positions = 
+      NumberSeek [] ((reverse $ positions):foundNumbers)
   | otherwise = finalSeek
-  where finalSeek = foldl' (buildNumber engine) 
-                           (NumberSeek False [] []) 
-                           $ range $ rowBounds engine r
+  where finalSeek@NumberSeek{..} = 
+            foldl' (buildNumber engine) 
+                   (NumberSeek [] []) 
+                   $ 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
+  | (not $ null positions) && isDigit c = NumberSeek (p:positions) foundNumbers
+  | (not $ null positions) && not (isDigit c) = NumberSeek [] ((reverse positions):foundNumbers)
+  | (null positions) && isDigit c = NumberSeek [p] foundNumbers
+  | otherwise = NumberSeek [] 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
+  where (V2 _ c1, V2 _ c2) = bounds engine
 
-neighbours :: Position -> [Position]
+neighbours :: Position -> Region
 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
+touchPoint :: Region -> Position -> Bool
+touchPoint region point = not $ null $ intersect region $ neighbours point
+
+touchRegion :: Region -> Region -> Bool
+touchRegion region1 region2 = any (touchPoint region2) region1
+
 
-readNumber :: Engine -> NumPos -> Int
+readNumber :: Engine -> Region -> Int
 readNumber engine ps = read $ map (engine !) ps
 
-stars :: Engine -> [Position]
-stars engine = filter ((==) '*' . (engine !)) $ indices engine
+findSymbols :: Engine -> Region
+findSymbols engine = filter (isEngineSymbol . (engine !)) $ indices engine
 
-starTouchesNumber :: Position -> NumPos -> Bool
-starTouchesNumber star ps = not $ null $ intersect ps halo
-  where halo = neighbours star
+findStars :: Engine -> Region
+findStars engine = filter ((==) '*' . (engine !)) $ indices engine
 
-adjacentNumbers :: [NumPos] -> Position -> [NumPos]
-adjacentNumbers nums star = filter (starTouchesNumber star) nums
+possibleGears :: [Region] -> Position -> [Region]
+possibleGears nums star = filter (flip touchPoint star) nums