From: Neil Smith Date: Tue, 1 Aug 2023 16:30:42 +0000 (+0100) Subject: Done teleporter code X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;ds=sidebyside;h=56796d54a5048d5f38ac06b1fdea48c045bb626e;p=synacor-challenge.git Done teleporter code --- diff --git a/CoinSolver.hs b/CoinSolver.hs deleted file mode 100644 index d3a9e13..0000000 --- a/CoinSolver.hs +++ /dev/null @@ -1,19 +0,0 @@ -import Data.Map.Strict as M -import Data.Map.Strict ((!)) -import Data.List - -data Coins = Red | Blue | Shiny | Corroded | Concave - deriving (Ord, Eq, Show, Enum, Bounded) - -allCoins = [Red .. Concave] - -main = print solve - -coins :: M.Map Coins Int -coins = M.fromList $ zip [Red .. Concave] [2, 9, 5, 3, 7] - -solve :: [[Coins]] -solve = [ [a, b, c, d, e] - | [a, b, c, d, e] <- permutations allCoins - , (coins ! a) + (coins ! b) * (coins ! c) ^2 + (coins ! d) ^3 - (coins ! e) == 399 - ] diff --git a/codes_found.md b/codes_found.md new file mode 100644 index 0000000..0cb6907 --- /dev/null +++ b/codes_found.md @@ -0,0 +1,18 @@ +## First code +From arch.spec hint section +> pwiuBbPSgwrt + +## Second code +After self-test +> hORWzmTEPkRE + +## Third code +After using the tablet +> PRfkKApjpukS + +## Fourth code +Lighting the lantern in the cavern +> MSVFHKWMXrVA + +## Using the teleporter +> PLqwUDZxwKuh diff --git a/coins_used.txt b/coins_used.txt index ad7f95d..c109ba4 100644 --- a/coins_used.txt +++ b/coins_used.txt @@ -1,6 +1,4 @@ take tablet -doorway - use tablet doorway look diff --git a/found_teleporter.txt b/found_teleporter.txt index 95d38c9..734b6c2 100644 --- a/found_teleporter.txt +++ b/found_teleporter.txt @@ -1,5 +1,5 @@ take tablet -# get first code +# get third code use tablet doorway north @@ -23,7 +23,7 @@ west west south north -# get second code +# get fourth code west ladder darkness @@ -61,12 +61,12 @@ use red coin use shiny coin use concave coin use corroded coin -# now got coin puzzle code +# now got fifth code code north take teleporter use teleporter take business card take strange book -look bookshelf -look business card -look strange book +# issue :poke8 command here +# this gets the sixth code +use teleporter diff --git a/full_solution.txt b/full_solution.txt new file mode 100644 index 0000000..ea1511d --- /dev/null +++ b/full_solution.txt @@ -0,0 +1,88 @@ +take tablet +# get third code +use tablet +doorway +north +north +bridge +continue +down +east +take empty lantern +west +west +passage +ladder +west +south +north +take can +use can +use lantern +west +west +south +north +# get fourth code +west +ladder +darkness +continue +west +west +west +west +north +take red coin +north +north +west +take blue coin +up +take shiny coin +down +east +east +take concave coin +inv +down +take corroded coin +up +west +look monument +look +look red coin +look blue coin +look shiny coin +look corroded coin +look concave coin +use blue coin +use red coin +use shiny coin +use concave coin +use corroded coin +# now got fifth code code +north +take teleporter +use teleporter +take business card +take strange book +look business card +look strange book +# issue :poke8 command here +:poke8 +# this gets the sixth code +use teleporter +north +north +north +north +north +north +north +east +take journal +west +north +north +take orb diff --git a/got_orb.txt b/got_orb.txt new file mode 100644 index 0000000..8420e94 --- /dev/null +++ b/got_orb.txt @@ -0,0 +1,78 @@ +use tablet +doorway +north +bridge +north +bridge +continue +down +east +take empty lantern +west +west +passage +ladder +west +south +north +take can +use can +use lantern +west +west +south +north +west +ladder +darkness +continue +west +west +west +west +north +take red coin +north +north +west +take blue coin +up +take shiny coin +down +east +east +take concave coin +down +take corroded coin +up +west +use blue coin +use red coin +use shiny coin +use concave coin +use corroded coin +north +take teleporter +use teleporter +take business card +take strange book +look strange book +use teleporter +north +north +north +north +north +north +north +north +north +take orb +look orb +north +north +north +east +east +east +vault diff --git a/src/Ackermann.hs b/src/Ackermann.hs new file mode 100644 index 0000000..4dc3b20 --- /dev/null +++ b/src/Ackermann.hs @@ -0,0 +1,64 @@ + +-- import Debug.Trace + +import Data.List +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) +-- import Data.Maybe + +import Control.Monad.State.Strict +-- import Control.Monad.Reader +-- import Control.Monad.Writer +-- import Control.Monad.RWS.Strict + +import Control.Parallel.Strategies + + +type Memo = M.Map (Int, Int) Int + +type MemoF = State Memo + +main :: IO () +main = + do let resultPairs = fmap evalAck [0 .. (2 ^ 15 - 1)] `using` parList rdeepseq + let result = filter ((== 6) . snd) resultPairs + print result + +r7Gives6 :: Int -> Bool +r7Gives6 r7 = result == 6 + where result = evalState (ackermann 4 1 r7) M.empty + +evalAck :: Int -> (Int, Int) +evalAck r7 = (r7, evalState (ackermann 4 1 r7) M.empty) + + +ackermann :: Int -> Int -> Int -> MemoF Int +ackermann r0 r1 r7 = do + memoResult <- memoLookup r0 r1 + case memoResult of + Just r -> return r + Nothing -> + do if r0 == 0 + then do let res = ((r1 + 1) `mod` (2 ^ 15)) + memoStore r0 r1 res + return res + else if r1 == 0 + then do res <- ackermann (r0 - 1) r7 r7 + memoStore r0 r1 res + return res + else do subResult <- ackermann r0 (r1 - 1) r7 + res <- ackermann (r0 - 1) subResult r7 + memoStore r0 r1 res + return res + +memoLookup :: Int -> Int -> MemoF (Maybe Int) +memoLookup r0 r1 = + do table <- get + return $ M.lookup (r0, r1) table + +memoStore :: Int -> Int -> Int -> MemoF () +memoStore r0 r1 result = + do table <- get + let table' = M.insert (r0, r1) result table + put table' + diff --git a/src/CoinSolver.hs b/src/CoinSolver.hs new file mode 100644 index 0000000..d3a9e13 --- /dev/null +++ b/src/CoinSolver.hs @@ -0,0 +1,19 @@ +import Data.Map.Strict as M +import Data.Map.Strict ((!)) +import Data.List + +data Coins = Red | Blue | Shiny | Corroded | Concave + deriving (Ord, Eq, Show, Enum, Bounded) + +allCoins = [Red .. Concave] + +main = print solve + +coins :: M.Map Coins Int +coins = M.fromList $ zip [Red .. Concave] [2, 9, 5, 3, 7] + +solve :: [[Coins]] +solve = [ [a, b, c, d, e] + | [a, b, c, d, e] <- permutations allCoins + , (coins ! a) + (coins ! b) * (coins ! c) ^2 + (coins ! d) ^3 - (coins ! e) == 399 + ] diff --git a/src/Main.hs b/src/Main.hs index be6e522..d7ad6f3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -157,7 +157,11 @@ handleCommand ":untrace" state = handleCommand ":poke8" state = do let machines = state ^. ssMachines let machine = head machines - let machine' = machine & registers . ix 7 .~ 1 + let machine' = machine & registers . ix 7 .~ 25734 + & memory . ix 5489 .~ 21 + & memory . ix 5490 .~ 21 + & memory . ix 5495 .~ 7 + -- let machine' = machine & memory . ix 5451 .~ 7 return $ state & ssMachines .~ (machine' : (tail machines)) handleCommand command state = return $ runOneInput state command @@ -173,6 +177,14 @@ runWithoutInput state = state & ssMachines %~ (machine' :) (exState, machine', output) = runMachine [] (machine & inputIndex .~ 0) runOneInput :: SynacorState -> String -> SynacorState +runOneInput state ":poke8" = state & ssMachines .~ ssMAchinesNew + where machine0 = head $ state ^. ssMachines + machine = machine0 & registers . ix 7 .~ 25734 + & memory . ix 5489 .~ 21 + & memory . ix 5490 .~ 21 + & memory . ix 5495 .~ 7 + ssMAchinesNew = machine : (tail $ state ^. ssMachines) + runOneInput state input = state & ssMachines %~ (machine' :) & ssInputs %~ (input :) & ssOutputs %~ ((showOutput output) :) diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs index cbd5e04..757bd5f 100644 --- a/src/SynacorEngine.hs +++ b/src/SynacorEngine.hs @@ -40,7 +40,7 @@ data ExecutionState = Runnable | Blocked | Terminated deriving (Ord, Eq, Show) -- returns (returnValue, finalMachine, outputs) runMachine :: [Word16] -> Machine -> (ExecutionState, Machine, [Word16]) -runMachine inputs machine = runRWS runAll inputs machine +runMachine inputs machine = runRWS (runAll (10 ^ 6)) inputs machine makeMachine :: Memory -> Machine @@ -85,17 +85,20 @@ makeMachine memory = Machine -- ) x -- return x' -runAll :: ProgrammedMachine ExecutionState -runAll = do cip <- gets _ip - opcode <- getLocation cip - traceMachine - -- opcode' <- traceMachine opcode - -- exState <- runStep opcode' - exState <- runStep opcode - case exState of - Terminated -> return Terminated - Blocked -> return Blocked - _ -> runAll +runAll :: Int -> ProgrammedMachine ExecutionState +runAll executionLimit + | executionLimit == 0 = return Terminated + | otherwise = + do cip <- gets _ip + opcode <- getLocation cip + traceMachine + -- opcode' <- traceMachine opcode + -- exState <- runStep opcode' + exState <- runStep opcode + case exState of + Terminated -> return Terminated + Blocked -> return Blocked + _ -> runAll (executionLimit - 1) runStep :: Word16 -> ProgrammedMachine ExecutionState @@ -270,11 +273,33 @@ traceMachine :: ProgrammedMachine () traceMachine = do isTracing <- gets _tracing when isTracing - do cip <- gets _ip + do cip <- gets _ip + (l, _) <- dissembleInstruction cip + registers <- gets _registers + let regVals = intercalate "; " $ fmap show $ M.elems registers + stack <- gets _stack + let stackVals = intercalate "; " $ fmap show $ take 10 stack + tell $ fmap (fromIntegral . ord) (">> " ++ l ++ " : r> " ++ regVals ++ " : s> " ++ stackVals ++ "<<") + +runDissemble :: Word16 -> Int -> Machine -> [String] +runDissemble startAt num machine =fst $ evalRWS (dissemble startAt num) [] machine + + +dissemble :: Word16 -> Int -> ProgrammedMachine [String] +dissemble startAt num = go startAt num [] + where go _ 0 ls = return $ reverse ls + go here n ls = + do (line, step) <- dissembleInstruction here + go (here + step) (n - 1) (line : ls) + +dissembleInstruction :: Word16 -> ProgrammedMachine (String, Word16) +dissembleInstruction cip = + do -- cip <- gets _ip opcode <- getLocation cip - a <- getLocation (cip + 1) - b <- getLocation (cip + 2) - c <- getLocation (cip + 3) + mem <- gets _memory + let a = mem ! (cip + 1) + let b = mem ! (cip + 2) + let c = mem ! (cip + 3) let sa = show a let sb = show b let sc = show c @@ -307,9 +332,17 @@ traceMachine = do 18 -> ["ret"] 19 -> ["out", sa, "*", sva] 20 -> ["in", sa, "*", sva] - 21 -> ["noop", sa, sb, sc, "*", sva, svb, svc] + 21 -> ["noop"] _ -> ["illegal", sa, sb, sc, "*", sva, svb, svc] - tell $ fmap (fromIntegral . ord) (">> " ++ (show cip) ++ ": " ++ (intercalate " " traceText) ++ "<<") + let stepSize = + if | opcode `elem` [0, 18, 21] -> 1 + | opcode `elem` [2, 3, 6, 17, 19, 20] -> 2 + | opcode `elem` [1, 7, 8, 14, 15, 16] -> 3 + | opcode `elem` [4, 5, 9, 10, 11, 12, 13] -> 4 + | otherwise -> 1 + return ( ((show cip) ++ ": " ++ (intercalate " " traceText)) + , stepSize + ) getValue :: Word16 -> ProgrammedMachine Word16 getValue loc = diff --git a/synacor.cabal b/synacor.cabal index 11f7b23..60ac8f5 100644 --- a/synacor.cabal +++ b/synacor.cabal @@ -95,10 +95,23 @@ executable synacor hs-source-dirs: app, src default-language: Haskell2010 +executable ackermann + import: common-extensions + main-is: Main.hs + main-is: Ackermann.hs + build-depends: base >=4.16, containers, mtl, parallel + hs-source-dirs: app, src + default-language: Haskell2010 + hs-source-dirs: ., app, src + ghc-options: -O2 + -Wall + -threaded + -rtsopts "-with-rtsopts=-N" + + executable coinsolver import: common-extensions main-is: Main.hs - build-depends: split main-is: CoinSolver.hs build-depends: base >=4.16, containers hs-source-dirs: app, src @@ -109,7 +122,6 @@ executable coinsolver -threaded -rtsopts "-with-rtsopts=-N" - library import: common-extensions build-depends: base >=4.16, containers, binary, bytestring, mtl, lens diff --git a/test1.txt b/test1.txt deleted file mode 100644 index 558f944..0000000 --- a/test1.txt +++ /dev/null @@ -1,2 +0,0 @@ -take tablet -doorway diff --git a/test2.txt b/test2.txt deleted file mode 100644 index b14ced5..0000000 --- a/test2.txt +++ /dev/null @@ -1,11 +0,0 @@ - -take tablet -inv -go south -go north -go doorway -north -north -bridge -continue -down