理解并避免无限递归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.所以我决定将它变成一个函数,以便我以后可以优化或取消它.我写了类似的东西:

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)