never executed always true always false

    1 {-# LANGUAGE TypeFamilies #-}
    2 {-|
    3 Module:      Y2021.D15
    4 Description: Advent of Code 2021 Day 15 Solutions.
    5 License:     MIT
    6 Maintainer:  @tylerjl
    7 
    8 Solutions to the 2021 day 15 set of problems for <adventofcode.com>.
    9 -}
   10 module Y2021.D15
   11   ( parse15
   12   , part15A
   13   , part15B
   14   ) where
   15 
   16 import Control.Arrow
   17 import Data.Attoparsec.Text hiding  (take)
   18 import Data.Either.Utils            (fromRight)
   19 import Data.Foldable
   20 import Data.List.Extra              (transpose)
   21 import Data.Map.Strict              (Map)
   22 import Data.Text                    (Text)
   23 import Math.Geometry.Grid hiding    (distance)
   24 import Math.Geometry.Grid.Square
   25 import Math.Geometry.GridMap hiding (foldl', map, filter)
   26 import Math.Geometry.GridMap.Lazy
   27 
   28 import qualified Data.Heap as H
   29 import qualified Data.Map.Strict as M
   30 import qualified Math.Geometry.GridMap as GM
   31 
   32 type Cavern = LGridMap RectSquareGrid Int
   33 data Distance a
   34   = Infinite
   35   | Distance a
   36   deriving (Eq, Show)
   37 
   38 instance Ord a => Ord (Distance a) where
   39   Infinite     `compare` Infinite     = EQ
   40   (Distance _) `compare` Infinite     = LT
   41   (Distance a) `compare` (Distance b) = a `compare` b
   42   Infinite     `compare` (Distance _) = GT
   43 
   44 type Paths = Map (Int, Int) (Distance Int)
   45 
   46 -- |Solution to part A
   47 part15A :: Text -> Int
   48 part15A (parse15 -> grid) =
   49   case flip (M.!) (endPosition grid) $ cheapestPath grid of
   50     Distance d -> d
   51     Infinite -> error "can't reach goal"
   52 
   53 cheapestPath :: Cavern -> Paths
   54 cheapestPath grid = go (H.singleton (H.Entry (Distance 0) (0, 0))) nodes
   55   where
   56     go (H.viewMin -> Nothing) paths = paths
   57     go (H.viewMin -> Just (H.Entry dist point, q)) paths
   58       = go q' paths'
   59       where
   60         (q', paths') = foldl' measure (q, paths)
   61             [(n, grid ! n) | n <- neighbours grid point]
   62         measure (heap, costs) (neigh, cost)
   63           | alt < toNeigh = ( H.insert (H.Entry alt neigh) heap
   64                             , M.insert neigh alt costs
   65                             )
   66           | otherwise = (heap, costs)
   67           where
   68             alt = dist `addDist` Distance cost
   69             toNeigh = costs M.! neigh
   70     allNodes = map fst $ GM.toList grid
   71     nodes = M.fromList $ zip allNodes (repeat Infinite)
   72 
   73 endPosition :: Cavern -> (Int, Int)
   74 endPosition = (pred *** pred) . size
   75 
   76 addDist :: Num a => Distance a -> Distance a -> Distance a
   77 addDist (Distance a) (Distance b) = Distance (a + b)
   78 addDist Infinite (Distance b) = Distance b
   79 addDist (Distance a) Infinite = Distance a
   80 addDist Infinite Infinite = Infinite
   81 
   82 -- |Solution to part B
   83 part15B :: Text -> Int
   84 part15B (expandBy 5 . parse15 -> grid) =
   85   case flip (M.!) (endPosition grid) $ cheapestPath grid of
   86     Distance d -> d
   87     Infinite -> error "can't reach goal"
   88 
   89 expandBy :: Int -> Cavern -> Cavern
   90 expandBy n g
   91   = GM.mapWithKey populate $ lazyGridMap (rectSquareGrid rows' cols') (repeat 0 :: [Int])
   92   where
   93     (rows, cols) = size g
   94     (rows', cols') = (rows * n, cols * n)
   95     populate (x, y) _ = iterate elevate (g ! (x `mod` cols, y `mod` rows)) !! (extX + extY)
   96       where (extX, extY) = (x `div` cols, y `div` rows)
   97 
   98 elevate :: Integral a => a -> a
   99 elevate n = max 1 ((n + 1) `mod` 10)
  100 
  101 -- |Parse.
  102 parse15 :: Text -> Cavern
  103 parse15 = fromRight . parseOnly (grid <$> parser)
  104   where
  105     grid [] = error "empty input"
  106     grid rows@(row:_) =
  107       lazyGridMap (rectSquareGrid (length row) (length rows)) (concat $ transpose rows)
  108     parser = line `sepBy1` endOfLine <* atEnd
  109     line = many1 (read . (: []) <$> digit)