Комбинат запоминания и хвостовой рекурсии
Можно ли как-то совместить запоминание и хвостовую рекурсию? Сейчас я изучаю 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)
Memoizing 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)
Но можете ли вы совместить запоминание и хвостовую рекурсию? Я сделал несколько попыток, но не могу заставить его работать. Или это просто невозможно?
5 ответов
Как всегда, продолжения дают элегантное решение:
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), чтобы показать, что он не Stackru (он правильно использует tailcalls).
Возможно, я обобщу слово "запоминать" и покажу его на "выдумке" дальше...
РЕДАКТИРОВАТЬ
Хорошо, вот следующий шаг, я думаю, отделяющий запоминание от факториала:
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
Задача запоминания хвостовых рекурсивных функций, конечно же, заключается в том, что когда хвостовая рекурсивная функция
let f x =
......
f x1
самому вызову запрещается делать что-либо с результатом рекурсивного вызова, в том числе помещать его в кеш. Tricky; Так что мы можем сделать?
Критическое понимание здесь заключается в том, что поскольку рекурсивной функции не разрешается делать что-либо с результатом рекурсивного вызова, результат для всех аргументов рекурсивных вызовов будет одинаковым! Поэтому, если трассировка рекурсивного вызова это
f x0 -> f x1 -> f x2 -> f x3 -> ... -> f xN -> res
тогда для всех x в x0,x1,...,xN результат f x будет такой же, а именно рез. Таким образом, последний вызов рекурсивной функции, нерекурсивный вызов, знает результаты для всех предыдущих значений - он может их кэшировать. Единственное, что вам нужно сделать, это передать ему список посещенных значений. Вот что может выглядеть для факториала:
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 не будет вызвана.
Обратите внимание, что в этом примере, когда мы перешли от нерекурсивного факториала к хвостовому рекурсивному факториалу, мы использовали тот факт, что умножение является ассоциативным и коммутативным - хвостовой рекурсивный факториал выполняет другой набор умножений, чем не хвостовой рекурсивный.
Фактически, существует общий метод перехода от нерекурсивного к хвостовому рекурсивному алгоритму, который дает алгоритм, эквивалентный тройнику. Эта техника называется "преобразованием, проходящим через продолжение". Пройдя по этому пути, вы можете взять нерекурсивный факториал для запоминания и получить хвостовой рекурсивный факториал для запоминания с помощью механического преобразования. См. Ответ Брайана для ознакомления с этим методом.
Я не уверен, есть ли более простой способ сделать это, но один из подходов - создать запоминающий 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)
РЕДАКТИРОВАТЬ
Как указал Митя, 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
РЕДАКТИРОВАТЬ
Я немного расскажу о том, как это можно сравнить с другими решениями. Этот метод использует преимущество того факта, что исключения предоставляют побочный канал: функция типа '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()
Я написал тест для визуализации памятки. Каждая точка является рекурсивным вызовом.
......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 возвращает те же результаты, что и прямое запоминание, как эта функция.
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
Это должно работать, если взаимная хвостовая рекурсия через 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