Let's say I have the following function:
new_func <- function(.data, .x, .fns, ...){
# Arguments
value_var_expr <- rlang::enquo(.x)
func <- .fns
func_chr <- deparse(substitute(.fns))
passed_args <- list(...)
# New Param Args ----
# I do this because na.rm = TRUE when passed to say quantile gets
# converted to 1 or 100%
if ("na.rm" %in% names(passed_args)) {
tmp_args <- passed_args[!names(passed_args) == "na.rm"]
}
if (!exists("tmp_args")) {
args <- passed_args
} else {
args <- tmp_args
}
ret <- purrr::map(
.x = dplyr::as_tibble(.data),
.f = ~ func(.x, unlist(args)) %>%
purrr::imap(.f = ~ cbind(.x, name = .y)) %>%
purrr::map_df(dplyr::as_tibble)
) %>%
purrr::imap(.f = ~ cbind(.x, sim_number = .y)) %>%
purrr::map_df(dplyr::as_tibble) %>%
dplyr::select(sim_number, name, .x) %>%
dplyr::mutate(.x = as.numeric(.x)) %>%
dplyr::mutate(sim_number = factor(sim_number)) %>%
dplyr::rename(value = .x)
cn <- c("sim_number", "name", func_chr)
names(ret) <- cn
return(ret)
}
Now try using IQR with no additional arguments passed
> new_func(mtcars, mpg, IQR)
Error in if (na.rm) x <- x[!is.na(x)] else if (anyNA(x)) stop("missing values and NaN's not allowed if 'na.rm' is FALSE") :
argument is of length zero
Passing only na.rm = TRUE
> new_func(mtcars, mpg, IQR, na.rm = TRUE)
Error in if (na.rm) x <- x[!is.na(x)] else if (anyNA(x)) stop("missing values and NaN's not allowed if 'na.rm' is FALSE") :
argument is of length zero
Passing type = 7
> new_func(mtcars, mpg, IQR, type = 7)
# A tibble: 11 × 3
sim_number name IQR
<fct> <dbl> <dbl>
1 mpg 1 7.38
2 cyl 1 4
3 disp 1 205.
4 hp 1 83.5
5 drat 1 0.84
6 wt 1 1.03
7 qsec 1 2.01
8 vs 1 1
9 am 1 1
10 gear 1 1
11 carb 1 2
Now I cannot pass simply ... like I could if I were doing say ret <- sapply(.data, .x, ...)
How can I correct this? I did try doing something like dots <- rlang::enquos(...) and then doing func(.x, !!!dots) which also fails.
CodePudding user response：
I'm not sure if I'm understanding this completely, but I think the issue is that you're passing an empty list as an argument.
This might be a solution:
library(tidyverse)
new_func <- function(.data, .x, .fns, ...){
# Arguments
value_var_expr <- rlang::enquo(.x)
func <- .fns
func_chr <- deparse(substitute(.fns))
passed_args <- list(...)
# New Param Args ----
# I do this because na.rm = TRUE when passed to say quantile gets
# converted to 1 or 100%
if ("na.rm" %in% names(passed_args)) {
args <- passed_args[!names(passed_args) == "na.rm"]
} else {
args <- passed_args
}
if (length(args) < 0) {
args <- NULL
}
ret <- purrr::map(
.x = dplyr::as_tibble(.data),
.f = ~ func(.x, unlist(args)) %>%
purrr::imap(.f = ~ cbind(.x, name = .y)) %>%
purrr::map_df(dplyr::as_tibble)
) %>%
purrr::imap(.f = ~ cbind(.x, sim_number = .y)) %>%
purrr::map_df(dplyr::as_tibble) %>%
dplyr::select(sim_number, name, .x) %>%
dplyr::mutate(.x = as.numeric(.x)) %>%
dplyr::mutate(sim_number = factor(sim_number)) %>%
dplyr::rename(value = .x)
cn <- c("sim_number", "name", func_chr)
names(ret) <- cn
return(ret)
}
new_func(mtcars, mpg, IQR, type = 7, na.rm = TRUE)
#> # A tibble: 11 × 3
#> sim_number name IQR
#> <fct> <dbl> <dbl>
#> 1 mpg 1 7.38
#> 2 cyl 1 4
#> 3 disp 1 205.
#> 4 hp 1 83.5
#> 5 drat 1 0.84
#> 6 wt 1 1.03
#> 7 qsec 1 2.01
#> 8 vs 1 1
#> 9 am 1 1
#> 10 gear 1 1
#> 11 carb 1 2
CodePudding user response：
We may need to take care of the cases where args returns length 0
new_func <- function(.data, .x, .fns, ...){
# Arguments
value_var_expr <- rlang::enquo(.x)
func <- .fns
func_chr <- deparse(substitute(.fns))
passed_args <- list(...)
if(length(passed_args) > 0) {
# New Param Args ----
# I do this because na.rm = TRUE when passed to say quantile gets
# converted to 1 or 100%
if ("na.rm" %in% names(passed_args)) {
tmp_args <- passed_args[!names(passed_args) == "na.rm"]
}
if (!exists("tmp_args")) {
args <- passed_args
} else {
args <- tmp_args
}
} else {
args <- NULL
}
if(length(args) == 0) args <- NULL
ret <- purrr::map(
.x = dplyr::as_tibble(.data),
.f = ~ if(is.null(args)) func(.x) else func(.x, unlist(args)) %>%
purrr::imap(.f = ~ cbind(.x, name = .y)) %>%
purrr::map_df(dplyr::as_tibble)
) %>%
purrr::imap(.f = ~ cbind(.x, sim_number = .y)) %>%
purrr::map_dfr(dplyr::as_tibble, .id = 'name') %>%
dplyr::select(sim_number, name, `.x`) %>%
dplyr::mutate(.x = as.numeric(.x)) %>%
dplyr::mutate(sim_number = factor(sim_number)) %>%
dplyr::rename(value = .x)
cn <- c("sim_number", "name", func_chr)
names(ret) <- cn
return(ret)
}
-testing
> new_func(mtcars, mpg, IQR, na.rm = TRUE)
# A tibble: 11 × 3
sim_number name IQR
<fct> <chr> <dbl>
1 mpg mpg 7.38
2 cyl cyl 4
3 disp disp 205.
4 hp hp 83.5
5 drat drat 0.84
6 wt wt 1.03
7 qsec qsec 2.01
8 vs vs 1
9 am am 1
10 gear gear 1
11 carb carb 2
> new_func(mtcars, mpg, IQR)
# A tibble: 11 × 3
sim_number name IQR
<fct> <chr> <dbl>
1 mpg mpg 7.38
2 cyl cyl 4
3 disp disp 205.
4 hp hp 83.5
5 drat drat 0.84
6 wt wt 1.03
7 qsec qsec 2.01
8 vs vs 1
9 am am 1
10 gear gear 1
11 carb carb 2
>
> new_func(mtcars, mpg, IQR, type = 7)
# A tibble: 11 × 3
sim_number name IQR
<fct> <chr> <dbl>
1 mpg mpg 7.38
2 cyl cyl 4
3 disp disp 205.
4 hp hp 83.5
5 drat drat 0.84
6 wt wt 1.03
7 qsec qsec 2.01
8 vs vs 1
9 am am 1
10 gear gear 1
11 carb carb 2