Draft for server-side filtering by area

R/opq.R

@@ -5,7 +5,9 @@
 #'      or (ii) a character string in the form \code{xmin,ymin,xmax,ymax}. These
 #'      will be passed to \link{getbb} to be converted to a numerical bounding
 #'      box. Can also be (iii) a matrix representing a bounding polygon as
-#'      returned from `getbb(..., format_out = "polygon")`.
+#'      returned from `getbb(..., format_out = "polygon")`. To search in an area,
+#'      (iv) a character string with a relation or a (closed) way id in the
+#'      format \code{way(id)}, \code{rel(id)} or \code{relation(id)}.
 #' @param nodes_only If `TRUE`, query OSM nodes only. Some OSM structures such
 #'      as `place = "city"` or `highway = "traffic_signals"` are represented by
 #'      nodes only. Queries are built by default to return all nodes, ways, and
@@ -61,7 +63,7 @@
 opq <- function (bbox = NULL, nodes_only = FALSE,
                  datetime = NULL, datetime2 = NULL,
                  timeout = 25, memsize) {
-
+area<- bbox # TODO break API: rename function parameter bbox to area
     timeout <- format (timeout, scientific = FALSE)
     prefix <- paste0 ("[out:xml][timeout:", timeout, "]")
     suffix <- ifelse (
@@ -91,12 +93,23 @@ opq <- function (bbox = NULL, nodes_only = FALSE,
             prefix <- paste0 ('[date:\"', datetime, '\"]', prefix)
         }
     }
+    if (length (area) == 4 |
+        (is.character(area) && !all (grepl ("^(rel|relation|way)\\([0-9]+\\)$", area))) |
+        all(dim(area) == c(2, 2))
+    ){  # bbox (i & ii & iii)
+      bbox <- bbox_to_string (area)
+      area <- NULL
+    } else {  # bbox (iv) polygon
+      bbox <- NULL
+    }
 
     res <- list (
-        bbox = bbox_to_string (bbox),
+        bbox = bbox,
+        area = area,
         prefix = paste0 (prefix, ";\n(\n"),
         suffix = suffix, features = NULL
     )
+    # res <- res[!sapply (res, is.null)]
     class (res) <- c (class (res), "overpass_query")
     attr (res, "datetime") <- datetime
     attr (res, "datetime2") <- datetime2
@@ -249,9 +262,7 @@ add_osm_feature <- function (opq,
         stop ("Bounding box has to either be set in opq or must be set here")
     }
 
-    if (is.null (bbox)) {
-        bbox <- opq$bbox
-    } else {
+    if (!is.null (bbox)) {
         bbox <- bbox_to_string (bbox)
         opq$bbox <- bbox
     }
@@ -425,9 +436,7 @@ add_osm_features <- function (opq,
         stop ("Bounding box has to either be set in opq or must be set here")
     }
 
-    if (is.null (bbox)) {
-        bbox <- opq$bbox
-    } else {
+    if (!is.null (bbox)) {
         bbox <- bbox_to_string (bbox)
         opq$bbox <- bbox
     }
@@ -753,12 +762,19 @@ opq_string_intern <- function (opq, quiet = TRUE) {
         }
 
         if (attr (opq, "nodes_only")) {
-
-            features <- paste0 (sprintf (
-                " node %s (%s);\n",
-                features,
-                opq$bbox
-            ))
+            if (!is.null (opq$bbox)){
+              features <- paste0 (sprintf (
+                  " node %s (%s);\n",
+                  features,
+                  opq$bbox
+              ))
+            } else if (!is.null (opq$area)){
+              searchArea<- paste0 (" (", opq$area, "; map_to_area->.searchArea;);\n")
+              features <- paste0 (searchArea, sprintf (
+                " node %s (area.searchArea);\n",
+                features
+              ))
+            }
 
         } else if (!is.null (attr (opq, "enclosing"))) {
 
@@ -779,23 +795,32 @@ opq_string_intern <- function (opq, quiet = TRUE) {
 
         } else {
 
-            features <- paste0 (
-                sprintf (
-                    " node %s (%s);\n",
-                    features,
-                    opq$bbox
-                ),
-                sprintf (
-                    " way %s (%s);\n",
-                    features,
-                    opq$bbox
-                ),
-                sprintf (
-                    " relation %s (%s);\n\n",
-                    features,
-                    opq$bbox
-                )
-            )
+            if (!is.null (opq$bbox)){
+              features <- paste0 (
+                  sprintf (
+                      " node %s (%s);\n",
+                      features,
+                      opq$bbox
+                  ),
+                  sprintf (
+                      " way %s (%s);\n",
+                      features,
+                      opq$bbox
+                  ),
+                  sprintf (
+                      " relation %s (%s);\n\n",
+                      features,
+                      opq$bbox
+                  )
+              )
+            } else if (!is.null (opq$area)){
+              searchArea<- paste0(" ( ", opq$area,"; map_to_area->.searchArea; );\n")
+              features <- paste0 (searchArea,
+                            sprintf ("  node %s (area.searchArea);\n", features),
+                            sprintf ("  way %s (area.searchArea);\n", features),
+                            sprintf ("  relation %s (area.searchArea);\n", features)
+              )
+            }
         }
 
         res <- paste0 (
@@ -826,13 +851,22 @@ opq_string_intern <- function (opq, quiet = TRUE) {
             )
         }
 
-        bbox <- paste0 (
-            sprintf (" node (%s);\n", opq$bbox),
-            sprintf (" way (%s);\n", opq$bbox),
-            sprintf (" relation (%s);\n", opq$bbox)
-        )
+        if (!is.null(opq$bbox)){
+          area <- paste0 (
+              sprintf (" node (%s);\n", opq$bbox),
+              sprintf (" way (%s);\n", opq$bbox),
+              sprintf (" relation (%s);\n", opq$bbox)
+          )
+        } else if (!is.null(opq$area)){
+          searchArea<- paste0(" ( ", opq$area, "; map_to_area->.searchArea; );\n")
+          area <- paste0 (searchArea,
+              "  node (area.searchArea);\n",
+              "  way (area.searchArea);\n",
+              "  relation (area.searchArea);\n"
+          )
+        }
 
-        res <- paste0 (opq$prefix, bbox, opq$suffix)
+        res <- paste0 (opq$prefix, area, opq$suffix)
     }
 
     return (res)