4dc3b20ec9605e8bb8b2bdce54273661cce5d09c
[synacor-challenge.git] / src / Ackermann.hs
1
2 -- import Debug.Trace
3
4 import Data.List
5 import qualified Data.Map.Strict as M
6 import Data.Map.Strict ((!))
7 -- import Data.Maybe
8
9 import Control.Monad.State.Strict
10 -- import Control.Monad.Reader
11 -- import Control.Monad.Writer
12 -- import Control.Monad.RWS.Strict
13
14 import Control.Parallel.Strategies
15
16
17 type Memo = M.Map (Int, Int) Int
18
19 type MemoF = State Memo
20
21 main :: IO ()
22 main =
23 do let resultPairs = fmap evalAck [0 .. (2 ^ 15 - 1)] `using` parList rdeepseq
24 let result = filter ((== 6) . snd) resultPairs
25 print result
26
27 r7Gives6 :: Int -> Bool
28 r7Gives6 r7 = result == 6
29 where result = evalState (ackermann 4 1 r7) M.empty
30
31 evalAck :: Int -> (Int, Int)
32 evalAck r7 = (r7, evalState (ackermann 4 1 r7) M.empty)
33
34
35 ackermann :: Int -> Int -> Int -> MemoF Int
36 ackermann r0 r1 r7 = do
37 memoResult <- memoLookup r0 r1
38 case memoResult of
39 Just r -> return r
40 Nothing ->
41 do if r0 == 0
42 then do let res = ((r1 + 1) `mod` (2 ^ 15))
43 memoStore r0 r1 res
44 return res
45 else if r1 == 0
46 then do res <- ackermann (r0 - 1) r7 r7
47 memoStore r0 r1 res
48 return res
49 else do subResult <- ackermann r0 (r1 - 1) r7
50 res <- ackermann (r0 - 1) subResult r7
51 memoStore r0 r1 res
52 return res
53
54 memoLookup :: Int -> Int -> MemoF (Maybe Int)
55 memoLookup r0 r1 =
56 do table <- get
57 return $ M.lookup (r0, r1) table
58
59 memoStore :: Int -> Int -> Int -> MemoF ()
60 memoStore r0 r1 result =
61 do table <- get
62 let table' = M.insert (r0, r1) result table
63 put table'
64