Question

我使用基因组数据我经常需要运行一百万或更多的回归模型。我在下面的循环工作，但速度很慢，并且从附加每条新记录的开销中继续变得越慢。

#### setup sample data ###
require(data.table)
data <- data.frame(
  C = rnorm(10, 5),
  D = rnorm(10, 7),
  E = rnorm(10, 9),
  A = rnorm(10, 1),
  B = rnorm(10, 3)
)
outcome <- c(rnorm(10, 5))
cov <- data.frame(cov1 = c(1, 1, 1, 2, 2, 1, 1, 1, 2, 2))
#### initialize results file ###
myresults <- data.table(NULL)
#### Run regression against same covariates and outcome for each column in data ##
for (i in 1:ncol(data)) {
  id = colnames(data)[i]
  mydata <- cbind(cov, outcome, data[, id])
  colnames(mydata)[ncol(mydata)] <- id #I can't figure out how to not have to do this
  fit <-
    glm(formula(paste0("outcome ~ as.factor(cov1) + ", id)), data = mydata)
  myresults <- rbindlist(list(
    myresults,
    data.table(
      id = id,
      estimate = signif(coef(summary(fit))[id, "Estimate"], digits = 4),
      pvalue = signif(coef(summary(fit))[id, "Pr(>|t|)"], digits = 4)
    )
  ))
}
myresults

这给我的输出结果文件正是我需要的。我可以修改它以添加到其他输出中，在循环中运行其他模型以通过协变量进行分层然后捕获等...我的输出始终具有与我的初始{{1}中的列相同的数据行数}。

data

通过切换到循环中看到的id estimate pvalue 1: C -0.22220 0.49230 2: D 0.64550 0.08568 3: E -0.06756 0.83990 4: A 0.39750 0.54060 5: B -0.34300 0.35410，我获得了一些改进。

我一直在尝试使用像data.table::rbindlist之类的东西，看看我是否可以加快速度，甚至可以使用lapply(split(data, colnames(data)))，但却无法让它发挥作用。

非常感谢帮助。

编辑：我对所有回复的人表示赞赏，因为他们都很有帮助，我很感激所花的时间。

明显的赢家是6倍的保证金是罗兰的评论。我列出了我在这里为后人所做的事情，以及它可以帮助其他人。

我合并为一个非常宽的数据集（260 x 470,000）

mclapply()

然后我把它变成了一个高大的数据集：

require(data.table)
require(reshape2)
bigdata <- cbind(mycovs, testdata)
test <- data.table(bigdata)

然后我运行了完整的回归模型并从系数表中取出了最后一行，如下所示：

    DT.m1 = melt(
  test,
  id.vars = c(
    "Sample_Plate",
    "BaseName",
    "Race",
    "Education",
    "mom_age_delv",
    "sex",
    "gest_age_wks",
    "MONTH_OLD",
    "DEPRESSION",
    "CD8T",
    "CD4T",
    "NK",
    "Bcell",
    "Mono",
    "Gran"
  ),
  measure.vars = c(16:ncol(test)),
  variable.name = "cpg",
  value.name = "betaval"
)

最后，我把它清理干净了。

system.time(res <-
              DT.m1[, {
                fit <-
                  glm(
                    DEPRESSION ~ as.factor(Sample_Plate) + as.factor(sex) + as.factor(Education) + as.factor(Race) + MONTH_OLD + mom_age_delv + gest_age_wks + CD8T + CD4T + NK + Bcell + Mono + Gran + betaval,
                    data = .SD
                  )
                coef(summary(fit))[nrow(coef(summary(fit))), c(1, 2, 4)]
              }, by = cpg])

这导致每1000个型号的时间约为10秒。接下来关闭的事情是~60秒。

清理部分似乎应该可以在data.table（）中完成，但我无法弄明白。我只能为我要求的每个coef列重复一个高2列向量。

如果您对如何改进有其他想法，请让我知道并再次感谢。

Answer 1

每次调用myresults <- rbindlist(list(myresults, ...))时，您都会复制整个myresults，修改副本，然后将名称指向副本。 R中低效循环的最常见原因是“增长对象”。您知道结果的确切维度（ncol(data)乘以3），所以只需将其开头即可。然后使用data.table通过引用分配（不复制）。

看看这是否有助于提高效率：

#### initialize results file ###
myresults <- data.table(
  id       = character(length(data)),
  estimate = numeric(  length(data)),
  pvalue   = numeric(  length(data))
)

#### Run regression against same covariates and outcome for each column in data ##
for (i in seq_along(data)) {
  id = colnames(data)[i]
  mydata <- cbind(cov, outcome, data[, id])
  colnames(mydata)[ncol(mydata)] <- id #I can't figure out how to not have to do this
  fit <-
    glm(formula(paste0("outcome ~ as.factor(cov1) + ", id)), data = mydata)
  set(
    myresults,
    i     = i,
    j     = c("id", "estimate", "pvalue"),
    value = list(
      id       = id,
      estimate = signif(coef(summary(fit))[id, "Estimate"], digits = 4),
      pvalue   = signif(coef(summary(fit))[id, "Pr(>|t|)"], digits = 4)
    )
  )
}

我还将for (i in 1:ncol(data))替换为for (i in seq_along(data))，因为当data没有列时，第一种方式行为很糟糕。你可能认为它永远不会发生，但以这种方式编写循环是一种坏习惯。

Answer 2

您应该尝试map和map_df

library(tidyverse)
myfun <- function(data, outcome, cov) {
    require(tidyverse)
      numcol <- ncol(data)
    newdata <- data %>%
                mutate(outcome = outcome, cov = cov$cov1)

    fmla <- map(names(newdata[,1:numcol]), ~glm(formula(paste0("outcome ~ as.factor(cov) + ", .x)), data=newdata))
    ans <- map_df(fmla, ~as_tibble(matrix(coef(summary(.x))[2, c(1,4)], ncol=2, byrow=TRUE)), .id="id") %>%
               rename(estimate=V1, pvalue=V2)
}

基准

有更大的数据

biggerdata <- as_tibble(matrix(rnorm(2000), nrow=10))
library(microbenchmark)
microbenchmark(myfun(biggerdata,outcome,cov), OP(biggerdata,outcome,cov))

Unit: milliseconds
                            expr      min         lq       mean     median
 myfun(biggerdata, outcome, cov)   71.534   72.98252   77.82994   76.31598
    OP(biggerdata, outcome, cov) 1936.986 1994.03518 2048.96934 2018.33299
         uq       max neval
   79.97554  106.9852   100
 2085.44655 2297.3878   100

OP功能

OP <- function(data, outcome, cov) {
    myresults <- data.table(NULL)
    #### Run regression against same covariates and outcome for each column in data ##
    for (i in 1:ncol(data)) {
        id = colnames(data)[i]
        mydata <- cbind(cov, outcome, data[, id])
        colnames(mydata)[ncol(mydata)] <- id #I can't figure out how to not have to do this
        fit <- glm(formula(paste0("outcome ~ as.factor(cov1) + ", id)), data = mydata)
        myresults <- rbindlist(list(
                        myresults,
                        data.table(
                              id = id,
                              estimate = signif(coef(summary(fit))[id, "Estimate"], digits = 4),
                              pvalue = signif(coef(summary(fit))[id, "Pr(>|t|)"], digits = 4)
                        )
        ))
    }
    myresults
}

处理cov中多个协变量的新函数

set.seed(20)
newcov <- data.frame(cov1 = sample(c(1,2), 10, replace=TRUE),
            cov2 = sample(c(1,2), 10, replace=TRUE),
            cov3 = sample(c(1,2), 10, replace=TRUE))

mynewfun <- function(data, outcome, cov) {
                require(tidyverse)
                numcol <- ncol(data)
                newdata <- data %>%
                        mutate(outcome = outcome) %>%
                          cbind(cov)

                covname <- names(cov)
                fmla <- map(names(newdata[,1:numcol]), ~glm(formula(paste0("outcome ~ ", paste0(covname, collapse=" + "), " + ", .x)), data=newdata))
                ans <- map_df(fmla, ~as_tibble(matrix(coef(summary(.x))[2, c(1,4)], ncol=2, byrow=TRUE)), .id="id") %>%
                       rename(estimate=V1, pvalue=V2)
                return(ans)
         }

mynewfun(data,outcome,newcov)

Answer 3

我不知道加速是否有意义，但我已对您的代码进行了一些简化。
首先，只需在循环外拨打factor和colnames(data)。

cov2 <- data.frame(cov1 = factor(c(1, 1, 1, 2, 2, 1, 1, 1, 2, 2)))
#
cnames <- colnames(data)
mydata2 <- data.frame(cov2, outcome, other = NA)

现在，定义lapply要使用的函数。请注意，此函数使用全局环境中存在的多个数据对象，通常是一种不好的做法。

fun <- function(i){
    id <- cnames[i]
    mydata2[, 3] <- data[, id]
    names(mydata2)[3] <- id
    fit <- glm(formula(paste0("outcome ~ cov1 + ", id)), data = mydata2)
    data.table(
        id = id,
        estimate = signif(coef(summary(fit))[id, "Estimate"], digits = 4),
        pvalue = signif(coef(summary(fit))[id, "Pr(>|t|)"], digits = 4)
    )
}

myresults2 <- rbindlist(lapply(seq_len(ncol(data)), fun))

identical(myresults, myresults2)
[1] TRUE

对象myresults是您的代码获得的对象。如您所见，结果完全相同。

Answer 4

在我的电脑上，速度提高了大约40％：

timestart <- Sys.time()

mydata <- cbind(cov, outcome, data)
my.glm <- function (mycol) {
  fit <- glm(eval(parse(text = paste("outcome ~ cov1 +", mycol))), data = mydata)
    data.table(
    id = mycol,
    estimate = signif(coef(summary(fit))[mycol, "Estimate"], digits = 4),
    pvalue = signif(coef(summary(fit))[mycol, "Pr(>|t|)"], digits = 4)
  )
}
(res.l <- do.call(rbind, lapply(colnames(data), my.glm)))

Sys.time() - timestart

更快地运行百万回归模型

4 个答案:

基准

OP功能

处理cov中多个协变量的新函数