Day5.hs

module Javran.AdventOfCode.Y2023.Day5 () where

import Control.Applicative
import Control.Monad
import qualified Data.IntMap.Strict as IM
import Data.List
import Data.List.Split hiding (sepBy)
import Javran.AdventOfCode.Prelude
import Text.ParserCombinators.ReadP hiding (count, get, many)

data Day5 deriving (Generic)

type AMapEntry = (Int, Int, Int)
type AlmanacMap = [AMapEntry]

almanacP :: ReadP ([Int], [AlmanacMap])
almanacP = do
  let nl = charP '\n'
      sp = charP ' '
  seeds <- strP "seeds:" *> many (sp *> decimal1P) <* nl
  let ws = words "seed soil fertilizer water light temperature humidity location"
      entryP = (,,) <$> (decimal1P <* sp) <*> (decimal1P <* sp) <*> (decimal1P <* nl)
  rs <- forM (zip ws (tail ws)) \(l, r) -> do
    nl
    strP (l <> "-to-" <> r <> " map:") <* nl
    many entryP
  pure (seeds, rs)

mkMapper :: AlmanacMap -> Int -> Int
mkMapper xs = auxLookup
  where
    -- key: src, value: (dst, range)
    m :: IM.IntMap (Int, Int)
    m = IM.fromList do
      (dst, src, rng) <- xs
      pure (src, (dst, rng))

    -- rely on split and maxView on left result to do our work
    auxLookup i
      | Just (dst, _) <- cur = dst
      | Just ((src, (dst, rng)), _) <- IM.maxViewWithKey lm
      , i < src + rng =
          dst + (i - src)
      | otherwise = i
      where
        (lm, cur, _) = IM.splitLookup i m

-- TODO: may want to go back and figure out how to do this faster.
-- TODO: I feel IntMap might have added too much overhead to our liking. need to try a linear version.
instance Solution Day5 where
  solutionRun _ SolutionContext {getInputS, answerShow} = do
    (seeds, maps) <- consumeOrDie almanacP <$> getInputS
    let ff = foldl' (\r m -> mkMapper m . r) id maps
    answerShow (minimum $ fmap ff seeds)
    answerShow $ minimum do
      [l, rng] <- chunksOf 2 seeds
      fmap ff [l .. l + rng - 1]