Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Modify get available datasets #382

Merged
merged 6 commits into from
Jun 16, 2021
Merged
Show file tree
Hide file tree
Changes from 5 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 7 additions & 0 deletions R/datasets.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"
66 changes: 40 additions & 26 deletions R/get_available_datasets.R
Original file line number Diff line number Diff line change
@@ -1,14 +1,21 @@
#' Get supported data sets
#' Fetch of build 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. If render = TRUE The function searches
#' the environment for R6 class objects and extracts the summary information
#' from the available classes using their `summary` methods. If render = FALSE
#' the function will fetch the data from package data. In practice this
#' means that it can be used to indicate supported data sets.
#' @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 Bool. If TRUE the supported data set table is build from the
#' available classes using `summary` methods. If FALSE (dafault) the supported
#' data set table is taken from package data.
#' @param namespace characterArray 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
Expand All @@ -25,34 +32,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)
}
21 changes: 21 additions & 0 deletions data-raw/render_available_datasets.R
Original file line number Diff line number Diff line change
@@ -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)
Binary file added data/all_country_data.rda
Binary file not shown.
2 changes: 2 additions & 0 deletions inst/WORDLIST
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,7 @@ campbell
capabilites
Centre
characater
characterArray
characterised
Chun
CIJ
Expand Down Expand Up @@ -93,6 +94,7 @@ ctb
curation
customised
cyclocomp
dafault
dataclass
DataClass
datahub
Expand Down
20 changes: 20 additions & 0 deletions man/all_country_data.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

24 changes: 18 additions & 6 deletions man/get_available_datasets.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 18 additions & 0 deletions tests/testthat/test-get_available_datasets.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
})

package_avaliable_data <- get_available_datasets()
rendered_available_data <- get_available_datasets(render = TRUE)
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(
package_avaliable_data,
rendered_available_data
)
}
)