steamline read_weighting_area

ipeaGIT · Sep 4, 2024 · ba43288 · ba43288
1 parent 85a1392
commit ba43288
Show file tree

Hide file tree

Showing 2 changed files with 50 additions and 53 deletions.
diff --git a/r-package/R/read_weighting_area.R b/r-package/R/read_weighting_area.R
@@ -45,61 +45,68 @@ read_weighting_area <- function(code_weighting = "all",
   # check if download failed
   if (is.null(temp_meta)) { return(invisible(NULL)) }
 
-  # Verify code_weighting input
-        # if code_weighting=="all", read the entire country
-        if(code_weighting=="all"){ message("Loading data for the whole country. This might take a few minutes.\n")
-
-        # list paths of files to download
-        file_url <- as.character(temp_meta$download_path)
-
-        # download files
-        temp_sf <- download_gpkg(file_url = file_url,
-                                 showProgress = showProgress,
-                                 cache = cache)
-
-        # check if download failed
-        if (is.null(temp_sf)) { return(invisible(NULL)) }
+  # if code_weighting=="all", read the entire country
+  if(code_weighting=="all"){ message("Loading data for the whole country. This might take a few minutes.\n")}
+
+  # check code_weighting exists in metadata
+  if (!any(code_weighting == 'all' |
+           code_weighting %in% temp_meta$code |
+           substring(code_weighting, 1, 2) %in% temp_meta$code |
+           code_weighting %in% temp_meta$code_abbrev |
+           (year < 1992 & temp_meta$code %in% "mu")
+  )) {
+    stop("Error: Invalid Value to argument code_weighting.")
+  }
 
-        return(temp_sf)
+  # get file url
+  if (code_weighting=="all" | year < 1992) {
+    file_url <- as.character(temp_meta$download_path)
 
-      }
+  } else if (is.numeric(code_weighting)) { # if using numeric code_weighting
+    file_url <- as.character(subset(temp_meta, code==substr(code_weighting, 1, 2))$download_path)
 
-  else if( !(substr(x = code_weighting, 1, 2) %in% temp_meta$code) & !(substr(x = code_weighting, 1, 2) %in% temp_meta$code_abbrev)){
-      stop("Error: Invalid Value to argument code_weighting.")
+  } else if (is.character(code_weighting)) { # if using chacracter code_abbrev
+    file_url <- as.character(subset(temp_meta, code_abbrev==substr(code_weighting, 1, 2))$download_path)
+  }
 
-  } else {
+  # download gpkg
+  temp_sf <- download_gpkg(file_url = file_url,
+                           showProgress = showProgress,
+                           cache = cache)
 
-    # list paths of files to download
-      if (is.numeric(code_weighting)){ file_url <- as.character(subset(temp_meta, code==substr(code_weighting, 1, 2))$download_path) }
-      if (is.character(code_weighting)){ file_url <- as.character(subset(temp_meta, code_abbrev==substr(code_weighting, 1, 2))$download_path) }
+  # check if download failed
+  if (is.null(temp_sf)) { return(invisible(NULL)) }
 
-    # download files
-    temp_sf <- download_gpkg(file_url = file_url,
-                             showProgress = showProgress,
-                             cache = cache)
+  # return all municipalities
+  if (code_weighting =='all') {
+    return(temp_sf)
+  }
 
-    # check if download failed
-    if (is.null(temp_sf)) { return(invisible(NULL)) }
+  # FILTER particular state or muni
+  x <- code_weighting
 
-    # return whole state
-    if(nchar(code_weighting)==2){
-      return(temp_sf)
+  if (!any(code_weighting %in% temp_sf$code_muni |
+           code_weighting %in% temp_sf$code_state |
+           code_weighting %in% temp_sf$abbrev_state)) {
+    stop("Error: Invalid Value to argument code_weighting.")
+  }
 
-    # return municipality
-    } else if(code_weighting %in% temp_sf$code_muni){    # Get weighting area
-      x <- code_weighting
-      temp_sf <- subset(temp_sf, code_muni==x)
-      return(temp_sf)
 
-    # return code weighting area
+  # particular state
+  if(nchar(code_weighting)==2){
 
-    } else if(code_weighting %in% temp_sf$code_weighting){    # Get weighting area
-      x <- code_weighting
-      temp_sf <- subset(temp_sf, code_weighting==x)
-      return(temp_sf)
+    if (is.numeric(code_weighting)) {
+      temp_sf <- subset(temp_sf, code_state == x)
+    }
 
-    } else{
-      stop("Error: Invalid Value to argument code_weighting.")
+    if (is.character(code_weighting)) {
+      temp_sf <- subset(temp_sf, abbrev_state == x)
     }
   }
+
+  # particular muni
+  if(nchar(code_weighting)==7 & is.numeric(code_weighting)){
+    temp_sf <- subset(temp_sf, code_muni == x)
+  }
+  return(temp_sf)
 }
diff --git a/r-package/tests/testthat/test-read_weighting_area.R b/r-package/tests/testthat/test-read_weighting_area.R
@@ -14,16 +14,6 @@ test_that("read_weighting_area", {
 #  expect_true(is( read_weighting_area(code_weighting="AC", year=2010) , "sf"))
   expect_true(is( read_weighting_area(code_weighting=11, year=2010) , "sf"))
 
-  test_code <- read_weighting_area(code_weighting=5205109003001, year=2010)
-
-  # check sf object
-  testthat::expect_true(is(test_code, "sf"))
-
-
-  # check number of weighting areas
-   testthat::expect_equal(nrow(test_code), 1)
-
-
 })