Day8.hs

module Javran.AdventOfCode.Y2022.Day8 (

) where

import Control.Monad
import qualified Data.Array.Unboxed as UA
import Data.Function.Memoize (memoFix)
import Data.List
import Data.Word
import Javran.AdventOfCode.GridSystem.RowThenCol.Uldr
import Javran.AdventOfCode.Prelude

data Day8 deriving (Generic)

type H = Word8

{-
  `mkMaxInDir atCoord d` creates a memoized function `maxInDir c`:

  - it is assumed that `isJust (atCoord c)`
  - computes the maximum height along the way (in the direction of `d`),
    including the height of initial coordinate.

 -}
mkMaxInDir :: (Coord -> Maybe H) -> Dir -> Coord -> H
mkMaxInDir atCoord d = memoFix \self c ->
  let Just h = atCoord c
      c' = applyDir d c
   in case atCoord c' of
        Nothing -> h
        Just _ -> max h (self c')

instance Solution Day8 where
  solutionRun _ SolutionContext {getInputS, answerShow} = do
    xs <- lines <$> getInputS
    let rows = length xs
        cols = length (head xs)
        coords = (,) <$> [0 .. rows - 1] <*> [0 .. cols - 1]
        m' :: UA.UArray (Int, Int) Word8
        m' = UA.array ((0, 0), (rows - 1, cols - 1)) do
          (r, rs) <- zip [0 ..] xs
          (c, hRaw) <- zip [0 ..] rs
          pure ((r, c), read [hRaw])
        atCoord c = (m' UA.! c) <$ guard (inRange (UA.bounds m') c)
        dirAndMaxFns = fmap (\d -> (d, mkMaxInDir atCoord d)) allDirs
        isVisible coord = or do
          let Just h = atCoord coord
          (d, maxInDir) <- dirAndMaxFns
          let coord' = applyDir d coord
          case atCoord coord' of
            Nothing -> pure True
            Just _ -> do
              pure $ h > maxInDir coord'

    answerShow $ length do
      c <- coords
      guard $ isVisible c

    answerShow $ maximum do
      coord <- coords
      let Just h = atCoord coord
          dists = do
            d <- allDirs
            let hs =
                  unfoldr
                    ( \cur -> do
                        h' <- atCoord cur
                        pure (h', applyDir d cur)
                    )
                    (applyDir d coord)
                (ls, rs) = span (< h) hs
            pure $ length ls + length (take 1 rs)
      pure $ product dists