Έχουν δημοσιευτεί
Κυριακή, 5 Σεπτεμβρίου 2010 9:13 μμ
από το μέλος
PALLADIN
Συνεχίζοντας τις περιπέτειες μου στον χώρο του monadic memoization, αποφάσισα να
εμπλουτίσω την προηγουμενη προσπάθειά μου με το Continuation Monad, έτσι ώστε να έχω tail calls και να αποφύγω "περίεργα" stack overflows.
Η ιδέα είναι να συνδυάσω το State Monad με το Continuation Monad (StateT Monad Transformer) και ως "δια μαγείας" όλα να δουλέψουν.
type StateContMonad<'s, 'a, 'r> = StateContMonad of ('s -> ('s -> 'a -> 'r) -> 'r)
type StateContBuilder() =
member self.Return value = StateContMonad (fun state k -> k state value)
member self.Bind(StateContMonad contStateMonad, f) = StateContMonad (fun state k -> contStateMonad state (fun state' value -> let (StateContMonad contMonad') = f value in contMonad' state' k))
member self.Delay( f : unit -> StateContMonad<'s, 'a, 'r> ) = StateContMonad (fun state k -> let (StateContMonad contStateMonad) = f () in contStateMonad state k)
let memo = new StateContBuilder()
// val Y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
let rec Y f value = f (Y f) value
// val check : 'a -> StateContMonad<Map<'a,'r>,'r option,'r> when 'a : comparison
let check (value : 'a) : StateContMonad<Map<'a, 'r>, option<'r>, 'r> = StateContMonad (fun map k -> k map (Map.tryFind value map))
// val store : 'a * 'r -> StateContMonad<Map<'a,'r>,unit,'r> when 'a : comparison
let store (argument : 'a, result : 'r) : StateContMonad<Map<'a, 'r>, unit, 'r> = StateContMonad (fun map k -> k (Map.add argument result map) ())
// val memoize : ('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b> when 'a : comparison
let memoize f argument =
memo {
let! checkResult = check argument
match checkResult with
| Some result -> return result
| None ->
let! result = f argument
do! store (argument, result)
return result
}
// val execute : (('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> 'b when 'a : comparison
let execute f n = let (StateContMonad contStateMonad) = Y (memoize << f) n in contStateMonad Map.empty (fun _ value -> value)
// val big : int -> BigInteger
let big (value : int) = new System.Numerics.BigInteger(value)
// val fib : (BigInteger -> StateContMonad<'a,BigInteger,'b>) -> BigInteger -> StateContMonad<'a,BigInteger,'b>
let fib f n =
if n = big 0 then memo { return big 0 }
elif n = big 1 then memo { return big 1 }
else
memo {
let! nMinus1Fib = f (n - big 1)
let! nMinus2Fib = f (n - big 2)
return nMinus1Fib + nMinus2Fib
}
execute fib (big 100000)