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)
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
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
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]
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) ]
-touchPoint :: [Position] -> Position -> Bool
+touchPoint :: Region -> Position -> Bool
touchPoint region point = not $ null $ intersect region $ neighbours point
-touchRegion :: [Position] -> [Position] -> Bool
+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
-findSymbols :: Engine -> [Position]
+findSymbols :: Engine -> Region
findSymbols engine = filter (isEngineSymbol . (engine !)) $ indices engine
-findStars :: Engine -> [Position]
+findStars :: Engine -> Region
findStars engine = filter ((==) '*' . (engine !)) $ indices engine
-possibleGears :: [NumPos] -> Position -> [NumPos]
+possibleGears :: [Region] -> Position -> [Region]
possibleGears nums star = filter (flip touchPoint star) nums