我使用基因组数据我经常需要运行一百万或更多的回归模型。我在下面的循环工作，但速度很慢，并且从附加每条新记录的开销中继续变得越慢。
#### 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列向量。
如果您对如何改进有其他想法，请让我知道并再次感谢。
答案 0 :(得分：2)
每次调用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没有列时，第一种方式行为很糟糕。你可能认为它永远不会发生，但以这种方式编写循环是一种坏习惯。
答案 1 :(得分：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 <- 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
}
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)
答案 2 :(得分：1)
我不知道加速是否有意义，但我已对您的代码进行了一些简化。
首先，只需在循环外拨打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是您的代码获得的对象。如您所见，结果完全相同。
答案 3 :(得分：1)
在我的电脑上，速度提高了大约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