Refactor code and use internally esp_move_can

rOpenSpain · Jan 15, 2024 · 73f50ae · 73f50ae
1 parent 5fc151a
commit 73f50ae
Show file tree

Hide file tree

Showing 11 changed files with 53 additions and 163 deletions.
diff --git a/R/esp_get_can_box.R b/R/esp_get_can_box.R
@@ -159,20 +159,7 @@ esp_get_can_box <- function(style = "right",
   moving <- isTRUE(moveCAN) | length(moveCAN) > 1
 
   if (moving) {
-    offset <- c(550000, 920000)
-
-    if (length(moveCAN) > 1) {
-      coords <- sf::st_point(moveCAN)
-      coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-      coords <- sf::st_transform(coords, 3857)
-      coords <- sf::st_coordinates(coords)
-      offset <- offset + as.double(coords)
-    }
-
-    can <- sf::st_transform(lall, 3857) + offset
-    can <- sf::st_sfc(can, crs = 3857)
-    can <- sf::st_transform(can, sf::st_crs(lall))
-    lall <- can
+    lall <- esp_move_can(lall, moveCAN = moveCAN)
   }
 
   # Transform
@@ -220,20 +207,7 @@ esp_get_can_provinces <- function(moveCAN = TRUE,
   moving <- isTRUE(moveCAN) | length(moveCAN) > 1
 
   if (moving) {
-    offset <- c(550000, 920000)
-
-    if (length(moveCAN) > 1) {
-      coords <- sf::st_point(moveCAN)
-      coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-      coords <- sf::st_transform(coords, 3857)
-      coords <- sf::st_coordinates(coords)
-      offset <- offset + as.double(coords)
-    }
-
-    can <- sf::st_transform(lall, 3857) + offset
-    can <- sf::st_sfc(can, crs = 3857)
-    can <- sf::st_transform(can, sf::st_crs(lall))
-    lall <- can
+    lall <- esp_move_can(lall, moveCAN = moveCAN)
   }
 
   # Transform

diff --git a/R/esp_get_capimun.R b/R/esp_get_capimun.R
@@ -160,25 +160,10 @@ esp_get_capimun <- function(year = Sys.Date(),
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
 
-      # Move CAN
-      can <- sf::st_sf(sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
+      can <- esp_move_can(can, moveCAN = moveCAN)
 
       # Regenerate
       if (nrow(penin) > 0) {

diff --git a/R/esp_get_ccaa.R b/R/esp_get_ccaa.R
@@ -248,25 +248,11 @@ esp_get_ccaa_siane <- function(ccaa = NULL,
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
 
       # Move CAN
-      can <- sf::st_sf(sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
+      can <- esp_move_can(can, moveCAN = moveCAN)
 
       # Regenerate
       if (nrow(penin) > 0) {

diff --git a/R/esp_get_comarca.R b/R/esp_get_comarca.R
@@ -139,25 +139,11 @@ esp_get_comarca <- function(region = NULL,
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
 
       # Move CAN
-      can <- sf::st_sf(sf::st_drop_geometry(can),
-        geom = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
+      can <- esp_move_can(can, moveCAN = moveCAN)
 
       # Regenerate
       if (nrow(penin) > 0) {

diff --git a/R/esp_get_munic.R b/R/esp_get_munic.R
@@ -273,26 +273,11 @@ esp_get_munic <- function(year = "2019",
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
 
       # Move CAN
-      can <- sf::st_sf(
-        sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
+      can <- esp_move_can(can, moveCAN = moveCAN)
 
       # Regenerate
       if (nrow(penin) > 0) {
@@ -417,27 +402,11 @@ esp_get_munic_siane <- function(year = Sys.Date(),
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
 
       # Move CAN
-      can <- sf::st_sf(
-        sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
-
+      can <- esp_move_can(can, moveCAN = moveCAN)
       # Regenerate
       if (nrow(penin) > 0) {
         data_sf <- rbind(penin, can)

diff --git a/R/esp_get_nuts.R b/R/esp_get_nuts.R
@@ -267,26 +267,11 @@ esp_get_nuts <- function(year = "2016",
 
   if (moving) {
     if (length(grep("ES7", data_sf$NUTS_ID)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("ES7", data_sf$NUTS_ID), ]
       can <- data_sf[grep("ES7", data_sf$NUTS_ID), ]
 
       # Move can
-      can <- sf::st_sf(
-        sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
+      can <- esp_move_can(can, moveCAN = moveCAN)
 
       # Regenerate
       if (nrow(penin) > 0) {

diff --git a/R/esp_get_prov.R b/R/esp_get_prov.R
@@ -346,26 +346,10 @@ esp_get_prov_siane <- function(prov = NULL,
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
-      data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
 
-      # Move can
-      can <- sf::st_sf(
-        sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
-      )
+      can <- esp_move_can(can, moveCAN = moveCAN)
 
       # Regenerate
       if (nrow(penin) > 0) {

diff --git a/R/esp_get_roads.R b/R/esp_get_roads.R
@@ -90,16 +90,6 @@ esp_get_roads <- function(year = Sys.Date(),
 
   if (moving) {
     if (length(grep("05", data_sf$codauto)) > 0) {
-      offset <- c(550000, 920000)
-
-      if (length(moveCAN) > 1) {
-        coords <- sf::st_point(moveCAN)
-        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
-        coords <- sf::st_transform(coords, 3857)
-        coords <- sf::st_coordinates(coords)
-        offset <- offset + as.double(coords)
-      }
-
       data_sf <- sf::st_transform(data_sf, 3857)
       penin <- data_sf[-grep("05", data_sf$codauto), ]
       can <- data_sf[grep("05", data_sf$codauto), ]
@@ -112,12 +102,13 @@ esp_get_roads <- function(year = Sys.Date(),
       )
 
       # Move can
-      can <- sf::st_sf(
-        sf::st_drop_geometry(can),
-        geometry = sf::st_geometry(can) + offset,
-        crs = sf::st_crs(can)
+      can <- sf::st_sf(sf::st_drop_geometry(can),
+        geometry = sf::st_geometry(can), crs = sf::st_crs(can)
       )
 
+      can <- esp_move_can(can, moveCAN = moveCAN)
+
+
       # Regenerate
       data_sf <- rbind(penin, can)
     }

diff --git a/R/esp_move_can.R b/R/esp_move_can.R
@@ -69,6 +69,14 @@ esp_move_can <- function(x, moveCAN = TRUE) {
   }
 
   is_sfc <- inherits(x, "sfc")
+
+  # If no object then return the same
+  g <- sf::st_geometry(x)
+
+  if (length(g) == 0) {
+    return(x)
+  }
+
   moving <- FALSE
   moving <- isTRUE(moveCAN) | length(moveCAN) > 1
 

diff --git a/man/esp_move_can.Rd b/man/esp_move_can.Rd
diff --git a/tests/testthat/test-esp_move_can.R b/tests/testthat/test-esp_move_can.R
@@ -37,8 +37,12 @@ test_that("sfc", {
   expect_identical(sf::st_crs(moved3), sf::st_crs(teide_sfc_3857))
 
   # Check movs
-  mat <- sf::st_coordinates(sf::st_geometry(moved3[1]) -
-    sf::st_geometry(teide_sfc_3857[1]))
+
+  # Avoid errors due to changes in precision across GDAL versions
+  skip_on_cran()
+
+  a1 <- sf::st_geometry(moved3[1]) - sf::st_geometry(teide_sfc_3857[1])
+  mat <- sf::st_coordinates(a1)
 
   # Default mov in 3857
   expect_identical(
@@ -51,14 +55,11 @@ test_that("sfc", {
 
   moved4 <- esp_move_can(teide_sfc, moveCAN = c(5, 10))
 
+  a2 <- sf::st_geometry(moved4) - sf::st_geometry(teide_sfc)
+  mat2 <- sf::st_coordinates(a2)
 
-  mat2 <- sf::st_coordinates(sf::st_geometry(moved4) -
-    sf::st_geometry(teide_sfc))
 
 
-  # Avoid errors due to changes in precision across GDAL versions
-  skip_on_cran()
-
   expect_equal(sort(unique(as.integer(mat2))), c(9L, 14L))
 })
 
@@ -102,3 +103,24 @@ test_that("sf", {
 
   expect_true(all(sf::st_is_valid(moved3)))
 })
+
+
+test_that("Empty", {
+  teide <- data.frame(
+    name = rep("test", 20),
+    lon = seq(-16.1, -15.8, length.out = 20),
+    lat = seq(28.2, 29, length.out = 20)
+  )
+
+  teide_sf <- sf::st_as_sf(teide, coords = c("lon", "lat"), crs = 4326)
+  teide_null <- teide_sf[teide_sf$name != "test", ]
+  expect_equal(nrow(teide_null), 0)
+  expect_identical(teide_null, esp_move_can(teide_null, moveCAN = TRUE))
+
+  # sfc
+  teide_null_sfc <- sf::st_geometry(teide_null)
+  expect_equal(length(teide_null_sfc), 0)
+  expect_identical(teide_null_sfc, esp_move_can(teide_null_sfc,
+    moveCAN = TRUE
+  ))
+})