r - 当高阶参数保留时，如何删除模型中的低阶参数？

Question

问题：只要模型中保留高阶参数（即交互作用），我就无法删除模型中的低阶参数（例如，主效应参数）。即使这样做，模型也会被重构，并且新模型不会嵌套在更高的模型中。
请参阅以下示例（因为我来自我使用的 ANOVA contr.sum）：

d <- data.frame(A = rep(c("a1", "a2"), each = 50), B = c("b1", "b2"), value = rnorm(100))
options(contrasts=c('contr.sum','contr.poly'))
m1 <- lm(value ~ A * B, data = d)
m1

## Call:
## lm(formula = value ~ A * B, data = d)
## 
## Coefficients:
## (Intercept)           A1           B1        A1:B1  
##   -0.005645    -0.160379    -0.163848     0.035523  

m2 <- update(m1, .~. - A)
m2

## Call:
## lm(formula = value ~ B + A:B, data = d)

## Coefficients:
## (Intercept)           B1       Bb1:A1       Bb2:A1  
##   -0.005645    -0.163848    -0.124855    -0.195902  

可以看出，虽然我删除了一个参数（A），但新模型（m2）被重构并且没有嵌套在更大的模型（m1）中。如果我将我的因子转换为数值对比变量，我可以获得所需的结果，但是如何使用 R 的因子功能获得它？

问题：如何去除 R 中的低阶因子并获得一个模型，该模型确实缺少该参数且未重构（即较小模型中的参数数量必须更少）？

---

但为什么？我想使用包中的函数为lmer模型获取“类型 3”之类的 p 值。所以这个例子实际上只是一个例子。KRmodcomppbkrtest

为什么不交叉验证？我觉得这实际上更像是一个 R 而不是一个统计问题（即，我知道你永远不应该拟合一个具有交互但没有主要影响之一的模型，但我仍然想这样做）。

Answer 1

这是一种答案；我不知道直接用公式来制定这个模型......

如上构造数据：

d <- data.frame(A = rep(c("a1", "a2"), each = 50),
                B = c("b1", "b2"), value = rnorm(100))
options(contrasts=c('contr.sum','contr.poly'))

确认仅从公式中减去因子不起作用的原始发现：

m1 <- lm(value ~ A * B, data = d)
coef(m1)
## (Intercept)          A1          B1       A1:B1 
## -0.23766309  0.04651298 -0.13019317 -0.06421580 

m2 <- update(m1, .~. - A)
coef(m2)
## (Intercept)          B1      Bb1:A1      Bb2:A1 
## -0.23766309 -0.13019317 -0.01770282  0.11072877 

制定新的模型矩阵：

X0 <- model.matrix(m1)
## drop Intercept column *and* A from model matrix
X1 <- X0[,!colnames(X0) %in% "A1"]

lm.fit允许直接指定模型矩阵：

m3 <- lm.fit(x=X1,y=d$value)
coef(m3)
## (Intercept)          B1       A1:B1 
## -0.2376631  -0.1301932  -0.0642158 

此方法仅适用于允许明确指定模型矩阵的少数特殊情况（例如lm.fit，glm.fit）。

更普遍：

## need to drop intercept column (or use -1 in the formula)
X1 <- X1[,!colnames(X1) %in% "(Intercept)"]
## : will confuse things -- substitute something inert
colnames(X1) <- gsub(":","_int_",colnames(X1))
newf <- reformulate(colnames(X1),response="value")
m4 <- lm(newf,data=data.frame(value=d$value,X1))
coef(m4)
## (Intercept)          B1   A1_int_B1 
##  -0.2376631  -0.1301932  -0.0642158 

这种方法的缺点是它不能将多个输入变量识别为来自同一个预测变量（即，来自多于 2 个水平的因子的多个因子水平）。

Answer 2

我认为最直接的解决方案是使用model.matrix. 可能，您可以通过一些花哨的步法和自定义对比来实现您想要的。但是，如果您想要“类型 3 esque”的 p 值，您可能希望模型中的每个术语都使用它，在这种情况下，我认为我的方法model.matrix无论如何都很方便，因为您可以轻松地隐式循环遍历所有模型，将一列放在一次。提供一种可能的方法并不是对其统计优点的认可，但我确实认为你提出了一个明确的问题，并且似乎知道它在统计上可能不合理，所以我认为没有理由不回答它。

## initial data
set.seed(10)
d <- data.frame(
  A = rep(c("a1", "a2"), each = 50),
  B = c("b1", "b2"),
  value = rnorm(100))

options(contrasts=c('contr.sum','contr.poly'))

## create design matrix
X <- model.matrix(~ A * B, data = d)

## fit models dropping one effect at a time
## change from 1:ncol(X) to 2:ncol(X)
## to avoid a no intercept model
m <- lapply(1:ncol(X), function(i) {
  lm(value ~ 0 + X[, -i], data = d)
})
## fit (and store) the full model
m$full <- lm(value ~ 0 + X, data = d)
## fit the full model in usual way to compare
## full and regular should be equivalent
m$regular <- lm(value ~ A * B, data = d)
## extract and view coefficients
lapply(m, coef)

这将导致最终输出：

[[1]]
   X[, -i]A1    X[, -i]B1 X[, -i]A1:B1 
  -0.2047465   -0.1330705    0.1133502 

[[2]]
X[, -i](Intercept)          X[, -i]B1       X[, -i]A1:B1 
        -0.1365489         -0.1330705          0.1133502 

[[3]]
X[, -i](Intercept)          X[, -i]A1       X[, -i]A1:B1 
        -0.1365489         -0.2047465          0.1133502 

[[4]]
X[, -i](Intercept)          X[, -i]A1          X[, -i]B1 
        -0.1365489         -0.2047465         -0.1330705 

$full
X(Intercept)          XA1          XB1       XA1:B1 
  -0.1365489   -0.2047465   -0.1330705    0.1133502 

$regular
(Intercept)          A1          B1       A1:B1 
 -0.1365489  -0.2047465  -0.1330705   0.1133502 

到目前为止，对于使用lm. 你提到这最终是为了lmer()，所以这里是一个使用混合模型的例子。我相信，如果您有多个随机截距（即，需要从模型的固定和随机部分删除效果），它可能会变得更加复杂。

## mixed example
require(lme4)

## data is a bit trickier
set.seed(10)
mixed <- data.frame(
  ID = factor(ID <- rep(seq_along(n <- sample(3:8, 60, TRUE)), n)),
  A = sample(c("a1", "a2"), length(ID), TRUE),
  B = sample(c("b1", "b2"), length(ID), TRUE),
  value = rnorm(length(ID), 3) + rep(rnorm(length(n)), n))

## model matrix as before
X <- model.matrix(~ A * B, data = mixed)

## as before but allowing a random intercept by ID
## becomes trickier if you need to add/drop random effects too
## and I do not show an example of this
mm <- lapply(1:ncol(X), function(i) {
  lmer(value ~ 0 + X[, -i] + (1 | ID), data = mixed)
})

## full model
mm$full <- lmer(value ~ 0 + X + (1 | ID), data = mixed)
## full model regular way
mm$regular <- lmer(value ~ A * B + (1 | ID), data = mixed)

## view all the fixed effects
lapply(mm, fixef)

这给了我们...

[[1]]
   X[, -i]A1    X[, -i]B1 X[, -i]A1:B1 
 0.009202554  0.028834041  0.054651770 

[[2]]
X[, -i](Intercept)          X[, -i]B1       X[, -i]A1:B1 
        2.83379928         0.03007969         0.05992235 

[[3]]
X[, -i](Intercept)          X[, -i]A1       X[, -i]A1:B1 
        2.83317191         0.02058800         0.05862495 

[[4]]
X[, -i](Intercept)          X[, -i]A1          X[, -i]B1 
        2.83680235         0.01738798         0.02482256 

$full
X(Intercept)          XA1          XB1       XA1:B1 
  2.83440919   0.01947658   0.02928676   0.06057778 

$regular
(Intercept)          A1          B1       A1:B1 
 2.83440919  0.01947658  0.02928676  0.06057778