关于dplyr Github repo已经存在一些问题,至少有一个相关的SO问题,但是没有一个问题完全覆盖了我的问题 - 我想.
tidyr::separate(我认为)不适合我的情况()有一个特殊情况的答案.do()".这是我的用例:我想计算精确的二项式置信区间
dd <- data.frame(x=c(3,4),n=c(10,11))
get_binCI <- function(x,n) {
rbind(setNames(c(binom.test(x,n)$conf.int),c("lwr","upr")))
}
with(dd[1,],get_binCI(x,n))
## lwr upr
## [1,] 0.06673951 0.6524529
Run Code Online (Sandbox Code Playgroud)
我可以完成这项工作,do()但我想知道是否有一种更具表现力的方式来做到这一点(感觉mutate() 可能有一个.n参数正在讨论总结() ...)
library("dplyr")
dd %>% group_by(x,n) %>%
do(cbind(.,get_binCI(.$x,.$n)))
## Source: local data frame [2 x 4]
## Groups: x, n
##
## x n lwr upr
## 1 3 10 0.06673951 0.6524529
## 2 4 11 0.10926344 0.6920953
Run Code Online (Sandbox Code Playgroud)
jor*_*ran 13
另一种变体,虽然我认为我们都在这里分裂.
> dd <- data.frame(x=c(3,4),n=c(10,11))
> get_binCI <- function(x,n) {
+ as_data_frame(setNames(as.list(binom.test(x,n)$conf.int),c("lwr","upr")))
+ }
>
> dd %>%
+ group_by(x,n) %>%
+ do(get_binCI(.$x,.$n))
Source: local data frame [2 x 4]
Groups: x, n
x n lwr upr
1 3 10 0.06673951 0.6524529
2 4 11 0.10926344 0.6920953
Run Code Online (Sandbox Code Playgroud)
就个人而言,如果我们只是通过可读性,我发现这更可取:
foo <- function(x,n){
bi <- binom.test(x,n)$conf.int
data_frame(lwr = bi[1],
upr = bi[2])
}
dd %>%
group_by(x,n) %>%
do(foo(.$x,.$n))
Run Code Online (Sandbox Code Playgroud)
......但现在我们真的在分裂头发.
mar*_*dly 10
另一种选择可能是使用purrr::map一系列功能.
如果在函数中替换rbind为:
dplyr::bind_rowsget_binCI
library(tidyverse)
dd <- data.frame(x = c(3, 4), n = c(10, 11))
get_binCI <- function(x, n) {
bind_rows(setNames(c(binom.test(x, n)$conf.int), c("lwr", "upr")))
}
Run Code Online (Sandbox Code Playgroud)
你可以用purrr::map2与tidyr::unnest:
dd %>% mutate(result = map2(x, n, get_binCI)) %>% unnest()
#> x n lwr upr
#> 1 3 10 0.06673951 0.6524529
#> 2 4 11 0.10926344 0.6920953
Run Code Online (Sandbox Code Playgroud)
或purrr::map2_dfr用dplyr::bind_cols:
dd %>% bind_cols(map2_dfr(.$x, .$n, get_binCI))
#> x n lwr upr
#> 1 3 10 0.06673951 0.6524529
#> 2 4 11 0.10926344 0.6920953
Run Code Online (Sandbox Code Playgroud)
这里有一些使用rowwise和 的可能性nesting。
library("dplyr")
library("tidyr")
Run Code Online (Sandbox Code Playgroud)
具有重复 x/n 组合的数据框,为了好玩
dd <- data.frame(x=c(3, 4, 3), n=c(10, 11, 10))
Run Code Online (Sandbox Code Playgroud)
返回数据帧的 CI 函数的一个版本,如@Joran 的
get_binCI_df <- function(x,n) {
binom.test(x, n)$conf.int %>%
setNames(c("lwr", "upr")) %>%
as.list() %>% as.data.frame()
}
Run Code Online (Sandbox Code Playgroud)
x和n以前一样分组,删除重复项。
dd %>% group_by(x,n) %>% do(get_binCI_df(.$x,.$n))
# # A tibble: 2 x 4
# # Groups: x, n [2]
# x n lwr upr
# <dbl> <dbl> <dbl> <dbl>
# 1 3 10 0.1181172 0.8818828
# 2 4 11 0.1092634 0.6920953
Run Code Online (Sandbox Code Playgroud)
Usingrowwise保留所有行,但会删除x,n除非您将它们放回 using cbind(.(就像 Ben 在他的 OP 中所做的那样)。
dd %>% rowwise() %>% do(cbind(., get_binCI_df(.$x,.$n)))
# Source: local data frame [3 x 4]
# Groups: <by row>
#
# # A tibble: 3 x 4
# x n lwr upr
# * <dbl> <dbl> <dbl> <dbl>
# 1 3 10 0.06673951 0.6524529
# 2 4 11 0.10926344 0.6920953
# 3 3 10 0.06673951 0.6524529
Run Code Online (Sandbox Code Playgroud)
感觉嵌套可以更干净地工作,但这是我所能得到的。Usingmutate意味着我可以直接使用xandn代替.$xand .$n,但是 mutate 需要一个值,所以它需要被包裹在list.
dd %>% rowwise() %>% mutate(ci=list(get_binCI_df(x, n))) %>% unnest()
# # A tibble: 3 x 4
# x n lwr upr
# <dbl> <dbl> <dbl> <dbl>
# 1 3 10 0.06673951 0.6524529
# 2 4 11 0.10926344 0.6920953
# 3 3 10 0.06673951 0.6524529
Run Code Online (Sandbox Code Playgroud)
最后,对于 dplyr 来说,这似乎是一个悬而未决的问题(截至 2017 年 10 月 5 日);见https://github.com/tidyverse/dplyr/issues/2326;如果实现了类似的东西,那将是最简单的方法!
这是使用data.table包的快速解决方案
首先,对功能稍作改动
get_binCI <- function(x,n) as.list(setNames(binom.test(x,n)$conf.int, c("lwr", "upr")))
Run Code Online (Sandbox Code Playgroud)
然后,简单地说
library(data.table)
setDT(dd)[, get_binCI(x, n), by = .(x, n)]
# x n lwr upr
# 1: 3 10 0.06673951 0.6524529
# 2: 4 11 0.10926344 0.6920953
Run Code Online (Sandbox Code Playgroud)
这使用了"标准"dplyr工作流程,但正如@BenBolker在评论中指出的那样,它需要调用get_binCI两次:
dd %>% group_by(x,n) %>%
mutate(lwr=get_binCI(x,n)[1],
upr=get_binCI(x,n)[2])
x n lwr upr
1 3 10 0.06673951 0.6524529
2 4 11 0.10926344 0.6920953
Run Code Online (Sandbox Code Playgroud)