@@ -307,59 +307,8 @@ new_epi_archive <- function(
307307 other_keys = NULL ,
308308 additional_metadata = NULL ,
309309 compactify = NULL ,
310- clobberable_versions_start = NA ,
310+ clobberable_versions_start = NULL ,
311311 versions_end = NULL ) {
312- assert_data_frame(x )
313- if (! test_subset(c(" geo_value" , " time_value" , " version" ), names(x ))) {
314- cli_abort(
315- " Columns `geo_value`, `time_value`, and `version` must be present in `x`."
316- )
317- }
318- if (anyMissing(x $ version )) {
319- cli_abort(" Column `version` must not contain missing values." )
320- }
321-
322- geo_type <- geo_type %|| % guess_geo_type(x $ geo_value )
323- time_type <- time_type %|| % guess_time_type(x $ time_value )
324- other_keys <- other_keys %|| % character (0L )
325- additional_metadata <- additional_metadata %|| % list ()
326-
327- # Finish off with small checks on keys variables and metadata
328- if (! test_subset(other_keys , names(x ))) {
329- cli_abort(" `other_keys` must be contained in the column names of `x`." )
330- }
331- if (any(c(" geo_value" , " time_value" , " version" ) %in% other_keys )) {
332- cli_abort(" `other_keys` cannot contain \" geo_value\" , \" time_value\" , or \" version\" ." )
333- }
334- if (any(names(additional_metadata ) %in% c(" geo_type" , " time_type" ))) {
335- cli_warn(" `additional_metadata` names overlap with existing metadata fields \" geo_type\" , \" time_type\" ." )
336- }
337-
338- # Conduct checks and apply defaults for `compactify`
339- assert_logical(compactify , len = 1 , any.missing = FALSE , null.ok = TRUE )
340-
341- # Apply defaults and conduct checks for
342- # `clobberable_versions_start`, `versions_end`:
343- versions_end <- versions_end %|| % max_version_with_row_in(x )
344- validate_version_bound(clobberable_versions_start , x , na_ok = TRUE )
345- validate_version_bound(versions_end , x , na_ok = FALSE )
346- if (nrow(x ) > 0L && versions_end < max(x [[" version" ]])) {
347- cli_abort(
348- " `versions_end` was {versions_end}, but `x` contained
349- updates for a later version or versions, up through {max(x$version)}" ,
350- class = " epiprocess__versions_end_earlier_than_updates"
351- )
352- }
353- if (! is.na(clobberable_versions_start ) && clobberable_versions_start > versions_end ) {
354- cli_abort(
355- " `versions_end` was {versions_end}, but a `clobberable_versions_start`
356- of {clobberable_versions_start} indicated that there were later observed versions" ,
357- class = " epiprocess__versions_end_earlier_than_clobberable_versions_start"
358- )
359- }
360-
361- # --- End of validation and replacing missing args with defaults ---
362-
363312 # Create the data table; if x was an un-keyed data.table itself,
364313 # then the call to as.data.table() will fail to set keys, so we
365314 # need to check this, then do it manually if needed
@@ -441,18 +390,91 @@ new_epi_archive <- function(
441390 )
442391}
443392
393+ # ' `validate_epi_archive` ensures correctness of arguments fed to `as_epi_archive`.
394+ # '
395+ # ' @rdname epi_archive
396+ # '
397+ # ' @export
398+ validate_epi_archive <- function (
399+ x ,
400+ geo_type = NULL ,
401+ time_type = NULL ,
402+ other_keys = NULL ,
403+ additional_metadata = NULL ,
404+ compactify = NULL ,
405+ clobberable_versions_start = NULL ,
406+ versions_end = NULL ) {
407+ # Finish off with small checks on keys variables and metadata
408+ if (! test_subset(other_keys , names(x ))) {
409+ cli_abort(" `other_keys` must be contained in the column names of `x`." )
410+ }
411+ if (any(c(" geo_value" , " time_value" , " version" ) %in% other_keys )) {
412+ cli_abort(" `other_keys` cannot contain \" geo_value\" , \" time_value\" , or \" version\" ." )
413+ }
414+ if (any(names(additional_metadata ) %in% c(" geo_type" , " time_type" ))) {
415+ cli_warn(" `additional_metadata` names overlap with existing metadata fields \" geo_type\" , \" time_type\" ." )
416+ }
417+
418+ # Conduct checks and apply defaults for `compactify`
419+ assert_logical(compactify , len = 1 , any.missing = FALSE , null.ok = TRUE )
420+
421+ # Apply defaults and conduct checks for
422+ # `clobberable_versions_start`, `versions_end`:
423+ validate_version_bound(clobberable_versions_start , x , na_ok = TRUE )
424+ validate_version_bound(versions_end , x , na_ok = FALSE )
425+ if (nrow(x ) > 0L && versions_end < max(x [[" version" ]])) {
426+ cli_abort(
427+ " `versions_end` was {versions_end}, but `x` contained
428+ updates for a later version or versions, up through {max(x$version)}" ,
429+ class = " epiprocess__versions_end_earlier_than_updates"
430+ )
431+ }
432+ if (! is.na(clobberable_versions_start ) && clobberable_versions_start > versions_end ) {
433+ cli_abort(
434+ " `versions_end` was {versions_end}, but a `clobberable_versions_start`
435+ of {clobberable_versions_start} indicated that there were later observed versions" ,
436+ class = " epiprocess__versions_end_earlier_than_clobberable_versions_start"
437+ )
438+ }
439+ }
440+
444441
445442# ' `as_epi_archive` converts a data frame, data table, or tibble into an
446443# ' `epi_archive` object.
447444# '
448445# ' @rdname epi_archive
449446# '
450447# ' @export
451- as_epi_archive <- function (x , geo_type = NULL , time_type = NULL , other_keys = NULL ,
452- additional_metadata = list (),
453- compactify = NULL ,
454- clobberable_versions_start = NA ,
455- versions_end = max_version_with_row_in(x )) {
448+ as_epi_archive <- function (
449+ x ,
450+ geo_type = NULL ,
451+ time_type = NULL ,
452+ other_keys = NULL ,
453+ additional_metadata = NULL ,
454+ compactify = NULL ,
455+ clobberable_versions_start = NULL ,
456+ versions_end = NULL ) {
457+ assert_data_frame(x )
458+ if (! test_subset(c(" geo_value" , " time_value" , " version" ), names(x ))) {
459+ cli_abort(
460+ " Columns `geo_value`, `time_value`, and `version` must be present in `x`."
461+ )
462+ }
463+ if (anyMissing(x $ version )) {
464+ cli_abort(" Column `version` must not contain missing values." )
465+ }
466+
467+ geo_type <- geo_type %|| % guess_geo_type(x $ geo_value )
468+ time_type <- time_type %|| % guess_time_type(x $ time_value )
469+ other_keys <- other_keys %|| % character (0L )
470+ additional_metadata <- additional_metadata %|| % list ()
471+ clobberable_versions_start <- clobberable_versions_start %|| % NA
472+ versions_end <- versions_end %|| % max_version_with_row_in(x )
473+
474+ validate_epi_archive(
475+ x , geo_type , time_type , other_keys , additional_metadata ,
476+ compactify , clobberable_versions_start , versions_end
477+ )
456478 new_epi_archive(
457479 x , geo_type , time_type , other_keys , additional_metadata ,
458480 compactify , clobberable_versions_start , versions_end
@@ -652,31 +674,6 @@ group_by.epi_archive <- function(.data, ..., .add = FALSE, .drop = dplyr::group_
652674}
653675
654676
655- # ' Test for `epi_archive` format
656- # '
657- # ' @param x An object.
658- # ' @param grouped_okay Optional; Boolean; should a `grouped_epi_archive` also
659- # ' count? Default is `FALSE`.
660- # ' @return `TRUE` if the object inherits from `epi_archive`.
661- # '
662- # ' @export
663- # ' @examples
664- # ' is_epi_archive(jhu_csse_daily_subset) # FALSE (this is an epi_df, not epi_archive)
665- # ' is_epi_archive(archive_cases_dv_subset) # TRUE
666- # '
667- # ' # By default, grouped_epi_archives don't count as epi_archives, as they may
668- # ' # support a different set of operations from regular `epi_archives`. This
669- # ' # behavior can be controlled by `grouped_okay`.
670- # ' grouped_archive <- archive_cases_dv_subset %>% group_by(geo_value)
671- # ' is_epi_archive(grouped_archive) # FALSE
672- # ' is_epi_archive(grouped_archive, grouped_okay = TRUE) # TRUE
673- # '
674- # ' @seealso [`is_grouped_epi_archive`]
675- is_epi_archive <- function (x , grouped_okay = FALSE ) {
676- inherits(x , " epi_archive" ) || grouped_okay && inherits(x , " grouped_epi_archive" )
677- }
678-
679-
680677# ' Clone an `epi_archive` object.
681678# '
682679# ' @param x An `epi_archive` object.
0 commit comments