knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "man/figures/README-", out.width = "100%" )
plotKML: Visualization of Spatial and Spatio-Temporal Objects in Google Earth
How to cite:
Install development versions from github:
library(devtools) install_github("envirometrix/plotKML") # install_github("envirometrix/plotKML", ref = "stars")
We will now present new sf methods and compare them with current sp approach. Start with POINTS
suppressPackageStartupMessages({ library(plotKML) library(sp) library(rgdal) library(sf) }) # Load data data(eberg) coordinates(eberg) <- ~ X + Y proj4string(eberg) <- CRS("+init=epsg:31467") ## subset to 20 percent: eberg <- eberg[runif(nrow(eberg)) < .1, ] # sp methods plotKML(eberg["CLYMHT_A"], open.kml = FALSE) plotKML(eberg["CLYMHT_A"], colour_scale = rep("#FFFF00", 2), points_names = "", open.kml = FALSE) # convert eberg to sf format eberg_sf <- st_as_sf(eberg) # and apply sf methods plotKML(eberg_sf["CLYMHT_A"], open.kml = FALSE) plotKML(eberg_sf["CLYMHT_A"], points_names = "", colour_scale = SAGA_pal[[2]], open.kml = FALSE) #Change palette plotKML(eberg_sf["CLYMHT_A"], colour_scale = rep("#FFFF00", 2), points_names = "", open.kml = FALSE) # Degenerate palette
Recent version of sf could show a warning message relative to the old PROJ4string specified by get("ref_CRS", envir = plotKML.opts).
We can now compare the two implementations:
all.equal(readLines("eberg__CLYMHT_A__.kml"), readLines("eberg_sf__CLYMHT_A__.kml"))
The two string mismatches are simply caused by the different names and classes:
id_mismatches <- readLines("eberg__CLYMHT_A__.kml") != readLines("eberg_sf__CLYMHT_A__.kml") readLines("eberg__CLYMHT_A__.kml")[id_mismatches] readLines("eberg_sf__CLYMHT_A__.kml")[id_mismatches]
We can also use kml_layer functions:
data(eberg_grid) gridded(eberg_grid) <- ~ x + y proj4string(eberg_grid) <- CRS("+init=epsg:31467") eberg_grid_sf <- st_as_sf(eberg_grid) # sfc objects kml_open("eberg_grids.kml") kml_layer(st_geometry(eberg_grid_sf)) kml_close("eberg_grids.kml") # sf objects kml_open("eberg_grid_sf.kml") kml_layer(eberg_grid_sf, colour = DEMSRT6, colour_scale = R_pal[["terrain_colors"]]) kml_layer(eberg_grid_sf, colour = TWISRT6, colour_scale = SAGA_pal[[1]]) kml_close("eberg_grid_sf.kml")
This is also a more complex example where we add a legend to the plot:
shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" kml_file = "kml_file_point.kml" legend_file = "kml_legend.png" kml_open(kml_file) kml_layer( eberg_sf["CLYMHT_A"], colour = CLYMHT_A, points_names = eberg_sf[["CLYMHT_A"]], size = 1, shape = shape, alpha = 0.75, colour_scale = SAGA_pal[[2]] ) kml_legend.bar(eberg_sf$CLYMHT_A, legend.file = legend_file, legend.pal = SAGA_pal[[1]]) kml_screen(image.file = legend_file) kml_close(kml_file) kml_View(kml_file)
Then we present sf methods for MULTIPOINT objects.
The idea is exactly the same, but MULTIPOINT object are converted to POINT.
eberg_sf_MULTIPOINT <- eberg_sf %>% dplyr::mutate(random_ID = sample(1:4, size = dplyr::n(), replace = TRUE)) %>% dplyr::group_by(random_ID) %>% dplyr::summarise() plotKML(eberg_sf_MULTIPOINT["random_ID"], open.kml = FALSE)
Then we present LINESTRING methods, starting from the sp example:
# sp data(eberg_contours) plotKML(eberg_contours, open.kml = FALSE) plotKML(eberg_contours, colour = Z, altitude = Z, open.kml = FALSE) # sf eberg_contours_sf <- st_as_sf(eberg_contours) plotKML(eberg_contours_sf, open.kml = FALSE) plotKML(eberg_contours_sf, colour = Z, altitude = Z, open.kml = FALSE)
Again, the kml files are identical but for super small differences (if they are present) due to rounding errors:
all.equal(readLines("eberg_contours.kml"), readLines("eberg_contours_sf.kml")) id_mismatches <- which(readLines("eberg_contours.kml") != readLines("eberg_contours_sf.kml")) readLines("eberg_contours.kml")[id_mismatches[1:5]] readLines("eberg_contours_sf.kml")[id_mismatches[1:5]]
The same ideas can be applied to MULTILINESTRING objects.
The only problem is that some of the features in eberg_contous_sf are not valid according to the simple feature definition of LINESTRING.
For example
eberg_contours@lines[[4]]
since it would represent a LINESTRING with only 1 point:
st_is_valid(st_geometry(eberg_contours_sf)[[4]], NA_on_exception = FALSE, reason = TRUE)
So we need to exclude these elements and create a MULTILINESTRING object,
ID_valid <- vapply( st_geometry(eberg_contours_sf), function(x) isTRUE(st_is_valid(x)), logical(1) ) eberg_contous_sf_multi <- eberg_contours_sf %>% dplyr::filter(ID_valid) %>% dplyr::group_by(Z) %>% dplyr::summarise() plotKML(eberg_contous_sf_multi, colour = Z, altitude = Z, open.kml = FALSE)
We can also use kml_layer functions:
# sfc LINESTRING object kml_open("eberg_contours_sfc.kml") kml_layer(st_geometry(eberg_contours_sf)) kml_close("eberg_contours_sfc.kml")
Then we can work with POLYGON geometry, starting from sp example:
# sp set.seed(1) # I set the seed to compare the kml files data(eberg_zones) plotKML(eberg_zones["ZONES"], open.kml = FALSE) ## add altitude: zmin = 230 plotKML(eberg_zones["ZONES"], altitude = zmin + runif(length(eberg_zones)) * 500, open.kml = FALSE) # sf objects with sfc_POLYGON geometry eberg_zones_sf <- st_as_sf(eberg_zones) set.seed(1) plotKML(eberg_zones_sf["ZONES"], open.kml = FALSE) plotKML(eberg_zones_sf["ZONES"], altitude = zmin + runif(length(eberg_zones)) * 500, open.kml = FALSE)
and compare the results:
all.equal(readLines("eberg_zones__ZONES__.kml"), readLines("eberg_zones_sf__ZONES__.kml"))
The differences here (if they are present) are caused by extremely small rounding problems:
id_mismatches <- readLines("eberg_zones__ZONES__.kml") != readLines("eberg_zones_sf__ZONES__.kml") readLines("eberg_zones__ZONES__.kml")[id_mismatches][1:5] readLines("eberg_zones_sf__ZONES__.kml")[id_mismatches][42]
Again, the same ideas can be applied to MULTIPOLYGON objects:
eberg_zones_sf_MULTI <- eberg_zones_sf %>% dplyr::group_by(ZONES) %>% dplyr::summarise() %>% st_cast("MULTIPOLYGON") plotKML(eberg_zones_sf_MULTI["ZONES"], open.kml = FALSE)
We will now present plotKML methods applied to stars objects.
We extended the plotKML() function to stars objects representing Raster Data Cubes creating a wrapper to RasterLayer method:
library(stars) # Start with a raster data cube (g <- read_stars(system.file("external/test.grd", package = "raster"))) plotKML(g, open.kml = FALSE)
Default methods do not work if the third dimension does not represent a Date or POSIXct object:
# Test with another example: (L7 <- read_stars(system.file("tif/L7_ETMs.tif", package = "stars"))) plotKML(L7, open.kml = FALSE)
It fails. The problems is that there is no method definition for plotKML() function for objects of class RasterBrick.
The code behind as(x, "Raster") is defined here and it says that if length(dim(x)) > 2 (i.e. there is an extra dimension other than x and y), then it creates a RasterBrick object.
We can still plot the raster associated to one of the layers in the RasterBrick with a little bit of extra work:
plotKML(raster::raster(as(L7, "Raster"), layer = 1), open.kml = FALSE)
We are working on defining an extension to stars object with a temporal dimension as a wrapper around RasterBrickTimeSeries methods.
Let's focus now on Vector Data cubes:
# Vector data cube data(air, package = "spacetime") d = st_dimensions(station = st_as_sfc(stations), time = dates) (aq = st_as_stars(list(PM10 = air), dimensions = d)) (agg = aggregate(aq, "months", mean, na.rm = TRUE)) plotKML(agg, open.kml = FALSE)
Unfortunately there is a known bug in plotKML/spacetime and the following example fails:
# Spatial aggregation: (a = aggregate(agg, st_as_sf(DE_NUTS1), mean, na.rm = TRUE)) plotKML(a) # error # The error is in as(obj, "STIDF"), i.e. the conversion between STFDF and STIDF
Moreover, all the examples fail if the third dimension is not a temporal object (since the methods we defined as wrappers around STFDF class):
nc = read_sf(system.file("gpkg/nc.gpkg", package="sf")) nc.df = st_set_geometry(nc, NULL) mat = as.matrix(nc.df[c("BIR74", "SID74", "NWBIR74", "BIR79", "SID79", "NWBIR79")]) dim(mat) = c(county = 100, var = 3, year = 2) # make it a 3-dimensional array dimnames(mat) = list(county = nc$NAME, var = c("BIR", "SID", "NWBIR"), year = c(1974, 1979)) (nc.st = st_as_stars(pop = mat)) (nc.geom <- st_set_dimensions(nc.st, 1, st_geometry(nc))) plotKML(nc.geom)
We can somehow fix this problem converting the stars object into sf format:
# We can use the following approach plotKML(st_as_sf(nc.geom), open.kml = FALSE)
In some cases, it is still possible to redefine a temporal dimension (but unfortunately the example fails for the same bug as the previous case):
(nc.geom <- st_set_dimensions(nc.geom, 3, as.Date(c("1974-01-01","1979-01-01")))) (nc.geom <- split(aperm(nc.geom, c(1,3,2)))) plotKML(nc.geom)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.