运行许多方差分析并提取某些列的快速方法

时间:2018-09-21 06:58:50

标签: r dataframe dplyr anova

对于几个y,我有包含响应变量(sex)和两个因子(timegroup)的数据:

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) })) ,所以我想知道有没有更快的方法。

2 个答案:

答案 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的数量,您的改进可能会有所不同。