Комбинация memoization и tail-recursion
Можно ли как-то совместить воспоминания и хвостовую рекурсию? Я изучаю F # на данный момент и понимаю обе концепции, но не могу их комбинировать.
Предположим, что у меня есть следующая функция memoize (из Функциональное программирование реального мира):
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)
и следующей функции factorial:
let rec factorial(x) = if (x = 0) then 1 else x * factorial(x - 1)
Запоминание factorial не слишком сложно и делает его хвостовым рекурсивом также:
let rec memoizedFactorial =
memoize (fun x -> if (x = 0) then 1 else x * memoizedFactorial(x - 1))
let tailRecursiveFactorial(x) =
let rec factorialUtil(x, res) = if (x = 0)
then res
else let newRes = x * res
factorialUtil(x - 1, newRes)
factorialUtil(x, 1)
Но можете ли вы объединить memoization и tail-recursion? Я сделал несколько попыток, но не могу заставить его работать. Или это просто невозможно?
Ответы
Ответ 1
Как всегда, продолжения дают элегантное решение tailcall:
open System.Collections.Generic
let cache = Dictionary<_,_>() // TODO move inside
let memoizedTRFactorial =
let rec fac n k = // must make tailcalls to k
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
if n=0 then
k 1
else
fac (n-1) (fun r1 ->
printfn "multiplying by %d" n //***
let r = r1 * n
cache.Add(n,r)
k r)
fun n -> fac n id
printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in cache do
printfn "%d: %d" k v
printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2
printfn "---"
// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3
Существует два типа тестов. Во-первых, эти демонстрации, вызывающие F (4), кэшируют F (4), F (3), F (2), F (1), как вы бы хотели.
Затем закомментируйте *** printf и раскомментируйте окончательный тест (и скомпилируйте в режиме Release), чтобы показать, что он не StackOverflow (он правильно использует хвосты).
Возможно, я обобщу 'memoize' и продемонстрирую его на следующем рисунке.
ИЗМЕНИТЬ
Хорошо, вот следующий шаг, я думаю, развязывание memoization от factorial:
open System.Collections.Generic
let cache = Dictionary<_,_>() // TODO move inside
let memoize fGuts n =
let rec newFunc n k = // must make tailcalls to k
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
fGuts n (fun r ->
cache.Add(n,r)
k r) newFunc
newFunc n id
let TRFactorialGuts n k memoGuts =
if n=0 then
k 1
else
memoGuts (n-1) (fun r1 ->
printfn "multiplying by %d" n //***
let r = r1 * n
k r)
let memoizedTRFactorial = memoize TRFactorialGuts
printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in cache do
printfn "%d: %d" k v
printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2
printfn "---"
// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3
ИЗМЕНИТЬ
Хорошо, вот полностью обобщенная версия, которая, похоже, работает.
open System.Collections.Generic
let memoize fGuts =
let cache = Dictionary<_,_>()
let rec newFunc n k = // must make tailcalls to k
match cache.TryGetValue(n) with
| true, r -> k r
| _ ->
fGuts n (fun r ->
cache.Add(n,r)
k r) newFunc
cache, (fun n -> newFunc n id)
let TRFactorialGuts n k memoGuts =
if n=0 then
k 1
else
memoGuts (n-1) (fun r1 ->
printfn "multiplying by %d" n //***
let r = r1 * n
k r)
let facCache,memoizedTRFactorial = memoize TRFactorialGuts
printfn "---"
let r = memoizedTRFactorial 4
printfn "%d" r
for KeyValue(k,v) in facCache do
printfn "%d: %d" k v
printfn "---"
let r2 = memoizedTRFactorial 5
printfn "%d" r2
printfn "---"
// comment out *** line, then run this
//let r3 = memoizedTRFactorial 100000
//printfn "%d" r3
let TRFibGuts n k memoGuts =
if n=0 || n=1 then
k 1
else
memoGuts (n-1) (fun r1 ->
memoGuts (n-2) (fun r2 ->
printfn "adding %d+%d" r1 r2 //%%%
let r = r1+r2
k r))
let fibCache, memoizedTRFib = memoize TRFibGuts
printfn "---"
let r5 = memoizedTRFib 4
printfn "%d" r5
for KeyValue(k,v) in fibCache do
printfn "%d: %d" k v
printfn "---"
let r6 = memoizedTRFib 5
printfn "%d" r6
printfn "---"
// comment out %%% line, then run this
//let r7 = memoizedTRFib 100000
//printfn "%d" r7
Ответ 2
Задача запоминания хвостовых рекурсивных функций, конечно же, заключается в том, что при хвостичной рекурсивной функции
let f x =
......
f x1
вызывает себя, ему не разрешено делать что-либо с результатом рекурсивного вызова, в том числе помещать его в кеш. Tricky; Так что мы можем сделать?
Критическое понимание здесь заключается в том, что, поскольку рекурсивной функции не разрешено ничего делать с результатом рекурсивного вызова, результат для всех аргументов для рекурсивных вызовов будет таким же! Поэтому, если трассировка рекурсивного вызова - это
f x0 -> f x1 -> f x2 -> f x3 -> ... -> f xN -> res
то для всех x в x0, x1,..., xN результат f x будет таким же, а именно res. Таким образом, последний вызов рекурсивной функции, нерекурсивный вызов, знает результаты для всех предыдущих значений - он может их кэшировать. Единственное, что вам нужно сделать - это передать ему список посещенных значений. Вот что он может искать факториал:
let cache = Dictionary<_,_>()
let rec fact0 l ((n,res) as arg) =
let commitToCache r =
l |> List.iter (fun a -> cache.Add(a,r))
match cache.TryGetValue(arg) with
| true, cachedResult -> commitToCache cachedResult; cachedResult
| false, _ ->
if n = 1 then
commitToCache res
cache.Add(arg, res)
res
else
fact0 (arg::l) (n-1, n*res)
let fact n = fact0 [] (n,1)
Но подождите! Посмотрите - l параметр fact0 содержит все аргументы для рекурсивных вызовов fact0 - точно так же, как стек будет в нерекурсивной версии! Это точно. Любой нерекурсивный рекурсивный алгоритм может быть преобразован в хвостовую рекурсивную, перемещая "список кадров стека" из стека в кучу и преобразуя "постобработку" результата рекурсивного вызова в прогулку по этой структуре данных.
Прагматическая заметка: приведенный выше факторный пример иллюстрирует общую технику. Это совершенно бесполезно, так как есть - для факториальной функции достаточно кэшировать результат верхнего уровня fact n, потому что вычисление fact n для конкретного n только попадает в уникальный ряд (n, res) пар аргументов fact0 - если (n, 1) еще не кэшируется, то ни одна из пар fact0 не будет вызвана.
Обратите внимание, что в этом примере, когда мы перешли от нерекурсивного факториала к хвостовому рекурсивному факториалу, мы использовали тот факт, что умножение ассоциативно и коммутативно - хвосторекурсивный факториал выполняет другой набор умножений, -трехово-рекурсивный.
На самом деле существует общий метод перехода от нерекурсивного к хвостовому рекурсивному алгоритму, который дает алгоритм, эквивалентный тройнику. Этот метод называется "преходящим преобразованием". Идя по этому маршруту, вы можете взять не-хвост-рекурсивный memoizing factorial и получить хвосто-рекурсивный memoizing factorial, в значительной степени, механическую трансформацию. См. Ответ Брайана для изложения этого метода.
Ответ 3
Я не уверен, есть ли более простой способ сделать это, но одним из способов было бы создать 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
Затем вы можете использовать этот комбинатор вместо "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)
ИЗМЕНИТЬ
Как отметил Митя, memoY не сохраняет хвостовые рекурсивные свойства memoee. Здесь пересмотренный комбинатор, который использует исключения и изменяемое состояние для memoize любой рекурсивной функции без (даже если исходная функция не является самой хвостовой рекурсивной!):
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]
К сожалению, механизм, который вставлен в каждый рекурсивный вызов, несколько тяжелый, поэтому производительность на не memoized входах, требующих глубокой рекурсии, может быть немного медленной. Однако, по сравнению с некоторыми другими решениями, это имеет то преимущество, что для естественного выражения рекурсивных функций оно требует довольно минимальных изменений:
let fib = memoY (fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2)))
let _ = fib 5000
ИЗМЕНИТЬ
Я немного расскажу о том, как это сравнивается с другими решениями. Этот метод использует тот факт, что исключения предоставляют боковой канал: функция типа '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]
Раньше процесс memoization выглядел так:
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()
Ответ 4
Я написал тест для визуализации memoization. Каждая точка является рекурсивным вызовом.
......720 // factorial 6
......720 // factorial 6
.....120 // factorial 5
......720 // memoizedFactorial 6
720 // memoizedFactorial 6
120 // memoizedFactorial 5
......720 // tailRecFact 6
720 // tailRecFact 6
.....120 // tailRecFact 5
......720 // tailRecursiveMemoizedFactorial 6
720 // tailRecursiveMemoizedFactorial 6
.....120 // tailRecursiveMemoizedFactorial 5
Решение kvb возвращает те же результаты, что и прямая memoization, как эта функция.
let tailRecursiveMemoizedFactorial =
memoize
(fun x ->
let rec factorialUtil x res =
if x = 0 then
res
else
printf "."
let newRes = x * res
factorialUtil (x - 1) newRes
factorialUtil x 1
)
Проверить исходный код.
open System.Collections.Generic
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)
let rec factorial(x) =
if (x = 0) then
1
else
printf "."
x * factorial(x - 1)
let rec memoizedFactorial =
memoize (
fun x ->
if (x = 0) then
1
else
printf "."
x * memoizedFactorial(x - 1))
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 tailRecFact =
let factHelper fact (x, res) =
if x = 0 then
res
else
printf "."
fact (x-1, x*res)
let memoized = memoY factHelper
fun x -> memoized (x,1)
let tailRecursiveMemoizedFactorial =
memoize
(fun x ->
let rec factorialUtil x res =
if x = 0 then
res
else
printf "."
let newRes = x * res
factorialUtil (x - 1) newRes
factorialUtil x 1
)
factorial 6 |> printfn "%A"
factorial 6 |> printfn "%A"
factorial 5 |> printfn "%A\n"
memoizedFactorial 6 |> printfn "%A"
memoizedFactorial 6 |> printfn "%A"
memoizedFactorial 5 |> printfn "%A\n"
tailRecFact 6 |> printfn "%A"
tailRecFact 6 |> printfn "%A"
tailRecFact 5 |> printfn "%A\n"
tailRecursiveMemoizedFactorial 6 |> printfn "%A"
tailRecursiveMemoizedFactorial 6 |> printfn "%A"
tailRecursiveMemoizedFactorial 5 |> printfn "%A\n"
System.Console.ReadLine() |> ignore
Ответ 5
Это должно работать, если взаимная рекурсия хвоста через y не создает кадры стека:
let rec y f x = f (y f) x
let memoize (d:System.Collections.Generic.Dictionary<_,_>) f n =
if d.ContainsKey n then d.[n]
else d.Add(n, f n);d.[n]
let rec factorialucps factorial' n cont =
if n = 0I then cont(1I) else factorial' (n-1I) (fun k -> cont (n*k))
let factorialdpcps =
let d = System.Collections.Generic.Dictionary<_, _>()
fun n -> y (factorialucps >> fun f n -> memoize d f n ) n id
factorialdpcps 15I //1307674368000
