streamlined read_state (from 142 to 50 lines of code)

ipeaGIT · Sep 2, 2024 · a60da5d · a60da5d
1 parent 8235a1f
commit a60da5d
Show file tree

Hide file tree

Showing 5 changed files with 39 additions and 99 deletions.
diff --git a/r-package/R/read_municipal_seat.R b/r-package/R/read_municipal_seat.R
@@ -24,7 +24,7 @@ read_municipal_seat <- function(year = 2010,
                                 cache = TRUE){
 
   # Get metadata with data url addresses
-  temp_meta <- select_metadata(geography="municipal_seat", year=year, simplified=F)
+  temp_meta <- select_metadata(geography="municipal_seat", year=year, simplified=FALSE)
 
   # list paths of files to download
   file_url <- as.character(temp_meta$download_path)

diff --git a/r-package/R/read_state.R b/r-package/R/read_state.R
@@ -36,107 +36,51 @@ read_state <- function(code_state = "all",
   # Get metadata with data url addresses
   temp_meta <- select_metadata(geography="state", year=year, simplified=simplified)
 
-  # check if download failed
+  # check if metadata download failed
   if (is.null(temp_meta)) { return(invisible(NULL)) }
 
+  # check code_state exists in metadata
+  if (!any(code_state == 'all' |
+           code_state %in% temp_meta$code |
+           code_state %in% temp_meta$code_abbrev |
+           (year < 1992 & temp_meta$code == "st")
+           )) {
+    stop("Error: Invalid Value to argument code_state.")
+    }
 
-# BLOCK 2.1 From 1872 to 1991  ----------------------------
-  x <- year
-
-if( x < 1992){
-
-#   if( !(substr(x = code_state, 1, 2) %in% temp_meta$code) &
-#       !(substr(x = code_state, 1, 2) %in% temp_meta$code_abbrev) &
-#       !(substr(x = code_state, 1, 3) %in% "all")) {
-#       stop("Error: Invalid Value to argument code_state.")
-#       }
-
-  if(is.null(code_state)){ stop("Value to argument 'code_state' cannot be NULL")}
-
-  if(code_state=="all"){
 
-    # list paths of files to download
+  # get file url
+  if (code_state=="all" | year < 1992) {
     file_url <- as.character(temp_meta$download_path)
 
-    # download gpkg
-    temp_sf <- download_gpkg(file_url = file_url,
-                             showProgress = showProgress,
-                             cache = cache)
-
-    # check if download failed
-    if (is.null(temp_sf)) { return(invisible(NULL)) }
-
-    return(temp_sf)
-
-  } else if(nchar(code_state)==2){
+      } else if (is.numeric(code_state)) { # if using numeric code_state
+        file_url <- as.character(subset(temp_meta, code==substr(code_state, 1, 2))$download_path)
 
-    # list paths of files to download
-    file_url <- as.character(temp_meta$download_path)
+        } else if (is.character(code_state)) { # if using chacracter code_abbrev
+          file_url <- as.character(subset(temp_meta, code_abbrev==substr(code_state, 1, 2))$download_path)
+        }
 
-    # download gpkg
-    temp_sf <- download_gpkg(file_url = file_url,
-                             showProgress = showProgress,
-                             cache = cache)
+  # download gpkg
+  temp_sf <- download_gpkg(file_url = file_url,
+                           showProgress = showProgress,
+                           cache = cache)
 
-    # check if download failed
-    if (is.null(temp_sf)) { return(invisible(NULL)) }
+  # check if download failed
+  if (is.null(temp_sf)) { return(invisible(NULL)) }
 
-    temp_sf <- subset(temp_sf,code_state==substr(code_state, 1, 2))
+  # data files before 1992 do not have state code nor state abbrev
+  if (year < 1992){
     return(temp_sf)
   }
 
-}  else {
-
-
-# BLOCK 2.2 From 2000 onwards  ----------------------------
-
-  # Verify code_state input
-
-  # if code_state=="all", read the entire country
-    if(code_state=="all"){
-
-      # list paths of files to download
-      file_url <- as.character(temp_meta$download_path)
-
-      # download gpkg
-      temp_sf <- download_gpkg(file_url = file_url,
-                               showProgress = showProgress,
-                               cache = cache)
-
-      # check if download failed
-      if (is.null(temp_sf)) { return(invisible(NULL)) }
-
-      return(temp_sf)
-    }
-
-  if (!(substr(x = code_state, 1, 2) %in% temp_meta$code) & !(substr(x = code_state, 1, 2) %in% temp_meta$code_abbrev)) {
-      stop("Error: Invalid Value to argument code_state.")
-
-  } else{
-
-    # list paths of files to download
-    if (is.numeric(code_state)){ file_url <- as.character(subset(temp_meta, code==substr(code_state, 1, 2))$download_path) }
-    if (is.character(code_state)){ file_url <- as.character(subset(temp_meta, code_abbrev==substr(code_state, 1, 2))$download_path) }
-
-
-    # download gpkg
-    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 (nchar(code_state)==2) {
-      return(temp_sf)
-
-    # } else if(code_state %in% shape$code_state){
-    #   x <- code_state
-    #   shape <- subset(shape, code_state==x)
-    #   return(shape)
-
-    } else{
-      stop("Error: Invalid Value to argument code_state.")
-    }
-  }
-}}
+  # if particular state
+  x <- code_state
+  if (code_state!='all' & is.numeric(x)) {
+      temp_sf <- subset(temp_sf, code_state == x)
+      }
+  if (code_state!='all' & is.character(code_state)) {
+      temp_sf <- subset(temp_sf, abbrev_state == x)
+      }
+
+  return(temp_sf)
+}
diff --git a/r-package/R/utils.R b/r-package/R/utils.R
@@ -93,6 +93,7 @@ select_metadata <- function(geography, year=NULL, simplified=NULL){
 
 #' Support function to download metadata internally used in geobr
 #'
+#'
 #' @keywords internal
 #' @examples \dontrun{ if (interactive()) {
 #' df <- download_metadata()
@@ -123,7 +124,6 @@ download_metadata <- function(){ # nocov start
     if (is.null(check_con) | isFALSE(check_con)) { return(invisible(NULL)) }
   }
 
-
   # download metadata to temp file
   try( silent = TRUE,
        downloaded_files <- curl::multi_download(
@@ -183,7 +183,7 @@ download_gpkg <- function(file_url = parent.frame()$file_url,
 
     # if server1 fails, replace url and test connection with server2
     if (is.null(check_con) | isFALSE(check_con)) {
-      url <- url2
+      url <- file_url2
       try( silent = TRUE, check_con <- check_connection(file_url[1], silent = FALSE))
       if (is.null(check_con) | isFALSE(check_con)) { return(invisible(NULL)) }
     }

diff --git a/r-package/tests/tests_rafa/long_term_cache.R b/r-package/tests/tests_rafa/long_term_cache.R
@@ -13,9 +13,7 @@ https://gitlab.com/cnrgh/databases/r-fscache
 #'
 #' 3) usar {curl} multi_download (aguardando resposta sobre etag)
 #'    - baixa de novo se arquivo atualiza: sim, SOH se tamanho de arquivo for diferente
-falta soh
-- adicionar parametro template de cache em todas funcoes (municipality ja foi)
-- substituir bar_progress por showProgress em todas funcoes (municipality ja foi)
+
 
 
 

diff --git a/r-package/tests/testthat/test-read_state.R b/r-package/tests/testthat/test-read_state.R
@@ -19,7 +19,6 @@ test_that("read_state", {
   expect_true(is(  read_state(code_state='AC', year=2010) , "sf"))
 
 
-
   # check sf object
   test_code <- read_state(code_state=11, year=2010)
   testthat::expect_true(is(test_code, "sf"))
@@ -49,5 +48,4 @@ test_that("read_state", {
    testthat::expect_error(read_state( year=9999999))
    testthat::expect_error(read_state(showProgress = 'aaaa'))
 
-
 })