Done teleporter code

[synacor-challenge.git] / src / Ackermann.hs

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'
+