理解并避免无限递归 R

Question

我找不到任何关于如何在 R 中处理无限递归的建议。我想以最一般的方式说明我的问题，以便其他人可以从中受益。随意编辑它。

我曾经运行过一个双循环

for (k in 1:n){ for (i in 1:m){
f[i,,k] <- an expression that depends on g[i-1,,k]
g[i,,k] <- a mixture of g[i-1,,k] and f[i,,k]}}

这运行良好，但现在我希望找到最符合我标准的 k。所以我决定把它变成一个函数，以便我以后可以优化或 uniroot 它。我写了类似的东西：

f <- function(i,k){an expression that depends on g(i-1,k)}
g <- function(i,k){an expression that depends on g(i-1,k) and f(i,k)}

我认为这两个问题很相似，但令我惊讶的是，我得到了无限递归错误。

我阅读了有关最大内存的信息，但我确信有一种更美观的方式来做到这一点。

我的可重现示例：

library(memoise)

gradient <- function(x,y,tau){if (x-y > 0) {- tau} else {(1-tau)}}
aj <- c(-3,-4,-2,-3,-5,-6,-4,-5,-1,rep(-1,15))
f <- function(x,vec){sum(x^vec)-1}
root <- uniroot(f, interval=c(0,200), vec=aj)$root

memloss<-function(i,k){if (i==1) {c(rep(0,24))} else if (i <= 0 | k < -5) {0} else {gradient(dailyreturn[i-1],weight(i-1,k)%*%A[i-1,],0.0025)*A[i-1,]}}
memweight <- function(i,k){if (i==1) {c(rep(root,24)^aj)} else if (i <= 0 | k < -5) {0} else {(exp(- (2^(k)/(sqrt(1415))) * loss(i,k))) / (weight(i-1,k) %*%  exp(- 2^(k)/(sqrt(1415)) * loss(i,k)) ) * weight(i-1,k)}}
loss <- memoize(memloss)
weight <- memoize(memweight)

dailyreturn 是一个向量（长度为 2080）

A 是一个 1414 x 24 矩阵

希望对你有帮助。

Answer 1

存在三个问题。

首先，您需要一个用于递归的初始案例。 以下导致无限递归（i 的值不断减小，但永远不会停止）。

f <- function(i) g(i-1)
g <- function(i) g(i-1) + f(i)
f(5)

以下将停止。

f <- function(i) g(i-1)
g <- function(i) if( i <= 0 ) 0 else g(i-1) + f(i)
f(5)

第二个问题是其中一些值将被重新计算成指数次。

f(500) # Too long

在更抽象的术语中，考虑顶点为f(i) 和g(i) 的图，对于i 的所有值， 具有对应于函数调用的边。递归允许您像探索一棵树一样探索此图。 但在这种情况下，它不是一棵树，您最终会多次评估相同的函数（探索相同的节点）。以下代码绘制此图。

library(igraph)
n <- 5
g <- graph.empty() 
g <- g + vertices( paste0("f(", 1:n, ")" ) )
g <- g + vertices( paste0("g(", 0:n, ")" ) )
for( i in 1:n) {
  g <- g + edge( paste0("f(", i ,")"), paste0( "g(", i-1, ")" ) )
  g <- g + edge( paste0("g(", i ,")"), paste0( "f(", i, ")" ) )
  g <- g + edge( paste0("g(", i ,")"), paste0( "g(", i-1, ")" ) )
}
plot(g)

一种解决方法是存储您已经计算的值以避免重新计算它们： 这称为memoization。

library(memoise)
f <- function(i) G(i-1)
g <- function(i) if( i <= 0 ) 1 else G(i-1) + F(i)
F <- memoize(f)
G <- memoize(g)
f(500)

当你记忆函数时，递归调用的次数变成线性的， 但它仍然可能太大。您可以按照初始错误消息的建议增加限制：

options( expressions = 5e5 )

如果这还不够，您可以通过使用越来越大的i 值来预填充表格。 以你的例子：

options( expressions = 5e5 )
loss(1000,10) # Does not work: Error: protect(): protection stack overflow
loss(500,10)  # Automatically stores the values of loss(i,100) for i=1:500
loss(1000,10) # Works

第三，可能存在不必要地增加调用堆栈大小的函数调用。 在你的例子中，如果你在错误之后输入traceback()，你会看到很多中间函数 位于调用堆栈中，因为 weight(i,k) 和 loss(i,k) 在函数参数中使用。 如果将这些调用移到函数参数之外，调用堆栈会更小，而且似乎可以工作。

library(memoise)
gradient <- function(x,y,tau){
  if (x-y > 0) { - tau   } 
  else         { (1-tau) }
}
aj <- c(-3,-4,-2,-3,-5,-6,-4,-5,-1,rep(-1,15))
f <- function(x,vec){sum(x^vec)-1}
root <- uniroot(f, interval=c(0,200), vec=aj)$root
memloss<-function(i,k){
  cat( "loss(", i, ",", k, ")\n", sep="" )
  if (i==1) {
    c(rep(0,24))
  } else if (i <= 0 | k < -5) {
    0
  } else {
    w <- weight(i-1,k)   # Changed
    gradient(dailyreturn[i-1],w%*%A[i-1,],0.0025)*A[i-1,]
  }
}
memweight <- function(i,k){
  cat( "weight(", i, ",", k, ")\n", sep="" )
  if (i==1) {
    c(rep(root,24)^aj)
  } else if (i <= 0 | k < -5) {
    0
  } else {
    w <- weight(i-1,k)  # Changed
    l <- loss(i,k)      # Changed
    (exp(- (2^(k)/(sqrt(1415))) * l)) / (w %*%  exp(- 2^(k)/(sqrt(1415)) * l) ) * w
  }
}
loss <- memoize(memloss)
weight <- memoize(memweight)

A <- matrix(1, 1414, 24)
dailyreturn <- rep(1,2080)
options( expressions = 1e5 )
loss(1400,10)