Ошибка при создании динамических функций в R

Question

Я обнаружил очень тонкую ошибку в моем коде R только сейчас. Следующий код принимает список объектов в качестве входных данных и создает новые поля для каждого из объектов.

Каждый объект изначально имеет два поля (w, p, s, u), а затем я создаю more, beta, phi и т. Д. С нормальными переменными все в порядке. Однако динамические функции (Q, K, K1, K2) не верны. Предположим, у меня есть два nigs, nigs [[1]] и nigs [[2]], функции Q, K, K1 и K2 для nigs [[1]] будут такими же, как 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)); }
  }

EDIT

Основная ошибка, которую я допустил, заключается в том, что я предположил, что for { } ввел новые области действия, в этом случае w,p,s,u каждый раз отличаются w,p,s,u, фактически нет. Только функции в R вводят новые области. И это правило видимости отличается от C / Java.

Answer 1

В объектно-ориентированной терминологии каждый nigs[[i]] является объектом, а функции Q, K и т. Д. Являются методами, которые воздействуют на свойства объекта w, p и т. Д. Используя пакет proto, мы установите каждый nigs[[i]] на объект прото, а затем обновите объект, как указано. Обратите внимание, что все методы принимают объект в качестве первого аргумента, поэтому, если p является прототипом, содержащим метод Q, тогда p$Q(t) означает поиск в p для Q, а затем запустить его с аргументами p и t, поэтому p$Q(t) совпадает с with(p, Q(p, t)). Таким образом, мы добавили дополнительный первый аргумент к каждому из методов ниже. Подробнее см. домашняя страница прото .

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

Answer 2

Это нормальное поведение лексической области видимости. Вместо этого вы можете использовать замыкание.

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