替换循环以在 R 中进行 T 检验

问题描述

我有一个具有以下结构的数据框:

set.seed(1)
dat<- data.frame(gender=sample(rep(c("Man","Woman"),3000)),age=sample(rep(c("Young","Old"),question=rep(c("Q1","Q2","Q3"),2000),response=rep(c("Res1","Res2"),3000),value=sample(rep(c(0,1),3000)))
head(dat)
#  gender   age question response value
#1    Man   Old       Q1     Res1     0
#2    Man Young       Q2     Res2     1
#3    Man   Old       Q3     Res1     0
#4  Woman   Old       Q1     Res2     1
#5    Man   Old       Q2     Res1     1
#6    Man   Old       Q3     Res2     1

我创建了一个循环来对每个问题的每个回答进行 t 检验,并将输出加入数据帧中。

library(tidyverse)
library(rstatix)
data.list1<- list()
for (i in 1:length(table(dat$question))) {
  dat1<- dat %>% 
    filter(question==names(table(dat$question))[[i]])
  data.list2 <- list()
  for(f in 1:(ncol(dat1)-3)){
    dat2<- dat1 %>% 
      t_test(reformulate(colnames(dat1)[f],"value"),detailed=T) %>% 
      mutate(question=names(table(dat$question))[[i]],response=names(table(dat$response))[[f]])
    data.list2[[f]]<- dat2
  }
  data.list1[[i]] <- bind_rows(data.list2)
}
final.output<- bind_rows(data.list1) %>% 
  select(question,response,group1,estimate1,group2,estimate2,p)
final.output
#  question response group1 estimate1 group2 estimate2     p
#  <chr>    <chr>    <chr>      <dbl> <chr>      <dbl> <dbl>
#1 Q1       Res1     Man        0.492 Woman      0.494 0.932
#2 Q1       Res2     Old        0.484 Young      0.502 0.418
#3 Q2       Res1     Man        0.500 Woman      0.509 0.687
#4 Q2       Res2     Old        0.489 Young      0.518 0.198
#5 Q3       Res1     Man        0.495 Woman      0.510 0.504
#6 Q3       Res2     Old        0.511 Young      0.494 0.452

我的问题是我实际使用的数据帧比本示例中使用的数据帧大得多,并且包含更多变量,因此循环需要很长时间才能运行(超过 10 分钟)。有没有办法不使用循环就获得相同的输出

解决方法

我们可以使用 imapselect '问题'、循环列和'值' 循环列名的命名向量,然后在按'问题'分组后,{{1} } summarise 中的 t_test 输出和 list(来自 unnesttidyr 输出

list

-输出

library(purrr)
library(dplyr)
library(rstatix)
library(tidyr)
imap_dfr(c(gender = "gender",age = "age"),~ {
     nm1 <- .x
     dat %>% 
        select(question,.x,value) %>%
        group_by(question) %>% 
        summarise(out =  list(t_test(reformulate( nm1,"value"),detailed = TRUE,data = cur_data())))},.id = 'variable') %>%
 unnest(c(out))