5

I can't find any advice on how to deal with infinite recursion in R. I would like to illustrate my problem in the most general way so that others can benefit from it. Feel free to edit it.

I used to run a double for loop 

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]}}

This was running fine but now I hoped to find the k that would best fit my criterion. So I decided to turn it into a function so that i could later optimize or uniroot it. I wrote something like that :

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

I thought the two problems were similar but to my great surprise, I get infinite recursion errors.

I read about max memory but I am sure there is a more aesthetic way of doing it.

My reproducible example :

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)

where dailyreturn is a vector (of length 2080)

A is a 1414 x 24 matrix

I hope that helps.

4

1 回答 1

9

存在三个问题。

首先，您需要递归的初始案例。以下导致无限递归（ 的值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)
于 2013-05-30T09:49:16.453 回答