Проблема с передачей аргумента функции внутри собственной функции

При вызове функций внутри функций, которые зависят от оценки имен в пределах фрейма данных, я использую do.call, который оценивает свои аргументы перед передачей функции и, таким образом, упрощает отладку и написание кода, и я чувствую, что могу быть более уверен в том, что это делает. (Для отладки просто используйте call вместо do.call, который покажет, что функция будет пытаться запустить; синтаксис также немного отличается, поэтому при этом также удалите структуру списка внутри вызова.)

(Благодарим Джоша О'Брайена за эту идею: https://stackoverflow.com/a/7668846/210673 )

В этом случае это будет выглядеть так:

test.fun <- function(x, data, event){
  require(crrstep)
  select.mod <- do.call("crrstep", 
         list(formula=x, etype=substitute(event), failcode=1, cencode=0,
              data=as.name("data"), direction = "backward", criterion = "AIC", 
              crr.object = TRUE, trace = FALSE))
  print(select.mod)
}

test.fun(x=formula1, data=testdata, event=fstatus) 

substitute(event) указывает ему использовать имя, данное функции, а не имя event. as.name("data") указывает ему искать data внутри функции, а не передавать фактический фрейм данных. Другой вариант - substitute(data), который будет искать фактический фрейм данных, который у вас есть.

пример с использованием lm

Вот пример очень похожего поведения с использованием lm и аргумента weights:

Вот пример набора данных и вызов lm, а не внутри другой функции. Я печатаю call элемент ответа, чтобы увидеть, что он на самом деле сделал.

> set.seed(5)
> dd <- data.frame(x=1:10,y=round(rnorm(10,mean=10),1), z=round(runif(10,1,4),1))
> lm(y~x, weights=z, data=dd)$call
lm(formula = y ~ x, data = dd, weights = z)

Естественный способ, который не работает, потому что он ищет w во фрейме данных:

> f1 <- function(f,w,d){
+   lm(formula=f,weights=w, data=d)
+ }
> f1(y~x, z, dd)
Error in eval(expr, envir, enclos) : object 'w' not found

Вызов можно построить со строками; это немного проще:

> f2 <- function(f,w,d){
+   do.call("lm", list(formula=as.formula(f), weights=as.name(w), data=as.name(d)))
+ }
> f2("y~x", "z", "dd")$call
lm(formula = y ~ x, data = dd, weights = z)

Или можно использовать substitute; здесь я вызываю функцию для моего фактического набора данных dd, а не d внутри функции. Это может пригодиться позже, если я захочу использовать update.

> f3 <- function(f,w,d){
+   do.call("lm", list(formula=f, weights=substitute(w), data=substitute(d)))
+ }
> f3(y~x, z, dd)$call
lm(formula = y ~ x, data = dd, weights = z)

Но я мог бы также использовать d внутри функции; на этот раз обратите внимание на data = d в вызове вместо data = dd.

> f4 <- function(f,w,d){
+   do.call("lm", list(formula=f, weights=substitute(w), data=as.name("d")))
+ }
> f4(y~x, z, dd)$call
lm(formula = y ~ x, data = d, weights = z)

Он также работает, чтобы вставить фактический фрейм данных, но вызов длиннее. Однако это может быть желательно, если вы изменяете фрейм данных программно перед каждым вызовом и хотите иметь запись о том, что это за фрейм данных. (Однако я бы предпочел сохранить этот фрейм данных более явным образом, если он вам действительно понадобится позже.)

> f5 <- function(f,w,d){
+   do.call("lm", list(formula=f, weights=substitute(w), data=d))
+ }
> f5(y~x, z, dd)$call
lm(formula = y ~ x, data = list(x = 1:10, y = c(9.2, 11.4, 8.7, 
10.1, 11.7, 9.4, 9.5, 9.4, 9.7, 10.1), z = c(3.7, 3.2, 1.6, 1.7, 
1.4, 2.4, 2.3, 3.9, 1.4, 3.9)), weights = z)

Еще одно, чтобы показать, что вы не можете просто использовать substitute без do.call, поскольку substitute выполняется внутри вызова lm.

> f6 <- function(f,w,d){
+   lm(formula=f,weights=substitute(w), data=d)
+ }
> f6(y~x, z, dd)
Error in model.frame.default(formula = f, data = d, weights = substitute(w),  : 
  invalid type (symbol) for variable '(weights)'

Я не совсем понимаю, почему, но, похоже, он потерпит неудачу, если вы передадите свой аргумент etype в качестве индексированного фрейма данных. Однако, похоже, это сработает, если вы заранее создадите вектор:

test.fun <- function(x,data,event){
  require(crrstep)
  etype <- data[,event]
  select.mod<- crrstep(formula=x,data=data,etype=etype, failcode=1, cencode=0, 
                   direction = "backward", criterion = "AIC", crr.object = TRUE, 
                   trace = FALSE)
#Rest of function omitted for now
print(select.mod)
}