From 095f000f2caa530abf85236c5ba4d79e46fea3e0 Mon Sep 17 00:00:00 2001 From: Joan Maspons Date: Sat, 6 Jul 2024 12:34:01 +0200 Subject: [PATCH] Implement format = sf for functions returning osmapi_gps_track objects --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 1 + R/osmapi_gps_traces.R | 16 ++++++++-- R/st_as_sf.R | 55 ++++++++++++++++++++++++++++---- R/zzz.R | 1 + codemeta.json | 6 ++-- inst/WORDLIST | 5 +++ man/osm_get_data_gpx.Rd | 4 ++- man/st_as_sf.Rd | 24 ++++++++++++-- tests/testthat/test-gps_traces.R | 37 ++++++++++++++++----- 11 files changed, 126 insertions(+), 26 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 903c280e..3b8b52f5 100644 --- a/DESCRIPTION +++ b/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", , "joanmaspons@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0003-2286-8727")), diff --git a/NAMESPACE b/NAMESPACE index 02707ba0..f88b0875 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index dd7681d7..bce61891 100644 --- a/NEWS.md +++ b/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 diff --git a/R/osmapi_gps_traces.R b/R/osmapi_gps_traces.R index 62a5b93c..1d71d8db 100644 --- a/R/osmapi_gps_traces.R +++ b/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,7 +400,7 @@ 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 { @@ -405,6 +408,10 @@ osm_get_data_gpx <- function(gpx_id, format) { } } + 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) diff --git a/R/st_as_sf.R b/R/st_as_sf.R index b22a138d..2ad50943 100644 --- a/R/st_as_sf.R +++ b/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) +} diff --git a/R/zzz.R b/R/zzz.R index 1c774ea1..27351909 100644 --- a/R/zzz.R +++ b/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() diff --git a/codemeta.json b/codemeta.json index e6ebb988..7aa6d4a1 100644 --- a/codemeta.json +++ b/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" } diff --git a/inst/WORDLIST b/inst/WORDLIST index 4e26dd68..a6c57f65 100644 --- a/inst/WORDLIST +++ b/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 diff --git a/man/osm_get_data_gpx.Rd b/man/osm_get_data_gpx.Rd index 8a7e303f..2d0a5bcc 100644 --- a/man/osm_get_data_gpx.Rd +++ b/man/osm_get_data_gpx.Rd @@ -11,12 +11,14 @@ osm_get_data_gpx(gpx_id, format) \item{format}{Format of the output. If missing (default), the response will be the exact file that was uploaded. If \code{"R"}, a \code{data.frame}. +If \code{"sf"}, \code{"sf_lines"}, or \code{"sf_points"}, a \code{sf} object from package \pkg{sf} (see \code{\link[=st_as_sf]{st_as_sf()}} for details). If \code{"gpx"}, the response will always be a GPX format file. If \code{"xml"}, a \code{xml} file in an undocumented format.} } \value{ If missing \code{format}, returns a \link[xml2:oldclass]{xml2::xml_document} with the original file data. If \code{format = "R"}, returns a -data frame with one point per row. If \code{format = "gpx"}, returns a \link[xml2:oldclass]{xml2::xml_document} in the GPX format. If +data frame with one point per row. If \code{format = "sf*"}, returns a \code{sf} object from \pkg{sf}. If \code{format = "gpx"}, +returns a \link[xml2:oldclass]{xml2::xml_document} in the GPX format. If \code{format = "xml"}, returns a \link[xml2:oldclass]{xml2::xml_document} in an undocumented format. } \description{ diff --git a/man/st_as_sf.Rd b/man/st_as_sf.Rd index 1466e539..b3342054 100644 --- a/man/st_as_sf.Rd +++ b/man/st_as_sf.Rd @@ -4,25 +4,43 @@ \alias{st_as_sf} \alias{st_as_sf.osmapi_map_notes} \alias{st_as_sf.osmapi_changesets} +\alias{st_as_sf.osmapi_gps_track} \title{Convert osmapiR objects to sf objects} \usage{ st_as_sf.osmapi_map_notes(x, ...) st_as_sf.osmapi_changesets(x, ...) + +st_as_sf.osmapi_gps_track(x, format = c("line", "points"), ...) } \arguments{ \item{x}{an osmapiR object.} -\item{...}{passed on to \code{st_as_sf()} from \pkg{sf}.} +\item{...}{passed on to \code{st_as_sf()} from \pkg{sf} package.} + +\item{format}{Format of the output. If \code{"line"} (the default), return a \code{sf} object with one \code{LINESTRING}. +If \code{"points"}, return a \code{sf} with the \code{POINT}s of the track as features. See below for details.} } \value{ -Returns a \code{sf} object from \pkg{sf}. +Returns a \code{sf} object from \pkg{sf} package. + +When x is a \code{osmapi_gps_track} object and \code{format = "line"}, the result will have \code{XYZM} dimensions for +coordinates, elevation and time (will loss the POSIXct type) if available. For \code{format = "points"}, the result will +have \code{XY} dimensions and elevation and time will be independent columns if available. } \description{ Convert osmapiR objects to sf objects +} +\examples{ +\dontrun{ +trk <- osm_get_data_gpx(gpx_id = 3498170, format = "R") +st_as_sf(trk, format = "line") +st_as_sf(trk, format = "points") +} + } \seealso{ -\code{st_as_sf()} from \pkg{sf} +\code{st_as_sf()} from \pkg{sf} package. Other methods: \code{\link{tags_list2wide}()} diff --git a/tests/testthat/test-gps_traces.R b/tests/testthat/test-gps_traces.R index 31ed7a52..c438c0ec 100644 --- a/tests/testthat/test-gps_traces.R +++ b/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) })