循环实现Leave-One-Out观察并运行glm,一次一个变量

时间:2016-10-09 17:20:23

标签: r loops regression cross-validation glm

我有一个包含96个观察数据和1106个变量的数据框。

  • 我想通过留出一个对一个观察点进行逻辑回归,一次一个。 (因此,对于第一组观测结果,第一组观测结果将被删除,第二组观测结果将总共95次,第二次观测结果被删除,依此类推,因此有95组观测值,每组观测值都有一组观察遗漏了。)

  • 此外,我想一次只在一个变量上运行每组观察。在对一个变量运行95次观测的回归之后,我想提取p值(省略截距p值)。

  • 我已经能够手动完成所有这一切,一次一个。然而,这样做96次非常繁琐,我确信必须有一种方法可以通过循环或多个循环自动执行此操作。

以下是我如何手动完成10次观察的演示。

## Create 10 data frames by removing one observation from each ##
di.1 <- mainDF [-1,]
di.2 <- mainDF [-2,]
di.3 <- mainDF [-3,]
di.4 <- mainDF [-4,]
di.5 <- mainDF [-5,]
di.6 <- mainDF [-6,]
di.7 <- mainDF [-7,]
di.8 <- mainDF [-8,]
di.9 <- mainDF [-9,]
di.10 <- mainDF [-10,]

## Create data frames to put each p-value result in ## 
dt.1 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.2 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.3 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.4 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.5 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.6 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.7 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.8 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.9 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)
dt.10 <- data.frame(intercept=numeric(), gene=numeric(), stringsAsFactors=FALSE)

## Run logistic regression on each data frame with one one obs. left out ##
## GLM run on one variable at a time##
## Extract p-values and put in separate dfs ##

for (i in 2:1106)
{
  formulas <- glm(response ~ di.1[,i], data=di.1, family= "binomial")
  dt.1[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.2[,i], data=di.2, family= "binomial")
  dt.2[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.3[,i], data=di.3, family= "binomial")
  dt.3[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.4[,i], data=di.4, family= "binomial")
  dt.4[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.5[,i], data=di.5, family= "binomial")
  dt.5[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.6[,i], data=di.6, family= "binomial")
  dt.6[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.7[,i], data=di.7, family= "binomial")
  dt.7[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.8[,i], data=di.8, family= "binomial")
  dt.8[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.9[,i], data=di.9, family= "binomial")
  dt.9[i,] <- coef(summary(formulas))[,4]
}
for (i in 2:1106)
{
  formulas <- glm(response ~ di.10[,i], data=di.10, family= "binomial")
  dt.10[i,] <- coef(summary(formulas))[,4]
}

## Remove intercept p-values ##
dt.1<- dt.1[-c(1)]
dt.2<- dt.2[-c(1)]
dt.3<- dt.3[-c(1)]
dt.4<- dt.4[-c(1)]
dt.5<- dt.5[-c(1)]
dt.6<- dt.6[-c(1)]
dt.7<- dt.7[-c(1)]
dt.8<- dt.8[-c(1)]
dt.9<- dt.9[-c(1)]
dt.10<- dt.10[-c(1)]

## Export data frames, then manually copy and paste them into one CSV ##
write.csv(dt.1, file = "MyData.csv")
write.csv(dt.2, file = "MyData2.csv")
write.csv(dt.3, file = "MyData3.csv")
write.csv(dt.4, file = "MyData4.csv")
write.csv(dt.5, file = "MyData5.csv")
write.csv(dt.6, file = "MyData6.csv")
write.csv(dt.7, file = "MyData7.csv")
write.csv(dt.8, file = "MyData8.csv")
write.csv(dt.9, file = "MyData9.csv")
write.csv(dt.10, file = "MyData10.csv")

我想知道如何在不必每次观察每个观察的情况下完成所有这些工作。

以下是我正在使用的一大块数据:

  Response  X1  X2  X3  X4  X5  X6  X7  X8  X9  X10

P1  N       1   1   1   0   1   0   1   0   2    2
P2  N       2   1   1   0   2   2   1   2   2    2
P3  N       2   1   2   1   1   0   1   1   0    1
P4  Y       1   1   2   0   1   0   0   1   1    1
P5  N       2   2   1   1   1   0   0   0   1    1
P6  N       2   1   2   1   1   0   0   0   2    1
P7  Y       2   1   1   0   2   0   0   0   2    0
P8  Y       2   1   1   0   2   0   0   1   0    2
P9  N       1   1   1   0   2   0   0   0   1    0
P10 N       2   1   2   1   1   0   1   0   0    2

非常感谢你的时间!

1 个答案:

答案 0 :(得分:1)

正如我之前在评论中所说的那样,我不会使用glmsummary.glm,因为对于您的任务而言,这将太慢,因为您将适应96 * 1106 GLM 。我将使用glm.fit,并计算回归系数myselft的p值。下面的函数f就是这样做的。它需要1D向量x作为协变量(不允许NA)而另一个1D向量y作为响应(不允许NA)。自Logistic回归完成后,要求y是两个级别的因子(或0-1个二进制值)。

f <- function (x, y) {
  ## call `glm.fit`
  fit <- glm.fit(cbind(1,x), y, family = binomial())
  ## estimated regression coefficients
  beta <- unname(fit$coefficients)
  ## since there are only two coefficients, I don't bother using `chol2inv`
  ## then extract square root of diagonals for standard errors
  se <- sqrt(diag(chol2inv(fit$qr$qr, size = fit$qr$rank)))
  ## deal with possible rank-deficient case
  if (length(se) < 2L) se <- c(se, NA_real_)
  ## z-score
  z <- beta / se
  ## p-value (0.05 significance level)
  2 * pnorm(-abs(z))
  }

如果您不相信它的正确性,我们可以对此功能进行测试。以示例数据框dat为例,我们执行Response ~ X1

dat <- 
structure(list(Response = structure(c(1L, 1L, 1L, 2L, 1L, 1L, 
2L, 2L, 1L, 1L), .Label = c("N", "Y"), class = "factor"), X1 = c(1L, 
2L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 2L), X2 = c(1L, 1L, 1L, 1L, 2L, 
1L, 1L, 1L, 1L, 1L), X3 = c(1L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 
2L), X4 = c(0L, 0L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 1L), X5 = c(1L, 
2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L), X6 = c(0L, 2L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L), X7 = c(1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 
1L), X8 = c(0L, 2L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 0L), X9 = c(2L, 
2L, 0L, 1L, 1L, 2L, 2L, 0L, 1L, 0L), X10 = c(2L, 2L, 1L, 1L, 
1L, 1L, 0L, 2L, 0L, 2L)), .Names = c("Response", "X1", "X2", 
"X3", "X4", "X5", "X6", "X7", "X8", "X9", "X10"), row.names = c("P1", 
"P2", "P3", "P4", "P5", "P6", "P7", "P8", "P9", "P10"), class = "data.frame")

## code response into factor
dat[[1]] <- factor(dat[[1]])

## call `f`
f(dat[[2]], dat[[1]])
# [1] 0.8559137 0.8804148

## call `glm` + `summary.glm`
coef(summary(glm(Response ~ X1, data = dat, family = binomial())))
#              Estimate Std. Error    z value  Pr(>|z|)
#(Intercept) -0.4700036   2.588435 -0.1815783 0.8559137
#X1          -0.2231436   1.483239 -0.1504434 0.8804148

所以p值匹配!

我们现在需要另一个函数g来组织您计划作为双嵌套循环执行的操作。外部循环控制“留一出”,而内部循环由lapply排列以循环数据框列。在外部循环的每次迭代结束时,将得到的p值数据帧写入“.csv”文件。

g <- function (dat) {
  ## convert response to factor (if it is not readily is)
  y <- as.factor(dat[[1]])
  ## leave-one-out
  for (i in 1:nrow(dat)) {
    ## covariates data frame
    covariates <- dat[-i, -1]
    ## response vector
    response <- y[-i]
    ## call `f` to get a data frame of p-values
    result <- as.data.frame(lapply(covariates, f, y = response))
    ## write data frame to file
    write.csv(result, file = paste0(i,".csv"), row.names = FALSE)
    }
  }

当我运行g(dat)时,我会按预期获得10个“.csv”文件。

<强>随访:

  

我仍然在抓住如何在R中进行循环,因此看到这非常有帮助。在将此应用于我的数据时,我是否会在dat中添加我想要使用的数据框的名称?我是否需要在glm.fit功能部分中指定数据框?

没有。 glm.fit(以及lm.fit)也没有公式界面。它只需要数值矩阵而没有缺失值,直接矩阵计算得到估计。这正是它比glm更快的原因。它不采用和消化数据帧。您可以阅读?glm.fit以查看它需要的参数。

您的数据框dat不必具有列名。如上所述,我们无处使用配方界面。函数g假定dat的第一列是响应,而所有其他列是独立变量。此外,g不会检查缺失值/ NA,因此您应确保dat没有不完整的案例。这些只是gf的要求。

dat中使用列名的唯一好处是,这些列名将在导出的“.csv”文件中写为标题,这可能会提高可读性。