more input checks and update tests

R/agg_worldpop_f.R

@@ -35,6 +35,12 @@ agg_worldpop <- function(shape, country_code, method, resolution, year, async =
 message <- NULL
 pop_ras <- NULL
 
+valid_countries <- readRDS(system.file("ex", "countries.rds", package = "geodata"))$ISO3
+invalid_countries <- country_code[(!country_code %in% valid_countries)]
+if (length(invalid_countries) > 0){
+  message <- glue::glue("{invalid_countries} is not a valid IS03 country code.")
+}
+
 if (!(method %in% c("Unconstrained", "Constrained"))){
   message <-"Method must be either \"Constrained\" or \"Unconstrained\""
 }

R/prep_summary_f.R

@@ -59,7 +59,7 @@ prep_summary <- function(covs, remove = FALSE, logger = NULL){
                         "Y minimum", "Y maximum"
                         )
 
-  if (remove == TRUE){
+  if (remove){
     # remove columns with the same values
     cov_df <- cov_df[vapply(cov_df, function(x) length(unique(x)) > 1, logical(1L))]
   }

R/resp_combine_f.R

@@ -38,7 +38,7 @@
 resp_combine <- function(df, df_area_column, df_resp_column, shape, shape_area_column, logger = NULL) {
 
   # check inputs
-  if (!("data.frame" %in% class(df))){
+  if (!inherits(df, "data.frame")){
     logger |> writeLog(type = "error", "df must be a data.frame")
   }
 
@@ -49,7 +49,7 @@ resp_combine <- function(df, df_area_column, df_resp_column, shape, shape_area_c
     logger |> writeLog(type = "error", glue::glue("df does not contain the column(s): {missing_column}"))
   }
 
-  if (!("sf" %in% class(shape))){
+  if (!inherits(shape, "sf")){
     logger |> writeLog(type = "error", "shape must be an sf object")
   }
 

R/resp_download_f.R

@@ -22,6 +22,42 @@
 #'
 resp_download <- function(df, area_column, resp_column, country_code, admin_level, logger = NULL) {
 
+  # check inputs
+  if (!inherits(df, "data.frame")){
+    logger |> writeLog(type = "error", "df must be a data.frame")
+    return()
+  }
+
+  character_variables = list("area_column" = area_column,
+                             "resp_column" = resp_column,
+                             "country_code" = country_code,
+                             "admin_level" = admin_level)
+  for (i in names(character_variables)){
+    if (!inherits(character_variables[[i]], "character")){
+      logger |> writeLog(type = "error", glue::glue("{i} must be a character string"))
+      return()
+    }
+  }
+
+  df_columns <- c(area_column, resp_column)
+  if (!all(df_columns %in% colnames(df))){
+    missing_column <- df_columns[!(df_columns %in% colnames(df))]
+    missing_column <- paste(missing_column, collapse = ",")
+    logger |> writeLog(type = "error", glue::glue("df does not contain the column(s): {missing_column}"))
+  }
+
+  valid_countries <- readRDS(system.file("ex", "countries.rds", package = "geodata"))$ISO3
+  invalid_countries <- country_code[(!country_code %in% valid_countries)]
+  if (length(invalid_countries) > 0){
+    logger |> writeLog(type = "error", glue::glue("{invalid_countries} is not a valid IS03 country code"))
+    return()
+  }
+
+  if (!(admin_level %in% c("ADM1", "ADM2"))){
+    logger |> writeLog(type = "error", "admin_level must be either ADM1 or ADM2")
+    return()
+  }
+
   shape <- NULL
 
   for (c in country_code){
@@ -34,7 +70,7 @@ resp_download <- function(df, area_column, resp_column, country_code, admin_leve
     )
 
     if (is.null(resp) || resp$status_code != 200){
-      logger |> writeLog(type = "error", "The requested boundaries could not be downloaded")
+      logger |> writeLog(type = "error", "The requested boundaries could not be downloaded, the requested admin level may be unavailable")
       return()
     } else {
       cont <- httr2::resp_body_json(resp)

tests/testthat/test-agg_worldpop.R

@@ -34,7 +34,7 @@ expect_error(agg_worldpop(lie_shape, country_code[1], "aaaa", "1km", 2012), "Met
 expect_error(agg_worldpop(lie_shape, country_code[1], "Constrained", "aaaa", 2020),"Resolution must be either \"100m\" or \"1km\"")
 expect_error(agg_worldpop(lie_shape, country_code[1], "Constrained", "1km", 2012), "Constrained population data is only available for 2020")
 expect_error(agg_worldpop(lie_shape, country_code[1], "Unconstrained", "1km", 1999), "Unconstrained data is only available between 2000 and 2020")
-expect_error(agg_worldpop(lie_shape, "ZZZ", "Unconstrained", "1km", 2000), "The requested data could not be found")
+expect_error(agg_worldpop(lie_shape, "ZZZ", "Unconstrained", "1km", 2000), "ZZZ is not a valid IS03 country code.")
 })
 
 test_that("{shinytest2} recording: e2e_agg_worldpop", {

tests/testthat/test-resp_download.R

@@ -10,6 +10,16 @@ test_that("Check resp_download function works as expected for multiple countries
   expect_equal(nrow(result), 37)
 })
 
+test_that("Check resp_download returns errors with faulty inputs", {
+  expect_error(resp_download(df, 1, resp_column, "LIE", "ADM1"), "area_column must be a character string")
+  expect_error(resp_download(df, area_column, 1, "LIE", "ADM1"), "resp_column must be a character string")
+  expect_error(resp_download(df, area_column, resp_column, 1, "ADM1"), "country_code must be a character string")
+  expect_error(resp_download(df, area_column, resp_column, "LIE", 1), "admin_level must be a character string")
+  expect_error(resp_download(df, "a", resp_column, "LIE", "ADM1"), "df does not contain the column\\(s\\): a")
+  expect_error(resp_download(df, area_column, "a", "LIE", "ADM1"), "df does not contain the column\\(s\\): a")
+  expect_error(resp_download(df, area_column, resp_column, "LIE", "a"), "admin_level must be either ADM1 or ADM2")
+  expect_error(resp_download(df, area_column, resp_column, "ZZZ", "ADM1"), "ZZZ is not a valid IS03 country code")
+})
 
 test_that("Check resp_download reports errors when data cannot be merged", {
   tdf <- df