Merge pull request #44 from ropensci/sf_gpx

Implement format = sf for functions returning osmapi_gps_track objects

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: osmapiR
 Title: 'OpenStreetMap' API
-Version: 0.1.0.9005
+Version: 0.1.0.9006
 Authors@R: c(
     person("Joan", "Maspons", , "[email protected]", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0003-2286-8727")),

NAMESPACE

@@ -70,6 +70,7 @@ export(osmchange_modify)
 export(set_osmapi_connection)
 export(set_osmapi_url)
 export(st_as_sf.osmapi_changesets)
+export(st_as_sf.osmapi_gps_track)
 export(st_as_sf.osmapi_map_notes)
 export(tags_list2wide)
 export(tags_wide2list)

NEWS.md

@@ -9,6 +9,7 @@
 * Updated links to the new osmapiR home at rOpenSci (#40)
 * Add format = "sf" for `osm_list_gpxs()` (#42)
 * Split functions to parse gpx data from different API endpoints and different properties (#43)
+* Add format = "sf" for functions returning objects of class `osmapi_gps_track` (#44)
 
 # osmapiR 0.1.0
 

R/osmapi_gps_traces.R

@@ -375,6 +375,7 @@ osm_get_metadata_gpx <- function(gpx_id, format = c("R", "xml")) {
 #' @param gpx_id The track id represented by a numeric or a character value.
 #' @param format Format of the output. If missing (default), the response will be the exact file that was uploaded.
 #'   If `"R"`, a `data.frame`.
+#'   If `"sf"`, `"sf_lines"`, or `"sf_points"`,  a `sf` object  from package \pkg{sf} (see [st_as_sf()] for details).
 #'   If `"gpx"`, the response will always be a GPX format file.
 #'   If `"xml"`, a `xml` file in an undocumented format.
 #'
@@ -383,8 +384,10 @@ osm_get_metadata_gpx <- function(gpx_id, format = c("R", "xml")) {
 #'
 #' @return
 #' If missing `format`, returns a [xml2::xml_document-class] with the original file data. If `format = "R"`, returns a
-#' data frame with one point per row. If `format = "gpx"`, returns a [xml2::xml_document-class] in the GPX format. If
+#' data frame with one point per row. If `format = "sf*"`, returns a `sf` object from \pkg{sf}. If `format = "gpx"`,
+#' returns a [xml2::xml_document-class] in the GPX format. If
 #' `format = "xml"`, returns a [xml2::xml_document-class] in an undocumented format.
+#'
 #' @family get GPS' functions
 #' @export
 #'
@@ -397,14 +400,18 @@ osm_get_data_gpx <- function(gpx_id, format) {
   if (missing(format)) {
     ext <- "data"
   } else {
-    stopifnot(format %in% c("R", "xml", "gpx"))
+    format <- match.arg(format, c("R", "sf", "sf_line", "sf_points", "xml", "gpx"))
     if (format == "gpx") {
       ext <- "data.gpx"
     } else {
       ext <- "data.xml"
     }
   }
 
+  if (!missing(format) && format == "sf" && !requireNamespace("sf", quietly = TRUE)) {
+    stop("Missing `sf` package. Install with:\n\tinstall.package(\"sf\")")
+  }
+
   req <- osmapi_request(authenticate = TRUE)
   req <- httr2::req_method(req, "GET")
   req <- httr2::req_url_path_append(req, "gpx", gpx_id, ext)
@@ -414,9 +421,12 @@ osm_get_data_gpx <- function(gpx_id, format) {
 
   if (missing(format) || format %in% c("xml", "gpx")) {
     out <- obj_xml
-  } else {
+  } else { # format %in% c("R", "sf", "sf_line", "sf_points")
     out <- gpx_xml2df(obj_xml)
 
+    if (format %in% c("sf", "sf_line", "sf_points")) {
+      out <- sf::st_as_sf(out, format = if (format %in% c("sf", "sf_line")) "line" else "points")
+    }
   }
 
   return(out)

R/st_as_sf.R

@@ -1,11 +1,24 @@
 #' Convert osmapiR objects to sf objects
 #'
 #' @param x an osmapiR object.
-#' @param ... passed on to `st_as_sf()` from \pkg{sf}.
+#' @param format Format of the output. If `"line"` (the default), return a `sf` object with one `LINESTRING`.
+#'   If `"points"`, return a `sf` with the `POINT`s of the track as features. See below for details.
+#' @param ... passed on to `st_as_sf()` from \pkg{sf} package.
+#'
+#' @return Returns a `sf` object from \pkg{sf} package.
+#'
+#'   When x is a `osmapi_gps_track` object and `format = "line"`, the result will have `XYZM` dimensions for
+#'   coordinates, elevation and time (will loss the POSIXct type) if available. For `format = "points"`, the result will
+#'   have `XY` dimensions and elevation and time will be independent columns if available.
 #'
-#' @return Returns a `sf` object from \pkg{sf}.
 #' @family methods
-#' @seealso `st_as_sf()` from \pkg{sf}
+#' @seealso `st_as_sf()` from \pkg{sf} package.
+#' @examples
+#' \dontrun{
+#' trk <- osm_get_data_gpx(gpx_id = 3498170, format = "R")
+#' st_as_sf(trk, format = "line")
+#' st_as_sf(trk, format = "points")
+#' }
 #'
 #' @name st_as_sf
 NULL
@@ -15,9 +28,9 @@ NULL
 #' @export
 st_as_sf.osmapi_map_notes <- function(x, ...) {
   if (nrow(x) == 0) {
-    suppressWarnings(out <- sf::st_as_sf(x = as.data.frame(x), coords = c("lon", "lat"), crs = sf::st_crs(4326)))
+    suppressWarnings(out <- sf::st_as_sf(x = as.data.frame(x), coords = c("lon", "lat"), crs = sf::st_crs(4326)), ...)
   } else {
-    out <- sf::st_as_sf(x = as.data.frame(x), coords = c("lon", "lat"), crs = sf::st_crs(4326))
+    out <- sf::st_as_sf(x = as.data.frame(x), coords = c("lon", "lat"), crs = sf::st_crs(4326), ...)
     class(out) <- c("sf_osmapi_map_notes", "sf", "data.frame")
   }
   # TODO: mapview::mapview(out) -> Error in clean_columns(as.data.frame(obj), factorsAsCharacter) :
@@ -35,7 +48,7 @@ st_as_sf.osmapi_changesets <- function(x, ...) {
   if (nrow(x) == 0) {
     out[1, 1] <- NA
     out$geometry <- sf::st_sfc(sf::st_polygon(), crs = sf::st_crs(4326))
-    out <- sf::st_as_sf(x = as.data.frame(out[integer(), ]), crs = sf::st_crs(4326))
+    out <- sf::st_as_sf(x = as.data.frame(out[integer(), ]), crs = sf::st_crs(4326), ...)
     return(out)
   }
 
@@ -45,9 +58,37 @@ st_as_sf.osmapi_changesets <- function(x, ...) {
   geom <- do.call(sf::st_as_sfc, bbox)
   out$geometry <- geom
 
-  out <- sf::st_as_sf(x = as.data.frame(out), crs = sf::st_crs(4326))
+  out <- sf::st_as_sf(x = as.data.frame(out), crs = sf::st_crs(4326), ...)
   class(out) <- c("sf_osmapi_changesets", "sf", "data.frame")
 
   return(out)
 }
 
+
+#' @rdname st_as_sf
+#'
+#' @export
+st_as_sf.osmapi_gps_track <- function(x, format = c("line", "points"), ...) {
+  format <- match.arg(format)
+
+  if (nrow(x) == 0) {
+    out <- x[, setdiff(names(x), c("lon", "lat"))]
+    out[1, 1] <- NA
+    out$geometry <- sf::st_sfc(sf::st_polygon(), crs = sf::st_crs(4326))
+    out <- sf::st_as_sf(x = as.data.frame(out[integer(), ]), crs = sf::st_crs(4326), ...)
+
+    return(out)
+  }
+
+  if (format == "line") {
+    x_num <- list2DF(lapply(x, as.numeric))
+    x_num <- x_num[, intersect(c("lon", "lat", "ele", "time"), names(x_num))] # sort XYZM columns
+    geometry <- sf::st_sfc(sf::st_linestring(x = as.matrix(x_num)), crs = sf::st_crs(4326))
+
+    out <- sf::st_as_sf(x = data.frame(geometry), crs = sf::st_crs(4326), ...)
+  } else if (format == "points") {
+    out <- sf::st_as_sf(x = as.data.frame(x), coords = c("lon", "lat"), crs = sf::st_crs(4326), ...)
+  }
+
+  return(out)
+}

R/zzz.R

@@ -3,6 +3,7 @@
 .onLoad <- function(libname, pkgname) { # nocov start
   s3_register("sf::st_as_sf", "osmapi_map_notes")
   s3_register("sf::st_as_sf", "osmapi_changesets")
+  s3_register("sf::st_as_sf", "osmapi_gps_track")
 
 
   op <- options()

codemeta.json

@@ -8,7 +8,7 @@
   "codeRepository": "https://github.com/ropensci/osmapiR",
   "issueTracker": "https://github.com/ropensci/osmapiR/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.0.9005",
+  "version": "0.1.0.9006",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -163,7 +163,7 @@
     "SystemRequirements": null
   },
   "keywords": ["openstreetmap", "OSM", "openstreetmap-api", "osmapi", "API", "osm", "r", "r-package"],
-  "fileSize": "14113.689KB",
+  "fileSize": "14118.29KB",
   "citation": [
     {
       "@type": "SoftwareSourceCode",
@@ -180,7 +180,7 @@
       "name": "osmapiR: OpenStreetMap API",
       "identifier": "10.32614/CRAN.package.osmapiR",
       "url": "https://docs.ropensci.org/osmapiR/",
-      "description": "R package version 0.1.0.9005 \nhttps://github.com/ropensci/osmapiR",
+      "description": "R package version 0.1.0.9006 \nhttps://github.com/ropensci/osmapiR",
       "@id": "https://doi.org/10.32614/CRAN.package.osmapiR",
       "sameAs": "https://doi.org/10.32614/CRAN.package.osmapiR"
     }

inst/WORDLIST

@@ -148,6 +148,7 @@ fot
 fred
 Fusers
 Fwww
+Garmin
 geo
 geodata
 Geroni
@@ -219,6 +220,8 @@ libname
 licence
 Lifecycle
 lifecycle
+linestring
+LINESTRING
 lIwawoZup
 lon
 lt
@@ -493,7 +496,9 @@ xsd
 xsi
 XtQPTSyuTOu
 xU
+XY
 xyz
+XYZM
 yaml
 ymax
 ymin

tests/testthat/test-gps_traces.R

@@ -175,23 +175,44 @@ test_that("osm_get_data_gpx works", {
     trk_data$gpx <- osm_get_data_gpx(gpx_id = 3458743, format = "gpx") # identical to xml resp but heavier mock file
     ## gpx responses has `content-type` = "application/gpx+xml and httptest2 save them as raw instead of xml files
     trk_data$xml <- osm_get_data_gpx(gpx_id = 3458743, format = "xml")
-    trk_data$R <- osm_get_data_gpx(gpx_id = 3458743, format = "R")
+    trk_data$df <- osm_get_data_gpx(gpx_id = 3458743, format = "R")
+    trk_data$sf_line <- osm_get_data_gpx(gpx_id = 3458743, format = "sf_line")
+    trk_data$sf_points <- osm_get_data_gpx(gpx_id = 3458743, format = "sf_points")
   })
 
   lapply(trk_data[c("raw", "gpx", "xml")], expect_s3_class, class = "xml_document")
 
-  expect_s3_class(trk_data$R, c("osmapi_gps_track", "data.frame"))
-  expect_named(trk_data$R, column_gpx)
-
-  mapply(function(x, cl) expect_true(inherits(x, cl)), x = trk_data$R, cl = class_columns[names(trk_data$R)])
+  expect_s3_class(trk_data$df, class = c("osmapi_gps_track", "data.frame"), exact = TRUE)
+  expect_s3_class(trk_data$sf_line, class = c("sf", "data.frame"), exact = TRUE)
+  expect_s3_class(trk_data$sf_points, class = c("sf", "data.frame"), exact = TRUE)
+  expect_named(trk_data$df, column_gpx)
+  expect_named(trk_data$sf_line, "geometry")
+  expect_named(trk_data$sf_points, c("ele", "time", "geometry"))
+
+  mapply(function(x, cl) expect_true(inherits(x, cl)), x = trk_data$df, cl = class_columns[names(trk_data$df)])
+  mapply(function(x, cl) expect_true(inherits(x, cl)),
+    x = trk_data$sf_line, cl = class_columns[names(trk_data$sf_line)]
+  )
+  mapply(function(x, cl) expect_true(inherits(x, cl)),
+    x = trk_data$sf_points, cl = class_columns[names(trk_data$sf_points)]
+  )
 
   # Check that time is extracted, otherwise it's 00:00:00 in local time
-  expect_false(all(strftime(as.POSIXct(trk_data$R$time), format = "%M:%S") == "00:00"))
+  expect_false(all(strftime(as.POSIXct(trk_data$df$time), format = "%M:%S") == "00:00"))
 
-  # Compare xml & R
+  # Compare sf_line, sf_points, xml & R
+  expect_equal(nrow(trk_data$df), nrow(trk_data$sf_line$geometry[[1]]))
+  expect_equal(nrow(trk_data$df), nrow(trk_data$sf_points))
   trk <- xml2::xml_child(trk_data$xml, search = 2)
   trkseg <- xml2::xml_child(trk, search = 3)
-  expect_equal(nrow(trk_data$R), xml2::xml_length(trkseg))
+  expect_equal(nrow(trk_data$df), xml2::xml_length(trkseg))
+
+
+  ## Empty gpx
+  empty_sf <- sf::st_as_sf(empty_gpx_df())
+  expect_s3_class(empty_sf, class = c("sf", "data.frame"), exact = TRUE)
+  expect_named(empty_sf, c("ele", "time", "geometry"))
+  expect_identical(nrow(empty_sf), 0L)
 })