@@ -255,9 +255,10 @@ group_modify.epi_df <- function(.data, .f, ..., .keep = FALSE) {
255
255
256
256
# ' Complete epi_df
257
257
# '
258
- # ' A [tidyr::complete()] analogue for `epi_df` objects. This function fills in
259
- # ' missing combinations of `geo_value` and `time_value` with `NA` values. See
260
- # ' the examples for usage details.
258
+ # ' A ‘tidyr::complete()’ analogue for ‘epi_df’ objects. This function
259
+ # ' can be used, for example, to add rows for missing combinations
260
+ # ' of ‘geo_value’ and ‘time_value’, filling other columns with `NA`s.
261
+ # ' See the examples for usage details.
261
262
# '
262
263
# ' @param data an `epi_df`
263
264
# ' @param ... see [`tidyr::complete`]
@@ -378,8 +379,101 @@ arrange_canonical.default <- function(x, ...) {
378
379
# ' @export
379
380
arrange_canonical.epi_df <- function (x , ... ) {
380
381
rlang :: check_dots_empty()
381
- keys <- key_colnames(x )
382
382
x %> %
383
- dplyr :: relocate(dplyr :: all_of(keys ), .before = 1 ) %> %
384
- dplyr :: arrange(dplyr :: across(dplyr :: all_of(keys )))
383
+ arrange_row_canonical() %> %
384
+ arrange_col_canonical()
385
+ }
386
+
387
+ arrange_row_canonical <- function (x , ... ) {
388
+ UseMethod(" arrange_row_canonical" )
389
+ }
390
+
391
+ # ' @export
392
+ arrange_row_canonical.default <- function (x , ... ) {
393
+ rlang :: check_dots_empty()
394
+ cli :: cli_abort(c(
395
+ " `arrange_row_canonical()` is only meaningful for an {.cls epi_df}."
396
+ ))
397
+ return (x )
398
+ }
399
+
400
+ # ' @export
401
+ arrange_row_canonical.epi_df <- function (x , ... ) {
402
+ rlang :: check_dots_empty()
403
+ x %> % dplyr :: arrange(dplyr :: across(dplyr :: all_of(key_colnames(. ))))
404
+ }
405
+
406
+ arrange_col_canonical <- function (x , ... ) {
407
+ UseMethod(" arrange_col_canonical" )
408
+ }
409
+
410
+ # ' @export
411
+ arrange_col_canonical.default <- function (x , ... ) {
412
+ rlang :: check_dots_empty()
413
+ cli :: cli_abort(c(
414
+ " `arrange_col_canonical()` is only meaningful for an {.cls epi_df}."
415
+ ))
416
+ return (x )
417
+ }
418
+
419
+ # ' @export
420
+ arrange_col_canonical.epi_df <- function (x , ... ) {
421
+ rlang :: check_dots_empty()
422
+ x %> % dplyr :: relocate(dplyr :: all_of(key_colnames(. )), .before = 1 )
423
+ }
424
+
425
+ # ' @export
426
+ group_epi_df <- function (x ) {
427
+ x %> % group_by(across(all_of(kill_time_value(key_colnames(. )))))
428
+ }
429
+
430
+ # ' Aggregate an `epi_df` object
431
+ # '
432
+ # ' Aggregates an `epi_df` object by the specified group columns, summing the
433
+ # ' `value` column, and returning an `epi_df`. If aggregating over `geo_value`,
434
+ # ' the resulting `epi_df` will have `geo_value` set to `"total"`.
435
+ # '
436
+ # ' @param .x an `epi_df`
437
+ # ' @param value_col character vector of the columns to aggregate
438
+ # ' @param group_cols character vector of column names to group by. "time_value" is
439
+ # ' included by default.
440
+ # ' @return an `epi_df` object
441
+ # '
442
+ # ' @export
443
+ sum_groups_epi_df <- function (.x , sum_cols = " value" , group_cols = character ()) {
444
+ assert_class(.x , " epi_df" )
445
+ assert_character(sum_cols )
446
+ assert_character(group_cols )
447
+ checkmate :: assert_subset(sum_cols , setdiff(names(.x ), key_colnames(.x )))
448
+ checkmate :: assert_subset(group_cols , key_colnames(.x ))
449
+ if (! " time_value" %in% group_cols ) {
450
+ group_cols <- c(" time_value" , group_cols )
451
+ }
452
+
453
+ out <- .x %> %
454
+ group_by(across(all_of(group_cols ))) %> %
455
+ dplyr :: summarize(across(all_of(sum_cols ), sum ), .groups = " drop" )
456
+
457
+ # To preserve epi_df-ness, we need to ensure that the `geo_value` column is
458
+ # present.
459
+ out <- if (! " geo_value" %in% group_cols ) {
460
+ out %> %
461
+ mutate(geo_value = " total" ) %> %
462
+ relocate(geo_value , .before = 1 )
463
+ } else {
464
+ out
465
+ }
466
+
467
+ # The `geo_type` will be correctly inherited here by the following logic:
468
+ # - if `geo_value` is in `group_cols`, then the constructor will see the
469
+ # geo_value here and will correctly read the existing values
470
+ # - if `geo_value` is not in `group_cols`, then the constructor will see
471
+ # the unrecognizeable "total" value and will correctly infer the "custom"
472
+ # geo_type.
473
+ out %> %
474
+ as_epi_df(
475
+ as_of = attr(.x , " metadata" )$ as_of ,
476
+ other_keys = intersect(attr(.x , " metadata" )$ other_keys , group_cols )
477
+ ) %> %
478
+ arrange_canonical()
385
479
}
0 commit comments