结合memoization和尾递归

Question

有可能以某种方式结合memoization和tail-recursion吗？我现在正在学习F#并理解这两个概念,但似乎无法将它们结合起来.

假设我有以下memoize功能(来自Real-World Functional Programming):

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和尾递归吗？我做了一些尝试,但似乎无法让它工作.或者这根本不可能？

Answer 1

与往常一样,continuation产生优雅的尾调解决方案:

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(它正确使用tailcalls).

也许我会概括出'memoize'并在'fib'上展示它......

编辑

好的,我认为下一步是将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

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)

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

务实的说明:上面的因子例子说明了一般技术.这是非常无用的 - 对于阶乘函数来说,它足以缓存顶级fact n结果,因为fact n对特定n的计算只会触发一系列(n,res)参数的唯一系列到fact0 - if(n, 1)尚未缓存,那么将不会调用对的fact0.

注意,在这个例子中,当我们从非尾递归因子变为尾递归因子时,我们利用了乘法是关联和可交换的事实 - 尾递归因子执行一组不同的乘法而不是非尾 - 递归的.

实际上,存在从非尾递归到尾递归算法的一般技术,其产生等效于tee的算法.这种技术被称为"连续传递变换".走这条路线,你可以采用一个非尾递归的记忆因子,并通过几乎机械的转换得到一个尾递归的记忆因子.请参阅Brian的回答以了解此方法.

Answer 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)

编辑

正如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 option为此我们可以使用函数的返回类型.这将导致以下memoizing组合:

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而不是a 的事实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在这种情况下),我们不妨走一路,只是使用在返回延续类型,而不是作为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()