feat: add .uniques argument (default to TRUE) to allow to get the dup…

…licated IDs if required
adatar-do · Jul 24, 2024 · 65e6cf2 · 65e6cf2
1 parent e9d3ff5
commit 65e6cf2
Show file tree

Hide file tree

Showing 13 changed files with 167 additions and 113 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: sfDR
 Title: Simple Features for Dominican Republic Administrative Boundaries
-Version: 0.2.0
+Version: 0.2.2
 Authors@R: 
     c(person(given = "Daniel E.",
            family = "de la Rosa",

diff --git a/R/dm.R b/R/dm.R
@@ -9,6 +9,8 @@
 #' @param .mun Logical; if FALSE, removes columns related to municipalities. Defaults to FALSE.
 #' @param .prov Logical; if FALSE, removes columns related to provinces. Defaults to FALSE.
 #' @param .reg Logical; if FALSE, removes columns related to regions. Defaults to FALSE.
+#' @param .uniques Logical; if TRUE, removes some duplicated IDs inserted to consider
+#'  territories names changes over time. Defaults to TRUE.
 #'
 #' @return A data frame or `sf` object (if .sf is TRUE) with the loaded and processed data.
 #' @export
@@ -34,23 +36,27 @@
 #'
 #' @examples
 #' \dontrun{
-#'   # Load and process the data as sf object
-#'   result <- dr_municipal_districts(TRUE, TRUE, TRUE, TRUE)
-#'   print(result)
+#' # Load and process the data as sf object
+#' result <- dr_municipal_districts(TRUE, TRUE, TRUE, TRUE)
+#' print(result)
 #' }
 #'
-dr_municipal_districts <- function(.sf = TRUE, .mun = FALSE, .prov = FALSE, .reg = FALSE) {
+dr_municipal_districts <- function(.sf = TRUE, .mun = FALSE, .prov = FALSE, .reg = FALSE, .uniques = TRUE) {
   MD_ID <- NULL
 
+  metadata <- pins::pin_read(
+    pins::board_folder(system.file("extdata", package = "sfDR")),
+    "DR_MD_METADATA"
+  )
+
+  if (.uniques) {
+    metadata <- metadata %>%
+      dplyr::distinct(MD_ID, .keep_all = T)
+  }
+
   drmd <- DR_MUNICIPAL_DISTRICTS %>%
-    dplyr::left_join(
-      pins::pin_read(
-        pins::board_folder(system.file("extdata", package = "sfDR")),
-        "DR_MD_METADATA"
-      ) %>%
-        dplyr::distinct(MD_ID, .keep_all = T),
-      by = dplyr::join_by(MD_ID)
-    ) %>%
+    sf::st_as_sf() %>%
+    dplyr::left_join(metadata, by = dplyr::join_by(MD_ID)) %>%
     .add_mun(.prov, .reg)
 
   if (!.mun) {

diff --git a/R/municipality.R b/R/municipality.R
@@ -8,6 +8,8 @@
 #' @param .sf Logical; if TRUE, converts the result to an `sf` object. Defaults to TRUE.
 #' @param .prov Logical; if FALSE, removes columns related to provinces. Defaults to FALSE.
 #' @param .reg Logical; if FALSE, removes columns related to regions. Defaults to FALSE.
+#' @param .uniques Logical; if TRUE, removes some duplicated IDs inserted to consider
+#'  territories names changes over time. Defaults to TRUE.
 #'
 #' @return A data frame or `sf` object (if .sf is TRUE) with the loaded and processed data.
 #' @export
@@ -31,34 +33,38 @@
 #'
 #' @examples
 #' \dontrun{
-#'   # Load and process the data as sf object
-#'   result <- dr_municipalities(TRUE, TRUE, TRUE)
-#'   print(result)
+#' # Load and process the data as sf object
+#' result <- dr_municipalities(TRUE, TRUE, TRUE)
+#' print(result)
 #' }
 #'
-dr_municipalities <- function(.sf = TRUE, .prov = FALSE, .reg = FALSE){
+dr_municipalities <- function(.sf = TRUE, .prov = FALSE, .reg = FALSE, .uniques = TRUE) {
   MUN_ID <- NULL
 
+  metadata <- pins::pin_read(
+    pins::board_folder(system.file("extdata", package = "sfDR")),
+    "DR_MUN_METADATA"
+  )
+
+  if (.uniques) {
+    metadata <- metadata %>%
+      dplyr::distinct(MUN_ID, .keep_all = T)
+  }
+
   drm <- DR_MUN %>%
-    dplyr::left_join(
-      pins::pin_read(
-        pins::board_folder(system.file('extdata', package = 'sfDR')),
-        'DR_MUN_METADATA'
-      ) %>%
-        dplyr::distinct(MUN_ID, .keep_all = T),
-      by = dplyr::join_by(MUN_ID)
-    ) %>%
+    sf::st_as_sf() %>%
+    dplyr::left_join(metadata, by = dplyr::join_by(MUN_ID)) %>%
     .add_prov(.reg)
 
-  if(!.prov){
+  if (!.prov) {
     drm <- drm %>%
       dplyr::select(-dplyr::starts_with("PROV"))
   }
-  if(!.reg){
+  if (!.reg) {
     drm <- drm %>%
       dplyr::select(-dplyr::starts_with("REG"))
   }
-  if(!.sf){
+  if (!.sf) {
     drm <- drm %>%
       sf::st_drop_geometry()
   }
@@ -67,7 +73,7 @@ dr_municipalities <- function(.sf = TRUE, .prov = FALSE, .reg = FALSE){
 
 
 
-.add_prov <- function(drm, .reg = FALSE){
+.add_prov <- function(drm, .reg = FALSE) {
   MUN_ID <- NULL
 
   drm %>%

diff --git a/R/province.R b/R/province.R
@@ -7,6 +7,8 @@
 #'
 #' @param .sf Logical; if TRUE, converts the result to an `sf` object. Defaults to TRUE.
 #' @param .reg Logical; if FALSE, removes columns related to regions. Defaults to FALSE.
+#' @param .uniques Logical; if TRUE, removes some duplicated IDs inserted to consider
+#'  territories names changes over time. Defaults to TRUE.
 #'
 #' @return A data frame or `sf` object (if .sf is TRUE) with the loaded and processed data.
 #' @export
@@ -28,30 +30,34 @@
 #'
 #' @examples
 #' \dontrun{
-#'   # Load and process the data as sf object
-#'   result <- dr_provinces(TRUE, TRUE)
-#'   print(result)
+#' # Load and process the data as sf object
+#' result <- dr_provinces(TRUE, TRUE)
+#' print(result)
 #' }
 #'
-dr_provinces <- function(.sf = TRUE, .reg = FALSE){
+dr_provinces <- function(.sf = TRUE, .reg = FALSE, .uniques = TRUE) {
   PROV_ID <- NULL
 
+  metadata <- pins::pin_read(
+    pins::board_folder(system.file("extdata", package = "sfDR")),
+    "DR_PROV_METADATA"
+  )
+
+  if (.uniques) {
+    metadata <- metadata %>%
+      dplyr::distinct(PROV_ID, .keep_all = T)
+  }
+
   drp <- DR_PROV %>%
-    dplyr::left_join(
-      pins::pin_read(
-        pins::board_folder(system.file('extdata', package = 'sfDR')),
-        'DR_PROV_METADATA'
-      ) %>%
-        dplyr::distinct(PROV_ID, .keep_all = T),
-      by = dplyr::join_by(PROV_ID)
-    ) %>%
+    sf::st_as_sf() %>%
+    dplyr::left_join(metadata, by = dplyr::join_by(PROV_ID)) %>%
     .add_reg()
 
-  if(!.reg){
+  if (!.reg) {
     drp <- drp %>%
       dplyr::select(-dplyr::starts_with("REG"))
   }
-  if(!.sf){
+  if (!.sf) {
     drp <- drp %>%
       sf::st_drop_geometry()
   }
@@ -60,20 +66,20 @@ dr_provinces <- function(.sf = TRUE, .reg = FALSE){
 
 
 
-.add_reg <- function(drp){
-  drp = drp %>%
+.add_reg <- function(drp) {
+  drp <- drp %>%
     dplyr::mutate(
       REG_ID = dplyr::case_when(
-        as.numeric(PROV_ID) %in% c(25, 18, 9) ~ '01',
-        as.numeric(PROV_ID) %in% c(13, 24, 28) ~ '02',
-        as.numeric(PROV_ID) %in% c(6, 19, 14, 20) ~ '03',
-        as.numeric(PROV_ID) %in% c(27, 15, 5, 26) ~ '04',
-        as.numeric(PROV_ID) %in% c(21, 2, 17, 31) ~ '05',
-        as.numeric(PROV_ID) %in% c(4, 3, 16, 10) ~ '06',
-        as.numeric(PROV_ID) %in% c(22, 7) ~ '07',
-        as.numeric(PROV_ID) %in% c(12, 11, 8) ~ '08',
-        as.numeric(PROV_ID) %in% c(23, 30, 29) ~ '09',
-        as.numeric(PROV_ID) %in% c(1, 32) ~ '10'
+        as.numeric(PROV_ID) %in% c(25, 18, 9) ~ "01",
+        as.numeric(PROV_ID) %in% c(13, 24, 28) ~ "02",
+        as.numeric(PROV_ID) %in% c(6, 19, 14, 20) ~ "03",
+        as.numeric(PROV_ID) %in% c(27, 15, 5, 26) ~ "04",
+        as.numeric(PROV_ID) %in% c(21, 2, 17, 31) ~ "05",
+        as.numeric(PROV_ID) %in% c(4, 3, 16, 10) ~ "06",
+        as.numeric(PROV_ID) %in% c(22, 7) ~ "07",
+        as.numeric(PROV_ID) %in% c(12, 11, 8) ~ "08",
+        as.numeric(PROV_ID) %in% c(23, 30, 29) ~ "09",
+        as.numeric(PROV_ID) %in% c(1, 32) ~ "10"
       )
     ) %>%
     dplyr::left_join(
@@ -90,9 +96,7 @@ dr_provinces <- function(.sf = TRUE, .reg = FALSE){
 #'
 #' @param ... Arguments to pass to `dr_provinces()`.
 #' @export
-get_dr_provinces <- function(...){
+get_dr_provinces <- function(...) {
   lifecycle::deprecate_warn("0.1.0", "get_dr_provinces()", "dr_provinces()")
   dr_provinces(...)
 }
-
-
diff --git a/R/region.R b/R/region.R
@@ -5,6 +5,8 @@
 #' and adds metadata. It also optionally converts the result to an `sf` object.
 #'
 #' @param .sf Logical; if TRUE, converts the result to an `sf` object. Defaults to TRUE.
+#' @param .uniques Logical; if TRUE, removes some duplicated IDs inserted to consider
+#'  territories names changes over time. Defaults to TRUE.
 #'
 #' @return A data frame or `sf` object (if .sf is TRUE) with the loaded and processed data.
 #' @export
@@ -23,24 +25,28 @@
 #'
 #' @examples
 #' \dontrun{
-#'   # Load and process the data as sf object
-#'   result <- dr_regions()
-#'   print(result)
+#' # Load and process the data as sf object
+#' result <- dr_regions()
+#' print(result)
 #' }
 #'
-dr_regions <- function(.sf = TRUE) {
+dr_regions <- function(.sf = TRUE, .uniques = TRUE) {
   REG_ID <- NULL
   geometry <- NULL
 
+  metadata <- pins::pin_read(
+    pins::board_folder(system.file("extdata", package = "sfDR")),
+    "DR_REG_METADATA"
+  )
+
+  if (.uniques) {
+    metadata <- metadata %>%
+      dplyr::distinct(REG_ID, .keep_all = T)
+  }
+
   drr <- DR_REG %>%
-    dplyr::left_join(
-      pins::pin_read(
-        pins::board_folder(system.file("extdata", package = "sfDR")),
-        "DR_REG_METADATA"
-      ) %>%
-        dplyr::distinct(REG_ID, .keep_all = T),
-      by = dplyr::join_by(REG_ID)
-    ) %>%
+    sf::st_as_sf() %>%
+    dplyr::left_join(metadata, by = dplyr::join_by(REG_ID)) %>%
     dplyr::relocate(geometry, .after = dplyr::last_col())
 
   if (!.sf) {
@@ -50,4 +56,3 @@ dr_regions <- function(.sf = TRUE) {
 
   drr
 }
-
diff --git a/R/sec.R b/R/sec.R
@@ -10,6 +10,8 @@
 #' @param .mun Logical; if FALSE, removes columns related to municipalities. Defaults to FALSE.
 #' @param .prov Logical; if FALSE, removes columns related to provinces. Defaults to FALSE.
 #' @param .reg Logical; if FALSE, removes columns related to regions. Defaults to FALSE.
+#' @param .uniques Logical; if TRUE, removes some duplicated IDs inserted to consider
+#'  territories names changes over time. Defaults to TRUE.
 #'
 #' @return A data frame or `sf` object (if .sf is TRUE) with the loaded and processed data.
 #' @export
@@ -37,46 +39,50 @@
 #'
 #' @examples
 #' \dontrun{
-#'   # Load and process the data as sf object
-#'   result <- dr_sections(TRUE, TRUE, TRUE, TRUE, TRUE)
-#'   print(result)
+#' # Load and process the data as sf object
+#' result <- dr_sections(TRUE, TRUE, TRUE, TRUE, TRUE)
+#' print(result)
 #' }
 #'
-dr_sections <- function(.sf = TRUE, .dm = FALSE, .mun = FALSE, .prov = FALSE, .reg = FALSE){
+dr_sections <- function(.sf = TRUE, .dm = FALSE, .mun = FALSE, .prov = FALSE, .reg = FALSE, .uniques = TRUE) {
   SEC_ID <- NULL
 
+  metadata <- pins::pin_read(
+    pins::board_folder(system.file("extdata", package = "sfDR")),
+    "DR_SECTIONS_METADATA"
+  )
+
+  if (.uniques) {
+    metadata <- metadata %>%
+      dplyr::distinct(SEC_ID, .keep_all = T)
+  }
+
   drs <- DR_SECTIONS %>%
-    dplyr::left_join(
-      pins::pin_read(
-        pins::board_folder(system.file('extdata', package = 'sfDR')),
-        'DR_SECTIONS_METADATA'
-      ) %>%
-        dplyr::distinct(SEC_ID, .keep_all = T),
-      by = dplyr::join_by(SEC_ID)
-    ) %>%
+    sf::st_as_sf() %>%
+    dplyr::left_join(metadata, by = dplyr::join_by(SEC_ID)) %>%
     .add_dm(.mun, .prov, .reg)
 
-  if(!.dm){
+  if (!.dm) {
     drs <- drs %>%
       dplyr::select(-dplyr::starts_with("MD"))
   }
 
-  if(!.mun){
+  if (!.mun) {
     drs <- drs %>%
       dplyr::select(-dplyr::starts_with("MUN"))
   }
 
-  if(!.prov){
+  if (!.prov) {
     drs <- drs %>%
       dplyr::select(-dplyr::starts_with("PROV"))
   }
 
-  if(!.reg){
+  if (!.reg) {
     drs <- drs %>%
       dplyr::select(-dplyr::starts_with("REG"))
   }
 
-  if(!.sf){
+  if (!.sf) {
     drs <- drs %>%
       sf::st_drop_geometry()
   }
@@ -86,7 +92,7 @@ dr_sections <- function(.sf = TRUE, .dm = FALSE, .mun = FALSE, .prov = FALSE, .r
 
 
 
-.add_dm <- function(drsec, .mun = FALSE, .prov = FALSE, .reg = FALSE){
+.add_dm <- function(drsec, .mun = FALSE, .prov = FALSE, .reg = FALSE) {
   SEC_ID <- NULL
 
   drsec %>%
@@ -96,6 +102,3 @@ dr_sections <- function(.sf = TRUE, .dm = FALSE, .mun = FALSE, .prov = FALSE, .r
       by = "MD_ID"
     )
 }
-
-
-
diff --git a/data-raw/dr_provinces.R b/data-raw/dr_provinces.R
@@ -6,6 +6,7 @@ dr_province <- dplyr::tribble(
   "NA", "_NA_", "00",
   "DN", "Distrito Nacional", "01",
   "AZU", "Azua", "02",
+  "AZU", "Azua de Compostela", "02",
   "BAH", "Baoruco", "03",
   "BAH", "Bahoruco", "03",
   "BAR", "Barahona", "04",