f# - ejemplos - recursividad valor

Combinar memoria y recursión de cola

Question

¿Es posible combinar la memorización y la recursión de cola de alguna manera? Estoy aprendiendo F # en este momento y entiendo ambos conceptos, pero no puedo combinarlos.

Supongamos que tengo la siguiente función memoize (de la Programación Funcional Real-World ):

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)

y la siguiente función factorial :

let rec factorial(x) = if (x = 0) then 1 else x * factorial(x - 1)

El factorial memoria no es demasiado difícil y hacer que sea recursivo por la cola tampoco:

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)

¿Pero puedes combinar memoria y recursión final? Hice algunos intentos pero parece que no puedo hacer que funcione. ¿O esto simplemente no es posible?

Answer 1

Como siempre, las continuaciones producen una elegante solución de 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

Hay dos tipos de pruebas. En primer lugar, esto demuestra que llamar a F (4) almacena en caché F (4), F (3), F (2), F (1) como lo desea.

Luego, comente el *** printf y elimine el comentario de la prueba final (y compile en modo Release) para mostrar que no contiene (usa tailcalls correctamente).

Tal vez generalice ''memoize'' y lo demuestre en ''fib'' next ...

EDITAR

Bien, aquí está el próximo paso, creo, desacoplando la memoria de 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

EDITAR

Ok, aquí hay una versión completamente generalizada que parece funcionar.

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

Answer 2

Escribí una prueba para visualizar la memorización. Cada punto es una llamada recursiva.

......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

La solución de kvb arroja los mismos resultados que la memoria recta como esta función.

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
)

Probar el código fuente

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

Answer 3

La dificultad de memorizar las funciones recursivas de la cola es, por supuesto, que cuando la función recursiva de la cola

let f x =
......
f x1

se llama a sí mismo, no está permitido hacer nada con el resultado de la llamada recursiva, incluida la colocación en caché. Difícil; ¿Entonces, qué podemos hacer?

La idea crítica aquí es que, dado que la función recursiva no tiene permitido hacer nada con el resultado de una llamada recursiva, ¡el resultado de todos los argumentos para las llamadas recursivas será el mismo! Por lo tanto, si el seguimiento de llamadas de recursión es este

f x0 -> f x1 -> f x2 -> f x3 -> ... -> f xN -> res

entonces para todo x en x0, x1, ..., xN el resultado de fx será el mismo, es decir, res. Por lo tanto, la última invocación de una función recursiva, la llamada no recursiva, conoce los resultados de todos los valores anteriores; está en posición de almacenarlos en caché. Lo único que debe hacer es pasarle una lista de valores visitados. Esto es lo que podría parecer factorial:

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)

¡Pero espera! El parámetro Look - l de fact0 contiene todos los argumentos para las llamadas recursivas a fact0 - ¡igual que la pila en una versión no recursiva! Eso es exactamente correcto. Cualquier algoritmo recursivo no cola se puede convertir a recursivo de cola moviendo la "lista de montones de pila" de pila a pila y convirtiendo el "postprocesamiento" de resultado de llamada recursiva en una caminata sobre esa estructura de datos.

Nota pragmática: el ejemplo factorial anterior ilustra una técnica general. Es bastante inútil como es - para la función factorial es suficiente para almacenar en caché el fact n alto nivel, porque el cálculo de fact n para una n particular solo golpea una serie única de pares de argumentos (n, res) a fact0 - si (n, 1) aún no está en la memoria caché, entonces ninguno de los pares fact0 a los que se llamará son.

Nótese que en este ejemplo, cuando pasamos de un factorial recursivo sin cola a un factorial recursivo de cola, explotamos el hecho de que la multiplicación es asociativa y conmutativa - el factorial recursivo de cola ejecuta un conjunto diferente de multiplicaciones que el de una cola no consecutiva uno recursivo

De hecho, existe una técnica general para pasar del algoritmo recursivo sin cola al recursivo de cola, que produce un algoritmo equivalente a un tee. Esta técnica se llama "transformación de paso continuo". Yendo por esa ruta, puede tomar un factorial de memorización sin cola recursiva y obtener un factorial de memorización de cola recursiva mediante una transformación mecánica. Vea la respuesta de Brian para la exposición de este método.

Answer 4

No estoy seguro de si hay una forma más sencilla de hacerlo, pero un enfoque sería crear un combinador de y para la memorización:

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

Luego, puede usar este combinador en lugar de "let rec", con el primer argumento que representa la función para llamar recursivamente:

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)

EDITAR

Como señaló Mitya, memoY no conserva las propiedades recursivas de cola del memoee. Aquí hay un combinador revisado que usa excepciones y estado mutable para memorizar cualquier función recursiva sin desbordar la pila (incluso si la función original no es recursiva en sí misma):

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]

Desafortunadamente, la maquinaria que se inserta en cada llamada recursiva es algo pesada, por lo que el rendimiento en entradas no memorizadas que requieren recursión profunda puede ser un poco lento. Sin embargo, en comparación con algunas otras soluciones, esto tiene el beneficio de que requiere cambios bastante mínimos a la expresión natural de las funciones recursivas:

let fib = memoY (fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2)))
let _ = fib 5000

EDITAR

Me extenderé un poco sobre cómo esto se compara con otras soluciones. Esta técnica aprovecha el hecho de que las excepciones proporcionan un canal lateral: una función de tipo ''a -> ''b realidad no necesita devolver un valor de tipo ''b , sino que puede salir mediante una excepción. No necesitaríamos usar excepciones si el tipo de devolución contiene explícitamente un valor adicional que indique la falla. Por supuesto, podríamos usar la ''b option como el tipo de retorno de la función para este propósito. Esto llevaría al siguiente combinador de memorización:

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]

Previamente, nuestro proceso de memorización se veía así:

fun fib n ->
printfn "%i" n;
if n <= 1 then n
else (fib (n-1)) + (fib (n-2))
|> memoY

Ahora, necesitamos incorporar el hecho de que fib debe devolver una int option lugar de una int . Dado un flujo de trabajo adecuado para los tipos de option , esto podría escribirse de la siguiente manera:

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

Sin embargo, si estamos dispuestos a cambiar el tipo de devolución del primer parámetro (de la int option int a int option en este caso), también podemos usar todo el camino y simplemente usar continuaciones en el tipo de devolución, como en la solución de Brian. Aquí hay una variación de sus definiciones:

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

Y nuevamente, si tenemos una expresión de cálculo adecuada para construir funciones CPS, podemos definir nuestra función recursiva de la siguiente manera:

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

Esto es exactamente lo mismo que Brian, pero creo que la sintaxis aquí es más fácil de seguir. Para que esto funcione, todo lo que necesitamos son las dos definiciones siguientes:

type CpsBuilder() =
member this.Return x k = k x
member this.Bind(m,f) k = m (fun a -> f a k)
let cps = CpsBuilder()

Answer 5

Eso debería funcionar si la recursividad de cola mutua a través de y no está creando marcos de pila:

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