Question

我有一个模型构建函数，其中公式可以包含一些函数，我希望它工作，如果用户多次输入函数，只有第一次使用警告。例如，在lm中如果我们使用相同的变量两次，则删除第二个变量：

y<-1:3
x<-1:3 
lm(y~x+x)

Call:
lm(formula = y ~ x + x)

Coefficients:
(Intercept)            x  
          0            1

这是有效的，因为terms中使用的函数model.frame删除了具有相同名称的变量。但在我的情况下，我正在使用公式中的函数，这些函数不一定具有相同的参数列表，我希望这种行为能够扩展，以便这些函数的参数无关紧要：

model(y~x+fn("x"))
  (Intercept) x temp
1           1 1    1
2           1 2    1
3           1 3    1
model(y~x+fn("x")+fn("x")) #identical function calls
  (Intercept) x temp
1           1 1    1
2           1 2    1
3           1 3    1
model(y~x+fn("x")+fn("z")) #function with different argument value
Error in attr(all_terms, "variables")[[1 + ind_fn]] : 
  subscript out of bounds

这是我上面使用的示例函数（高度简化）：

model <- function(formula, data) {    

  #the beginning is pretty much copied from lm function    
  mf <- match.call(expand.dots = FALSE)   
  mf <- mf[c(1L,  match(c("formula", "data"), names(mf), 0L))]
  mf[[1L]] <- as.name("model.frame")
  mf$na.action <- as.name("na.pass")  

  all_terms <- if (missing(data)){ 
    terms(formula, "fn")
  } else terms(formula, "fn", data = data)

  #find the position of the function call in the formula
  ind_fn <- attr(all_terms, "specials")$fn

  #update the formula by removing the "fn" part
  if(!is.null(ind_fn)){
    fn_term <- attr(all_terms, "variables")[[1 + ind_fn]]
    formula <- update( formula, paste(". ~ .-", deparse(fn_term, 
                       width.cutoff = 500L, backtick = TRUE)))  
     mf$formula<-formula           
  } 

  # build y and X
  mf <- eval(mf, parent.frame())   
  y <- model.response(mf, "numeric")
  mt <- attr(mf, "terms")
  X <- model.matrix(mt, mf)


  #if fn was in formula do something with it
  if (!is.null(ind_fn)){

    foobar<-function(type=c("x","z")){
      if(type=="x"){
        rep(1,nrow(X))
      } else rep(0,nrow(X))
    }
    fn_term[[1]]<-as.name("foobar") 
    temp<-eval(fn_term)
    X<-cbind(X,temp)
  }  

  X
  }

我可以检查特殊名称（函数调用）并将它们重命名为与第一次出现相同，但我想知道是否会有更聪明的方法处理它？

Answer 1

我无法让您的代码正常工作，但假设我已经理解了您的任务，也许这样的事情可以实现您所追求的目标。

f <- y ~ x + fn("x") + fn("z") + z + fn('a')
# get list of terms
vars <- as.list(attr(terms(f), 'variables'))
# get those terms that are duplicate calls
redundant <- vars[sapply(vars, is.call) & duplicated(sapply(vars, function(x) as.list(x)[[1]]))]
# remove the duplicate calls from the formula
update(f, paste(". ~ .", paste(sapply(redundant, deparse), collapse='-'), sep='-'))
# y ~ x + fn("x") + z

R型的公式为y~fn（type =“x”）+ fn（type =“z”），忽略fn的第二次出现？

1 个答案: