Modify get available datasets

NAMESPACE

@@ -34,6 +34,7 @@ export(get_regional_data)
 export(initialise_dataclass)
 export(make_github_workflow)
 export(make_new_data_source)
+export(render_available_datasets)
 export(reset_cache)
 export(start_using_memoise)
 export(stop_using_memoise)

R/datasets.R

@@ -39,3 +39,10 @@
 #' @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
+#' @return A tibble of available datasets and related information.
+"all_country_data"

R/get_available_datasets.R

@@ -1,9 +1,8 @@
-#' Get supported data sets
+#' Fetch table of 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 The function returns data on what countries are available from
+#' the data provided with this package. This is rendered through the function
+#' `render_available_datasets()`.
 #' @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
@@ -26,6 +25,33 @@
 #' # see only regional level datasets
 #' get_available_datasets("regional")
 get_available_datasets <- function(type) {
+  if (!missing(type)) {
+    target_type <- match.arg(
+      type,
+      choices = c("national", "regional"),
+      several.ok = TRUE
+    )
+    all_country_data <- all_country_data %>%
+      filter(type %in% target_type)
+  }
+  return(all_country_data)
+}
+
+#' Make table of supported data sets and store as package data
+#'
+#' @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.
+#' @family interface
+#' @importFrom rlang .data
+#' @importFrom dplyr select bind_rows filter
+#' @importFrom tibble as_tibble
+#' @export
+#' @examples
+#' # see all available datasets
+#' render_available_datasets()
+render_available_datasets <- function() {
   envi <- ls(getNamespace("covidregionaldata"), all.names = TRUE)
   # regional data
   starts_with_capitals_idx <- grep("^[A-Z]", envi)
@@ -44,15 +70,5 @@ get_available_datasets <- function(type) {
   )
   available_country_data <- valid_country_objects %>%
     bind_rows()
-
-  if (!missing(type)) {
-    target_type <- match.arg(
-      type,
-      choices = c("national", "regional"),
-      several.ok = TRUE
-    )
-    available_country_data <- available_country_data %>%
-      filter(type %in% target_type)
-  }
   return(available_country_data)
 }

data-raw/render_available_datasets.R

@@ -0,0 +1,21 @@
+# render available datasets table
+
+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)
+    }
+  }
+)
+all_country_data <- valid_country_objects %>%
+  bind_rows()
+usethis::use_data(all_country_data, overwrite = TRUE)

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")
 })
+
+get_available_datasets_data <- get_available_datasets()
+render_available_datasets_data <- render_available_datasets()
+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"
+  ),
+  {
+    expect_identical(
+      get_available_datasets_data,
+      render_available_datasets_data
+    )
+  }
+)