Merge pull request #104 from cmu-delphi/94-create-an-epi_df-constructor

Created an `epi_df` constructor

Author: rachlobay

NAMESPACE

@@ -40,6 +40,7 @@ export(growth_rate)
 export(is_epi_archive)
 export(is_epi_df)
 export(mutate)
+export(new_epi_df)
 export(relocate)
 export(rename)
 export(slice)

R/epi_df.R

@@ -84,6 +84,85 @@
 #' @name epi_df
 NULL
 
+
+#' Creates an `epi_df` object
+#'
+#' Creates a new `epi_df` object. By default, builds an empty tibble with the 
+#' correct metadata for an `epi_df` object (ie. `geo_type`, `time_type`, and `as_of`).
+#' Refer to the below info. about the arguments for more details.
+#'
+#' @param x A data.frame, [tibble::tibble], or [tsibble::tsibble] to be converted
+#' @param geo_type Type for the geo values. If missing, then the function will
+#'   attempt to infer it from the geo values present; if this fails, then it
+#'   will be set to "custom".
+#' @param time_type Type for the time values. If missing, then the function will
+#'   attempt to infer it from the time values present; if this fails, then it
+#'   will be set to "custom".
+#' @param as_of Time value representing the time at which the given data were
+#'   available. For example, if `as_of` is January 31, 2022, then the `epi_df`
+#'   object that is created would represent the most up-to-date version of the
+#'   data available as of January 31, 2022. If the `as_of` argument is missing,
+#'   then the current day-time will be used.
+#' @param additional_metadata List of additional metadata to attach to the
+#'   `epi_df` object. The metadata will have `geo_type`, `time_type`, and
+#'   `as_of` fields; named entries from the passed list or will be included as
+#'   well.
+#' @param ... Additional arguments passed to methods.
+#' @return An `epi_df` object.
+#' 
+#' @export
+new_epi_df = function(x = tibble::tibble(), geo_type, time_type, as_of,
+                      additional_metadata = list(), ...) {
+  # Check that we have a data frame
+  if (!is.data.frame(x)) {
+    Abort("`x` must be a data frame.")
+  }
+  
+  # If geo type is missing, then try to guess it
+  if (missing(geo_type)) {
+    geo_type = guess_geo_type(x$geo_value)
+  }
+  
+  # If time type is missing, then try to guess it
+  if (missing(time_type)) {
+    time_type = guess_time_type(x$time_value)
+  }
+  
+  # If as_of is missing, then try to guess it
+  if (missing(as_of)) {
+    # First check the metadata for an as_of field
+    if ("metadata" %in% names(attributes(x)) &&
+        "as_of" %in% names(attributes(x)$metadata)) {
+      as_of = attributes(x)$metadata$as_of
+    }
+    
+    # Next check for as_of, issue, or version columns
+    else if ("as_of" %in% names(x)) as_of = max(x$as_of)
+    else if ("issue" %in% names(x)) as_of = max(x$issue)
+    else if ("version" %in% names(x)) as_of = max(x$version)
+    
+    # If we got here then we failed
+    else as_of = Sys.time() # Use the current day-time
+  }
+  
+  # Define metadata fields
+  metadata = list()
+  metadata$geo_type = geo_type
+  metadata$time_type = time_type
+  metadata$as_of = as_of
+  metadata = c(metadata, additional_metadata)
+  
+  # Reorder columns (geo_value, time_value, ...)
+  if(sum(dim(x)) != 0){
+    x = dplyr::relocate(x, .data$geo_value, .data$time_value)
+  }
+  
+  # Apply epi_df class, attach metadata, and return
+  class(x) = c("epi_df", class(x))
+  attributes(x)$metadata = metadata
+  return(x)
+}
+
 #' Convert to `epi_df` format
 #'
 #' Converts a data frame or tibble into an `epi_df` object. See the [getting
@@ -142,47 +221,8 @@ as_epi_df.tbl_df = function(x, geo_type, time_type, as_of,
     Abort("`x` must contain a `time_value` column.")
   }
 
-  # If geo type is missing, then try to guess it
-  if (missing(geo_type)) {
-    geo_type = guess_geo_type(x$geo_value)
-  }
-
-  # If time type is missing, then try to guess it
-  if (missing(time_type)) {
-    time_type = guess_time_type(x$time_value)
-  }
-
-  # If as_of is missing, then try to guess it
-  if (missing(as_of)) {
-    # First check the metadata for an as_of field
-    if ("metadata" %in% names(attributes(x)) &&
-        "as_of" %in% names(attributes(x)$metadata)) {
-      as_of = attributes(x)$metadata$as_of
-    }
-
-    # Next check for as_of, issue, or version columns
-    else if ("as_of" %in% names(x)) as_of = max(x$as_of)
-    else if ("issue" %in% names(x)) as_of = max(x$issue)
-    else if ("version" %in% names(x)) as_of = max(x$version)
-
-    # If we got here then we failed
-    else as_of = Sys.time() # Use the current day-time
-  }
-
-  # Define metadata fields
-  metadata = list()
-  metadata$geo_type = geo_type
-  metadata$time_type = time_type
-  metadata$as_of = as_of
-  metadata = c(metadata, additional_metadata)
-
-  # Reorder columns (geo_value, time_value, ...)
-  x = dplyr::relocate(x, .data$geo_value, .data$time_value)
-
-  # Apply epi_df class, attach metadata, and return
-  class(x) = c("epi_df", class(x))
-  attributes(x)$metadata = metadata
-  return(x)
+  new_epi_df(x, geo_type, time_type, as_of,
+             additional_metadata = list(), ...)
 }
 
 #' @method as_epi_df data.frame

man/new_epi_df.Rd

@@ -0,0 +1,27 @@
+test_that("new_epi_df works as intended", {
+  
+  # Empty tibble
+  wmsg = capture_warnings(a <- new_epi_df())
+  expect_match(wmsg[1],
+                 "Unknown or uninitialised column: `geo_value`.")
+  expect_match(wmsg[2],
+                 "Unknown or uninitialised column: `time_value`.")
+  expect_true(is_epi_df(a))
+  expect_identical(attributes(a)$metadata$geo_type, "custom")
+  expect_identical(attributes(a)$metadata$time_type, "custom")
+  expect_true(lubridate::is.POSIXt(attributes(a)$metadata$as_of))
+  
+  # Simple non-empty tibble with geo_value and time_value cols
+  tib <- tibble::tibble(
+    x = 1:10, y = 1:10,
+    time_value = rep(seq(as.Date("2020-01-01"), by = 1, length.out = 5), times = 2),
+    geo_value = rep(c("ca", "hi"), each = 5)
+  )
+  
+  epi_tib = new_epi_df(tib)
+  expect_true(is_epi_df(epi_tib))
+  expect_length(epi_tib, 4L)
+  expect_identical(attributes(epi_tib)$metadata$geo_type, "state")
+  expect_identical(attributes(epi_tib)$metadata$time_type, "day")
+  expect_true(lubridate::is.POSIXt(attributes(epi_tib)$metadata$as_of))
+})