#############################################################
## get some OSM
library(osmdata)
## Data (c) OpenStreetMap contributors, ODbL 1.0. http://www.openstreetmap.org/copyright
library(xml2)
gda94 <- matrix(rep(c(521494, 5247625), each = 2) + c(-1, 1) * 100, ncol = 2)
ext <- rgdal::project(gda94, "+init=epsg:28355", inv = TRUE)
q <- opq(bbox = as.vector(t(ext)))
#q <- add_osm_feature(q0, key = 'name', value = "Thames", value_exact = FALSE)
encoding <- "UTF-8"
obj <- osmdata()
obj$bbox <- q$bbox
obj$overpass_call <- opq_string(q)
doc <- osmdata:::overpass_query(query = obj$overpass_call, quiet = FALSE,
encoding = encoding)
## Issuing query to Overpass API ...
## Rate limit: 3
## Query complete!
# #saveRDS(doc, file = "inst/examples/osmdata/doc.rds")
# x <- readRDS("inst/examples/osmdata/doc.rds")
#############################################################
## functions to silicify the OSM message
## after parsing out ways (path), nodes (vertex) and
## pretending (for now) that each way is a feature (object)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
read_node <- function(x, ...) {
lst <- xml2::xml_find_all(xml2::read_xml(x), "//node") %>%
purrr::map(xml_attrs)
tibble::as_tibble(do.call(rbind, lst)) %>%
dplyr::transmute(vertex_ = id, x_ = as.numeric(lon), y_ = as.numeric(lat))
}
read_way <- function(x, ...) {
do.call(rbind, xml2::xml_find_all(xml2::read_xml(x), "//way") %>%
purrr::map(xml_attrs)) %>%
tibble::as_tibble() %>%
dplyr::rename(path = id) %>% mutate(object = rev_string(path))
}
read_way_ref <- function(x, ...) {
path <- read_way(x)
# path <- dplyr::mutate(path, id_ = as.character(seq_len(nrow(path))))
xml_find_all(xml2::read_xml(x), "//way") %>%
map(xml_find_all, "nd") %>%
map(function(a) do.call(rbind, xml_attrs(a)) %>% tibble::as_tibble() %>% dplyr::rename(vertex_ = ref)) %>%
setNames(path[["path"]]) %>%
bind_rows(.id = "path")
}
rev_string <- function(x) {
unlist(lapply(strsplit(x, ""), function(y) paste(rev(y), collapse = "")))
}
read_obj <- function(x) {
read_way(x) %>% dplyr::transmute(object = rev_string(path))
}
gibble.PATH <- function(x, ...) {
inner_join(x[["path"]], x[["path_link_vertex"]] %>% group_by(path) %>% summarize(nrow = n()) ) %>%
dplyr::mutate(ncol = 2, type = "MULTILINESTRING")
}
silicate_osm <- function(x) {
structure( list(object = read_obj(x),
path = read_way(x),
path_link_vertex = read_way_ref(x),
vertex = read_node(x)),
join_ramp = c("object", "path", "path_link_vertex", "vertex"),
class = c("PATH", "sc"))
}
#############################################################
## bring in to silicate PATH form
library(gibble)
library(purrr)
library(xml2)
library(silicate)
##
## Attaching package: 'silicate'
## The following object is masked from 'package:gibble':
##
## minimal_mesh
path_from_osm <- silicate_osm(doc)
dim(path_from_osm$vertex)
## [1] 3480 3
## the silicate generics now work, because PATH is a
## common-form
## note how sc_coord *expands* to the full set of instances
#sc_coord(path_from_osm)
#sc_path(path_from_osm)
#sc_object(path_from_osm)
## gibble is the geometry map, a run-length code of
## the expanded coordinate set
gm <- gibble(path_from_osm)
## Joining, by = "path"
library(sf)
## Linking to GEOS 3.5.1, GDAL 2.2.1, proj.4 4.9.3
sf_geom <- silicate:::build_sf(gm, sc_coord(path_from_osm))
## fakey up a full sf-feature data frame
sf_obj <- st_set_crs(st_sf(geometry = sf_geom, a = unique(gm$object)), 4326)
## Warning in if (is.na(x)) NA_crs_ else if (inherits(x, "crs")) x else if
## (is.numeric(x)) CPL_crs_from_epsg(as.integer(x)) else if (is.character(x))
## {: the condition has length > 1 and only the first element will be used
g <- dismo::gmap(as(sf_obj, "Spatial"), type = "satellite")
library(raster)
## Loading required package: sp
##
## Attaching package: 'raster'
## The following object is masked from 'package:dplyr':
##
## select
plot(g, addfun = function() plot(st_transform(sf_obj, projection(g)), add = T))


###################################################
## convert to PRIMITIVE and provide a summary
prim <- path_from_osm %>% PRIMITIVE()
## no. of segments
nrow(prim$segment)
## [1] 3617
## no. of unique vertices
nrow(prim$vertex)
## [1] 3480
## no. of segments per way
prim$segment %>% group_by(path) %>% tally()
## # A tibble: 107 x 2
## path n
## <chr> <int>
## 1 243649367 29
## 2 394940269 65
## 3 394940270 9
## 4 484154160 14
## 5 484154161 36
## 6 484154162 14
## 7 484154163 8
## 8 484154164 14
## 9 484154165 8
## 10 484154166 18
## # ... with 97 more rows
## no. of nodes per way
prim$path_link_vertex %>% group_by(path) %>% tally()
## # A tibble: 107 x 2
## path n
## <chr> <int>
## 1 243649367 30
## 2 394940269 66
## 3 394940270 10
## 4 484154160 15
## 5 484154161 37
## 6 484154162 15
## 7 484154163 9
## 8 484154164 15
## 9 484154165 9
## 10 484154166 19
## # ... with 97 more rows