I want to apply a function, which name is stored in a column as a string, on a value in another column, using dplyr. I have tried several things using mutate_
and a .dots
argument, but I am stuck now.
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))
input:
> 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
output:
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
One way , I could think of is using creating a lookup table and then getting the correct output format using 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"
Although, this gives a warning message but still the output is correct.
If we need this in a dplyr
chain
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
We can use 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
Another option is 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
NOTE: Without making any additional effort in creating look up tables
You can try that with do.call
but you have to use 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))))
To go full tidyverse here, we can use purrr's invoke_map()
function. It takes a list of functions and a list of lists of parameter values to use for each function. It's like a vectorized do.call()
.
The lubridate functions in df$fun
expect an argument x
, so we need to create a list of lists with each date stored as an element named x
. We can create a list-column of data-frames by copying the date column and using 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]>
Each element in the column params
is a data-frame with a column x
. This is our list of lists.
df2$params[1]
#> [[1]]
#> # A tibble: 1 × 1
#> x
#> <dttm>
#> 1 2017-01-02 22:51:36
With our two lists, we can use invoke_map()
and get a list of results.
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
But because we know that these functions return just one numeric value each, we can get the results in a nice vector with 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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.