Showing posts with label KML. Show all posts
Showing posts with label KML. Show all posts
Sunday, September 20, 2015
Convert OpenStreetMap Objects to KML with R
A quick geo-tip:
With the osmar and maptools package you can easily pull an OpenStreetMap object and convert it to KML, like below (thanks to adibender helping out on SO). I found the relation ID by googling for it (www.google.at/search?q=openstreetmap+relation+innsbruck).
Read more »
With the osmar and maptools package you can easily pull an OpenStreetMap object and convert it to KML, like below (thanks to adibender helping out on SO). I found the relation ID by googling for it (www.google.at/search?q=openstreetmap+relation+innsbruck).
# get OSM data
library(osmar)
library(maptools)
innsbruck <- get_osm(relation(113642), full = T)
sp_innsbruck <- as_sp(innsbruck, what = "lines")
# convert to KML
for( i in seq_along(sp_innsbruck) ) {
kmlLine(sp_innsbruck@lines[[i]], kmlfile = "innsbruck.kml",
lwd = 3, col = "blue", name = "Innsbruck")
}
shell.exec("innsbruck.kml")
Make a KML-File from an OpenStreetMap Trail
Ever wished to use a trail on OSM on your GPS or smartphone? With this neat little R-Script this can easily be done. You'll just need to search OpenStreetMap for the ID of the trail (way), put this as argument to osmar::get_osm, convert to KML and you're good to go!
Read more »
# get OSM data
library(osmar)
library(maptools)
rotewandsteig <- get_osm(way(166274005), full = T)
sp_rotewandsteig <- as_sp(rotewandsteig, what = "lines")
# convert to KML
kmlLine(sp_rotewandsteig@lines[[1]], kmlfile = "rotewandsteig.kml",
lwd = 3, col = "blue", name = "Rotewandsteig")
# view it
shell.exec("rotewandsteig.kml")
R GIS: Generalizer for KML Paths
I'm posting a recent project's spin-off, which is a custom line-generalizer which I used for huge KML-paths. Anyone with a less clumpsy approach?
Read more »
## line generalizing function: takes two vectors of with x/ycoords
## and return ids of x/y elements which distance to its next element
## is shorter than the average distance between consecutive vertices
## multiplied by 'fac'
check_dist <- function(x, y, fac) {
dm <- as.matrix(dist(cbind(x, y)))
## supradiagonal holds distance from 1st to 2nd, 2nd to 3rd, etc. element
d <- diag(dm[-1, -ncol(dm)])
mean_dist <- mean(d)
keep <- logical()
## allways keep first..
keep[1] <- T
for (i in 1:(length(x) - 2)) {
keep[i + 1] <- (d[i] > mean_dist * fac)
message(paste0("Distance from item ", i, " to item ", i + 1, " is: ", d[i]))
}
message(paste0("Treshold is: ", mean_dist * fac))
cat("--\n")
## .. and always keep last
keep[length(x)] <- T
return(keep)
}
## Testing function check_dist:
x <- rnorm(5)
y <- rnorm(5)
(keep <- check_dist(x, y, 1.2))
plot(x, y)
lines(x[keep], y[keep], lwd = 4, col = "green")
lines(x, y, lwd = 1, col = "red")
text(x, y + 0.1, labels = c(1:length(x)))
## exclude vertices by generalization rule. coordinate-nodes with low number of vertices,
## segments with less than 'min_for_gen' vertices will not be simplified, in any case coordinates will be
## rounded to 5-th decimal place
generalize_kml_contour_node <- function(node, min_for_gen, fac) {
require(XML)
LineString <- xmlValue(node, trim = T)
LineStrSplit <- strsplit(unlist(strsplit(LineString, "\\s")), ",")
# filter out empty LineStrings which result from strsplit on '\\s'
LineStrSplit <- LineStrSplit[sapply(LineStrSplit, length) > 0]
# all 3 values are required, in case of error see for missing z-values:
x <- round(as.numeric(sapply(LineStrSplit, "[[", 1, simplify = T)), 5)
y <- round(as.numeric(sapply(LineStrSplit, "[[", 2, simplify = T)), 5)
z <- round(as.numeric(sapply(LineStrSplit, "[[", 3, simplify = T)), 5)
# for lines longer than 'min_for_gen' vertices, generalize LineStrings
if (length(x) >= min_for_gen) {
keep <- check_dist(x, y, fac)
x <- x[keep]
y <- y[keep]
z <- z[keep]
xmlValue(node) <- paste(paste(x, y, z, sep = ","), collapse = " ")
# for all other cases, insert rounded values
} else {
xmlValue(node) <- paste(paste(x, y, z, sep = ","), collapse = " ")
}
}
## mind to use the appropiate namespace definition: alternatively use:
## c(kml ='http://opengis.net/kml/2.2')
kml_generalize <- function(kml_file, min_for_gen, fac) {
doc <- xmlInternalTreeParse(kml_file)
nodes <- getNodeSet(doc, "//kml:LineString//kml:coordinates", c(kml = "http://earth.google.com/kml/2.0"))
mapply(generalize_kml_contour_node, nodes, min_for_gen, fac)
saveXML(doc, paste0(dirname(kml_file), "/simpl_", basename(kml_file)))
}
## get KML-files and generalize them
kml_file <- tempfile(fileext = ".kml")
download.file("http://dev.openlayers.org/releases/OpenLayers-2.13.1/examples/kml/lines.kml",
kml_file, mode = "wb")
kml_generalize(kml_file, 5, 0.9)
shell.exec(kml_file)
shell.exec(paste0(dirname(kml_file), "/simpl_", basename(kml_file)))
Usecase for KML-Parsing: Make New KML-File from File-Collection
In this usecase I had collected several KMLs from the internet but wanted to strip them down for only the relevant parts (the Linestrings inside the Placemark-nodes) and put them all inside one final File. In my script I create a new KML file and populate a folder-node inside it with Linestrings from the collection of KML-files which all reside in the same source directory. For this one needs to parse each file and grab the appropiate nodes and add them to the target kml file. In addition I alter some oroginal values, i.e. I use the file names of the single KML-files as Placemark names inside the new KML-file.
Here is the final file as seen after opening in Google Earth:
Read more »
Here is the final file as seen after opening in Google Earth:
library(XML)
# new kml file... needs to be well-formed
z <-
''
ROUTES
new_xmlDoc <- xmlInternalTreeParse(z, useInternalNodes = TRUE)
# important add all namespace definitions...
ns <- c(gx="http://www.google.com/kml/ext/2.2",
kml="http://www.opengis.net/kml/2.2",
atom="http://www.w3.org/2005/Atom")
ensureNamespace(new_xmlDoc, ns)
# get the root off the new file for latter processing
new_root <- xmlRoot(new_xmlDoc)
# loop over files from folder
# and insert Placemark content of each file as children nodes into
# the new file
setwd("C:/Users/Kay/Google Drive/SKI-BIKE/Gastein")
files <- dir(pattern="bergfex*")
for (f in files) {
# get placemark node of each file
doc <- xmlInternalTreeParse(f, useInternalNodes = TRUE)
root <- xmlRoot(doc)
plcm_node <- root[["Document"]][["Folder"]][["Folder"]][["Placemark"]]
# insert file name as Placemark name
xmlValue(plcm_node[["name"]]) <- sub('bergfextour_(.*)[.]kml', '\\1', f)
# add placemark node to new doc
addChildren(new_root[["Document"]][["Folder"]], plcm_node)
}
# save it...
saveXML(new_xmlDoc, "collapsed_ROUTES.kml")
Saturday, September 19, 2015
R GIS: Function to Reverse KML Paths
This is a function I wrote up for reversing KML-paths. The paths within a KML can be partially matched by their name-tags
Read more »
## name: ReverseKmlPath
## use: Reverse KML-pathsby matching their Name tags
## arguments: PATH_TO_DOC, the path to the KML-file
## NAME, the value of the name tag, function uses partial matching!
## 'Trail_xyz' will be matched by 'rail'
## requirements: KML-structure with Placemarks containing aand a tag
## author: Kay Cichini
## date: 01-05-2014
## license: CC-BY-NC-SA
ReverseKmlPath <- function(PATH_TO_DOC, NAMES) {
require(XML)
doc <- xmlInternalTreeParse(PATH_TO_DOC)
if (xmlNamespaceDefinitions(doc)[[1]]$uri == "http://www.opengis.net/kml/2.2") {
namespaces <- c(kml = "http://www.opengis.net/kml/2.2")
flag <- 1
} else {
if (xmlNamespaceDefinitions(doc)[[1]]$uri == "http://earth.google.com/kml/2.0") {
namespaces <- c(kml0 = "http://earth.google.com/kml/2.0")
flag <- 0
} else {
stop ("Stopped!: Check namespace issue..")
}
}
for (NAME in NAMES) {
if (flag) {
query <- paste0("//kml:Placemark[contains(kml:name,'", sprintf("%s", NAME), "'", ")]//kml:coordinates")
} else {
query <- paste0("//kml0:Placemark[contains(kml0:name,'", sprintf("%s", NAME), "'", ")]//kml0:coordinates")
}
coords <- tryCatch(getNodeSet(doc, query, namespaces),
error = function(e) message(paste("\nError: *", NAME, "* was NOT successfully matched\n")))
for (i in length(coords)) {
#grab coordinates from node and reverse order
rev_coord_vector <- rev(unlist(strsplit(gsub("\\t|\\n", "", xmlValue(coords[[i]])), "\\s")))
rev_coord_string <- paste(rev_coord_vector, collapse = " ")
# re-insert reversed line-string:
xmlValue(coords[[i]]) <- rev_coord_string
# message
if (flag) {
query <- paste0("//kml:Placemark[contains(kml:name,'", sprintf("%s", NAME), "'", ")]//kml:name")
} else {
query <- paste0("//kml0:Placemark[contains(kml0:name,'", sprintf("%s", NAME), "'", ")]//kml0:name")
}
match <- xmlValue(getNodeSet(doc, query, namespaces)[[i]])
message(paste0("matched name: ", match, "\n..."))
}
}
# save:
message("Reversed paths saved to:")
saveXML(doc, paste0(dirname(PATH_TO_DOC), "/reversed_", basename(PATH_TO_DOC)),
prefix = newXMLCommentNode("This file was created with the R-package XML::saveXML, see: "))
}
## not run:
tf <- tempfile(fileext = ".kml")
download.file("http://dev.openlayers.org/releases/OpenLayers-2.13.1/examples/kml/lines.kml", tf, mode = "wb")
ReverseKmlPath( PATH_TO_DOC = tf, NAMES = c("Absolute", "Relative") )
shell.exec(tf)
shell.exec(paste0(dirname(tf), "/reversed_", basename(tf)))
Subscribe to:
Posts (Atom)