Done teleporter code

diff --git a/CoinSolver.hs b/CoinSolver.hs
deleted file mode 100644 (file)
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 (file)
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 ad7f95d5428b2aacbddf4b88b7b52eb3643568a7..c109ba450162c324bd16df0dcf44eb2ae0fe0106 100644 (file)
--- a/coins_used.txt
+++ b/coins_used.txt
@@ -1,6 +1,4 @@
 take tablet
 take tablet

-doorway
-

 use tablet
 doorway
 look
 use tablet
 doorway
 look

diff --git a/found_teleporter.txt b/found_teleporter.txt
index 95d38c97009911c74469ef9dd99b789d61a3be9e..734b6c2e9079f88aa9b532f1f1029d29138a3a7c 100644 (file)
--- a/found_teleporter.txt
+++ b/found_teleporter.txt
@@ -1,5 +1,5 @@
 take tablet
 take tablet

-# get first code
+# get third code

 use tablet
 doorway
 north
 use tablet
 doorway
 north


@@ -23,7 +23,7 @@ west
 west
 south
 north
 west
 south
 north

-# get second code
+# get fourth code

 west
 ladder
 darkness
 west
 ladder
 darkness


@@ -61,12 +61,12 @@ use red coin
 use shiny coin
 use concave coin
 use corroded 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
 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 (file)
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 (file)
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 (file)
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 (file)
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 be6e522cf64b1980bab72cb877512a8f37a44f72..d7ad6f3d843eba0c75bdd2da6bc042b7ccc19e7b 100644 (file)
--- 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
 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
 
      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
         (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) :)
 runOneInput state input = state & ssMachines %~ (machine' :)
                                 & ssInputs %~ (input :)
                                 & ssOutputs %~ ((showOutput output) :)

diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs
index cbd5e047c0792ade68966ec4d92788923218e446..757bd5f011ea9dbc31434176010031d6b9306db0 100644 (file)
--- 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])
 -- 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
 
 
 makeMachine :: Memory -> Machine


@@ -85,17 +85,20 @@ makeMachine memory = Machine
 --           ) x
 --      return x'
 
 --           ) 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
 
 
 runStep :: Word16 -> ProgrammedMachine ExecutionState


@@ -270,11 +273,33 @@ traceMachine :: ProgrammedMachine ()
 traceMachine = do
   isTracing <- gets _tracing
   when isTracing
 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
         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
         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]
                 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]
                 _ -> ["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 =
 
 getValue :: Word16 -> ProgrammedMachine Word16
 getValue loc =

diff --git a/synacor.cabal b/synacor.cabal
index 11f7b2399e025c2bbf37a6e886e38c13fee76a32..60ac8f53c830fe125cb0911952f9ea199f37a0f2 100644 (file)
--- a/synacor.cabal
+++ b/synacor.cabal
@@ -95,10 +95,23 @@ executable synacor
   hs-source-dirs:   app, src
   default-language: Haskell2010
 
   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
 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
   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"
 
                        -threaded 
                        -rtsopts "-with-rtsopts=-N"
 

-

 library
   import: common-extensions
   build-depends:  base >=4.16, containers, binary, bytestring, mtl, lens
 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 (file)
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 (file)
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