对于几个y
,我有包含响应变量(sex
)和两个因子(time
和group
)的数据:
set.seed(1)
df <- data.frame(y = rnorm(26*18),
group = sort(rep(LETTERS,18)),
sex = rep(c(rep("F",9),rep("M",9)),26),
time = rep(rep(sort(rep(1:3,3)),2),26))
df$sex <- factor(df$sex, levels = c("M","F"))
我想针对每个R
使用anova
的{{1}}在模型之间进行测试,并将其全部合并到一个group
中,该列具有对于我适合的模型中的每个因素,data.frame
anova
,其中每一行是我运行p-value
的每个group
。 >
这是我目前正在做的事情:
anova
但是实际上我有大约15,000个anova.df <- do.call(rbind,lapply(unique(df$group),function(i){
an.df <- anova(lm(y ~ sex*time,data=df %>% dplyr::filter(group == i)))
an.df <- data.frame(factor.name=rownames(an.df)[1:(nrow(an.df)-1)],p.value=an.df[1:(nrow(an.df)-1),which(colnames(an.df) == "Pr(>F)")]) %>%
tidyr::spread(factor.name,p.value) %>%
dplyr::mutate(group=i)
return(an.df)
}))
,所以我想知道有没有更快的方法。
答案 0 :(得分:1)
我认为purrr
可以为您提供帮助。
也许这不是最好的决定,但是尝试这样的事情:
df%>%
group_by(group)%>%
nest()%>%
mutate(fit = map(data, ~ anova(lm(y ~ sex*time, data = .x))))%>%
select(group,data,fit)%>%
unnest(fit)%>%
select(group,`Pr(>F)`)%>%
na.omit()%>%
mutate(var=rep(c("sex","time","sex:time"),times=nrow(.)/3))%>%
spread(var,`Pr(>F)`)
# A tibble: 26 x 4
group sex `sex:time` time
<fct> <dbl> <dbl> <dbl>
1 A 0.840 0.284 0.498
2 B 0.414 0.627 0.500
3 C 0.642 0.469 0.430
4 D 0.423 0.569 0.567
5 E 0.169 0.904 0.625
6 F 0.845 0.00390 0.869
7 G 0.937 0.318 0.473
8 H 0.329 0.663 0.609
9 I 0.977 0.144 0.158
10 J 0.823 0.448 0.193
# ... with 16 more rows
microbenchmark::microbenchmark(x= df%>%
group_by(group)%>%
nest()%>%
mutate(fit = map(data, ~ anova(lm(y ~ sex*time, data = .x))))%>%
select(group,data,fit)%>%
unnest(fit)%>%
select(group,`Pr(>F)`)%>%
na.omit()%>%
mutate(var=rep(c("sex","time","sex:time"),times=nrow(.)/3))%>%
spread(var,`Pr(>F)`),
y=anova.df <- do.call(rbind,lapply(unique(df$group),function(i){
an.df <- anova(lm(y ~ sex*time,data=df %>% dplyr::filter(group == i)))
an.df <- data.frame(factor.name=rownames(an.df)[1:(nrow(an.df)-1)],p.value=an.df[1:(nrow(an.df)-1),which(colnames(an.df) == "Pr(>F)")]) %>%
tidyr::spread(factor.name,p.value) %>%
dplyr::mutate(group=i)
return(an.df)
})),times=50)
Unit: milliseconds
expr min lq mean median uq max neval cld
x 69.98061 71.02417 74.0585 72.45625 74.08786 89.4715 50 a
y 166.63844 168.22296 181.6709 171.08077 184.14635 434.8872 50 b
答案 1 :(得分:1)
这是您原著的小版本:
br <- function(){
andf = do.call(rbind,lapply(unique(df$group), function(g){
an = anova(lm(y~sex*time, data=df[df$group==g,]))
setNames(an[-nrow(an),"Pr(>F)"],rownames(an)[-nrow(an)])
}))
andf = data.frame(andf)
andf$group = unique(df$group)
andf
}
我不确定您为什么使用“哪个”来选择“ Pr(> F)”列,因为只能有一个,所以直接将其子集化。还要注意这些组的基本子设置,以及-nrow(an)
会删除事物的最后一行。
我还尽可能地将其留在循环之外,因此到数据帧的转换和添加组ID不在循环之内。 lapply中的rbind
返回一个矩阵,而使用rbind.data.frame
则更慢,因此我必须在循环外转换为矩阵。
您的代码对列进行重新排序:
> head(op())
sex sex:time time group
1 0.8396437 0.283887315 0.4983305 A
2 0.4137317 0.626673282 0.5004230 B
3 0.6422066 0.469439754 0.4297816 C
但是我保留了anova
的订单:
> head(br())
sex time sex.time group
1 0.8396437 0.4983305 0.283887315 A
2 0.4137317 0.5004230 0.626673282 B
3 0.6422066 0.4297816 0.469439754 C
您不会说列顺序对您而言是否重要。
速度:将您使用我的代码与jyjek的代码进行比较:
> benchmark(op(), jy(), br())
test replications elapsed relative user.self sys.self user.child sys.child
3 br() 100 4.737 1.000 4.732 0.004 0 0
2 jy() 100 5.368 1.133 5.363 0.004 0 0
1 op() 100 12.769 2.696 12.767 0.000 0 0
由于每个分组的方差分析都是独立的,因此可以通过并行处理来实现真正的加速-您拥有多少个CPU内核?在我的代码中使用parallel:mclapply
可以将耗用的时间减少到4.4s,但是根据数据的大小和CPU的数量,您的改进可能会有所不同。