@@ -393,8 +393,8 @@ epi_slide <- function(x, f, ..., before, after, ref_time_values,
393
393
# ' @param x The `epi_df` object under consideration, [grouped][dplyr::group_by]
394
394
# ' or ungrouped. If ungrouped, all data in `x` will be treated as part of a
395
395
# ' single data group.
396
- # ' @param col_names A character vector of the names of one or more columns for
397
- # ' which to calculate the rolling mean.
396
+ # ' @param col_names A single tidyselection or a tidyselection vector of the
397
+ # ' names of one or more columns for which to calculate the rolling mean.
398
398
# ' @param ... Additional arguments to pass to `data.table::frollmean`, for
399
399
# ' example, `na.rm` and `algo`. `data.table::frollmean` is automatically
400
400
# ' passed the data `x` to operate on, the window size `n`, and the alignment
@@ -473,7 +473,8 @@ epi_slide <- function(x, f, ..., before, after, ref_time_values,
473
473
# ' leading window was intended, but the `after` argument was forgotten or
474
474
# ' misspelled.)
475
475
# '
476
- # ' @importFrom dplyr bind_rows mutate %>% arrange tibble
476
+ # ' @importFrom dplyr bind_rows mutate %>% arrange tibble select
477
+ # ' @importFrom rlang enquo quo_get_expr as_label
477
478
# ' @importFrom purrr map
478
479
# ' @importFrom data.table frollmean
479
480
# ' @importFrom lubridate as.period
@@ -484,7 +485,7 @@ epi_slide <- function(x, f, ..., before, after, ref_time_values,
484
485
# ' # slide a 7-day trailing average formula on cases
485
486
# ' jhu_csse_daily_subset %>%
486
487
# ' group_by(geo_value) %>%
487
- # ' epi_slide_mean(" cases" , new_col_names = "cases_7dav", names_sep = NULL, before = 6) %>%
488
+ # ' epi_slide_mean(cases, new_col_names = "cases_7dav", names_sep = NULL, before = 6) %>%
488
489
# ' # Remove a nonessential var. to ensure new col is printed
489
490
# ' dplyr::select(geo_value, time_value, cases, cases_7dav) %>%
490
491
# ' ungroup()
@@ -493,7 +494,7 @@ epi_slide <- function(x, f, ..., before, after, ref_time_values,
493
494
# ' # and accuracy, and to allow partially-missing windows.
494
495
# ' jhu_csse_daily_subset %>%
495
496
# ' group_by(geo_value) %>%
496
- # ' epi_slide_mean(" cases" ,
497
+ # ' epi_slide_mean(cases,
497
498
# ' new_col_names = "cases_7dav", names_sep = NULL, before = 6,
498
499
# ' # `frollmean` options
499
500
# ' na.rm = TRUE, algo = "exact", hasNA = TRUE
@@ -504,23 +505,23 @@ epi_slide <- function(x, f, ..., before, after, ref_time_values,
504
505
# ' # slide a 7-day leading average
505
506
# ' jhu_csse_daily_subset %>%
506
507
# ' group_by(geo_value) %>%
507
- # ' epi_slide_mean(" cases" , new_col_names = "cases_7dav", names_sep = NULL, after = 6) %>%
508
+ # ' epi_slide_mean(cases, new_col_names = "cases_7dav", names_sep = NULL, after = 6) %>%
508
509
# ' # Remove a nonessential var. to ensure new col is printed
509
510
# ' dplyr::select(geo_value, time_value, cases, cases_7dav) %>%
510
511
# ' ungroup()
511
512
# '
512
513
# ' # slide a 7-day centre-aligned average
513
514
# ' jhu_csse_daily_subset %>%
514
515
# ' group_by(geo_value) %>%
515
- # ' epi_slide_mean(" cases" , new_col_names = "cases_7dav", names_sep = NULL, before = 3, after = 3) %>%
516
+ # ' epi_slide_mean(cases, new_col_names = "cases_7dav", names_sep = NULL, before = 3, after = 3) %>%
516
517
# ' # Remove a nonessential var. to ensure new col is printed
517
518
# ' dplyr::select(geo_value, time_value, cases, cases_7dav) %>%
518
519
# ' ungroup()
519
520
# '
520
521
# ' # slide a 14-day centre-aligned average
521
522
# ' jhu_csse_daily_subset %>%
522
523
# ' group_by(geo_value) %>%
523
- # ' epi_slide_mean(" cases" , new_col_names = "cases_14dav", names_sep = NULL, before = 6, after = 7) %>%
524
+ # ' epi_slide_mean(cases, new_col_names = "cases_14dav", names_sep = NULL, before = 6, after = 7) %>%
524
525
# ' # Remove a nonessential var. to ensure new col is printed
525
526
# ' dplyr::select(geo_value, time_value, cases, cases_14dav) %>%
526
527
# ' ungroup()
@@ -604,29 +605,46 @@ epi_slide_mean <- function(x, col_names, ..., before, after, ref_time_values,
604
605
# `before` and `after` params.
605
606
m <- before + after + 1L
606
607
608
+ col_names_quo <- enquo(col_names )
609
+ col_names_chr <- as.character(rlang :: quo_get_expr(col_names_quo ))
610
+ if (startsWith(rlang :: as_label(col_names_quo ), " c(" )) {
611
+ # List or vector of col names. We need to drop the first element since it
612
+ # will be either "c" (if built as a vector) or "list" (if built as a
613
+ # list).
614
+ col_names_chr <- col_names_chr [- 1 ]
615
+ } else if (startsWith(rlang :: as_label(col_names_quo ), " list(" )) {
616
+ cli_abort(
617
+ " `col_names` must be a single tidy column name or a vector
618
+ (`c()`) of tidy column names" ,
619
+ class = " epiprocess__epi_slide_mean__col_names_in_list" ,
620
+ epiprocess__col_names = col_names_chr
621
+ )
622
+ }
623
+ # If single column name, do nothing.
624
+
607
625
if (is.null(names_sep )) {
608
- if (length(new_col_names ) != length(col_names )) {
626
+ if (length(new_col_names ) != length(col_names_chr )) {
609
627
cli_abort(
610
628
c(
611
629
" `new_col_names` must be the same length as `col_names` when
612
630
`names_sep` is NULL to avoid duplicate output column names."
613
631
),
614
632
class = " epiprocess__epi_slide_mean__col_names_length_mismatch" ,
615
633
epiprocess__new_col_names = new_col_names ,
616
- epiprocess__col_names = col_names
634
+ epiprocess__col_names = col_names_chr
617
635
)
618
636
}
619
637
result_col_names <- new_col_names
620
638
} else {
621
- if (length(new_col_names ) != 1L && length(new_col_names ) != length(col_names )) {
639
+ if (length(new_col_names ) != 1L && length(new_col_names ) != length(col_names_chr )) {
622
640
cli_abort(
623
641
" `new_col_names` must be either length 1 or the same length as `col_names`." ,
624
642
class = " epiprocess__epi_slide_mean__col_names_length_mismatch_and_not_one" ,
625
643
epiprocess__new_col_names = new_col_names ,
626
- epiprocess__col_names = col_names
644
+ epiprocess__col_names = col_names_chr
627
645
)
628
646
}
629
- result_col_names <- paste(new_col_names , col_names , sep = names_sep )
647
+ result_col_names <- paste(new_col_names , col_names_chr , sep = names_sep )
630
648
}
631
649
632
650
slide_one_grp <- function (.data_group , .group_key , ... ) {
@@ -675,7 +693,7 @@ epi_slide_mean <- function(x, col_names, ..., before, after, ref_time_values,
675
693
}
676
694
677
695
roll_output <- data.table :: frollmean(
678
- x = .data_group [, col_names ] , n = m , align = " right" , ...
696
+ x = select( .data_group , {{ col_names }}) , n = m , align = " right" , ...
679
697
)
680
698
681
699
if (after > = 1 ) {
0 commit comments