Merge pull request epiforecasts#382 from epiforecasts/modify-get_avai…

…lable_datasets

Modify get available datasets

R/datasets.R

@@ -39,3 +39,11 @@
 #' @description The region codes for JHU
 #' @return A tibble of region codes and related information.
 "JHU_codes"
+
+#' Table of available datasets along with level and other information.
+#' Rendered from the individual R6 class objects included in this package.
+#'
+#' @description Available datasets
+#' @concept utility
+#' @return A tibble of available datasets and related information.
+"all_country_data"

R/get_available_datasets.R

@@ -1,14 +1,18 @@
 #' Get supported data sets
 #'
-#' @description The function searches the environment for R6 class objects and
-#' extracts the summary information from the available classes using
-#' their `summary` methods. In practice this means that it can be used
-#' to indicate supported data sets.
+#' @description Returns data on what countries are available from
+#' the data provided with this package either using a cached dataset or built
+#' by searching the target namespace.
 #' @param type A character vector indicating the types of data to
 #' return. Current options include "national" (which are datasets at the
 #' national level which inherit from `CountryDataClass`) and
 #' "regional" (which are datasets at the regional level which inherit
 #' directly from `DataClass()`).
+#' @param render Logical If TRUE the supported data set table is built from the
+#' available classes using `summary` methods. If FALSE the supported
+#' data set table is taken from package data. Defaults to FALSE.
+#' @param namespace Character string The name of the namespace to search for
+#'  class objects. Defaults to "covidregionaldata" as the package.
 #' @return A list of available data sets and the spatial aggregation data is
 #' available for.
 #' @family interface
@@ -25,34 +29,41 @@
 #'
 #' # see only regional level datasets
 #' get_available_datasets("regional")
-get_available_datasets <- function(type) {
-  envi <- ls(getNamespace("covidregionaldata"), all.names = TRUE)
-  # regional data
-  starts_with_capitals_idx <- grep("^[A-Z]", envi)
-  starts_with_capitals <- envi[starts_with_capitals_idx]
-  exclude <- c("DataClass", "CountryDataClass")
-  valid_country_objects <- lapply(
-    starts_with_capitals,
-    function(x) {
-      country_obj <- get(x)
-      if (class(country_obj) == "R6ClassGenerator" & !(x %in% c(exclude))) {
-        dat <- get(x)$new()
-        dat <- dat$summary()
-        return(dat)
+#'
+#' # render the data
+#' get_available_datasets(render = TRUE)
+get_available_datasets <- function(type, render = FALSE,
+                                   namespace = "covidregionaldata") {
+  if (render) {
+    envi <- ls(getNamespace(namespace), all.names = TRUE)
+    starts_with_capitals_idx <- grep("^[A-Z]", envi)
+    starts_with_capitals <- envi[starts_with_capitals_idx]
+    exclude <- c("DataClass", "CountryDataClass")
+    valid_country_objects <- lapply(
+      starts_with_capitals,
+      function(x) {
+        country_obj <- get(x)
+        if (class(country_obj) == "R6ClassGenerator" & !(x %in% c(exclude))) {
+          dat <- get(x)$new()
+          dat <- dat$summary()
+          return(dat)
+        }
       }
-    }
-  )
-  available_country_data <- valid_country_objects %>%
-    bind_rows()
-
+    )
+    available_country_data <- valid_country_objects %>%
+      bind_rows()
+    country_data <- available_country_data
+  } else {
+    country_data <- all_country_data
+  }
   if (!missing(type)) {
     target_type <- match.arg(
       type,
       choices = c("national", "regional"),
       several.ok = TRUE
     )
-    available_country_data <- available_country_data %>%
+    country_data <- country_data %>%
       filter(type %in% target_type)
   }
-  return(available_country_data)
+  return(country_data)
 }

data-raw/render_available_datasets.R

@@ -0,0 +1,4 @@
+# render available datasets table
+
+all_country_data <- get_regional_data(render = TRUE)
+usethis::use_data(all_country_data, overwrite = TRUE)

inst/WORDLIST

@@ -63,6 +63,7 @@ campbell
 capabilites
 Centre
 characater
+characterArray
 characterised
 Chun
 CIJ
@@ -93,6 +94,7 @@ ctb
 curation
 customised
 cyclocomp
+dafault
 dataclass
 DataClass
 datahub

tests/testthat/test-get_available_datasets.R

@@ -63,3 +63,21 @@ test_that("National level datasets can be filtered for", {
   expect_equal(nrow(dplyr::filter(nat, class %in% "Italy")), 0)
   expect_equal(unique(nat$type), "national")
 })
+
+test_that(
+  paste(
+    "all_country_data is up to date.",
+    "This will fail if a new data source has been added, or an existing one",
+    "modified, but the table outlining available data (all_country_data) has",
+    "not been re-rendered. Run the code in",
+    "data-raw/render_available_datasets.R to update all_country_data"
+  ),
+  {
+    package_avaliable_data <- get_available_datasets()
+    rendered_available_data <- get_available_datasets(render = TRUE)
+    expect_identical(
+      package_avaliable_data,
+      rendered_available_data
+    )
+  }
+)