Merge pull request #339 from ropensci/bb-poly

getbb with sf_polygon for #338

Author: mpadge

.pre-commit-config.yaml

@@ -2,7 +2,7 @@
 # R specific hooks: https://github.com/lorenzwalthert/precommit
 repos:
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.4.1
+    rev: v0.4.2
     hooks:
     -   id: style-files
         args: [--style_pkg=spaceout, --style_fun=spaceout_style]    
@@ -73,7 +73,7 @@ repos:
         files: '\.(Rhistory|RData|Rds|rds)$'
         # `exclude: <regex>` to allow committing specific files
     -   id: description version
-        name: Version has been incremented in DESCRIPTION
+        name: Version has been incremeneted in DESCRIPTION
         entry: .hooks/description
         language: script
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: osmdata
 Title: Import 'OpenStreetMap' Data as Simple Features or Spatial Objects
-Version: 0.2.5.009
+Version: 0.2.5.016
 Authors@R: c(
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre")),
     person("Bob", "Rudis", role = "aut"),

NEWS.md

@@ -6,6 +6,11 @@
 
 - Implemented `c.osmdata_sc` method to join `osmdata_sc` objects (#333)
 
+## Minor changes
+
+- Improved `get_bb(..., format_out = "sf_polygon")` to return full metadata
+  along with geometries (#338 thanks to @RegularnaMatrica)
+
 
 0.2.5
 ===================

R/getbb.R

@@ -278,7 +278,14 @@ getbb <- function (place_name,
     }
 
     if (format_out == "sf_polygon") {
-        ret <- bb_as_sf_poly (gt_p, gt_mp, place_name)
+        ret_poly <- bb_as_sf_poly (gt_p, gt_mp, place_name)
+        obj_index <- as.integer (c (names (gt_p), names (gt_mp)))
+        ret_data <- obj [obj_index, which (!names (obj) %in% c ("boundingbox", "geotext"))]
+        ret <- cbind (ret_data, ret_poly)
+        # Then restore sf attributes:
+        nms <- names (ret)
+        attributes (ret) <- attributes (ret_poly)
+        names (ret) <- nms
     }
 
     return (ret)
@@ -318,7 +325,7 @@ get_nominatim_query <- function (place_name,
     }
 
     if (!silent) {
-        print (req$url)
+        message (req$url)
     }
 
     req <- httr2::req_retry (req, max_tries = 10L)
@@ -360,9 +367,12 @@ get_geotext_poly <- function (obj) {
 
     . <- NULL # suppress R CMD check note
 
+    index_final <- seq_len (nrow (obj))
+
     indx_multi <- grep ("MULTIPOLYGON", obj$geotext)
     gt_p <- NULL
     indx <- which (!(seq (nrow (obj)) %in% indx_multi))
+    index_final <- index_final [indx]
     gt_p <- obj$geotext [indx] %>%
         gsub ("POLYGON\\(\\(", "", .) %>%
         gsub ("\\)\\)", "", .) %>%
@@ -371,6 +381,9 @@ get_geotext_poly <- function (obj) {
     for (i in indx_na) {
         gt_p [[i]] <- NULL
     }
+    if (length (indx_na) > 0L) {
+        index_final <- index_final [-indx_na]
+    }
 
     # points and linestrings may be present in result, and will be prepended
     # by sf-standard prefixes, while (multi)polygons will have been stripped
@@ -384,11 +397,15 @@ get_geotext_poly <- function (obj) {
     ))
     if (length (indx) > 0) {
         gt_p <- gt_p [-indx]
+        index_final <- index_final [-indx]
     }
 
     if (length (gt_p) > 0) {
         gt_p <- lapply (gt_p, function (i) get1bdypoly (i))
+        lens <- vapply (gt_p, length, integer (1))
+        index_final <- rep (index_final, times = lens)
         gt_p <- do.call (c, gt_p)
+        names (gt_p) <- as.character (index_final)
     }
 
     return (gt_p)
@@ -407,6 +424,7 @@ get_geotext_multipoly <- function (obj) {
 
     indx_multi <- grep ("MULTIPOLYGON", obj$geotext)
     gt_mp <- NULL
+    index_final <- seq_len (nrow (obj)) [indx_multi]
 
     # nocov start
     # TODO: Test this
@@ -419,11 +437,17 @@ get_geotext_multipoly <- function (obj) {
         for (i in indx_na) {
             gt_mp [[i]] <- NULL
         }
+        if (length (indx_na) > 0L) {
+            index_final <- index_final [-indx_na]
+        }
     }
     # nocov end
 
     if (length (gt_mp) > 0) {
         gt_mp <- lapply (gt_mp, function (i) get1bdypoly (i))
+        lens <- vapply (gt_mp, length, integer (1))
+        index_final <- rep (index_final, times = lens)
+        names (gt_mp) <- as.character (index_final)
     }
 
     return (gt_mp)

codemeta.json

@@ -11,7 +11,7 @@
   "codeRepository": "https://github.com/ropensci/osmdata/",
   "issueTracker": "https://github.com/ropensci/osmdata/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.2.5.009",
+  "version": "0.2.5.016",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

tests/testthat/mock_bb_poly/nominatim/search-c1f6d2.json

@@ -38,7 +38,7 @@ test_that ("getbb-place_name", {
     range2 <- apply (res2, 1, function (i) diff (range (i)))
     expect_true (all (range2 >= range0))
 
-    expect_output (
+    expect_message (
         res0 <- with_mock_dir ("mock_bb", {
             getbb (place_name = "Salzburg", silent = FALSE)
         })
@@ -132,6 +132,7 @@ test_that ("getbb-polygon", {
     expect_is (res, "sf")
     expect_is (res$geometry, "sfc_POLYGON")
     expect_true (length (res$geometry) > 1)
+    expect_true (ncol (res) > 1)
 })
 
 test_that ("bbox-to-string", {

tests/testthat/mock_bb_sf/nominatim/search-c1f6d2.json

@@ -47,21 +47,14 @@ make_sfc <- function (x, type) {
     class (x) <- c (paste0 ("sfc_", class (x [[1L]]) [2L]), "sfc")
     attr (x, "bbox") <- bb
 
-    if (packageVersion ("sf") < 0.9) {
-        NA_crs_ <- structure (list ( # nolint
-            epsg = NA_integer_, # nolint
-            proj4string = NA_character_
-        ), # nolint
-        class = "crs"
-        )
-    } else {
-        NA_crs_ <- structure (list ( # nolint
+    NA_crs_ <- structure (
+        list ( # nolint
             input = NA_character_, # nolint
             wkt = NA_character_
         ), # nolint
         class = "crs"
-        )
-    }
+    )
+
     attr (x, "crs") <- NA_crs_
 
     return (x)