Merge pull request #21 from rubenfcasal/ria_coord

Fix bug in RIA coordinates (#20)
emf-creaf · Dec 18, 2023 · 77a92e8 · 77a92e8
2 parents e93dab4 + 53051a8
commit 77a92e8
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 11 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: meteospain
 Title: Access to Spanish Meteorological Stations Services
-Version: 0.1.3
+Version: 0.1.4
 Authors@R: 
     c(
       person(given = "Victor",

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# meteospain 0.1.4
+
+* Fixed bug in RIA coordinates (#20)
+
 # meteospain 0.1.3
 
 * meteocat API: new data limits, now daily data can be retrieved starting on 1989

diff --git a/R/ria_helpers.R b/R/ria_helpers.R
@@ -191,16 +191,8 @@
     dplyr::mutate(
       station_id = as.character(glue::glue("{province_id}-{station_id}")),
       altitude = units::set_units(.data$altitude, 'm'),
-      latitud = dplyr::if_else(
-        stringr::str_detect(.data$latitud, 'S'),
-        -as.numeric(stringr::str_remove_all(.data$latitud, '[A-Za-z]'))/1e7,
-        as.numeric(stringr::str_remove_all(.data$latitud, '[A-Za-z]'))/1e7
-      ),
-      longitud = dplyr::if_else(
-        stringr::str_detect(.data$longitud, 'W'),
-        -as.numeric(stringr::str_remove_all(.data$longitud, '[A-Za-z]'))/1e7,
-        as.numeric(stringr::str_remove_all(.data$longitud, '[A-Za-z]'))/1e7
-      )
+      latitud = .parse_coords_dmsh(latitud),
+      longitud = .parse_coords_dmsh(longitud),
     ) |>
     sf::st_as_sf(coords = c('longitud', 'latitud'), crs = 4326)
 

diff --git a/R/utils.R b/R/utils.R
@@ -171,6 +171,17 @@ relocate_vars <- function(data) {
   )
 }
 
+
+.parse_coords_dmsh <- function(coord){
+
+  # converts from "DDMMSSsssH" DMS format to numeric DD
+  dmsh <- stringr::str_sub_all(coord, 
+        cbind(start = c(1, 3, 5, 10), length = c(2, 2, 5, 1)))
+  sapply(dmsh, function(x) (as.numeric(x[1]) + as.numeric(x[2])/60 + 
+         as.numeric(x[3])/3600000) * if (grepl(x[4],"W|S")) -1 else 1)
+}
+
+
 unnest_safe <- function(x, ...) {
 
   # if x is a list instead of a dataframe, something went wrong (happens sometimes in