Day 11: Reactor

Megathread guidelines

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL

FAQ

  • LeixB@lemmy.world
    link
    fedilink
    arrow-up
    3
    ·
    1 month ago

    Haskell

    import Control.Arrow
    import Data.Char
    import Text.ParserCombinators.ReadP
    
    import Data.Array qualified as A
    import Data.Map.Strict qualified as M
    
    parse = M.fromList . fst . last . readP_to_S (((,) <$> (munch1 isAlpha <* string ": ") <*> (munch1 isAlpha `sepBy` char ' ')) `endBy` char '\n')
    
    out = 0 :: Int -- index of out node
    
    buildAdjList m = (keys, adj)
      where
        keys = M.insert "out" out . snd . M.mapAccumWithKey (\a k _ -> (succ a, a)) (succ out) $ m
        adj = A.listArray (out, out + M.size m) $ [] : (fmap (keys M.!) <$> M.elems m)
    
    findPaths adj src dest = go src
      where
        go i
          | i == dest = 1 :: Int
          | otherwise = sum $ (r A.!) <$> (adj A.! i)
    
        r = A.listArray bounds $ go <$> A.range bounds
        bounds = A.bounds adj
    
    part1 (keys, adj) = findPaths adj (keys M.! "you") out
    
    -- Since graph must be acyclic, one of fft_dac or dac_fft will be 0
    part2 (keys, adj)
      | fft_dac /= 0 = svr_fft * fft_dac * dac_out
      | otherwise = svr_dac * dac_fft * fft_out
        where
          [svr, fft, dac] = (keys M.!) <$> ["svr", "fft", "dac"]
          svr_fft = findPaths adj svr fft
          fft_dac = findPaths adj fft dac
          dac_out = findPaths adj dac out
    
          svr_dac = findPaths adj svr dac
          dac_fft = findPaths adj dac fft
          fft_out = findPaths adj fft out
    
    main = getContents >>= print . (part1 &&& part2) . buildAdjList . parse