funcion - dplyr:: mutate para agregar múltiples valores

funcion select en r

Question

Hay un par de problemas sobre esto en el repositorio de Dplyr Github , y al menos una pregunta de SO relacionada, pero ninguna de ellas cubre mi pregunta, creo.

• Agregar varias columnas en una llamada mutada de dplyr es más o menos lo que quiero, pero hay una respuesta de caso especial para ese caso ( tidyr::separate ) que no (creo) funciona para mí.
• Este problema ("resumir o mutar con funciones que devuelven múltiples valores / columnas") dice "use do() ".

Aquí está mi caso de uso: quiero calcular los intervalos de confianza binomiales exactos

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

Puedo hacer esto con do() pero me pregunto si hay una manera más expresiva de hacerlo (se siente como que mutate() podría tener un argumento .n como se está discutiendo para el resumen () ...)

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

Answer 1

Aquí hay algunas posibilidades con rowwise y nesting .

library("dplyr")
library("tidyr")

Marco de datos con repetidas combinaciones x / n, por diversión

dd <- data.frame(x=c(3, 4, 3), n=c(10, 11, 10))

una versión de la función CI que devuelve un marco de datos, como @ Joran''s

get_binCI_df <- function(x,n) {
  binom.test(x, n)$conf.int %>% 
    setNames(c("lwr", "upr")) %>% 
    as.list() %>% as.data.frame()
}

Agrupando por x y n como antes, elimina el duplicado.

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

El uso de rowwise mantiene todas las filas pero elimina x y n menos que las vuelva a cbind(. usando cbind(. (Como Ben lo hace en su 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

Parece que la anidación podría funcionar de manera más limpia, pero esto es lo mejor que puedo conseguir. Usar mutate significa que puedo usar x y n directamente en lugar de .$x y .$n , pero mutar espera un solo valor, por lo que debe incluirse en la 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

Finalmente, parece que algo como esto es un problema abierto (a partir del 5 de octubre de 2017) para dplyr; vea https://github.com/tidyverse/dplyr/issues/2326 ; Si se implementa algo así, ¡esa será la forma más fácil!

Answer 2

Aquí hay una solución rápida utilizando el paquete data.table lugar

Primero, un pequeño cambio en la función.

get_binCI <- function(x,n) as.list(setNames(binom.test(x,n)$conf.int, c("lwr", "upr")))

Entonces, simplemente

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

Answer 3

Esto utiliza un flujo de trabajo dplyr "estándar", pero como @BenBolker observa en los comentarios, requiere llamar a get_binCI dos veces:

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

Answer 4

Otra opción podría ser usar la familia de funciones purrr::map .

Si reemplaza rbind con dplyr::bind_rows en la función get_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")))
}

Puedes usar purrr::map2 con 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

O purrr::map2_dfr con 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

Answer 5

Otra variante, aunque creo que todos estamos dividiendo los pelos aquí.

> 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

Personalmente, si solo vamos por legibilidad, encuentro esto preferible:

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))

... pero ahora estamos realmente dividiendo los pelos.