You can get country specific POLIS data & fix bug in save_polis_data

R/construct_api_url.R

@@ -12,6 +12,7 @@
 #'        API resource.
 #' @param min_date The minimum date for the date range filter.
 #' @param max_date The maximum date for the date range filter.
+#' @param country_code ISO3 country code to filter the data. Default is NULL.
 #' @param date_field The field name in the API corresponding to the date.
 #' @param region_field The field name in the API corresponding to the region.
 #' @param region The specific region to filter the data. If NULL or empty,
@@ -24,12 +25,13 @@
 #' @examples
 #' construct_api_url(
 #'   "https://api.example.com/", "data", "2020-01-01", "2020-12-31",
-#'   "dateField", "regionField", "AFRO", c("field1", "field2")
+#'   "dateField", "NGA", "regionField", "AFRO", c("field1", "field2")
 #' )
 #' @export
 
 construct_api_url <- function(endpoint, suffix, min_date, max_date,
-                              date_field, region_field, region, select_vars) {
+                              date_field, country_code,
+                              region_field, region, select_vars) {
   # Base URL construction
   base_url <- paste0(endpoint, suffix)
 
@@ -46,8 +48,16 @@ construct_api_url <- function(endpoint, suffix, min_date, max_date,
     region_filter <- glue::glue(" and {region_field} eq '{region}'")
   }
 
+  # country code filter
+  country_code_filter <- ""
+  if (!is.null(country_code) && country_code != "" ) {
+    country_code_filter <- glue::glue(
+      " and CountryISO3Code eq '{country_code}'")
+  }
+
   # Combine date and region filters
-  filter_query <- paste(date_filter, region_filter, sep = "")
+  filter_query <- paste(date_filter, country_code_filter,
+                        region_filter, sep = "")
 
   # Select query for additional fields
   select_query <- ""

R/get_polis_api_data.R

@@ -28,6 +28,7 @@
 #'               Represents the WHO region from which to retrieve the data.
 #'               Possible values are AFRO; AMRO; EMRO; EURO; SEARO; WPRO Use
 #'               'Global' to retrieve global data. Default is 'AFRO'.
+#' @param country_code ISO3 country code to filter the data. Default is NULL.
 #' @param select_vars Vector of variables to select from the API response.
 #'                    If NULL (default), all variables are selected.
 #' @param polis_api_key API key for authentication.
@@ -51,6 +52,7 @@ get_polis_api_data <- function(min_date = "2021-01-01",
                                max_date = Sys.Date(),
                                data_type = "cases",
                                region = "AFRO",
+                               country_code = NULL,
                                select_vars = NULL,
                                updated_dates = FALSE,
                                polis_api_key,
@@ -80,7 +82,7 @@ get_polis_api_data <- function(min_date = "2021-01-01",
   # Construct the full API URL
   api_url <- construct_api_url(
     api_endpoint, endpoint_suffix, min_date, max_date,
-    date_field, region_field, region, select_vars
+    date_field, country_code, region_field, region, select_vars
   )
 
   # all API iteratively

R/save_polis_data.R

@@ -22,45 +22,44 @@
 #' # save_polis_data(polis_data, "./polis_datasets")
 #'
 #' @export
-save_polis_data <- function(polis_data, polis_path,
-                            filname, max_datasets = 5) {
-
+#' @export
+save_polis_data <- function(polis_data, polis_path, filname, max_datasets = 5) {
   cli::cli_process_start("Saving POLIS data into a compressed RDS file.")
 
-  # generate the file name based on the current date
+  # Generate the file name based on the current date
   suffix_name <- sprintf("_%s.rds", format(Sys.Date(), "%Y_%V"))
   full_path <- file.path(polis_path, paste0(filname, suffix_name))
 
-  # save polis list
+  # Save POLIS list
   saveRDS(polis_data, full_path, compress = "xz")
 
-  cli::cli_process_done(  )
+  cli::cli_process_done()
 
   # Check existing datasets and keep only the 5 most recent
   existing_files <- list.files(
     polis_path, pattern = "\\.rds$", full.names = TRUE)
 
-  # Check existing RDS datasets and keep only the 5 most recent
-  existing_files <- list.files(
-    polis_path, pattern = "\\.rds$", full.names = TRUE)
-
   # Exclude files that contain 'polis_data_update_log' in the name
   existing_files <- grep(
     "polis_data_update_log", existing_files, value = TRUE, invert = TRUE)
 
-  if (length(existing_files) > 5) {
+  # Keep only files starting with the specified filname
+  existing_files <- grep(
+    paste0("^", filname), basename(existing_files), value = TRUE)
+
+  if (length(existing_files) > max_datasets) {
     # Sort files by date, assuming the naming convention holds the date info
     file_dates <- sapply(existing_files, function(x) {
       as.Date(stringr::str_extract(x, "\\d{4}_\\d{2}"), "%Y_%V")
     })
 
-    oldest_files <- existing_files[order(
-      file_dates)][1:(length(existing_files)-5)]
+    oldest_files <- existing_files[order(file_dates)][1:(
+      length(existing_files) - max_datasets)]
 
     cli::cli_alert_success(
       "Removing {length(oldest_files)} old file(s) to keep top {max_datasets}.")
 
-    suppressMessages(file.remove(oldest_files))
+    suppressMessages(file.remove(file.path(polis_path, oldest_files)))
   }
-  cli::cli_process_done(  )
+  cli::cli_process_done()
 }

R/update_polis_api_data.R

@@ -21,6 +21,7 @@
 #'                  (Human Specimen Viruses). Default is 'cases'.
 #' @param region Region code for data filtering, default is 'AFRO'.
 #'               This parameter filters the data by the specified WHO region.
+#' @param country_code ISO3 country code to filter the data. Default is NULL.
 #' @param select_vars Vector of variables to select, default is NULL (all vars).
 #'                    This parameter allows for the selection of specific
 #'                    variables from the API response.
@@ -50,6 +51,7 @@ update_polis_api_data <- function(min_date,
                                   max_date = Sys.Date(),
                                   data_type = "cases",
                                   region = "AFRO",
+                                  country_code = NULL,
                                   select_vars = NULL,
                                   file_path = NULL,
                                   save_directly = FALSE,
@@ -82,7 +84,7 @@ update_polis_api_data <- function(min_date,
   # Retrieve data from the API
   new_data <- get_polis_api_data(
     min_date = min_date, max_date = max_date,
-    data_type = data_type, region = region,
+    data_type = data_type, region = region, country_code = country_code,
     select_vars = select_vars, updated_dates = TRUE,
     log_results = FALSE, polis_api_key = polis_api_key,
   )

tests/testthat/test-check_status_api.R

@@ -1,8 +1,8 @@
 testthat::test_that("Check Status API Responses", {
   # Testing for successful status code 200
-  expect_null(check_status_api(200))
+  testthat::expect_null(check_status_api(200))
   # Testing for various error status codes
-  expect_error(check_status_api(413))
+  testthat::expect_error(check_status_api(413))
   # Testing for an unspecified status code
-  expect_error(check_status_api(999))
+  testthat::expect_error(check_status_api(999))
 })

tests/testthat/test-construct_api_url.R

@@ -4,14 +4,15 @@ testthat::test_that("API URL Construction without selection", {
 
   actual_url <- construct_api_url(
     base, "data", "2020-01-01",
-    "2020-12-31", "dateField", "regionField", "AFRO", select_vars = NULL)
+    "2020-12-31", "dateField", NULL, "regionField",  "AFRO",
+    select_vars = NULL)
 
   expected_url <- paste0(
     base, "data?$filter=dateField%20ge%20DateTime",
     "'2020-01-01'%20and%20dateField%20le%20DateTime",
     "'2020-12-31'%20and%20regionField%20eq%20'AFRO'")
 
-  expect_equal(actual_url, expected_url)
+  testthat::expect_equal(actual_url, expected_url)
 
 }
 )
@@ -22,7 +23,7 @@ testthat::test_that("API URL Construction without selection", {
 
   actual_url <- construct_api_url(
     base, "data", "2020-01-01",
-    "2020-12-31", "dateField", "regionField", "AFRO",
+    "2020-12-31", "dateField", NULL, "regionField","AFRO",
     c("field1", "field2"))
 
   expected_url <- paste0(
@@ -31,7 +32,7 @@ testthat::test_that("API URL Construction without selection", {
     "'2020-12-31'%20and%20regionField%20eq%20'AFRO'",
     "&$select=field1,field2")
 
-  expect_equal(actual_url, expected_url)
+  testthat::expect_equal(actual_url, expected_url)
 
 }
 )

tests/testthat/test-get_api_date_suffix.R

@@ -1,16 +1,16 @@
 testthat::test_that("Get API Date Suffix Functionality", {
   # Test for valid data types
-  expect_equal(get_api_date_suffix("cases"),
+  testthat::expect_equal(get_api_date_suffix("cases"),
                list(endpoint_suffix = "Case",
                     date_fields_initial = "CaseDate",
                     date_field = "LastUpdateDate"))
-  expect_equal(get_api_date_suffix("virus"),
+  testthat::expect_equal(get_api_date_suffix("virus"),
                list(endpoint_suffix = "Virus",
                     date_fields_initial = "VirusDate",
                     date_field = "UpdatedDate"))
   # Add more tests for other valid data types
 
   # Test for an invalid data type
-  expect_error(
+  testthat::expect_error(
     get_api_date_suffix("invalid_type"), "Invalid data_type specified")
 })

tests/testthat/test-get_polis_api_data.R

@@ -27,9 +27,9 @@ testthat::test_that("get_polis_api_data returns correct data structure", {
                                "2021-01-31", "cases", "AFRO")
 
   # Assertions
-  expect_type(result, "list")
-  expect_true(all(c("id", "date", "cases") %in% names(result)))
-  expect_equal(nrow(result), 5)
+  testthat::expect_type(result, "list")
+  testthat::expect_true(all(c("id", "date", "cases") %in% names(result)))
+  testthat::expect_equal(nrow(result), 5)
 })
 
 

tests/testthat/test-iterative_api_call.R

@@ -5,7 +5,7 @@ testthat::test_that("Get the correct response and status code form API call", {
     head(1) |>
     httr2::resps_data(\(resp) httr2::resp_status(resp))
 
-  expect_equal(status_code, 200)
+  testthat::expect_equal(status_code, 200)
 })
 
 

tests/testthat/test-process_api_response.R

@@ -4,6 +4,6 @@ testthat::test_that("Test functionality of process_api_response", {
   response <- iterative_api_call(url)  |>
     process_api_response()
 
-  expect_type(response, 'list')
+  testthat::expect_type(response, 'list')
 })
 

tests/testthat/test-update_polis_api_data.R

@@ -35,7 +35,7 @@ test_that("Main update_polis_api_data functionality", {
   suppressWarnings(
     result <- update_polis_api_data("2021-01-01", "2021-01-20")
   )
-  expect_equal(nrow(result), 20)
+  testthat::expect_equal(nrow(result), 20)
 
 })