never executed always true always false

    1 {-|
    2 Module:      Y2021.D11
    3 Description: Advent of Code 2021 Day 11 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the 2021 day 11 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2021.D11
   10   ( parse11
   11   , part11A
   12   , part11B
   13   , solve11A
   14   , solve11B
   15   ) where
   16 
   17 import Data.Attoparsec.Text
   18 import Data.Either.Utils            (fromRight)
   19 import Data.Monoid
   20 import Data.Text                    (Text)
   21 import Math.Geometry.Grid
   22 import Math.Geometry.Grid.Octagonal (rectOctGrid, RectOctGrid)
   23 import Math.Geometry.GridMap
   24 import Math.Geometry.GridMap.Lazy
   25 
   26 import qualified Math.Geometry.GridMap as G
   27 
   28 -- |A GADT is useful here; although we could wrap an `Int` it's nice to have
   29 -- something with a bit more state
   30 data Octopus a
   31   = Flashed
   32   | Flashing
   33   | Unflashed a
   34   deriving (Eq, Ord, Show)
   35 -- |Type alias for better readability.
   36 type Octopi = LGridMap RectOctGrid (Octopus Int)
   37 
   38 -- |Solution to part A
   39 part11A :: Text -> Int
   40 part11A = solve11A . parse11
   41 
   42 -- |Solve part A
   43 solve11A :: Octopi -> Int
   44 solve11A = getSum . fst . flip (!!) 100 . iterate octoStep . (,) (Sum 0)
   45 
   46 -- |Solution to part B
   47 part11B :: Text -> Int
   48 part11B = solve11B . parse11
   49 
   50 -- |Solve part B
   51 solve11B :: Octopi -> Int
   52 solve11B = go 1 . step
   53   where
   54     go n octopi
   55       | all isFlashed octopi = n
   56       | otherwise
   57         = go (succ n) (step $ G.map reset octopi)
   58     step = octoStep' . G.map succ'
   59 
   60 -- |This is primarily for part A, which asks for iterative steps through the
   61 -- grid but also a running sum of flashes. We could probably make it more
   62 -- efficient with `State` to track a running sum, but this is pretty simple and
   63 -- I know it works.
   64 octoStep :: (Sum Int, Octopi) -> (Sum Int, Octopi)
   65 octoStep (flashes, octopi)
   66   = ( flashes + foldMap flashed octopi'
   67     , G.map reset octopi'
   68     )
   69   where
   70     octopi' = octoStep' $ G.map succ' octopi
   71     flashed Flashed = Sum 1
   72     flashed _ = 0
   73 
   74 -- |Step function to increment an `Octopus`, with the ceiling being `Flashing`
   75 -- (we don't downgrade to `Flashed` outside of `octoStep'`)
   76 succ' :: Octopus Int -> Octopus Int
   77 succ' (Unflashed (succ -> n))
   78   | n > 9     = Flashing
   79   | otherwise = Unflashed n
   80 succ' other = other
   81 
   82 -- |After steps, we call this function on `Octopus` grid in order to turn it
   83 -- into a clean state for the next iteration.
   84 reset :: Octopus Int -> Octopus Int
   85 reset Flashed  = Unflashed 0
   86 reset Flashing = error "something went wrong!"
   87 reset other    = other
   88 
   89 -- |Recursive function to iterate an `Octopi` grid until the state has settled
   90 -- and no flashing `Octopus` change the state.
   91 octoStep' :: Octopi -> Octopi
   92 octoStep' gOrig@(G.mapWithKey (observeFlash gOrig) -> gStepped)
   93   | gOrig == gStepped = gOrig
   94   | otherwise         = octoStep' gStepped
   95 
   96 -- |On a given iteration, we can map the grid and test the flashes of adjacent
   97 -- neighbors to increment the level of this `Octopus`. It's important that: we
   98 -- increment the right number of times, and that each `Octopus` _stops_ flashing
   99 -- after one step, which we can do with a simple pattern match.
  100 observeFlash :: Octopi -> (Int, Int) -> Octopus Int -> Octopus Int
  101 observeFlash _ _ Flashed  = Flashed
  102 observeFlash _ _ Flashing = Flashed
  103 observeFlash g point oct@(Unflashed _)
  104   = iterate succ' oct !! length adjacentFlashers
  105   where
  106     adjacentFlashers = [x | x <- neighbours g point, isFlashing (g ! x)]
  107 
  108 -- |Simple predicate to check for a flashing octopus.
  109 isFlashing :: Octopus a -> Bool
  110 isFlashing Flashing = True
  111 isFlashing _ = False
  112 
  113 -- |Check whether this octopus has flashed.
  114 isFlashed :: Octopus a -> Bool
  115 isFlashed Flashed = True
  116 isFlashed _ = False
  117 
  118 -- |Parse puzzle input into a octagon rectangular grid. Need octagons in order
  119 -- to correctly ask for diagonal neighbors.
  120 parse11 :: Text -> Octopi
  121 parse11 = fromRight . parseOnly (grid <$> parser)
  122   where
  123     grid [] = error "empty input"
  124     grid rows@(row:_) =
  125       lazyGridMap (rectOctGrid (length row) (length rows)) (concat rows)
  126     parser = line `sepBy1` endOfLine <* atEnd
  127     line = many1 (Unflashed . read . (: []) <$> digit)