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