Merge pull request #43 from ropensci/gpx_pointsVStrack

Split functions to parse gpx data and factor out track parsing

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: osmapiR
 Title: 'OpenStreetMap' API
-Version: 0.1.0.9004
+Version: 0.1.0.9005
 Authors@R: c(
     person("Joan", "Maspons", , "joanmaspons@gmail.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0003-2286-8727")),

NEWS.md

@@ -8,6 +8,7 @@
 * Add format = "sf" for `osm_get_gpx_metadata()` (#38)
 * 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)
 
 # osmapiR 0.1.0
 

R/osmapi_gps_traces.R

@@ -109,13 +109,6 @@
 
   if (format == "R") {
     out <- gpx_xml2list(obj_xml)
-    names(out) <- vapply(out, function(x) {
-      url <- attr(x, "url")
-      if (is.null(url)) { # for private traces?
-        url <- ""
-      }
-      url
-    }, FUN.VALUE = character(1))
   } else {
     out <- obj_xml
   }
@@ -422,22 +415,8 @@ osm_get_data_gpx <- function(gpx_id, format) {
   if (missing(format) || format %in% c("xml", "gpx")) {
     out <- obj_xml
   } else {
-    out <- gpx_xml2list(obj_xml)
+    out <- gpx_xml2df(obj_xml)
 
-    if (length(out) > 1) {
-      warning(
-        "Unexpected output format at osm_get_data_gpx().",
-        "Please, open and issue with the `gpx_id` or the original file if the gpx is not public ",
-        "at https://github.com/ropensci/osmapiR/issues"
-      )
-    } else {
-      attrs <- attributes(out)
-      attrs <- attrs[setdiff(names(attrs), "class")]
-      names(attrs) <- paste0("gpx_", names(attrs))
-      out <- out[[1]]
-      attributes(out) <- c(attributes(out), attrs)
-      class(out) <- c("osmapi_gps_track", "data.frame")
-    }
   }
 
   return(out)

R/xml_to_R.R

@@ -284,81 +284,142 @@ gpx_meta_xml2DF <- function(xml) {
 
 # GPX files----
 
-gpx_xml2list <- function(xml) {
-  # xml_attrs <- xml2::xml_attrs(xml)
-
+gpx_xml2df <- function(xml) {
+  xml_attrs <- xml2::xml_attrs(xml)
   gpx <- xml2::xml_children(xml)
 
+  if ("metadata" %in% xml2::xml_name(gpx)) { # Always present for gpx/id responses
+    gpx_metadata <- xml2::as_list(gpx[xml2::xml_name(gpx) == "metadata"])
+    if (length(gpx_metadata) == 1) { # Only one <metadata> node
+      gpx_metadata <- gpx_metadata[[1]]
+    }
+    # For bounds as vector when creator="JOSM GPX export"
+    if (xml_attrs["creator"] == "JOSM GPX export") {
+      metadata <- xml2::xml_children(gpx[xml2::xml_name(gpx) == "metadata"])
+      metadata_attrs <- xml2::xml_attrs(metadata)
+      names(metadata_attrs) <- xml2::xml_name(metadata)
+      metadata_attrs <- metadata_attrs[vapply(metadata_attrs, length, FUN.VALUE = integer(1)) > 0]
+      gpx_metadata <- c(unlist(gpx_metadata, recursive = FALSE), metadata_attrs)
+    }
+  } else {
+    gpx_metadata <- NULL
+  }
+
   trk <- gpx[xml2::xml_name(gpx) == "trk"]
-  # xml_find_all(trk, xpath = ".//name") ## TODO: doesn't work :(
+  # xml2::xml_find_all(trk, xpath = ".//name") ## TODO: doesn't work :(
 
   if (length(trk) == 0) {
-    return(empty_gpx())
+    out <- empty_gpx_df()
+  } else if (length(trk) == 1) {
+    out <- trk_xml2df(trk = trk)
+    attributes(out) <- c(attributes(out), list(gpx_attributes = xml_attrs), gpx_metadata)
+    class(out) <- c("osmapi_gps_track", "data.frame")
+  } else if (length(trk) > 1) {
+    warning(
+      "GPX with more than one track. The result will be a list of class `osmapi_gpx`.",
+      "Please, open and issue with the `gpx_id` or the original file if the gpx is not public ",
+      "at https://github.com/ropensci/osmapiR/issues"
+    )
+    out <- gpx_xml2list(xml = xml)
   }
 
-  trkL <- lapply(trk, function(x) {
-    x_ch <- xml2::xml_children(x)
-    x_names <- xml2::xml_name(x_ch)
+  return(out)
+}
 
-    trk_details <- structure(xml2::xml_text(x_ch[x_names != "trkseg"]), names = x_names[x_names != "trkseg"])
 
-    trkseg <- x_ch[x_names == "trkseg"]
+empty_gpx_df <- function() {
+  out <- data.frame(lon = character(), lat = character(), ele = character(), time = as.POSIXct(Sys.time())[-1])
+  class(out) <- c("osmapi_gps_track", "data.frame")
 
-    trkseg_ch <- xml2::xml_children(trkseg)
-    trkseg_names <- xml2::xml_name(trkseg_ch)
-    trkpt <- trkseg_ch[trkseg_names == "trkpt"]
-    lat_lon <- do.call(rbind, xml2::xml_attrs(trkpt))
-    # xml2::xml_find_all(trkpt, ".//time") ## TODO: doesn't work :(
+  return(out)
+}
 
-    elem_points <- lapply(trkpt, function(y) {
-      pt <- xml2::xml_children(y)
-      elem_name <- vapply(pt, xml2::xml_name, FUN.VALUE = character(1))
-      sel <- elem_name %in% c("ele", "time")
-      vals <- structure(
-        vapply(pt[sel], xml2::xml_text, FUN.VALUE = character(1)),
-        names = elem_name[sel]
-      )
 
-      return(vals)
-    })
-    point_data <- do.call(rbind, elem_points)
+gpx_xml2list <- function(xml) {
+  xml_attrs <- xml2::xml_attrs(xml)
+  gpx <- xml2::xml_children(xml)
 
-    trkpt <- data.frame(lat_lon, point_data)
-    if ("time" %in% names(trkpt)) {
-      trkpt$time <- as.POSIXct(trkpt$time, format = "%Y-%m-%dT%H:%M:%OS", tz = "GMT")
+  if ("metadata" %in% xml2::xml_name(gpx)) { # Never seen for bbox trackpoints responses
+    gpx_metadata <- xml2::as_list(gpx[xml2::xml_name(gpx) == "metadata"])
+    if (length(gpx_metadata) == 1) {
+      gpx_metadata <- gpx_metadata[[1]]
     }
+  } else {
+    gpx_metadata <- NULL
+  }
 
-    out <- trkpt
-    attributes(out) <- c(attributes(out), trk_details)
-
-    return(out)
-  })
-
-  if ("metadata" %in% xml2::xml_name(gpx)) {
-    metaL <- xml2::as_list(gpx[xml2::xml_name(gpx) == "metadata"])
-
-    meta <- xml2::xml_children(gpx[xml2::xml_name(gpx) == "metadata"])
-    meta_attrs <- xml2::xml_attrs(meta)
-    names(meta_attrs) <- xml2::xml_name(meta)
-    meta_attrs <- meta_attrs[vapply(meta_attrs, length, FUN.VALUE = integer(1)) > 0]
+  trk <- gpx[xml2::xml_name(gpx) == "trk"]
+  # xml_find_all(trk, xpath = ".//name") ## TODO: doesn't work :(
 
-    attributes(trkL) <- c(attributes(trkL), unlist(metaL, recursive = FALSE), meta_attrs)
+  if (length(trk) == 0) {
+    return(empty_gpx_list())
   }
 
-  class(trkL) <- c("osmapi_gpx", class(trkL))
+  out <- lapply(trk, trk_xml2df)
+  names(out) <- vapply(out, function(x) {
+    url <- attr(x, "track_url")
+    if (is.null(url)) { # for private traces
+      url <- ""
+    }
+    url
+  }, FUN.VALUE = character(1))
+
+  attributes(out) <- c(attributes(out), list(gpx_attributes = xml_attrs), gpx_metadata)
+  class(out) <- c("osmapi_gpx", class(out))
 
-  return(trkL)
+  return(out)
 }
 
 
-empty_gpx <- function() {
+empty_gpx_list <- function() {
   out <- list()
   class(out) <- c("osmapi_gpx", "list")
 
   return(out)
 }
 
 
+trk_xml2df <- function(trk) {
+  trk_ch <- xml2::xml_children(trk)
+  trk_names <- xml2::xml_name(trk_ch)
+
+  trk_details <- structure(xml2::xml_text(trk_ch[trk_names != "trkseg"]), names = trk_names[trk_names != "trkseg"])
+  if (length(trk_details)) {
+    names(trk_details) <- paste0("track_", names(trk_details))
+  }
+
+  trkseg <- trk_ch[trk_names == "trkseg"]
+
+  trkseg_ch <- xml2::xml_children(trkseg)
+  trkseg_names <- xml2::xml_name(trkseg_ch)
+  trkpt <- trkseg_ch[trkseg_names == "trkpt"]
+  lat_lon <- do.call(rbind, xml2::xml_attrs(trkpt))
+  # xml2::xml_find_all(trkpt, ".//time") ## TODO: doesn't work :(
+
+  elem_points <- lapply(trkpt, function(y) {
+    pt <- xml2::xml_children(y)
+    elem_name <- vapply(pt, xml2::xml_name, FUN.VALUE = character(1))
+    sel <- elem_name %in% c("ele", "time")
+    vals <- structure(
+      vapply(pt[sel], xml2::xml_text, FUN.VALUE = character(1)),
+      names = elem_name[sel]
+    )
+
+    return(vals)
+  })
+  point_data <- do.call(rbind, elem_points)
+
+  out <- data.frame(lat_lon, point_data)
+  if ("time" %in% names(out)) {
+    out$time <- as.POSIXct(out$time, format = "%Y-%m-%dT%H:%M:%OS", tz = "GMT")
+  }
+
+  attributes(out) <- c(attributes(out), trk_details)
+
+  return(out)
+}
+
+
 ## user_details ----
 
 user_details_xml2DF <- function(xml) {

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.9004",
+  "version": "0.1.0.9005",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -163,7 +163,7 @@
     "SystemRequirements": null
   },
   "keywords": ["openstreetmap", "OSM", "openstreetmap-api", "osmapi", "API", "osm", "r", "r-package"],
-  "fileSize": "14112.96KB",
+  "fileSize": "14113.689KB",
   "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.9003 \nhttps://github.com/ropensci/osmapiR",
+      "description": "R package version 0.1.0.9005 \nhttps://github.com/ropensci/osmapiR",
       "@id": "https://doi.org/10.32614/CRAN.package.osmapiR",
       "sameAs": "https://doi.org/10.32614/CRAN.package.osmapiR"
     }

tests/testthat/test-gps_traces.R

@@ -169,6 +169,8 @@ test_that("osm_get_metadata_gpx works", {
 test_that("osm_get_data_gpx works", {
   trk_data <- list()
   with_mock_dir("mock_get_data_gpx", {
+    # gpx_id = 3458743: creator="JOSM GPX export" <metadata> bounds c("minlat", "minlon", "maxlat", "maxlon")
+    # gpx_id = 3498170: creator="Garmin Connect"
     trk_data$raw <- osm_get_data_gpx(gpx_id = 3458743)
     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