Я не уверен, есть ли более простой способ сделать это, но один из подходов - создать запоминающий y-комбинатор:
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
Затем вы можете использовать этот комбинатор вместо «let rec», с первым аргументом, представляющим функцию для рекурсивного вызова:
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)
EDIT
Как указал Митя, memoY не сохраняет хвостовые рекурсивные свойства мемои. Вот пересмотренный комбинатор, который использует исключения и изменяемое состояние для запоминания любой рекурсивной функции без переполнения стека (даже если исходная функция сама не является хвостовой рекурсивной!):
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]
К сожалению, механизм, который вставляется в каждый рекурсивный вызов, несколько тяжел, поэтому производительность на незарегистрированных входах, требующих глубокой рекурсии, может быть немного медленной. Однако по сравнению с некоторыми другими решениями это имеет то преимущество, что требует довольно минимальных изменений в естественном выражении рекурсивных функций:
let fib = memoY (fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2)))
let _ = fib 5000
EDIT
Я немного подробнее расскажу, как это можно сравнить с другими решениями. Этот метод использует преимущество того факта, что исключения предоставляют побочный канал: функция типа 'a -> 'b на самом деле не должна возвращать значение типа 'b, но вместо этого может выйти через исключение. Нам не нужно было бы использовать исключения, если возвращаемый тип явно содержал дополнительное значение, указывающее на ошибку. Конечно, мы могли бы использовать 'b option в качестве возвращаемого типа функции для этой цели. Это привело бы к следующему комбинатору запоминания:
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]
Ранее наш процесс запоминания выглядел так:
fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2))
|> memoY
Теперь нам нужно учесть тот факт, что fib должен возвращать int option вместо int. Учитывая подходящий рабочий процесс для option типов, это можно записать следующим образом:
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
Однако, если мы хотим изменить тип возвращаемого значения первого параметра (в данном случае с int до int option), мы можем также пройти весь путь и использовать вместо этого продолжения в типе возврата , как в решении Брайана. Вот вариант его определения:
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
И снова, если у нас есть подходящее вычислительное выражение для построения функций CPS, мы можем определить нашу рекурсивную функцию следующим образом:
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
Это точно так же, как то, что сделал Брайан, но я считаю, что здесь легче следовать синтаксису. Для этого нам понадобятся следующие два определения:
type CpsBuilder() =
member this.Return x k = k x
member this.Bind(m,f) k = m (fun a -> f a k)
let cps = CpsBuilder()