在R中创建动态函数的一个错误

Question

刚刚在我的R代码中发现了一个非常微妙的错误。以下代码将对象列表作为输入并为每个对象创建新字段。

每个对象最初有两个字段（w，p，s，u），然后我创建更多，beta，phi等等。正常变量都可以。但是动态函数（Q，K，K1，K2）不正确。假设我有两个nigs，nigs [[1]]和nigs [[2]]，nigs [[1]]的函数Q，K，K1和K2与nigs [[2]]相同！

我刚刚发现这个错误，并会咨询如何获得此代码正确（同时保持它的优雅:)谢谢！

D <- length(nigs) 

    for (i in 1:D) { 
    w <- nigs[[i]]$w 
    p <- nigs[[i]]$p 
    s <- nigs[[i]]$s 
    u <- nigs[[i]]$u 

    nigs[[i]]$beta <- beta <- w/s * p * (1-p^2)^(-1/2); 
    nigs[[i]]$phi <- phi <- w^2/s^2; 

    nigs[[i]]$z <- z <- (x-u)/s; 
    nigs[[i]]$alpha_bar <- alpha_bar <- w * (1-p^2)^(-1/2); 
    nigs[[i]]$y_bar <- y_bar <- sqrt(1+z^2); 

    nigs[[i]]$Q <- Q <- function(t) { sqrt(1 - (2*beta*t+t^2)/phi) } 
    nigs[[i]]$K <- K <- function(t) { u*t - w*Q(t) + w } 
    nigs[[i]]$K1 <- K1 <- function(t) { (u + w * (beta+t)/(Q(t)*phi)) } 
    nigs[[i]]$K2 <- K2 <- function(t) { qt = Q(t); (w/(qt * phi) + w * (beta+t)^2/(qt^3 * phi^2)); } 
    } 

编辑

我所做的主要错误是，我认为for { }引入了新的领域，在这种情况下，w,p,s,u是不同的，每次w,p,s,u，其实不是。只有R中的函数引入新的范围。这个范围规则与C/Java不同。

Answer 1

这是词法范围的正常行为。 您可以改为使用闭包。

f <- list() 
g <- list() 
for (i in 1:2) { 
    j <- i * 2 
    f[[i]] <- function() print(j) 
    g[[i]] <- (function() {j <- j; function() print(j)})() 
} 

然后，

> for (i in 1:2) f[[i]]() 
[1] 4 
[1] 4 
> for (i in 1:2) g[[i]]() 
[1] 2 
[1] 4 

Answer 2

在面向对象的术语各nigs[[i]]是一个对象，功能Q，K等是作用于该对象的属性w，p等。使用的方法proto软件包，我们将每个nigs[[i]]设置为proto对象，然后按照指示更新对象。请注意，所有方法都将对象作为第一个参数，所以如果p是含有方法Q一种原对象然后p$Q(t)意味着p寻找Q，然后用参数p和t运行它，以便p$Q(t)相同with(p, Q(p, t))。因此我们为下面的每个方法添加了额外的第一个参数。有关更多信息，请参阅proto home page。

library(proto) 

# initialize 
x <- 1 
nigs <- lapply(1:2, function(i) proto(w = i/3, p = i/3, s = i/3, u = i/3)) 

for(p in nigs) with(p, { 
    beta <- w/s * p * (1-p^2)^(-1/2) 
    phi <- w^2/s^2 

    z <- (x-u)/s 
    alpha_bar <- w * (1-p^2)^(-1/2) 
    y_bar <- sqrt(1+z^2) 

    Q <- function(., t) { sqrt(1 - (2*beta*t+t^2)/phi) } 
    K <- function(., t) { u*t - w*.$Q(t) + w } 
    K1 <- function(., t) { (u + w * (beta+t)/(.$Q(t)*phi)) } 
    K2 <- function(., t) { 
     qt = .$Q(t) 
     (w/(qt * phi) + w * (beta+t)^2/(qt^3 * phi^2)) 
    } 
    }) 

编辑：第二个可能的设计是创建一个父对象，meths保持方法，而不是在每个单独的原对象再次定义它们的上方。在这种情况下，每个方法中，我们必须确保我们使用的第一个参数传递的对象的属性，因为方法和属性现在位于不同的对象：

meths <- proto(
     Q = function(., t) sqrt(1 - (2*.$beta*t+t^2)/.$phi), 
     K = function(., t) .$u*t - .$w*.$Q(t) + .$w, 
     K1 = function(., t) (.$u + .$w * (.$beta+t)/(.$Q(t)*.$phi)), 
     K2 = function(., t) { 
      qt = .$Q(t) 
      (.$w/(qt * .$phi) + .$w * (.$beta+t)^2/(qt^3 * .$phi^2)) 
     } 
) 

# initialize - meths$proto means define proto object with parent meths 
x <- 1 
nigs <- lapply(1:2, function(i) meths$proto(w = i/3, p = i/3, s = i/3, u = i/3)) 

for(p in nigs) with(p, { 
    beta <- w/s * p * (1-p^2)^(-1/2) 
    phi <- w^2/s^2 

    z <- (x-u)/s 
    alpha_bar <- w * (1-p^2)^(-1/2) 
    y_bar <- sqrt(1+z^2) 
}) 

现在下面的作品通过查找Q在nigs[[1]]，但没有找到它在那里寻找其父母，meths，并运行在那里找到Q。在nigs[[1]]$Q(.1)呼叫隐式传递nigs[[1]]到Q作为其第一个参数，我们定义Q相对的身体内的所有属性的第一个参数使一切工作：

> nigs[[1]]$Q(.1) 
[1] 0.9587958