将函数和参数传递给函数并 purrr

Question

假设我有以下功能：

\n

new_func <- function(.data, .x, .fns, ...){\n  \n  # Arguments\n  value_var_expr <- rlang::enquo(.x)\n  func <- .fns\n  func_chr <- deparse(substitute(.fns))\n  passed_args <- list(...)\n  \n  # New Param Args ----\n  # I do this because na.rm = TRUE when passed to say quantile gets\n  # converted to 1 or 100%\n  if ("na.rm" %in% names(passed_args)) {\n    tmp_args <- passed_args[!names(passed_args) == "na.rm"]\n  }\n  \n  if (!exists("tmp_args")) {\n    args <- passed_args\n  } else {\n    args <- tmp_args\n  }\n  \n  ret <- purrr::map(\n    .x = dplyr::as_tibble(.data), \n    .f = ~ func(.x, unlist(args)) %>%\n      purrr::imap(.f = ~ cbind(.x, name = .y)) %>%\n      purrr::map_df(dplyr::as_tibble)\n  ) %>%\n    purrr::imap(.f = ~ cbind(.x, sim_number = .y)) %>%\n    purrr::map_df(dplyr::as_tibble) %>%\n    dplyr::select(sim_number, name, .x) %>%\n    dplyr::mutate(.x = as.numeric(.x)) %>%\n    dplyr::mutate(sim_number = factor(sim_number)) %>%\n    dplyr::rename(value = .x)\n  \n  cn <- c("sim_number", "name", func_chr)\n  names(ret) <- cn\n  \n  return(ret)\n  \n}\n

\n

现在尝试使用IQR不传递额外参数

\n

> new_func(mtcars, mpg, IQR)\n 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") : \nargument is of length zero\n

\n

仅通过na.rm = TRUE

\n

> new_func(mtcars, mpg, IQR, na.rm = TRUE)\n 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") : \nargument is of length zero\n

\n

通过type = 7

\n

> new_func(mtcars, mpg, IQR, type = 7)\n# A tibble: 11 \xc3\x97 3\n   sim_number  name    IQR\n   <fct>      <dbl>  <dbl>\n 1 mpg            1   7.38\n 2 cyl            1   4   \n 3 disp           1 205.  \n 4 hp             1  83.5 \n 5 drat           1   0.84\n 6 wt             1   1.03\n 7 qsec           1   2.01\n 8 vs             1   1   \n 9 am             1   1   \n10 gear           1   1   \n11 carb           1   2   \n

\n

现在我不能...像我那样简单地通过ret <- sapply(.data, .x, ...)

\n

我该如何纠正这个问题？我确实尝试过做类似的事情dots <- rlang::enquos(...)，然后做func(.x, !!!dots)也失败了。

\n

Answer 1

我们可能需要处理args返回length0的情况

\n

new_func <- function(.data, .x, .fns, ...){\n  \n  # Arguments\n  value_var_expr <- rlang::enquo(.x)\n  func <- .fns\n  func_chr <- deparse(substitute(.fns))\n  passed_args <- list(...)\n  \n  if(length(passed_args) > 0) {\n  \n  # New Param Args ----\n  # I do this because na.rm = TRUE when passed to say quantile gets\n  # converted to 1 or 100%\n  if ("na.rm" %in% names(passed_args)) {\n    tmp_args <- passed_args[!names(passed_args) == "na.rm"]\n  }\n  \n  \n  if (!exists("tmp_args")) {\n    args <- passed_args\n  } else {\n    args <- tmp_args\n  }\n  } else {\n     args <- NULL\n  } \n  if(length(args) == 0) args <- NULL\n  ret <- purrr::map(\n      .x = dplyr::as_tibble(.data), \n      .f = ~ if(is.null(args)) func(.x) else func(.x, unlist(args))  %>%\n        purrr::imap(.f = ~ cbind(.x, name = .y)) %>%\n        purrr::map_df(dplyr::as_tibble)\n    ) %>%\n    purrr::imap(.f = ~ cbind(.x, sim_number = .y))  %>%\n     purrr::map_dfr(dplyr::as_tibble, .id = 'name') %>%\n     dplyr::select(sim_number, name, `.x`) %>%\n       dplyr::mutate(.x = as.numeric(.x)) %>%\n       dplyr::mutate(sim_number = factor(sim_number)) %>%\n       dplyr::rename(value = .x)\n  \n     cn <- c("sim_number", "name", func_chr)\n     names(ret) <- cn\n    return(ret)\n}\n

\n

-测试

\n

> new_func(mtcars, mpg, IQR, na.rm = TRUE)\n# A tibble: 11 \xc3\x97 3\n   sim_number name     IQR\n   <fct>      <chr>  <dbl>\n 1 mpg        mpg     7.38\n 2 cyl        cyl     4   \n 3 disp       disp  205.  \n 4 hp         hp     83.5 \n 5 drat       drat    0.84\n 6 wt         wt      1.03\n 7 qsec       qsec    2.01\n 8 vs         vs      1   \n 9 am         am      1   \n10 gear       gear    1   \n11 carb       carb    2   \n> new_func(mtcars, mpg, IQR)\n# A tibble: 11 \xc3\x97 3\n   sim_number name     IQR\n   <fct>      <chr>  <dbl>\n 1 mpg        mpg     7.38\n 2 cyl        cyl     4   \n 3 disp       disp  205.  \n 4 hp         hp     83.5 \n 5 drat       drat    0.84\n 6 wt         wt      1.03\n 7 qsec       qsec    2.01\n 8 vs         vs      1   \n 9 am         am      1   \n10 gear       gear    1   \n11 carb       carb    2   \n> \n> new_func(mtcars, mpg, IQR, type = 7)\n# A tibble: 11 \xc3\x97 3\n   sim_number name     IQR\n   <fct>      <chr>  <dbl>\n 1 mpg        mpg     7.38\n 2 cyl        cyl     4   \n 3 disp       disp  205.  \n 4 hp         hp     83.5 \n 5 drat       drat    0.84\n 6 wt         wt      1.03\n 7 qsec       qsec    2.01\n 8 vs         vs      1   \n 9 am         am      1   \n10 gear       gear    1   \n11 carb       carb    2   \n

\n