检查模型只有一个因子协变量

Question

我正在编写一个R软件包，其中主要函数接受一个模型，该模型只能具有单个因子协变量（允许使用偏移量）。为确保用户遵守此规则，我需要进行检查。

例如，让我们看一下以下四个模型：

set.seed(123)
n <- 10 

## data
data <- data.frame(y = rnorm(n), 
  trt = rep(c(0, 1), each = n/2),
  x = 1:n)
datan <- data
datan$trt <- as.factor(datan$trt)

## models
mod1 <- lm(y ~ factor(trt), data = data)
mod2 <- lm(y ~ offset(x) + as.factor(trt), data = data)
mod3 <- lm(y ~ trt, data = datan)
mod4 <- glm(y ~ trt + offset(x), data = data)
mod5 <- lm(y ~ x + as.factor(trt), data = data)

模型1、2和3是可以的，模型4和5不行（模型4有一个非因素变量trt，模型5有第二个协变量x）。

我该如何使用R进行检查？最理想的情况是对于一个可行的模型，我会得到一个TRUE，而对于有问题的模型，我会得到一个FALSE。

这不仅适用于lm()和glm()，还适用于survreg()和coxph()（来自生存包）。有用的东西是查看公式eval(getCall(mod1)$formula)和数据（data / datan）。

- Heidi

Answer 1

如@LAP的先前回复中所示，您可以使用这些模型中的terms()。但是，我建议查看attr(...,"factors")和attr(...,"dataClasses")而不是转到需要将整个model.frame()存储在模型中的$model。这可能是也可能不是这种情况。特别是在重新拟合多个模型时，您可能希望能够不必每次都存储模型框架。

因此，一个想法是按照以下步骤继续：

• 检查attr(...,"factors")是否不仅有一列，如果是，则可以返回FALSE。
• 如果恰好有一个因子，则可以检查相应的attr(...,"dataClasses")是否为"factor"/"ordered"，然后返回TRUE，否则返回FALSE。

R代码：

one_factor <- function(object) {
  f <- attr(terms(object), "factors")
  if(length(f) == 0L || NCOL(f) != 1L) return(FALSE)
  d <- attr(terms(object), "dataClasses")
  if(d[colnames(f)] %in% c("ordered", "factor")) {
    return(TRUE)
  } else {
    return(FALSE)
  }
}

这似乎对基于单部分公式的对象很有效。

具有数字/因子/有序 trt 的虚拟数据：

d1 <- d2 <- d3 <- data.frame(y = log(1:9), x = 1:9, trt = rep(1:3, each = 3)) 
d2$trt <- factor(d2$trt)
d3$trt <- ordered(d3$trt)

各种公式规格：

f <- list(
  y ~ 1,
  y ~ x,
  y ~ trt,
  y ~ trt + x,
  y ~ trt + offset(x),
  y ~ trt + x + offset(x),
  y ~ trt + offset(as.numeric(trt)),
  y ~ factor(trt),
  y ~ factor(trt) + offset(x),
  y ~ factor(x > as.numeric(trt)),
  y ~ interaction(x, trt),
  y ~ 0 + trt
)

分别对 d1, d2, 和 d3 期望的结果如下:

ok1 <- c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE)
ok2 <- c(FALSE, FALSE, TRUE,  FALSE, TRUE,  FALSE, TRUE,  TRUE, TRUE, TRUE, TRUE, TRUE)
ok3 <- ok2

检查是否有未存储模型框架的lm：

lm1 <- lapply(f, lm, data = d1, model = FALSE)
identical(sapply(lm1, one_factor), ok1)
## [1] TRUE
lm2 <- lapply(f, lm, data = d2, model = FALSE)
identical(sapply(lm2, one_factor), ok2)
## [1] TRUE
lm3 <- lapply(f, lm, data = d3, model = FALSE)
identical(sapply(lm3, one_factor), ok3)
## [1] TRUE

检查 survreg（高斯分布）和 coxph。（后者会抛出许多关于非收敛的警告，这并不奇怪，因为虚拟数据结构。检查仍然按预期工作。）

library("survival")
d1$y <- d2$y <- d3$y <- Surv(d1$y + 0.5)

sr1 <- lapply(f, survreg, data = d1)
identical(sapply(sr1, one_factor), ok1)
## [1] TRUE
sr2 <- lapply(f, survreg, data = d2)
identical(sapply(sr2, one_factor), ok2)
## [1] TRUE
sr3 <- lapply(f, survreg, data = d3)
identical(sapply(sr3, one_factor), ok3)
## [1] TRUE

cph1 <- lapply(f, coxph, data = d1)
identical(sapply(cph1, one_factor), ok1)
## [1] TRUE
cph2 <- lapply(f, coxph, data = d2)
identical(sapply(cph2, one_factor), ok2)
## [1] TRUE
cph3 <- lapply(f, coxph, data = d3)
identical(sapply(cph3, one_factor), ok3)
## [1] TRUE

注意：如果您有多部分基于公式的对象，此函数可能会失败，并且底层测试需要进行调整。后者的示例可能包括计数回归模型（zeroinfl，hurdle），多项式对数几率（mlogit），工具变量（ivreg），异方差模型（vglm，betareg，crch）等。这些可能具有类似于y ~ trt | 1或y ~ trt | trt或y ~ trt | x的公式，在您的框架中可能仍然可行也可能不可行。

- Achim Zeileis

Answer 2

这需要进行更多的测试，但它可以适用于你的例子：

FOO <- function(x){
  vars <- labels(terms(x))
  test <- sapply(x$model[vars], class)
  all(test == "factor", length(test) == 1)
}

我们首先使用labels(terms())提取模型的协变量，这样可以忽略偏移量，并获得一个类别向量，然后测试两个条件（1. 变量是因子，2. 它只有一个变量）是否为真。

> sapply(list(mod1, mod2, mod3, mod4, mod5), FOO)
[1]  TRUE  TRUE  TRUE FALSE FALSE

- LAP