在数据帧上应用函数，包括 rbind 语句

Question

我正在寻找在一个非常大的数据框中使用四列来应用 fisher.test 的最快方法

下面是一个使用慢 for 循环的测试示例。

应用会更快，但我不知道如何在应用函数中使用 rbind。

也非常欢迎提供更快的建议。

testdf<-data.frame(a=c(80,1,3,4),b=c(100,200,300,400),c=c(1,2,3,4),d=c(200,250,350,450))

for (i in 1:nrow(testdf)){
  testdf$e[i] <- fisher.test(rbind(c(testdf$a[i],testdf$b[i]),c(testdf$c[i],testdf$d[i])))$p.value
}

非常感谢您的帮助

Answer 1

由于rowwise 的状态为“质疑”，这里有一个带有dplyr 和purrr 的tidyverse 解决方案。请参阅我上面的评论，在这种情况下，对 10,000 行进行基准测试，所有 3 行都需要非常相似的时间。

library(dplyr)
library(purrr)
testdf<-data.frame(a=c(80,1,3,4,80),b=c(100,200,300,400,100),c=c(1,2,3,4,1),d=c(200,250,350,450,200))
testdf <- 
  testdf %>%
  distinct %>%
  mutate(e = pmap_dbl(.l = list(a, b, c, d),
                      .f = ~ fisher.test(matrix(c(..1, ..2, ..3, ..4),
                                                ncol = 2,
                                                byrow = TRUE)
                                         )$p.value
                      )
          )

^{由reprex package (v0.3.0) 于 2020-04-24 创建}

Answer 2

这是使用dplyr::rowwise 的tidyverse 解决方案。我使用了您的原始语法以及@StupidWolf 的矩阵建议。在您非常小的数据集上，它的速度似乎大约是原来的两倍。

# https://stackoverflow.com/questions/61371610/apply-function-over-dataframe-including-rbind-statement

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

testdf<-data.frame(a=c(80,1,3,4),b=c(100,200,300,400),c=c(1,2,3,4),d=c(200,250,350,450))

for (i in 1:nrow(testdf)){
  testdf$e[i] <- fisher.test(rbind(c(testdf$a[i],testdf$b[i]),c(testdf$c[i],testdf$d[i])))$p.value
}

testdf <- testdf %>% 
  distinct() %>%
  rowwise() %>% 
  mutate(pvalue1 = fisher.test(rbind(c(a, b), 
                                     c(c, d)))$p.value)

testdf <- testdf %>% 
  distinct() %>%
  rowwise() %>% 
  mutate(pvalue2 = fisher.test(matrix(c(a, b, c, d), 
                                      ncol = 2))$p.value)

testdf
#> Source: local data frame [4 x 7]
#> Groups: <by row>
#> 
#> # A tibble: 4 x 7
#>       a     b     c     d        e  pvalue1  pvalue2
#>   <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl>    <dbl>
#> 1    80   100     1   200 3.00e-30 3.00e-30 3.00e-30
#> 2     1   200     2   250 1.00e+ 0 1.00e+ 0 1.00e+ 0
#> 3     3   300     3   350 1.00e+ 0 1.00e+ 0 1.00e+ 0
#> 4     4   400     4   450 1.00e+ 0 1.00e+ 0 1.00e+ 0
all.equal(testdf$e, testdf$pvalue1)
#> [1] TRUE
all.equal(testdf$e, testdf$pvalue2)
#> [1] TRUE

^{由reprex package (v0.3.0) 于 2020 年 4 月 23 日创建}

Answer 3

您可以尝试将行强制转换为矩阵：

apply(testdf,1,function(i)fisher.test(matrix(i,ncol=2))$p.value)

正如@Chuck 所指出的，它应该是 byrow=TRUE，以测试完全相同的矩阵。我选择了一条捷径，因为使用 fisher.test，您正在测试行和列之间的关联。只要不交换对角线，就可以得到相同的 p 值和优势比

如果您的矩阵确实很大，有几种方法，一种是获取矩阵中的唯一值，然后计算这些 pvalue。

另一种方法是计算the pvalue directly，但这仅适用于单面测试。