Simpler yet more powerful package' API

NAMESPACE

@@ -31,17 +31,15 @@ export(osm_delete_gpx)
 export(osm_delete_note)
 export(osm_delete_object)
 export(osm_details_logged_user)
-export(osm_details_user)
-export(osm_details_users)
 export(osm_diff_upload_changeset)
 export(osm_download_changeset)
 export(osm_feed_notes)
-export(osm_fetch_objects)
-export(osm_full_object)
 export(osm_get_data_gpx)
 export(osm_get_metadata_gpx)
+export(osm_get_objects)
 export(osm_get_points_gps)
 export(osm_get_preferences_user)
+export(osm_get_user_details)
 export(osm_hide_comment_changeset_discussion)
 export(osm_history_object)
 export(osm_list_gpxs)
@@ -50,7 +48,6 @@ export(osm_query_changesets)
 export(osm_read_bbox_notes)
 export(osm_read_changeset)
 export(osm_read_note)
-export(osm_read_object)
 export(osm_redaction_object)
 export(osm_relations_object)
 export(osm_reopen_note)
@@ -61,7 +58,6 @@ export(osm_unsubscribe_changeset_discussion)
 export(osm_update_changeset)
 export(osm_update_gpx)
 export(osm_update_object)
-export(osm_version_object)
 export(osm_ways_node)
 export(osmchange_create)
 export(osmchange_delete)

R/osm_get_objects.R

@@ -0,0 +1,215 @@
+#' Get OSM objects
+#'
+#' Retrieve objects by `type`, `id` and `version`.
+#'
+#' @param osm_type A vector with the type of the objects (`"node"`, `"way"` or `"relation"`). Recycled if it has a
+#'   different length than `osm_id`.
+#' @param osm_id Object ids represented by a numeric or a character vector.
+#' @param version An optional vector with the version number for each object. If missing, the last version will be
+#'   retrieved. Recycled if it has different length than `osm_id`.
+#' @param full_objects If `TRUE`, retrieves all other objects referenced by ways or relations. Not compatible with
+#'   `version`.
+#' @param format Format of the output. Can be `R` (default), `xml`, or `json`.
+#' @param tags_in_columns If `FALSE` (default), the tags of the objects are saved in a single list column `tags```
+#'   containing a `data.frame` for each OSM object with the keys and values. If `TRUE`, add a column for each key.
+#'   Ignored if `format != "R"`.
+#'
+#' @details
+#' `full_objects = TRUE` does not support specifying `version`.
+#' For ways, `full_objects = TRUE` implies that it will return the way specified plus all nodes referenced by the way.
+#' For a relation, it will return the following:
+#' * The relation itself
+#' * All nodes, ways, and relations that are members of the relation
+#' * Plus all nodes used by ways from the previous step
+#' * The same recursive logic is not applied to relations. This means: If relation r1 contains way w1 and relation r2,
+#'   and w1 contains nodes n1 and n2, and r2 contains node n3, then a "full" request for r1 will give you r1, r2, w1,
+#'   n1, and n2. Not n3.
+#'
+#' @note
+#' For downloading data for purposes other than editing or exploring the history of the objects, perhaps is better to
+#' use the Overpass API. A similar function to download OSM objects by `type` and `id` using Overpass, is implemented in
+#' [osmdata::opq_osm_id()].
+#'
+#' @return
+#' @family get OSM objects' functions
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' obj <- osm_get_objects(
+#'   osm_type = c("node", "way", "way", "relation", "relation", "node"),
+#'   osm_id = c("35308286", "13073736", "235744929", "40581", "341530", "1935675367"),
+#'   version = c(1, 3, 2, 5, 7, 1)
+#' )
+#' obj
+#' }
+osm_get_objects <- function(osm_type, osm_id, version, full_objects = FALSE,
+                            format = c("R", "xml", "json"), tags_in_columns = FALSE) {
+  format <- match.arg(format)
+
+  stopifnot(
+    '`osm_type` must be a vector containing values "node", "way" or "relation".' =
+      all(osm_type %in% c("node", "way", "relation"))
+  )
+
+  if (!missing(version) && full_objects) {
+    stop("Getting full objects with specific version is not supported.")
+  }
+  if (length(osm_id) %% length(osm_type) != 0 || length(osm_type) > length(osm_id)) {
+    stop("`osm_id` length must be a multiple of `osm_type` length.")
+  }
+
+  if (length(osm_id) == 1) {
+    if (full_objects && osm_type %in% c("way", "relation")) {
+      out <- osm_full_object(osm_type = osm_type, osm_id = osm_id, format = format, tags_in_columns = tags_in_columns)
+    } else if (!missing(version)) {
+      out <- osm_version_object(
+        osm_type = osm_type, osm_id = osm_id, version = version, format = format, tags_in_columns = tags_in_columns
+      )
+    } else {
+      out <- osm_read_object(osm_type = osm_type, osm_id = osm_id, format = format, tags_in_columns = tags_in_columns)
+    }
+
+    return(out)
+  }
+
+  type_id <- data.frame(type = osm_type, id = osm_id)
+  if (!missing(version)) {
+    if (length(version) %% nrow(type_id) != 0 || length(version) > nrow(type_id)) {
+      stop("`osm_id` length must be a multiple of `version` length.")
+    }
+    type_id$version <- version
+  }
+
+  if (nrow(type_id) > nrow(type_id <- unique(type_id))) {
+    warning("Duplicated elements discarded.")
+  }
+
+  type_idL <- split(type_id, type_id$type)
+
+  if (full_objects) {
+    out <- mapply(function(type, ids) {
+      if (type %in% c("way", "relation")) {
+        full_objL <- lapply(ids$id, function(id) {
+          osm_full_object(osm_type = type, osm_id = id, format = format)
+        })
+
+        if (format == "R") {
+          full_obj <- do.call(rbind, full_objL)
+        } else if (format == "xml") {
+          full_obj <- full_objL[[1]]
+
+          full_obj <- xml2::xml_new_root(full_objL[[1]])
+          for (i in seq_len(length(full_objL) - 1)) {
+            for (j in seq_len(xml2::xml_length(full_objL[[i + 1]]))) {
+              xml2::xml_add_child(full_obj, xml2::xml_child(full_objL[[i + 1]], search = j))
+            }
+          }
+        } else if (format == "json") {
+          full_obj <- full_objL[[1]]
+          if (length(full_objL) > 1) {
+            full_obj$elements <- do.call(c, c(list(full_obj$elements), lapply(full_objL[-1], function(x) x$elements)))
+          }
+        }
+      } else {
+        full_obj <- osm_fetch_objects(osm_type = paste0(type, "s"), osm_ids = ids$id, format = format)
+      }
+      full_obj
+    }, type = names(type_idL), ids = type_idL, SIMPLIFY = FALSE)
+  } else { # no full_objects
+    type_plural <- paste0(names(type_idL), "s") # type in plural for osm_fetch_objects()
+
+    if (missing(version)) {
+      out <- mapply(function(type, ids) {
+        osm_fetch_objects(osm_type = type, osm_ids = ids$id, format = format)
+      }, type = type_plural, ids = type_idL, SIMPLIFY = FALSE)
+    } else {
+      out <- mapply(function(type, ids) {
+        osm_fetch_objects(osm_type = type, osm_ids = ids$id, versions = ids$version, format = format)
+      }, type = type_plural, ids = type_idL, SIMPLIFY = FALSE)
+    }
+  }
+
+
+  ## Order objects
+
+  if (full_objects) {
+    # Order by types (node, way, relation)
+
+    if (format == "R") {
+      out <- do.call(rbind, out[intersect(c("node", "way", "relation"), names(ord_out))])
+      out <- rbind(out[out$type == "node", ], out[out$type == "way", ])
+      out <- rbind(out, out[out$type == "relation", ])
+    } else if (format == "xml") {
+      ## TODO: test. Use xml2::xml_find_all()?
+      out <- out[intersect(c("node", "way", "relation"), names(out))]
+      out_ordered <- xml2::xml_new_root(out[[1]])
+      for (i in seq_len(length(out) - 1)) {
+        for (j in seq_len(xml2::xml_length(out[[i + 1]]))) {
+          xml2::xml_add_child(out_ordered, xml2::xml_child(out[[i + 1]], search = j))
+        }
+      }
+      out <- out_ordered
+    } else if (format == "json") {
+      ord_out <- lapply(out, function(x) {
+        vapply(x$elements, function(y) do.call(paste, y[names(type_id)]), FUN.VALUE = character(1))
+      })
+      ord <- unlist(ord_out[intersect(c("node", "way", "relation"), names(ord_out))])
+      ord <- c(ord[grep("^node", ord)], ord[grep("^way", ord)], ord[grep("^relation", ord)])
+      ord <- data.frame(type = gsub("[0-9]+$", "", names(ord)), pos = as.integer(gsub("^[a-z.]+", "", names(ord))))
+      ord$pos[is.na(ord$pos)] <- 1 # for types with only 1 object
+
+      out_ordered <- out[[1]][setdiff(names(out[[1]]), "elements")]
+      out_ordered$elements <- apply(ord, 1, function(x) {
+        out[[x[1]]]$elements[[as.integer(x[2])]]
+      }, simplify = FALSE)
+      out <- out_ordered
+    }
+  } else {
+    ## Original order
+
+    ord_ori <- do.call(paste, type_id)
+
+    if (format == "R") {
+      out <- do.call(rbind, out)
+      ord_out <- do.call(paste, out[, intersect(names(type_id), c("type", "id", "version"))])
+      out <- out[match(ord_ori, ord_out), ]
+      rownames(out) <- NULL
+
+      if (tags_in_columns) {
+        out <- tags_list2wide(out)
+      }
+    } else if (format == "xml") {
+      ord_out <- lapply(out, function(x) {
+        out_type_id <- object_xml2DF(x)
+        do.call(paste, out_type_id[, names(type_id)])
+      })
+      ordL <- lapply(ord_out, function(x) match(ord_ori, x))
+      ord <- sort(unlist(ordL))
+      ord <- data.frame(type = gsub("[0-9]+$", "", names(ord)), pos = as.integer(gsub("^[a-z.]+", "", names(ord))))
+      ord$pos[is.na(ord$pos)] <- 1 # for types with only 1 object
+
+      out_ordered <- xml2::xml_new_root(out[[ord$type[1]]])
+      xml2::xml_remove(xml2::xml_children(out_ordered))
+      for (i in seq_len(nrow(ord))) {
+        xml2::xml_add_child(out_ordered, xml2::xml_child(out[[ord$type[i]]], search = ord$pos[i]))
+      }
+      out <- out_ordered
+    } else if (format == "json") {
+      ord_out <- lapply(out, function(x) {
+        vapply(x$elements, function(y) do.call(paste, y[names(type_id)]), FUN.VALUE = character(1))
+      })
+      ordL <- lapply(ord_out, function(x) match(ord_ori, x))
+      ord <- sort(unlist(ordL))
+      ord <- data.frame(type = gsub("[0-9]+$", "", names(ord)), pos = as.integer(gsub("^[a-z.]+", "", names(ord))))
+
+      out_ordered <- out[[1]][setdiff(names(out[[1]]), "elements")]
+      out_ordered$elements <- apply(ord, 1, function(x) {
+        out[[x[1]]]$elements[[as.integer(x[2])]]
+      }, simplify = FALSE)
+      out <- out_ordered
+    }
+  }
+
+  return(out)
+}

R/osm_get_user_details.R

@@ -0,0 +1,26 @@
+#' Details of users
+#'
+#' @param user_id The ids of the users to retrieve the details for, represented by a numeric or a character value (not
+#'   the display names).
+#' @param format Format of the output. Can be `R` (default), `xml`, or `json`.
+#'
+#' @return
+#' @family users' functions
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' usrs <- osm_details_users(user_ids = c(1, 24, 44, 45, 46, 48, 49, 50))
+#' usrs
+#' }
+osm_get_user_details <- function(user_id, format = c("R", "xml", "json")) {
+  format <- match.arg(format)
+
+  if (length(user_id) == 1) {
+    out <- osm_details_user(user_id = user_id, format = format)
+  } else {
+    out <- osm_details_users(user_ids = user_id, format = format)
+  }
+
+  return(out)
+}

R/elements.R → R/osmapi_elements.R

@@ -200,8 +200,8 @@ osm_create_object <- function(x, changeset_id) {
 #'   Ignored if `format != "R"`.
 #'
 #' @return
-#' @family get OSM objects' functions
-#' @export
+# @family get OSM objects' functions
+#' @noRd
 #'
 #' @examples
 #' \dontrun{
@@ -586,8 +586,8 @@ osm_history_object <- function(osm_type = c("node", "way", "relation"), osm_id,
 #'   Ignored if `format != "R"`.
 #'
 #' @return
-#' @family get OSM objects' functions
-#' @export
+# @family get OSM objects' functions
+#' @noRd
 #'
 #' @examples
 #' \dontrun{
@@ -665,8 +665,8 @@ osm_version_object <- function(osm_type = c("node", "way", "relation"), osm_id,
 #' [osmdata::opq_osm_id()].
 #'
 #' @return
-#' @family get OSM objects' functions
-#' @export
+# @family get OSM objects' functions
+#' @noRd
 #'
 #' @examples
 #' \dontrun{
@@ -690,12 +690,14 @@ osm_fetch_objects <- function(osm_type = c("nodes", "ways", "relations"), osm_id
   }
 
   if (format == "json") {
-    osm_type <- paste0(osm_type, ".json")
+    osm_type_endpoint <- paste0(osm_type, ".json")
+  } else {
+    osm_type_endpoint <- osm_type
   }
 
   req <- osmapi_request()
   req <- httr2::req_method(req, "GET")
-  req <- httr2::req_url_path_append(req, osm_type)
+  req <- httr2::req_url_path_append(req, osm_type_endpoint)
 
   if (osm_type == "nodes") {
     req <- httr2::req_url_query(req, nodes = paste(osm_ids, collapse = ","))
@@ -875,8 +877,8 @@ osm_ways_node <- function(node_id, format = c("R", "xml", "json"), tags_in_colum
 #' [osmdata::opq_osm_id()].
 #'
 #' @return
-#' @family get OSM objects' functions
-#' @export
+# @family get OSM objects' functions
+#' @noRd
 #'
 #' @examples
 #' \dontrun{

R/user_data.R → R/osmapi_user_data.R

@@ -48,8 +48,8 @@
 #' @param format Format of the output. Can be `R` (default), `xml`, or `json`.
 #'
 #' @return
-#' @family users' functions
-#' @export
+# @family users' functions
+#' @noRd
 #'
 #' @examples
 #' \dontrun{
@@ -141,8 +141,8 @@ osm_details_user <- function(user_id, format = c("R", "xml", "json")) {
 #' @param format Format of the output. Can be `R` (default), `xml`, or `json`.
 #'
 #' @return
-#' @family users' functions
-#' @export
+# @family users' functions
+#' @noRd
 #'
 #' @examples
 #' \dontrun{

R/osmchange.R

@@ -13,7 +13,7 @@
 #' @details
 #' `x` should follow the format of `osmapi_objects` with tags in wide format or a `tags` column with a list of
 #' data.frames with `key` and `value` columns. Missing tags or tags with `NA` in the value will be removed. See
-#' [osm_read_object()] for examples of the format.
+#' [osm_get_objects()] for examples of the format.
 #'
 #' @return
 #' @family OsmChange's functions

R/tags_list-wide.r

@@ -5,7 +5,7 @@
 #' to change the format of the tags.
 #'
 #' @rdname tags_list-wide
-#' @param x An `osmapi_objects` or `osmapi_changesets` objects as returned by, for example, [osm_read_object()] or
+#' @param x An `osmapi_objects` or `osmapi_changesets` objects as returned by, for example, [osm_get_objects()] or
 #'   [osm_read_changeset()].
 #'
 #' @details