Completed puzzle

diff --git a/codes_found.md b/codes_found.md
index 0cb69075c4b7a4c7ac46c21aca213e1d2e703c19..e8e1ae50d7d0c970409840befc779db87255cbe4 100644 (file)
--- a/codes_found.md
+++ b/codes_found.md
@@ -16,3 +16,6 @@ Lighting the lantern in the cavern
 
 ## Using the teleporter
 > PLqwUDZxwKuh
+
+## After the orb maze
+"qiwTT8UxHYxp" or mirrored to qxYHxU8TTwip

diff --git a/full_solution.txt b/full_solution.txt
index ea1511d4e3070aa3fd0adab84658cabbd03d87fe..cbf3da81bede4a3535d635d6fcd8c947ce41c1e8 100644 (file)
--- a/full_solution.txt
+++ b/full_solution.txt
@@ -86,3 +86,18 @@ west
 north
 north
 take orb
+north
+east
+east
+north
+west
+south
+east
+east
+west
+north
+north
+east
+vault
+take mirror
+use mirror

diff --git a/src/Main.hs b/src/Main.hs
index d7ad6f3d843eba0c75bdd2da6bc042b7ccc19e7b..101714e0bae87028fab082b2e55f4cbd4ca45f01 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,19 +1,19 @@
 import SynacorEngine
 
-import Debug.Trace
+-- import Debug.Trace
 
-import Numeric
+-- import Numeric
 import System.IO
 import Data.Char
 import Data.List
 import qualified Data.Map.Strict as M
-import Data.Map.Strict ((!))
+-- import Data.Map.Strict ((!))
 import Control.Lens -- hiding ((<|), (|>), (:>), (:<), indices)
 
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.RWS.Strict
+import Control.Monad.State.Strict hiding (state)
+-- import Control.Monad.Reader
+-- import Control.Monad.Writer
+-- import Control.Monad.RWS.Strict hiding (state)
 
 -- import Data.Bits
 import Data.Word
@@ -69,6 +69,7 @@ main =
       -- print state1
 
       stateF <- adventureHarness state1
+      print stateF
       return ()
       -- print $ stateF ^. ssInputs
       -- print $ stateF ^. ssOutputs
@@ -98,17 +99,17 @@ adventureHarness state =
   do command <- prompt "> "
      state' <- handleCommand command state
      let traceAndOutput = head $ state' ^. ssOutputs
-     let (newOutput, tracing) = spliceOut traceAndOutput
+     let (newOutput, traces) = spliceOut traceAndOutput
      putStrLn newOutput
      when (state' ^. ssTracing)
-          (appendFile (state' ^. ssDumpFile) $ unlines tracing)
+          (appendFile (state' ^. ssDumpFile) $ unlines traces)
      if (state' ^. ssContinue) 
         then (adventureHarness state')
         else return state'
 
 
 spliceOut :: String -> (String, [String])
-spliceOut s = doingOut s "" []
+spliceOut st = doingOut st "" []
   where doingOut s out traces
           | null s = (reverse out, reverse traces)
           | ">> " `isPrefixOf` s = doingTrace (drop 3 s) out traces ""
@@ -125,7 +126,7 @@ handleCommand ":save" state =
       let inputs = unlines $ tail $ reverse $ state ^. ssInputs
       writeFile filename inputs
       return $ state & ssUnsaved .~ True
-handleCommand ":load" state = 
+handleCommand ":load" _state = 
   do  filename <- prompt "From? "
       machineInput <- readFile filename
       let inputs = lines machineInput

diff --git a/src/OrbMaze.hs b/src/OrbMaze.hs
new file mode 100644 (file)
index 0000000..b9888da
--- /dev/null
+++ b/src/OrbMaze.hs
@@ -0,0 +1,125 @@
+
+import qualified Debug.Trace as DT
+
+import Data.List
+import Data.Maybe
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Linear
+import Control.Lens
+
+-- type Position = V2 Int -- x, y, origin bottom left
+newtype Position = Pos (V2 Int) -- x, y, origin bottom left
+  deriving (Show, Eq, Ord)
+
+
+instance Semigroup Position where
+  (Pos p) <> (Pos q) = Pos $ p ^+^ q
+
+instance Monoid Position where
+  mempty = Pos (V2 0 0)
+
+data Operator = Times | Divide | Plus | Minus
+  deriving (Show, Eq, Ord)
+
+data Cell = Literal Int | Op Operator
+  deriving (Show, Eq, Ord)
+
+type Grid = M.Map Position Cell
+
+data SearchState = SearchState 
+  { _path :: [Position]
+  , _value :: Int
+  , _operator :: Maybe Operator
+  }
+  deriving (Show, Eq, Ord)
+makeLenses ''SearchState
+
+main :: IO ()
+main = 
+  do -- print grid
+     let s = initialSearchState
+     -- print s
+     -- print $ neighbours s
+     let ps = bfs [s] 
+     print ps
+     print $ presentPath $ (fromMaybe s ps) ^. path
+
+grid :: Grid
+grid = M.fromList $ fmap (\(p, v) -> (Pos p, v))
+  [ (V2 0 3, Op Times),   (V2 1 3, Literal 8), (V2 2 3, Op Minus),   (V2 3 3, Literal 1)
+  , (V2 0 2, Literal 4),  (V2 1 2, Op Times),  (V2 2 2, Literal 11), (V2 3 2, Op Times)
+  , (V2 0 1, Op Plus),    (V2 1 1, Literal 4), (V2 2 1, Op Minus),   (V2 3 1, Literal 18)
+  , (V2 0 0, Literal 22), (V2 1 0, Op Minus),  (V2 2 0, Literal 9),  (V2 3 0, Op Times)
+  ]
+
+initialSearchState :: SearchState
+initialSearchState = SearchState {_path = [], _value = 22, _operator = Nothing}
+
+deltas :: [Position]
+deltas = fmap Pos [V2 -1 0, V2 1 0, V2 0 -1, V2 0 1]
+
+-- adjacents :: Position -> Grid -> [Position]
+-- adjacents here grid = filter (flip M.member grid) $ fmap (here <>) deltas
+
+neighbours :: SearchState -> [SearchState]
+neighbours state = catMaybes $ fmap (step state) deltas
+  -- where here = mconcat $ state ^. path
+
+step :: SearchState -> Position -> Maybe SearchState
+step state d =
+  do d' <- notStart state d
+     destination <- M.lookup ((currentPosition state) <> d') grid
+     state' <- addTerm state destination
+     return $ state' & path %~ (d' : )
+
+
+notStart :: SearchState -> Position -> Maybe Position
+notStart state delta 
+  | (mconcat (state ^. path)) <> delta == mempty = Nothing
+  | otherwise = Just delta
+
+bfs :: [SearchState] -> Maybe SearchState
+-- bfs a | DT.trace (show a) False = undefined
+bfs [] = Nothing
+bfs (s:agenda)
+  | isGoal s = Just s
+  | currentPosition s == Pos (V2 3 3) = bfs agenda
+  | length (s ^. path) == 15 = bfs agenda
+  | s ^. value < 0 = bfs agenda
+  | s ^. value > (2 ^ 16) = bfs agenda
+  | otherwise = bfs (agenda ++ nexts)
+  where nexts = neighbours s
+
+
+isGoal :: SearchState -> Bool
+isGoal s = (currentPosition s == Pos (V2 3 3)) && (s ^. value == 30)
+
+currentPosition :: SearchState -> Position
+currentPosition s = mconcat $ s ^. path
+
+currentValue :: SearchState -> Maybe Int
+currentValue s 
+  | (s ^. operator) == Nothing = Just $ s ^. value
+  | otherwise = Nothing
+
+addTerm :: SearchState -> Cell -> Maybe SearchState
+-- addTerm s c | DT.trace (show (s, c)) False = undefined
+addTerm s (Literal i) =
+  go (s ^. operator) i s 
+  where 
+    go Nothing _ _ = Nothing
+    go (Just Times)  i s = Just $ s & value %~ (* i) & operator .~ Nothing
+    go (Just Divide) i s = Just $ s & value %~ (`div` i) & operator .~ Nothing
+    go (Just Plus)   i s = Just $ s & value %~ (+ i) & operator .~ Nothing
+    go (Just Minus)  i s = Just $ s & value %~ (+ (-i)) & operator .~ Nothing
+addTerm s (Op op)
+  | (s ^. operator) == Nothing = Just $ s & operator .~ (Just op)
+  | otherwise = Nothing
+
+presentPath ps = fmap presentStep $ reverse ps
+  where 
+    presentStep (Pos (V2 0 1)) = "north"
+    presentStep (Pos (V2 0 -1)) = "south"
+    presentStep (Pos (V2 1 0)) = "east"
+    presentStep (Pos (V2 -1 0)) = "west"

diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs
index 757bd5f011ea9dbc31434176010031d6b9306db0..63fb20c60be300c6e4fa23402578523c8aad612d 100644 (file)
--- a/src/SynacorEngine.hs
+++ b/src/SynacorEngine.hs
@@ -1,6 +1,6 @@
 module SynacorEngine where
 
-import Debug.Trace
+-- import Debug.Trace
 
 -- import System.Environment
 import Data.Bits
@@ -12,7 +12,7 @@ import Data.Map.Strict ((!))
 import Control.Lens
 import Data.List
 import Data.Char
-import Numeric
+-- import Numeric
 
 import Control.Monad.State.Strict
 import Control.Monad.Reader
@@ -44,11 +44,11 @@ runMachine inputs machine = runRWS (runAll (10 ^ 6)) inputs machine
 
 
 makeMachine :: Memory -> Machine
-makeMachine memory = Machine
+makeMachine mem = Machine
   { _ip = 0
   , _inputIndex = 0
   , _registers = M.fromList [ (r, 0) | r <- [0..7] ]
-  , _memory = memory
+  , _memory = mem
   , _stack = []
   , _tracing = False
   }
@@ -275,10 +275,10 @@ traceMachine = do
   when isTracing
        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
+          regs <- gets _registers
+          let regVals = intercalate "; " $ fmap show $ M.elems regs
+          stk <- gets _stack
+          let stackVals = intercalate "; " $ fmap show $ take 10 stk
           tell $ fmap (fromIntegral . ord) (">> " ++ l ++ " : r> " ++ regVals ++ " : s> " ++ stackVals ++ "<<")
 
 runDissemble :: Word16 -> Int -> Machine -> [String]

diff --git a/synacor.cabal b/synacor.cabal
index 60ac8f53c830fe125cb0911952f9ea199f37a0f2..196d3f4dcd48fc2a215aa270c34ef102408c9b28 100644 (file)
--- a/synacor.cabal
+++ b/synacor.cabal
@@ -72,7 +72,7 @@ common common-extensions
 
 common build-directives
   build-depends:       base >=4.16
-  default-language:    Haskell2010
+  default-language:    GHC2021
   hs-source-dirs:      ., app, src
   other-modules:       SynacorEngine
   ghc-options:         -O2 
@@ -93,7 +93,7 @@ executable synacor
   -- other-extensions:
   build-depends:    containers, binary, bytestring, mtl, lens
   hs-source-dirs:   app, src
-  default-language: Haskell2010
+  default-language: GHC2021
 
 executable ackermann
   import: common-extensions
@@ -101,7 +101,7 @@ executable ackermann
   main-is:          Ackermann.hs
   build-depends:    base >=4.16, containers, mtl, parallel
   hs-source-dirs:   app, src
-  default-language: Haskell2010
+  default-language: GHC2021
   hs-source-dirs:      ., app, src
   ghc-options:         -O2 
                        -Wall 
@@ -115,7 +115,20 @@ executable coinsolver
   main-is:          CoinSolver.hs
   build-depends:    base >=4.16, containers
   hs-source-dirs:   app, src
-  default-language: Haskell2010
+  default-language: GHC2021
+  hs-source-dirs:      ., app, src
+  ghc-options:         -O2 
+                       -Wall 
+                       -threaded 
+                       -rtsopts "-with-rtsopts=-N"
+
+executable orbmaze
+  import: common-extensions
+  main-is: Main.hs
+  main-is:          OrbMaze.hs
+  build-depends:    base >=4.16, containers, linear, lens
+  hs-source-dirs:   app, src
+  default-language: GHC2021
   hs-source-dirs:      ., app, src
   ghc-options:         -O2 
                        -Wall