Error creating dynamic functions in R

Question

I found a very subtle error in my R code just now. The following code takes a list of objects as input and creates new fields for each of the objects.

Each object initially has two fields (w, p, s, u), and then I create more, beta, phi, etc. Normal variables are fine. However, the dynamic functions (Q, K, K1, K2) are incorrect. Suppose I have two niggs, niggs [[1]] and niggs [[2]], the functions Q, K, K1 and K2 for nigs [[1]] will be the same as nigs [[2]] !

I just found this error and will advise on how to get this code correctly (while maintaining my elegance :) Thanks!

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 <- (xu)/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

The main mistake I made is that I assumed that for { } introduces new scopes, in this case w,p,s,u differ w,p,s,u every time, in fact, no. Only functions in R introduce new areas. And this definition rule is different from C / Java.

Answer 1

This is the normal behavior of the lexical sphere. You can use closure instead.

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

then

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

Answer 2

In object-oriented terminology, each nigs[[i]] is an object, and functions Q , K , etc. are methods that act on the properties of the object w , p , etc. Using the proto package, we install each nigs[[i]] in the proto object, and then update the object as indicated. Note that all methods accept the object as the first argument, therefore, if p is a proto-object containing the Q method, then p$Q(t) means looking at p for Q and then starting it with the arguments p and t , therefore, p$Q(t) coincides with with(p, Q(p, t)) . Thus, we have added an additional first argument for each of the methods below. See the prototype homepage for more details.

 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 <- (xu)/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)) } }) 

EDIT: The second possible project is to create a parent meths object to hold methods, rather than defining them again in each individual proto object. In this case, in each method, we must be sure that we use the properties of the object passed in the first argument, since the methods and properties are now in different objects:

 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 <- (xu)/s alpha_bar <- w * (1-p^2)^(-1/2) y_bar <- sqrt(1+z^2) }) 

Now the following works by looking at Q in nigs[[1]] , but not detecting it, looking at its parent, meths and starting Q found there. In nigs[[1]]$Q(.1) call implicitly passes nigs[[1]] to Q as its first argument, and we defined all the properties inside the body of Q relative to the first argument, so everything works:

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