是否可以在保持简化表示法的同时更新模型对象的公式?

时间:2015-06-12 16:04:32

标签: r glm lm

我有一个带有一些交互术语的模型公式。当我通过update()更新模型时,*运算符会被弃用,以支持展开的x + y + x:y表单。这不是一个大问题,但是当通过anova()(或其他地方)比较模型时,它往往会使模型公式在视觉上变得不太合适,并且更改anova对象的标题是不方便的。 / p>

问题在于terms.formula()(通过update.formula())似乎并没有使强制简化公式变得微不足道(应该通过简化选项?)。

例如:

# Looking for Dep ~ Ind1 * Ind2 + Ind3

update.formula(Dep ~ Ind1 * Ind2, . ~ . + Ind3)
##Dep ~ Ind1 + Ind2 + Ind3 + Ind1:Ind2

也许通过simplify = TRUE完成这项工作?

update.formula(Dep ~ Ind1 * Ind2, . ~ . + Ind3, simplify = TRUE)
##Dep ~ Ind1 + Ind2 + Ind3 + Ind1:Ind2

或者这些条款会被重新排序,这会阻止它返回简化版本吗?

update.formula(Dep ~ Ind1 * Ind2, . ~ . + Ind3, simplify = TRUE, keep.order = TRUE)
##Dep ~ Ind1 + Ind2 + Ind3 + Ind1:Ind2

我目前使用的解决方法是只适合一个新模型,当模型调用需要多个额外的参数时,这种方法不太方便。有没有更好的解决方案来更新公式对象,同时保持简化的*表示法?

更清晰的用例(全因子设计):

i1 <- sample(c("A", "B"), 100, replace = TRUE)
i2 <- sample(c("C", "D"), 100, replace = TRUE)
i3 <- sample(c("E", "F"), 100, replace = TRUE)
i4 <- sample(c("G", "H"), 100, replace = TRUE)
d1 <- rnorm(100)
df <- data.frame(d1, i1, i2, i3, i4)

m1 <- lm(d1 ~ i1 * i2 * i3, data = df)
m2 <- update(m1, formula = . ~ . * i4)
m2s <- lm(d1 ~ i1 * i2 * i3 * i4, data  = df) # Explicitly declare new model

anova(m1, m2)
##Analysis of Variance Table

##Model 1: d1 ~ i1 * i2 * i3
##Model 2: d1 ~ i1 + i2 + i3 + i4 + i1:i2 + i1:i3 + i2:i3 + i1:i4 + i2:i4 + 
##    i3:i4 + i1:i2:i3 + i1:i2:i4 + i1:i3:i4 + i2:i3:i4 + i1:i2:i3:i4
##  Res.Df    RSS Df Sum of Sq      F Pr(>F)
##1     92 121.07                           
##2     84 118.70  8    2.3646 0.2092 0.9885

anova(m1, m2s)
##Analysis of Variance Table

##Model 1: d1 ~ i1 * i2 * i3
##Model 2: d1 ~ i1 * i2 * i3 * i4
##  Res.Df    RSS Df Sum of Sq      F Pr(>F)
##1     92 121.07                           
##2     84 118.70  8    2.3646 0.2092 0.9885

1 个答案:

答案 0 :(得分:2)

simplify中的{p> terms.formula与您的想法相反。您实际上想要simplify = FALSE,但使用默认stats::update.formula无法做到这一点。这是一个可以满足您需求的版本。请注意,默认方法刚刚更改为使用我的update_no_simplify.formula版本,并且公式方法刚刚更改为使用simplify = FALSE:

update_no_simplify <- function(object, ...) {
  UseMethod("update_no_simplify")
}

update_no_simplify.formula <- function(old, new) {
  tmp <- .Call(stats:::C_updateform, as.formula(old), as.formula(new))
  formula(terms.formula(tmp, simplify = FALSE))
}

update_no_simplify.default <- function (object, formula., ..., evaluate = TRUE) {
  if (is.null(call <- getCall(object))) 
    stop("need an object with call component")
  extras <- match.call(expand.dots = FALSE)$...
  if (!missing(formula.)) 
    call$formula <- update_no_simplify.formula(formula(object), formula.)
  if (length(extras)) {
    existing <- !is.na(match(names(extras), names(call)))
    for (a in names(extras)[existing]) call[[a]] <- extras[[a]]
    if (any(!existing)) {
      call <- c(as.list(call), extras[!existing])
      call <- as.call(call)
    }
  }
  if (evaluate) 
    eval(call, parent.frame())
  else call
}

m3 <- update_no_simplify(m1, . ~ . * i4)
anova(m1, m3)

输出:

##Analysis of Variance Table
##
##Model 1: d1 ~ i1 * i2 * i3
##Model 2: d1 ~ i1 * i2 * i3 * i4
##  Res.Df    RSS Df Sum of Sq     F Pr(>F)
##1     92 95.496                          
##2     84 89.193  8    6.3032 0.742 0.6542