问题:只要高阶参数(即交互)保留在模型中,我就无法删除模型中的低阶参数(例如,主效应参数)。即使这样做,模型也会被重构,新模型不会嵌套在更高的模型中
请参阅以下示例(因为我来自使用contr.sum
的ANOVA):
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
)被重构,并且在较大的模型中未嵌套({ {1}})。如果我在数值对比变量中每手变换我的因子,我可以得到所需的结果,但我如何使用R的因子能力得到它?
问题:如何删除R中的低阶因子并获得真正错过此参数且未重构的模型(即,较小模型中的参数数量必须较低) )?
但为什么?我希望使用m1
包中的lmer
函数获取KRmodcomp
模型的p值的“类型3”。所以这个例子只是一个例子。
为什么不CrossValidated?我觉得这更像是一个R然后是一个统计问题(也就是说,我知道你永远不应该让一个模型与交互但没有一个主要效果,但我还是想这样做。)
答案 0 :(得分:8)
这是一种答案;我不知道直接通过公式来制定这个模型......
按上述方式构建数据:
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级因子的多因子水平)。
答案 1 :(得分:5)
我认为最直接的解决方案是使用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