r - 理解并避免无限递归 R

Question

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

我曾经运行一个双 for 循环

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)