Je ne sais pas si il y a un moyen plus simple de faire cela, mais une approche serait de créer un memoizing y combinator:
let memoY f =
let cache = Dictionary<_,_>()
let rec fn x =
match cache.TryGetValue(x) with
| true,y -> y
| _ -> let v = f fn x
cache.Add(x,v)
v
fn
Ensuite, vous pouvez utiliser cette combinator en lieu et place de "let rec", avec le premier argument représente la fonction à appeler récursivement:
let tailRecFact =
let factHelper fact (x, res) =
printfn "%i,%i" x res
if x = 0 then res
else fact (x-1, x*res)
let memoized = memoY factHelper
fun x -> memoized (x,1)
MODIFIER
Comme Mitya souligné, memoY ne préserve pas la queue récursive propriétés de la memoee. Voici une version révisée du combinator qui utilise les exceptions et mutable état de memoize toute fonction récursive sans débordement de la pile (même si la fonction d'origine n'est pas lui-même la queue récursive!):
let memoY f =
let cache = Dictionary<_,_>()
fun x ->
let l = ResizeArray([x])
while l.Count <> 0 do
let v = l.[l.Count - 1]
if cache.ContainsKey(v) then l.RemoveAt(l.Count - 1)
else
try
cache.[v] <- f (fun x ->
if cache.ContainsKey(x) then cache.[x]
else
l.Add(x)
failwith "Need to recurse") v
with _ -> ()
cache.[x]
Malheureusement, la machine à laquelle est inséré dans chaque appel récursif est un peu lourd, de sorte que les performances de l'onu memoized entrées nécessitant une profondeur de récursivité peut être un peu lent. Cependant, par rapport à d'autres solutions, ce qui a l'avantage qu'il nécessite assez un minimum de changements de l'expression naturelle de fonctions récursives:
let fib = memoY (fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2)))
let _ = fib 5000
MODIFIER
Je vais développer un peu sur la façon dont cela se compare à d'autres solutions. Cette technique repose sur le fait que les exceptions de fournir un canal latéral: une fonction de type 'a -> 'b n'ont pas réellement besoin de retourner une valeur de type 'b, mais peut, au lieu de la sortie via une exception. Nous n'aurions pas besoin d'utiliser des exceptions si le type de retour de contenus explicitement une valeur supplémentaire indiquant l'échec. Bien sûr, on pourrait utiliser l' 'b option que le type de retour de la fonction à cet effet. Cela conduirait à la suite de memoizing combinator:
let memoO f =
let cache = Dictionary<_,_>()
fun x ->
let l = ResizeArray([x])
while l.Count <> 0 do
let v = l.[l.Count - 1]
if cache.ContainsKey v then l.RemoveAt(l.Count - 1)
else
match f(fun x -> if cache.ContainsKey x then Some(cache.[x]) else l.Add(x); None) v with
| Some(r) -> cache.[v] <- r;
| None -> ()
cache.[x]
Auparavant, notre memoization processus ressemblait à:
fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2))
|> memoY
Maintenant, il faut tenir compte du fait qu' fib doit retourner un int option au lieu d'un int. Compte tenu d'un flux de travail adapté pour option types, ce qui pourrait être rédigé comme suit:
fun fib n -> option {
printfn "%i" n
if n <= 1 then return n
else
let! x = fib (n-1)
let! y = fib (n-2)
return x + y
} |> memoO
Cependant, si nous sommes prêts à changer le type de retour de la premier paramètre (à partir de int de int option dans ce cas), on peut aussi bien aller tout le chemin et de n'utiliser que des prolongements dans le type de retour au lieu de cela, comme dans celui de Brian solution. Voici une variation sur ses définitions:
let memoC f =
let cache = Dictionary<_,_>()
let rec fn n k =
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
f fn n (fun r ->
cache.Add(n,r)
k r)
fun n -> fn n id
Et encore une fois, si nous avons adapté le calcul de l'expression pour la construction de CPS fonctions, nous pouvons définir notre fonction récursive comme ceci:
fun fib n -> cps {
printfn "%i" n
if n <= 1 then return n
else
let! x = fib (n-1)
let! y = fib (n-2)
return x + y
} |> memoC
C'est exactement la même chose que ce que Brian a fait, mais je trouve la syntaxe est plus facile à suivre. Pour faire ce travail, tous nous avons besoin sont les deux définitions suivantes:
type CpsBuilder() =
member this.Return x k = k x
member this.Bind(m,f) k = m (fun a -> f a k)
let cps = CpsBuilder()
