never executed always true always false

    1 {-|
    2 Module:      Y2021.D09
    3 Description: Advent of Code 2021 Day 09 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the 2021 day 09 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2021.D09
   10   ( part9A
   11   , part9B
   12   , parse9
   13   )
   14   where
   15 
   16 import Data.Attoparsec.Text hiding (take)
   17 import Data.Either.Utils (fromRight)
   18 import Data.List (group, sort, sortOn)
   19 import Data.List.Extra (nubOrdOn)
   20 import Data.Maybe (catMaybes)
   21 import Data.Ord (Down(Down))
   22 import Data.Text (Text)
   23 import Math.Geometry.Grid
   24 import Math.Geometry.Grid.Square
   25 import Math.Geometry.GridMap hiding (map)
   26 import Math.Geometry.GridMap.Lazy (lazyGridMap, LGridMap)
   27 
   28 -- |Type alias for better readability.
   29 type Point = (Int, Int)
   30 -- |Type alias for better readability.
   31 type SeaFloor = LGridMap RectSquareGrid Int
   32 -- |Type alias for better readability.
   33 type Basins = LGridMap RectSquareGrid (Maybe (Point, Int))
   34 
   35 -- |Solve part A
   36 part9A :: Text -> Int
   37 part9A = sum . map (succ . snd) . nubOrdOn fst . findBasins . parse9
   38 
   39 -- |Solve part B
   40 part9B :: Text -> Int
   41 part9B =
   42   product .
   43   take 3 .
   44   sortOn Down . map length . group . sort . map fst . findBasins . parse9
   45 
   46 -- |Some common glue between our mapping function and extracting the values
   47 -- we're interested in.
   48 findBasins :: SeaFloor -> [(Point, Int)]
   49 findBasins = catMaybes . elems . basins
   50 
   51 -- |Recursive map over `SeaFloor` that turns each grid point into a possible
   52 -- representation of the basin this point flows to. `Grid` takes the brunt of
   53 -- the boilterplate here with `neighbours` and `mapWithKey`.
   54 basins :: SeaFloor -> Basins
   55 basins g = mapWithKey toBasins g
   56   where
   57     -- Although `basins` is the top-level map, toBasins is what we'll
   58     -- recursively call when we find a point that has to map to a low point
   59     -- somewhere.
   60     toBasins point value
   61       | value == 9      = Nothing
   62       | []  <- adjacent = Just (point, value)
   63       | otherwise       = minimum (map (uncurry toBasins) adjacent)
   64       where
   65         adjacent = [(x, g ! x) | x <- neighbours g point, g ! x < value]
   66 
   67 -- |Parse puzzle input into a `Grid`. I could probably do the conversion from
   68 -- `[[Int]]` to `Grid outside of the parser, but it's nice to go directly to the
   69 -- main data structure for the problem.
   70 parse9 :: Text -> SeaFloor
   71 parse9 = fromRight . parseOnly (grid <$> parser)
   72   where
   73     grid [] = error "empty input"
   74     grid rows@(row:_) =
   75       lazyGridMap (rectSquareGrid (length row) (length rows)) (concat rows)
   76     parser = line `sepBy1` endOfLine <* atEnd
   77     line = many1 (read . (: []) <$> digit)