结合记忆和尾递归

Question

是否有可能以某种方式将记忆和尾递归结合起来？我目前正在学习 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)

但是你能将记忆化和尾递归结合起来吗？我做了一些尝试，但似乎无法使其发挥作用。或者这根本不可能？

Answer 1

与往常一样，延续产生了一个优雅的尾部调用解决方案：

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 并取消注释最终测试（并在发布模式下编译）以显示它没有 StackOverflow（它正确使用了 tailcalls）。

也许我会概括出“memoize”并在“fib”上演示它接下来...

编辑

好吧，我想这是下一步，将记忆与阶乘解耦：

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

Answer 2

当然，记忆尾递归函数的困境是，当尾递归函数

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

调用自身时，不允许它对递归调用的结果执行任何操作，包括将其放入缓存中。棘手；那么我们能做什么呢？

这里的关键见解是，由于不允许递归函数对递归调用的结果执行任何操作，因此递归调用的所有参数的结果将是相同的！因此，如果递归调用跟踪是这样的

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

，那么对于 x0,x1,...,xN 中的所有 x，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)

但是等等！看 - fact0 的 l 参数包含对 fact0 递归调用的所有参数 - 就像非尾递归版本中的堆栈一样！这是完全正确的。任何非尾递归算法都可以通过将“堆栈帧列表”从堆栈移动到堆并将递归调用结果的“后处理”转换为对该数据结构的遍历来转换为尾递归算法。

实用说明：上面的阶乘示例说明了一种通用技术。它毫无用处——对于阶乘函数来说，缓存顶级事实 n 的结果就足够了，因为特定 n 的事实 n 的计算只会命中 a fact0 的唯一一系列 (n,res) 参数对 - 如果 (n,1) 尚未缓存，则不会调用任何对fact0。

请注意，在这个例子中，当我们从非尾递归阶乘到尾递归阶乘时，我们利用了乘法是结合性和交换性这一事实——尾递归阶乘执行与非尾递归阶乘不同的乘法集。递归一。

事实上，存在从非尾递归算法到尾递归算法的通用技术，这产生了相当于 Tee 的算法。这种技术称为“连续传递变换”。按照这条路线，您可以采用非尾递归记忆阶乘，并通过几乎机械转换获得尾递归记忆阶乘。请参阅 Brian 的回答以了解此方法的说明。

Answer 3

我不确定是否有更简单的方法来做到这一点，但一种方法是创建一个记忆 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)

编辑

正如 Mitya 指出的，memoY 不保留 memoee 的尾递归属性。这是一个修改后的组合器，它使用异常和可变状态来记忆任何递归函数而不会溢出堆栈（即使原始函数本身不是尾递归！）：

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选项作为函数的返回类型来达到此目的。这将导致以下记忆组合器：

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 到 < code>int option 在这种情况下），我们也可以一路走下去，只在返回类型中使用延续，就像 Brian 的解决方案一样。这是他的定义的一个变体：

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

这与 Brian 所做的完全相同，但我发现这里的语法更简单跟随。为了实现这一点，我们需要以下两个定义：

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 4

我写了一个测试来可视化记忆。每个点都是一个递归调用。

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

Answer 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