调整功能以使用dplyr / magrittr

时间:2017-03-20 14:10:10

标签: r dplyr magrittr nse

我有:

df <- data_frame(
  a = 1:2, 
  b = list(1:10, 4:40)
)

foo <- function(x) mean(unlist(x))

以下按预期方式工作:

df$b %>% foo

但是,我无法确定foo需要对df %>% foo(b)进行哪些修改才能正常工作。

3 个答案:

答案 0 :(得分:6)

您可以将...参数直接传递给vars的{​​{1}}助手,例如

summarise_at

它适用于单个变量,是否列出列:

foo <- function(.tbl, ...){
    summarise_at(.tbl, 
                 vars(...), 
                 funs(mean(unlist(.))))
}

或多个:

df %>% foo(b)
## # A tibble: 1 × 1
##          b
##      <dbl>
## 1 18.48936

要进一步了解NSE,请查看lazyeval,这是dplyr用于实现其NSE的软件包。

另请注意,dplyr的SE / NSE系统刚刚在开发版本中重建(尚未在CRAN上重建,尚未记录)。

奖励积分:在基础R中完成所有工作!

df %>% foo(a, b)
## # A tibble: 1 × 2
##       a        b
##   <dbl>    <dbl>
## 1   1.5 18.48936

适用于列表列,组和多个列或组,保持类但丢弃分组:

foo <- function(.tbl, ...){
    # collect dots as character vector
    cols <- as.character(substitute(list(...))[-1])
    cls <- class(.tbl)

    # handle grouped tibbles properly
    if('grouped_df' %in% cls){
        cls <- cls[which(cls != 'grouped_df')]    # drop grouping
        res <- aggregate(.tbl[cols], 
                         .tbl[attr(.tbl, 'vars')], 
                         FUN = function(x){mean(unlist(x))})
    } else {
        res <- as.data.frame(lapply(.tbl[cols], function(x){mean(unlist(x))}))
    }

    class(res) <- cls    # keep class (tibble, etc.)
    res
}

答案 1 :(得分:4)

你可以这样得到结果:

library(dplyr)
library(purrr)
df %>% 
    mutate_(mn=~map_dbl(b, mean), size=~map_dbl(b, length)) %>%
    summarize_(m=~weighted.mean(mn, size))
#  m
#   <dbl>
# 1 18.49

或者以这种方式定义foo

foo2 <- function(d, col) {
    col_name <- as.character(substitute(col))
    mean(unlist(d[[col_name]]))
}
df %>% foo2(b)
[1] 18.49

答案 2 :(得分:4)

您可以使用以下内容更新该功能:

foo <- function(df, x) {
  x <- df[ deparse(substitute(x))] 
  mean(unlist(x)) }

df %>% foo(b)
[1] 18.48936