Day 17: Chronospatial Computer

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

  • gentooer@programming.dev
    link
    fedilink
    English
    arrow-up
    2
    ·
    edit-2
    9 days ago

    Haskell

    Runs in 10 ms. I was stuck for most of the day on the bdv and cdv instructions, as I didn’t read that the numerator was still register A. Once I got past that, it was pretty straight forward.

    Code
    import Control.Monad.State.Lazy
    import Data.Bits (xor)
    import Data.List (isSuffixOf)
    import qualified Data.Vector as V
    
    data Instr =
            ADV Int | BXL Int | BST Int | JNZ Int | BXC | OUT Int | BDV Int | CDV Int
    type Machine = (Int, Int, Int, Int, V.Vector Int)
    
    parse :: String -> Machine
    parse s =
        let (la : lb : lc : _ : lp : _) = lines s
            [a, b, c] = map (read . drop 12) [la, lb, lc]
            p = V.fromList $ read $ ('[' :) $ (++ "]") $ drop 9 lp
        in  (a, b, c, 0, p)
    
    getA, getB, getC, getIP :: State Machine Int
    getA  = gets $ \(a, _, _, _ , _) -> a
    getB  = gets $ \(_, b, _, _ , _) -> b
    getC  = gets $ \(_, _, c, _ , _) -> c
    getIP = gets $ \(_, _, _, ip, _) -> ip
    
    setA, setB, setC, setIP :: Int -> State Machine ()
    setA  a  = modify $ \(_, b, c, ip, p) -> (a, b, c, ip, p)
    setB  b  = modify $ \(a, _, c, ip, p) -> (a, b, c, ip, p)
    setC  c  = modify $ \(a, b, _, ip, p) -> (a, b, c, ip, p)
    setIP ip = modify $ \(a, b, c, _ , p) -> (a, b, c, ip, p)
    
    incIP :: State Machine ()
    incIP = getIP >>= (setIP . succ)
    
    getMem :: State Machine (Maybe Int)
    getMem = gets (\(_, _, _, ip, p) -> p V.!? ip) <* incIP
    
    getCombo :: State Machine (Maybe Int)
    getCombo = do
        n <- getMem
        case n of
            Just 4          -> Just <$> getA
            Just 5          -> Just <$> getB
            Just 6          -> Just <$> getC
            Just n | n <= 3 -> return $ Just n
            _               -> return Nothing
    
    getInstr :: State Machine (Maybe Instr)
    getInstr = do
        opcode <- getMem
        case opcode of
            Just 0 -> fmap        ADV  <$> getCombo
            Just 1 -> fmap        BXL  <$> getMem
            Just 2 -> fmap        BST  <$> getCombo
            Just 3 -> fmap        JNZ  <$> getMem
            Just 4 -> fmap (const BXC) <$> getMem
            Just 5 -> fmap        OUT  <$> getCombo
            Just 6 -> fmap        BDV  <$> getCombo
            Just 7 -> fmap        CDV  <$> getCombo
            _      -> return Nothing
    
    execInstr :: Instr -> State Machine (Maybe Int)
    execInstr (ADV n) = (getA >>= (setA . (`div` (2^n)))) *> return Nothing
    execInstr (BDV n) = (getA >>= (setB . (`div` (2^n)))) *> return Nothing
    execInstr (CDV n) = (getA >>= (setC . (`div` (2^n)))) *> return Nothing
    execInstr (BXL n) = (getB >>= (setB . xor n)) *> return Nothing
    execInstr (BST n) = setB (n `mod` 8) *> return Nothing
    execInstr (JNZ n) = do
        a <- getA
        case a of
            0 -> return ()
            _ -> setIP n
        return Nothing
    execInstr  BXC    = ((xor <$> getB <*> getC) >>= setB) *> return Nothing
    execInstr (OUT n) = return $ Just $ n `mod` 8
    
    run :: State Machine [Int]
    run = do
        mInstr <- getInstr
        case mInstr of
            Nothing    -> return []
            Just instr -> do
                mOut <- execInstr instr
                case mOut of
                    Nothing ->           run
                    Just n  -> (n :) <$> run
    
    solve2 :: Machine -> Int
    solve2 machine@(_, _, _, _, p') = head [a | x <- [1 .. 7], a <- go [x]]
        where
            p = V.toList p'
            go as =
                let a = foldl ((+) . (* 8)) 0 as
                in  case evalState (setA a *> run) machine of
                        ns  | ns == p           -> [a]
                            | ns `isSuffixOf` p ->
                                concatMap go [as ++ [a] | a <- [0 .. 7]]
                            | otherwise         -> []
    
    main :: IO ()
    main = do
        machine@(_, _, _, _, p) <- parse <$> getContents
        putStrLn $ init $ tail $ show $ evalState run machine
        print $ solve2 machine