Merge pull request #45 from ropensci/sf_gpx

Implement format = sf for functions returning osmapi_gpx objects

DESCRIPTION

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

NAMESPACE

@@ -71,6 +71,7 @@ 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_gpx)
 export(st_as_sf.osmapi_map_notes)
 export(tags_list2wide)
 export(tags_wide2list)

NEWS.md

@@ -10,6 +10,8 @@
 * 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)
+* Add format = "sf" for functions returning objects of class `osmapi_gpx` (#45)
+
 
 # osmapiR 0.1.0
 

R/osm_get_points_gps.R

@@ -9,7 +9,8 @@
 #'   than 5,000 points at a time. In order to retrieve all of the points for a bounding box, set `page_number = -1`.
 #'   When this parameter is 0 (zero), the command returns the first 5,000 points; when it is 1, the command returns
 #'   points 5,001–10,000, etc. A vector is also valid (e.g. `0:2` to get the first 3 pages).
-#' @param format Format of the output. Can be `"R"` (default) or `"gpx"`.
+#' @param format Format of the output. Can be `"R"` (default), `"sf_lines"` (`"sf"` is a synonym for `"sf_lines"`),
+#'   `"sf_points"` or `"gpx"`.
 #'
 #' @note In violation of the [GPX standard](https://www.topografix.com/GPX/1/1/#type_trksegType) when downloading public
 #'   GPX traces through the API, all waypoints of non-trackable traces are randomized (or rather sorted by lat/lon) and
@@ -21,7 +22,7 @@
 #'
 #' @return
 #' If `format = "R"`, returns a list of data frames with the points for each trace. For public traces, the data frame
-#' include the attributes `name`, `desc` and `url`.
+#' include the attributes `name`, `desc` and `url`. If `format = "sf"`, TODO: POINTS or LINE
 #'
 #' ## `format = "gpx"`
 #' Returns a [xml2::xml_document-class] with the following format:
@@ -56,19 +57,29 @@
 #'
 #' ## get attributes
 #' lapply(pts_gps, function(x) attributes(x)[c("name", "desc", "url")])
-osm_get_points_gps <- function(bbox, page_number = 0, format = c("R", "gpx")) {
+osm_get_points_gps <- function(bbox, page_number = 0, format = c("R", "sf", "sf_lines", "sf_points", "gpx")) {
   format <- match.arg(format)
+  if (format == "sf") format <- "sf_lines"
+  if (format %in% c("sf_lines", "sf_points")) {
+    if (!requireNamespace("sf", quietly = TRUE)) {
+      stop("Missing `sf` package. Install with:\n\tinstall.package(\"sf\")")
+    }
+    .format <- "R"
+  } else {
+    .format <- format
+  }
+
   bbox <- paste(bbox, collapse = ",")
 
   if (page_number >= 0) { # concrete pages
-    outL <- lapply(page_number, function(x) .osm_get_points_gps(bbox = bbox, page_number = x, format = format))
+    outL <- lapply(page_number, function(x) .osm_get_points_gps(bbox = bbox, page_number = x, format = .format))
   } else { # get all pages
     outL <- list()
     n <- 1
     i <- 1
     while (n > 0) {
-      outL[[i]] <- .osm_get_points_gps(bbox = bbox, page_number = i - 1, format = format)
-      if (format == "R") {
+      outL[[i]] <- .osm_get_points_gps(bbox = bbox, page_number = i - 1, format = .format)
+      if (format %in% c("R", "sf_lines", "sf_points")) {
         n <- length(outL[[i]])
       } else { # format == "gpx"
         n <- length(xml2::xml_children(outL[[i]]))
@@ -81,10 +92,15 @@ osm_get_points_gps <- function(bbox, page_number = 0, format = c("R", "gpx")) {
   }
 
   if (length(outL) == 1) {
-    return(outL[[1]])
+    out <- outL[[1]]
+    if (format %in% c("sf_lines", "sf_points")) {
+      out <- sf::st_as_sf(out, format = if (format == "sf_lines") "lines" else "points")
+    }
+
+    return(out)
   }
 
-  if (format == "R") {
+  if (format %in% c("R", "sf_lines", "sf_points")) {
     # rbind the last and first trkseg of consecutive pages if they have the same url (non private traces)
     url_1n_page <- lapply(outL, function(x) names(x)[c(1, length(x))])
     # TODO: length(url_1n_page[[i]]) == 1 OR trace divided in > 2 pages
@@ -100,6 +116,10 @@ osm_get_points_gps <- function(bbox, page_number = 0, format = c("R", "gpx")) {
 
     out <- do.call(c, outL)
     class(out) <- c("osmapi_gpx", "list")
+
+    if (format %in% c("sf_lines", "sf_points")) {
+      out <- sf::st_as_sf(out, format = if (format == "sf_lines") "lines" else "points")
+    }
   } else { # format == "gpx"
     # unite the last and first trkseg of consecutive pages if they have the same url (non private traces)
     # lapply(outL, function(x) xml2::xml_find_all(x, "//url", flatten = FALSE)) # TODO: doesn't work :(

R/st_as_sf.R

@@ -1,15 +1,17 @@
 #' Convert osmapiR objects to sf objects
 #'
 #' @param x an osmapiR object.
-#' @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 format Format of the output. If `"line"` (the default), return a `sf` object with one `LINESTRING` for each
+#'   track. 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.
+#' @return Returns a `sf` object from \pkg{sf} package or a list of for `osmapi_gpx` and `format = "points"`.
 #'
-#'   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.
+#'   When x is a `osmapi_gps_track` or `osmapi_gpx` object and `format = "line"`, the result will have `XYZM` dimensions
+#'   for coordinates, elevation and time if available. In this format, time will loss the POSIXct type as only numeric
+#    values are allowed.
+#'   For `format = "points"`, the result will have `XY` dimensions and elevation and time will be independent columns if
+#'   available.
 #'
 #' @family methods
 #' @seealso `st_as_sf()` from \pkg{sf} package.
@@ -66,7 +68,6 @@ st_as_sf.osmapi_changesets <- function(x, ...) {
 
 
 #' @rdname st_as_sf
-#'
 #' @export
 st_as_sf.osmapi_gps_track <- function(x, format = c("line", "points"), ...) {
   format <- match.arg(format)
@@ -90,5 +91,65 @@ st_as_sf.osmapi_gps_track <- function(x, format = c("line", "points"), ...) {
     out <- sf::st_as_sf(x = as.data.frame(x), coords = c("lon", "lat"), crs = sf::st_crs(4326), ...)
   }
 
+  # TODO: check attributes
+  return(out)
+}
+
+
+#' @rdname st_as_sf
+#' @export
+st_as_sf.osmapi_gpx <- function(x, format = c("lines", "points"), ...) {
+  format <- match.arg(format)
+
+  attr_names <- c("track_url", "track_name", "track_desc")
+
+  if (length(x) == 0) {
+    if (format == "points") {
+      out <- list()
+      class(out) <- c("sf_osmapi_gpx", "osmapi_gpx", "list")
+    } else { # format == "lines"
+      out <- list2DF(stats::setNames(rep(list(NA), 3L), nm = attr_names))
+      out$geometry <- sf::st_sfc(sf::st_linestring(), 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 == "lines") {
+    geometry <- lapply(x, function(trk) {
+      x_num <- list2DF(lapply(trk, as.numeric))
+      x_num <- x_num[, intersect(c("lon", "lat", "time"), names(x_num))] # sort XYM columns
+      sf::st_sfc(
+        sf::st_linestring(x = as.matrix(x_num), dim = if (ncol(x_num) == 3) "XYM" else "XY"),
+        crs = sf::st_crs(4326)
+      )
+    })
+    geometry <- do.call(c, geometry)
+
+    track_attributes <- vapply(x, function(trk) {
+      trk_attr <- attributes(trk)
+      # attr_names <- grep("^track_", names(trk_attr), value = TRUE)
+      a <- stats::setNames(rep(NA_character_, 3), nm = attr_names)
+      sel <- intersect(attr_names, names(trk_attr))
+      if (length(sel)) {
+        a[sel] <- unlist(trk_attr[sel])
+      }
+      a
+    }, FUN.VALUE = character(3))
+    track_attributes <- as.data.frame(t(track_attributes))
+    rownames(track_attributes) <- NULL
+
+    track_attributes$geometry <- geometry
+    out <- sf::st_as_sf(x = track_attributes, crs = sf::st_crs(4326), ...)
+  } else if (format == "points") {
+    out <- lapply(x, function(trk) {
+      sf::st_as_sf(x = as.data.frame(trk), coords = c("lon", "lat"), crs = sf::st_crs(4326), ...)
+    })
+    class(out) <- c("sf_osmapi_gpx", "osmapi_gpx", "list")
+  }
+
+  # TODO: check attributes
   return(out)
 }

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.9006",
+  "version": "0.1.0.9007",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -163,7 +163,7 @@
     "SystemRequirements": null
   },
   "keywords": ["openstreetmap", "OSM", "openstreetmap-api", "osmapi", "API", "osm", "r", "r-package"],
-  "fileSize": "14118.29KB",
+  "fileSize": "14079.909KB",
   "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.9006 \nhttps://github.com/ropensci/osmapiR",
+      "description": "R package version 0.1.0.9007 \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

@@ -390,6 +390,8 @@ setHook
 setNames
 sexualized
 sfc
+sfp
+sfpoints
 siebh
 socio
 SoftwareApplication
@@ -497,6 +499,7 @@ xsi
 XtQPTSyuTOu
 xU
 XY
+XYM
 xyz
 XYZM
 yaml