【问题标题】:How to feed a list of unquoted column names into `lapply` (so that I can use it with a `dplyr` function)如何将未加引号的列名列表提供给`lapply`(以便我可以将它与`dplyr`函数一起使用)
【发布时间】:2018-04-29 09:22:31
【问题描述】:

我正在尝试在tidyverse/dplyr 中编写一个函数,我希望最终与lapply(或map)一起使用。 (我一直在努力解决answer this question,但遇到了一个有趣的结果/死胡同。请不要将此标记为重复 - 这个问题是您在那里看到的答案的延伸/背离。)

是否有
1) 一种方法来获取引用变量列表以在 dplyr 函数中工作
(并且不使用已弃用的 SE_ 函数)或者是否存在
2)通过lapplymap 提供未引用字符串列表的某种方式

我使用Programming in Dplyr 小插图构建了我认为最符合当前标准的功能 与 NSE 合作。

样本数据:

sample_data <- 
    read.table(text = "REVENUEID AMOUNT  YEAR REPORT_CODE PAYMENT_METHOD INBOUND_CHANNEL  AMOUNT_CAT
               1 rev-24985629     30  FY18           S          Check            Mail     25,50
               2 rev-22812413      1  FY16           Q          Other      Canvassing   0.01,10
               3 rev-23508794    100  FY17           Q    Credit_card             Web   100,250
               4 rev-23506121    300  FY17           S    Credit_card            Mail   250,500
               5 rev-23550444    100  FY17           S    Credit_card             Web   100,250
               6 rev-21508672     25  FY14           J          Check            Mail     25,50
               7 rev-24981769    500  FY18           S    Credit_card             Web 500,1e+03
               8 rev-23503684     50  FY17           R          Check            Mail     50,75
               9 rev-24982087     25  FY18           R          Check            Mail     25,50
               10 rev-24979834     50  FY18           R    Credit_card             Web    50,75
                      ", header = TRUE, stringsAsFactors = FALSE)

报表生成函数

report <- function(report_cat){
    report_cat <- enquo(report_cat)
    sample_data %>%
    group_by(!!report_cat, YEAR) %>%
    summarize(num=n(),total=sum(AMOUNT)) %>% 
    rename(REPORT_VALUE = !!report_cat) %>% 
    mutate(REPORT_CATEGORY := as.character(quote(!!report_cat))[2])
}

这对于生成单个报告很有效:

> report(REPORT_CODE)
# A tibble: 7 x 5
# Groups:   REPORT_VALUE [4]
  REPORT_VALUE  YEAR   num total REPORT_CATEGORY
         <chr> <chr> <int> <int>           <chr>
1            J  FY14     1    25     REPORT_CODE
2            Q  FY16     1     1     REPORT_CODE
3            Q  FY17     1   100     REPORT_CODE
4            R  FY17     1    50     REPORT_CODE
5            R  FY18     2    75     REPORT_CODE
6            S  FY17     2   400     REPORT_CODE
7            S  FY18     2   530     REPORT_CODE

当我尝试设置要生成的所有 4 个报告的列表时,一切都崩溃了。 (诚​​然,函数最后一行所需的代码——返回一个用于填充列的字符串——应该足以说明我已经走错了方向。)

#the other reports
cat.list <- c("REPORT_CODE","PAYMENT_METHOD","INBOUND_CHANNEL","AMOUNT_CAT")

# Applying and Mapping attempts 
lapply(cat.list, report)
map_df(cat.list, report)

结果:

> lapply(cat.list, report)  
 Error in (function (x, strict = TRUE)  : 
  the argument has already been evaluated  

> map_df(cat.list, report)
 Error in (function (x, strict = TRUE)  : 
  the argument has already been evaluated

我还尝试将字符串列表转换为名称,然后再将其交给applymap

library(rlang)
cat.names <- lapply(cat.list, sym)
lapply(cat.names, report)
map_df(cat.names, report)
> lapply(cat.names, report)
 Error in (function (x, strict = TRUE)  : 
  the argument has already been evaluated 
> map_df(cat.names, report)
 Error in (function (x, strict = TRUE)  : 
  the argument has already been evaluated

无论如何,我问这个问题的原因是我认为我已经按照当前记录的标准编写了函数,但最终我看不到任何方法可以利用 apply 的成员甚至purrr::map 家族有这样的功能。除了重写函数以使用 namesuser 在这里完成 https://stackoverflow.com/a/47316151/5088194 有没有办法让这个函数与 applymap 一起使用?

我希望看到这个结果:

# A tibble: 27 x 5
# Groups:   REPORT_VALUE [16]
   REPORT_VALUE  YEAR   num total REPORT_CATEGORY
          <chr> <chr> <int> <int>           <chr>
 1            J  FY14     1    25     REPORT_CODE
 2            Q  FY16     1     1     REPORT_CODE
 3            Q  FY17     1   100     REPORT_CODE
 4            R  FY17     1    50     REPORT_CODE
 5            R  FY18     2    75     REPORT_CODE
 6            S  FY17     2   400     REPORT_CODE
 7            S  FY18     2   530     REPORT_CODE
 8        Check  FY14     1    25  PAYMENT_METHOD
 9        Check  FY17     1    50  PAYMENT_METHOD
10        Check  FY18     2    55  PAYMENT_METHOD
# ... with 17 more rows

【问题讨论】:

  • 很好的后续问题。有关symsquos 的解释,请参阅我的答案

标签: r dplyr tidyverse rlang lazyeval


【解决方案1】:

as.name 将字符串转换为名称,并可以传递给report

lapply(cat.list, function(x) do.call("report", list(as.name(x))))

字符参数另一种方法是重写report,使其接受字符串参数:

report_ch <- function(colname) {  
    report_cat <- rlang::sym(colname)   # as.name(colname) would also work here
    sample_data %>%
                group_by(!!report_cat, YEAR) %>%
                summarize(num = n(), total = sum(AMOUNT)) %>% 
                rename(REPORT_VALUE = !!report_cat) %>% 
                mutate(REPORT_CATEGORY = colname)
}

lapply(cat.list, report_ch)

wrapr 另一种方法是使用 wrapr 包重写 report,这是 rlang/tidyeval 的替代方案:

library(dplyr)
library(wrapr)

report_wrapr <- function(colname) 
  let(c(COLNAME = colname),
      sample_data %>%
                  group_by(COLNAME, YEAR) %>%
                  summarize(num = n(), total = sum(AMOUNT)) %>%
                  rename(REPORT_VALUE = COLNAME) %>%
                  mutate(REPORT_CATEGORY = colname)
   )

lapply(cat.list, report_wrapr)

当然,如果你使用不同的框架,这整个问题就会消失,例如

plyr

library(plyr)

report_plyr <- function(colname)
  ddply(sample_data, c(REPORT_VALUE = colname, "YEAR"), function(x)
     data.frame(num = nrow(x), total = sum(x$AMOUNT), REPORT_CATEOGRY = colname))

lapply(cat.list, report_plyr)

sqldf

library(sqldf)

report_sql <- function(colname, envir = parent.frame(), ...)
  fn$sqldf("select [$colname] REPORT_VALUE,
                   YEAR,
                   count(*) num,
                   sum(AMOUNT) total,
                   '$colname' REPORT_CATEGORY
            from sample_data
            group by [$colname], YEAR", envir = envir, ...)

lapply(cat.list, report_sql)              

基础 - 由

report_base_by <- function(colname)
      do.call("rbind", 
        by(sample_data, sample_data[c(colname, "YEAR")], function(x)
            data.frame(REPORT_VALUE = x[1, colname], 
                       YEAR = x$YEAR[1], 
                       num = nrow(x), 
                       total = sum(x$AMOUNT), 
                       REPORT_CATEGORY = colname)
         )
      )

lapply(cat.list, report_base_by)

data.table data.table 包提供了另一种选择,但已经被另一个答案所涵盖。

更新:添加了其他替代方案。

【讨论】:

  • 如此全面且精心设计的解决方案集合。这几天我会继续拆开这些东西——这里有很多东西要学。谢谢!
【解决方案2】:

我并不是真正的 dplyr 爱好者,但它的价值在于您如何使用 library(data.table) 来实现这一目标:

setDT(sample_data)

gen_report <- function(report_cat){
  sample_data[ , .(num = .N, total = sum(AMOUNT), REPORT_CATEGORY = report_cat), 
               by = .(REPORT_VALUE = get(report_cat), YEAR)] 
}

gen_report('REPORT_CODE')
lapply(cat.list, gen_report)

【讨论】:

    【解决方案3】:

    首先让我指出,在您最初的report 函数中,您可以使用quo_name 将quosure 转换为字符串,然后您可以在mutate 中使用,如下所示:

    library(dplyr)
    library(rlang)
    
    report <- function(report_cat){
      report_cat <- enquo(report_cat)
    
      sample_data %>%
        group_by(!!report_cat, YEAR) %>%
        summarize(num=n(),total=sum(AMOUNT)) %>%
        rename(REPORT_VALUE = !!report_cat) %>%
        mutate(REPORT_CATEGORY = quo_name(report_cat))
    }
    
    report(REPORT_CODE)
    

    现在,为了解决您的“如何通过lapplymap 提供不带引号的字符串列表以使其在dplyr 函数中工作”的问题,我提出了两种方法。

    1。使用rlang::sym 解析你的字符串并在输入lapplymap 时取消引用它

    library(purrr)
    
    cat.list <- c("REPORT_CODE","PAYMENT_METHOD","INBOUND_CHANNEL","AMOUNT_CAT")
    
    map_df(cat.list, ~report(!!sym(.)))    
    

    或使用syms,您可以一次解析向量的所有元素:

    map_df(syms(cat.list), ~report(!!.))
    

    结果:

    # A tibble: 27 x 5
    # Groups:   REPORT_VALUE [16]
       REPORT_VALUE  YEAR   num total REPORT_CATEGORY
              <chr> <chr> <int> <int>           <chr>
     1            J  FY14     1    25     REPORT_CODE
     2            Q  FY16     1     1     REPORT_CODE
     3            Q  FY17     1   100     REPORT_CODE
     4            R  FY17     1    50     REPORT_CODE
     5            R  FY18     2    75     REPORT_CODE
     6            S  FY17     2   400     REPORT_CODE
     7            S  FY18     2   530     REPORT_CODE
     8        Check  FY14     1    25  PAYMENT_METHOD
     9        Check  FY17     1    50  PAYMENT_METHOD
    10        Check  FY18     2    55  PAYMENT_METHOD
    # ... with 17 more rows 
    

    2。通过将 lapplymap inside 重写您的 report 函数,以便 report 可以执行 NSE

    report <- function(...){
      report_cat <- quos(...)
    
      map_df(report_cat, function(x) sample_data %>%
                 group_by(!!x, YEAR) %>%
                 summarize(num=n(),total=sum(AMOUNT)) %>%
                 rename(REPORT_VALUE = !!x) %>%
                 mutate(REPORT_CATEGORY = quo_name(x)))
    }
    

    通过将map_df 放在report 中,您可以利用quos,它将... 转换为quosures 列表。然后将它们输入map_df,并使用!! 逐一取消引用。

    report(REPORT_CODE, PAYMENT_METHOD, INBOUND_CHANNEL, AMOUNT_CAT)
    

    这样写的另一个好处是,您还可以提供一个字符串符号向量并使用!!! 将它们拼接起来,如下所示:

    report(!!!syms(cat.list))
    

    结果:

    # A tibble: 27 x 5
    # Groups:   REPORT_VALUE [16]
       REPORT_VALUE  YEAR   num total REPORT_CATEGORY
              <chr> <chr> <int> <int>           <chr>
     1            J  FY14     1    25     REPORT_CODE
     2            Q  FY16     1     1     REPORT_CODE
     3            Q  FY17     1   100     REPORT_CODE
     4            R  FY17     1    50     REPORT_CODE
     5            R  FY18     2    75     REPORT_CODE
     6            S  FY17     2   400     REPORT_CODE
     7            S  FY18     2   530     REPORT_CODE
     8        Check  FY14     1    25  PAYMENT_METHOD
     9        Check  FY17     1    50  PAYMENT_METHOD
    10        Check  FY18     2    55  PAYMENT_METHOD
    # ... with 17 more rows
    

    【讨论】:

    • 哇,我想我已经学到了 7 件新东西,而且我只完成了你所有解决方案的一半。有这么多有趣的层需要考虑。我想我开始认识到为什么函数式编程会以如此恭敬的语气被提及。谢谢!
    • @JensLeerssen 很高兴它有帮助。你总是每天都能学到一些东西:)
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2017-09-10
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多