Thoughts and Code : Monadic Memoization in F#

Το Ιστολόγιο

Ετικέτες

Ιστορικό Δημοσιεύσεων

Έχουν δημοσιευτεί Δευτέρα, 16 Αυγούστου 2010 10:38 μμ από το μέλος PALLADIN

Monadic Memoization in F#

Πρόσφατα χρειάστηκε να χρησιμοποιήσω μια memoization συνάρτηση για ένα πρόβλημα δυναμικού προγραμματισμού.

Υλοποιώντας την κλασσική τεχνική χρειαζόμαστε μια συνάρτηση σαν την παρακάτω:

let memoize f = 
	let cache = new Dictionary<_, _>()	
	(fun x -> match cache.TryGetValue(x) with
                  | true, y -> y
	          | _       -> let v = f(x)
                                       cache.Add(x, v)
                                       v)

Το πρόβλημα με την παραπάνω συνάρτηση είναι ότι χρειαζόμαστε "κριμένα" side effects.

Μετά από μελέτη κατέληξα ότι η pure functional λύση θα περιελάμβανε τον Y combinator και το State Monad.

Η κεντρική ιδέα είναι να μετατρέψουμε μια συνάρτηση από a -> b σε a -> m b,

plus ότι χρειαζόμαστε να κάνουμε abstract και τις αναδρομικές κλήσεις για να εισάγουμε τους ελεγχους στα arguments.

My F# solution:

type StateMonad<'a, 's> = StateMonad of ('s -> ('a * 's))
 
type StateBuilder() =
    member self.Return value = StateMonad (fun state -> (value, state))
    member self.Bind (StateMonad stateMonad, f) = StateMonad (fun state -> let value, state' = stateMonad state in let (StateMonad stateMonad') = f value in stateMonad' state')
 
let memo = new StateBuilder()
 
// val Y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
let rec Y f value = f (Y f) value
 
// val check : 'a -> StateMonad<'r option,Map<'a,'r>> when 'a : comparison
let check (value : 'a) : StateMonad<option<'r>, Map<'a, 'r>> = StateMonad (fun map -> (Map.tryFind value map, map))
// val store : 'a * 'r -> StateMonad<unit,Map<'a,'r>> when 'a : comparison
let store (argument : 'a, result : 'r) : StateMonad<unit, Map<'a, 'r>> = StateMonad (fun map -> ((), Map.add argument result map))
 
// val memoize :('a -> StateMonad<'b,Map<'a,'b>>) -> 'a -> StateMonad<'b,Map<'a,'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 -> StateMonad<'b,Map<'a,'b>>) -> 'a -> StateMonad<'b,Map<'a,'b>>) -> 'a -> 'b when 'a : comparison
let execute f n = let (StateMonad stateMonad) = Y (memoize << f) n in fst (stateMonad Map.empty)
 
// val fib : (int -> StateMonad<int,'a>) -> int -> StateMonad<int,'a>
let fib f n =
    if n = 0 then memo { return 0 }
    elif n = 1 then memo { return 1 }
    else
        memo {
            let! nMinus1Fib = f (n - 1)
            let! nMinus2Fib = f (n - 2)
            return nMinus1Fib + nMinus2Fib
        }
   
execute fib 1000

References: