Skip to content

Idiomatic cleanup of epi_slide_opt computation function checks #436

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Apr 25, 2024
Merged

Idiomatic cleanup of epi_slide_opt computation function checks #436

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
296d657
identical doesn't need isTRUE wrapper
nmdefries Apr 9, 2024
9e336de
make unsupported-f error message report more detail than just arg name
nmdefries Apr 9, 2024
a7aa15b
use map_lgl to check if user opt-f is valid
nmdefries Apr 9, 2024
34aa00b
Merge branch 'dev' into ndefries/opt-slide-cleanup
nmdefries Apr 11, 2024
fc2590d
imporove slide function f error context
nmdefries Apr 25, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -142,6 +142,7 @@ importFrom(rlang,caller_env)
importFrom(rlang,enquo)
importFrom(rlang,enquos)
importFrom(rlang,env)
importFrom(rlang,expr_label)
importFrom(rlang,f_env)
importFrom(rlang,f_rhs)
importFrom(rlang,is_environment)
Expand Down
18 changes: 9 additions & 9 deletions R/slide.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -376,8 +376,8 @@ epi_slide <- function(x, f, ..., before, after, ref_time_values,
#' @template opt-slide-details
#'
#' @importFrom dplyr bind_rows mutate %>% arrange tibble select
#' @importFrom rlang enquo quo_get_expr as_label
#' @importFrom purrr map
#' @importFrom rlang enquo quo_get_expr as_label expr_label caller_arg
#' @importFrom purrr map map_lgl
#' @importFrom data.table frollmean frollsum frollapply
#' @importFrom lubridate as.period
#' @importFrom checkmate assert_function
Expand Down Expand Up @@ -459,25 +459,25 @@ epi_slide_opt <- function(x, col_names, f, ..., before, after, ref_time_values,
# `data.table` and `slider` (or a function that has the exact same
# definition, e.g. if the function has been reexported or defined
# locally).
if (any(sapply(
c(frollmean, frollsum, frollapply),
if (any(map_lgl(
list(frollmean, frollsum, frollapply),
function(roll_fn) {
isTRUE(identical(f, roll_fn))
identical(f, roll_fn)
}
))) {
f_from_package <- "data.table"
} else if (any(sapply(
c(slide_sum, slide_prod, slide_mean, slide_min, slide_max, slide_all, slide_any),
} else if (any(map_lgl(
list(slide_sum, slide_prod, slide_mean, slide_min, slide_max, slide_all, slide_any),
function(roll_fn) {
isTRUE(identical(f, roll_fn))
identical(f, roll_fn)
}
))) {
f_from_package <- "slider"
} else {
# `f` is from somewhere else and not supported
cli_abort(
c(
"slide function `f` is not supported",
"problem with {rlang::expr_label(rlang::caller_arg(f))}",
"i" = "`f` must be one of `data.table`'s rolling functions (`frollmean`,
`frollsum`, `frollapply`. See `?data.table::roll`) or one of
`slider`'s specialized sliding functions (`slide_mean`, `slide_sum`,
Expand Down
Loading