R dplyr：将函数用作下一列中的一列中的字符串答案

【问题标题】：R dplyr: Use the function as a string in one column on the next columnR dplyr：将函数用作下一列中的一列中的字符串
【发布时间】：2017-02-01 09:21:27
【问题描述】：

我想使用 dplyr 在另一列中的值上应用一个函数，该函数的名称作为字符串存储在列中。我使用mutate_ 和.dots 参数尝试了几件事，但我现在卡住了。

library(lubridate)
library(dplyr)

df <- data.frame(date=as.POSIXct('2017/01/01 12:34') + 1:10*123456,
                 fun=rep(c('minute','hour','day','month','year'),2))

输入：

> df
                  date    fun
1  2017-01-02 22:51:36 minute
2  2017-01-04 09:09:12   hour
3  2017-01-05 19:26:48    day
4  2017-01-07 05:44:24  month
5  2017-01-08 16:02:00   year
6  2017-01-10 02:19:36 minute
7  2017-01-11 12:37:12   hour
8  2017-01-12 22:54:48    day
9  2017-01-14 09:12:24  month
10 2017-01-15 19:30:00   year

输出：

                  date    fun  res
1  2017-01-02 22:51:36 minute   51
2  2017-01-04 09:09:12   hour    9
3  2017-01-05 19:26:48    day    5
4  2017-01-07 05:44:24  month    1
5  2017-01-08 16:02:00   year 2017
6  2017-01-10 02:19:36 minute   19
7  2017-01-11 12:37:12   hour   12
8  2017-01-12 22:54:48    day   12
9  2017-01-14 09:12:24  month    1
10 2017-01-15 19:30:00   year 2017

【问题讨论】：

标签： r dplyr lubridate

【解决方案1】：

我能想到的一种方法是使用创建查找表，然后使用 match 获取正确的输出格式

x <- c("minute", "hour", "day", "month", "year")
y <- c("%M", "%H", "%d", "%m", "%Y")

format(df$date, format = y[match(df$fun, x)])
#[1] "51"   "09"   "05"   "01"   "2017" "19"   "12"   "12"   "01"   "2017"

虽然这会给出警告消息，但输出仍然正确。

如果我们在 dplyr 链中需要这个

library(dplyr)
df %>%
  mutate(res = format(date, format = y[match(df$fun, x)])) 


#                 date    fun   res
#1  2017-01-02 22:51:36 minute   51
#2  2017-01-04 09:09:12   hour   09
#3  2017-01-05 19:26:48    day   05
#4  2017-01-07 05:44:24  month   01
#5  2017-01-08 16:02:00   year 2017
#6  2017-01-10 02:19:36 minute   19
#7  2017-01-11 12:37:12   hour   12
#8  2017-01-12 22:54:48    day   12
#9  2017-01-14 09:12:24  month   01
#10 2017-01-15 19:30:00   year 2017

【讨论】：

我喜欢这个。矢量化ftw。
感谢您的回答。这也是一个非常优雅的解决方案

【解决方案2】：

你可以试试do.call，但你必须使用rowwise：

library("dplyr")
library("lubridate")

df <- data.frame(
  date = as.POSIXct('2017/01/01 12:34') + 1:10*123456,
  fun = rep(c('minute','hour','day','month','year'),2),
  stringsAsFactors = FALSE
)

df %>% rowwise() %>% mutate(res = as.character(do.call(fun, list(date))))

【讨论】：

虽然我也喜欢所有其他答案，但这个答案最接近我最初的想法。

【解决方案3】：

我们可以使用mapply

df$res <- mapply(function(x,y) get(x)(y), as.character(df$fun), df$date)
df$res
#[1]   51    9    5    1 2017   19   12   12    1 2017

另一个选项是data.table

library(data.table)
setDT(df)[, res := as.integer(get(as.character(fun))(date)), 1:nrow(df)]
df
#                  date    fun  res
#1: 2017-01-02 22:51:36 minute   51
#2: 2017-01-04 09:09:12   hour    9
#3: 2017-01-05 19:26:48    day    5
#4: 2017-01-07 05:44:24  month    1
#5: 2017-01-08 16:02:00   year 2017
#6: 2017-01-10 02:19:36 minute   19
#7: 2017-01-11 12:37:12   hour   12
#8: 2017-01-12 22:54:48    day   12
#9: 2017-01-14 09:12:24  month    1
#10: 2017-01-15 19:30:00   year 2017

注意：无需在创建查找表时做任何额外的努力

【讨论】：

有没有办法在dplyr 链中实现这一点？
@Wietze314 你可以使用来自purrr 的map，这也是tidyverse 的一部分
感谢您的回答。我有兴趣了解更多关于 purrr（以及我一直推迟的 data.table）的信息。
我不知道你可以将get()与函数一起使用，我在这里学到了一些东西。

【解决方案4】：

要在这里完整地整理一下，我们可以使用 purrr 的 invoke_map() 函数。它需要一个函数列表和一个用于每个函数的参数值列表。这就像一个矢量化的do.call()。

df$fun 中的 lubridate 函数需要一个参数 x，因此我们需要创建一个列表列表，其中每个日期存储为一个名为 x 的元素。我们可以通过复制日期列并使用nest() 来创建数据框的列表列。

df2 <- df %>% 
  mutate(x = date) %>% 
  tidyr::nest(x, .key = "params") 
df2
#> # A tibble: 10 × 3
#>                    date    fun            params
#>                   <dttm>  <chr>           <list>
#>   1  2017-01-02 22:51:36 minute <tibble [1 × 1]>
#>   2  2017-01-04 09:09:12   hour <tibble [1 × 1]>
#>   3  2017-01-05 19:26:48    day <tibble [1 × 1]>
#>   4  2017-01-07 05:44:24  month <tibble [1 × 1]>
#>   5  2017-01-08 16:02:00   year <tibble [1 × 1]>
#>   6  2017-01-10 02:19:36 minute <tibble [1 × 1]>
#>   7  2017-01-11 12:37:12   hour <tibble [1 × 1]>
#>   8  2017-01-12 22:54:48    day <tibble [1 × 1]>
#>   9  2017-01-14 09:12:24  month <tibble [1 × 1]>
#>   10 2017-01-15 19:30:00   year <tibble [1 × 1]>

params 列中的每个元素都是一个带有x 列的数据框。这是我们的列表。

df2$params[1]
#> [[1]]
#> # A tibble: 1 × 1
#>                      x
#>                  <dttm>
#>   1 2017-01-02 22:51:36

通过我们的两个列表，我们可以使用invoke_map() 并获取结果列表。

str(purrr::invoke_map(df2$fun, df2$params))
#> List of 10
#> $ : int 51
#> $ : int 9
#> $ : int 5
#> $ : num 1
#> $ : num 2017
#> $ : int 19
#> $ : int 12
#> $ : int 12
#> $ : num 1
#> $ : num 2017

但是因为我们知道这些函数每个都只返回一个数值，所以我们可以用invoke_map_dbl() 将结果放在一个漂亮的向量中。

df2 %>% 
  mutate(res = purrr::invoke_map_dbl(fun, params)) %>% 
  select(-params)
#> # A tibble: 10 × 3
#>                   date    fun   res
#>                 <dttm>  <chr> <dbl>
#> 1  2017-01-02 22:51:36 minute    51
#> 2  2017-01-04 09:09:12   hour     9
#> 3  2017-01-05 19:26:48    day     5
#> 4  2017-01-07 05:44:24  month     1
#> 5  2017-01-08 16:02:00   year  2017
#> 6  2017-01-10 02:19:36 minute    19
#> 7  2017-01-11 12:37:12   hour    12
#> 8  2017-01-12 22:54:48    day    12
#> 9  2017-01-14 09:12:24  month     1
#> 10 2017-01-15 19:30:00   year  2017

【讨论】：