3

我正在编写一个 R 包,其中 main 函数采用一个模型,该模型可能只有一个因子协变量(允许偏移)。为确保用户遵守此规则,我需要对此进行检查。

作为一个例子,让我们看看以下四个模型:

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()and glm(),而且适用于survreg()and coxph()(来自包生存)。可能有用的是查看公式eval(getCall(mod1)$formula)和数据 ( data/ datan)。

4

2 回答 2

1

正如@LAP 之前的回复中所指出的,您可以使用terms()这些模型中的。但是,我建议查看attr(..., "factors")andattr(..., "dataClasses")而不是转到$model要求将整个model.frame()存储在模型中的。这可能是也可能不是。具体来说,在重新拟合多个模型时,您可能不希望每次都存储模型框架。

因此,一个想法是按以下步骤进行:

  • 检查是否attr(..., "factors")有不完全一列,你可以返回FALSE
  • 如果恰好有一个因素,则可以检查对应的attr(..., "dataClasses")是否是"factor"/"ordered"然后返回TRUE,否则FALSE

代码:

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)
  }
}

这似乎适用于基于单部分formula的对象。

带有数字/因子/有序的虚拟数据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
)

d1d2和的预期结果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

注意:如果您有基于多部分Formula的对象,则此功能可能会失败,并且需要调整底层测试。后者的示例可能包括计数回归模型 ( zeroinfl, hurdle)、多项式 logit ( mlogit)、工具变量 ( ivreg)、异方差模型 ( vglm, betareg, crch) 等。这些可能有类似y ~ trt | 1or的公式,在您的框架中可能可行或不可行y ~ trt | trty ~ trt | x

于 2018-05-24T16:53:34.627 回答
0

这将需要更多测试,但它适用于您的示例:

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
于 2018-05-24T08:53:43.887 回答