diff --git a/README.md b/README.md new file mode 100644 index 0000000..c6ff1b2 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +This is a fork of plotKML from R-forge. + +If you were born to have adventure, the trip branch has a method for `plotKML` for `trip` objects (from the [trip](https://CRAN.R-project.org/package=enpls) package). + + +```R +devtools::install_github("Trackage/plotkml/pkg@trip") +``` + +See README for the original provenance. + diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index c4ab0ac..1965ee0 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -1,39 +1,19 @@ Package: plotKML -Version: 0.8-0 -Date: 2021-04-12 +Version: 0.5-9 +Date: 2017-05-15 Title: Visualization of Spatial and Spatio-Temporal Objects in Google Earth -Author: Tomislav Hengl [cre, aut], Andrea Gilardi [ctb], Pierre Roudier [ctb], Dylan Beaudette [ctb], Edzer Pebesma [ctb], Michael Blaschek [ctb] Authors@R: c(person("Tomislav", "Hengl", role = c("cre", "aut"), - email = "tom.hengl@opengeohub.org"), - person("Andrea", "Gilardi", role = "ctb"), + email = "tom.hengl@isric.org"), person("Pierre", "Roudier", role = "ctb"), person("Dylan", "Beaudette", role = "ctb"), - person("Edzer", "Pebesma", role = "ctb"), - person("Michael", "Blaschek", role = "ctb")) -Maintainer: Tomislav Hengl -Depends: R (>= 3.5.0) -Imports: methods, tools, utils, XML, landmap, sp, raster, rgdal, aqp, gstat, spacetime, colorspace, plotrix, dismo, pixmap, plyr, stringr, colorRamps, scales, zoo, RColorBrewer, RSAGA, classInt, sf, stars -Suggests: - adehabitatLT, - maptools, - fossil, - rjson, - animation, - spatstat, - spatstat.linnet, - spatstat.geom, - RCurl, - rgbif, - Hmisc, - uuid, - intervals, - reshape, - gdalUtils, - snowfall, - parallel, - tinytex, - testthat + person("Edzer", "Pebesma", role = "ctb"), + person("Michael", "Blaschek", role = "ctb")) +Maintainer: Tomislav Hengl +Depends: R (>= 2.13.0) +Imports: methods, tools, utils, XML, sp, raster, rgdal, spacetime, colorspace, plotrix, dismo, aqp, pixmap, plyr, stringr, colorRamps, scales, gstat, zoo, RColorBrewer, RSAGA, classInt +Suggests: adehabitat, maptools, fossil, spcosa, rjson, animation, spatstat, RCurl, rgbif, Hmisc, GSIF, uuid, intervals, reshape, gdalUtils, snowfall, parallel Description: Writes sp-class, spacetime-class, raster-class and similar spatial and spatio-temporal objects to KML following some basic cartographic rules. License: GPL -URL: https://github.com/Envirometrix/plotKML +URL: http://plotkml.r-forge.r-project.org/ LazyLoad: yes +RoxygenNote: 6.0.1 diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index f7f0ad8..e3577f3 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -1,55 +1,54 @@ -import(methods, tools) -importFrom("grDevices", "col2rgb", "dev.cur", "dev.list", "dev.new", "dev.off", "dev.set", "colorRamp", "colorRampPalette", "png", "rgb") -importFrom("graphics", "barplot", "image", "par", "persp", "pie", "polygon", "rect", "segments", "abline", "axis", "boxplot", "dotchart", "hist", "lines", "mtext", "points", "text") -importFrom("stats", "cutree", "dist", "dnorm", "hclust", "na.omit", "rnorm", "runif", "as.formula", "median", "quantile", "time", "var") -importFrom("utils", "compareVersion", "head", "write.table", "data", "glob2rx", "object.size", "read.csv", "setTxtProgressBar", "txtProgressBar") -importFrom("RColorBrewer", brewer.pal) -importFrom("scales", rescale) -importFrom("colorspace", coords, hex, mixcolor, HSV) -importFrom("classInt", classIntervals, findColours) -importFrom("plotrix", color.legend) -importFrom("dismo", maxent) -importFrom("gstat", variogram, variogramLine) -importFrom("zoo", as.Date, index) -importFrom("pixmap", pixmapIndexed, pixmapRGB) -importFrom("plyr", aaply, laply, llply, ldply) -importFrom("RSAGA", set.file.extension, rsaga.env, rsaga.get.version, rsaga.geoprocessor) -importFrom("raster", extract, stack, brick, rotate, nlayers, shift, projectRaster, extension, is.factor, as.factor, removeTmpFiles, rasterToPolygons, raster, projection, rasterize, writeRaster, extent, calc, getValues, "values<-", getZ, setZ, minValue, maxValue, image, ncol, nrow, ncell, res) -importFrom("XML", xmlValue, "xmlValue<-", xmlAttrs, "xmlAttrs<-", xmlNode, xmlSize, xmlParse, xmlTreeParse, xmlInternalTreeParse, xmlGetAttr, xmlName, xmlToList, newXMLDoc, newXMLNode, parseXMLAndAdd, xmlChildren, saveXML, xmlRoot, xpathApply, compareXMLDocs, append.XMLNode, xmlSchemaValidate, xmlSApply) -importClassFrom(XML, XMLInternalDocument, XMLAbstractNode, XMLNode, HTMLInternalDocument) -importFrom("aqp", profile_id, idname, horizonDepths, siteNames, site, horizons) -importClassFrom(aqp, SoilProfileCollection) - -import("sp") -import("sf") -import("stars") -import(rgdal) -import(stringr) -import(colorRamps) -importClassFrom(spacetime, STTDF, STIDF) - -exportClasses(SpatialMetadata, - sp.palette, - SpatialPhotoOverlay, - SpatialPredictions, - SpatialVectorsSimulations, - RasterBrickSimulations, - RasterBrickTimeSeries, - SpatialMaxEntOutput, - SpatialSamplingPattern) -exportMethods( - getCRS, - GetNames, - GetPalette, - kml, - kml_layer, - kml_metadata, - reproject, - spMetadata, - metadata2SLD, - plotKML, - vect2rast, - summary) -S3method(plot, SpatialPredictions) -export(check_projection, parse_proj4) -exportPattern("^[^\\.]") +#import(Hmisc) +import(methods, tools) +importFrom("grDevices", "col2rgb", "dev.cur", "dev.list", "dev.new", "dev.off", "dev.set", "colorRamp", "colorRampPalette", "png", "rgb") +importFrom("graphics", "barplot", "image", "par", "persp", "pie", "polygon", "rect", "segments", "abline", "axis", "boxplot", "dotchart", "hist", "lines", "mtext", "points", "text") +importFrom("stats", "cutree", "dist", "dnorm", "hclust", "na.omit", "rnorm", "runif", "as.formula", "median", "quantile", "time", "var") +importFrom("utils", "compareVersion", "head", "write.table", "data", "glob2rx", "object.size", "read.csv", "setTxtProgressBar", "txtProgressBar") +importFrom("RColorBrewer", brewer.pal) +importFrom("scales", rescale) +importFrom("colorspace", coords, hex, mixcolor, HSV) +importFrom("classInt", classIntervals, findColours) +importFrom("plotrix", color.legend) +importFrom("dismo", maxent) +importFrom("gstat", variogram, variogramLine) +import(zoo) +importFrom("pixmap", pixmapIndexed, pixmapRGB) +importFrom("plyr", aaply, laply, llply, ldply) +importFrom("RSAGA", set.file.extension, rsaga.env, rsaga.get.version, rsaga.geoprocessor) +importFrom("raster", extract, stack, brick, rotate, nlayers, shift, projectRaster, extension, is.factor, as.factor, removeTmpFiles, rasterToPolygons, raster, projection, rasterize, writeRaster, extent, calc, getValues, "values<-", getZ, setZ, minValue, maxValue, image, ncol, nrow, ncell, res) +importFrom("XML", xmlValue, "xmlValue<-", xmlAttrs, "xmlAttrs<-", xmlNode, xmlSize, xmlParse, xmlTreeParse, xmlInternalTreeParse, xmlGetAttr, xmlName, xmlToList, newXMLDoc, newXMLNode, parseXMLAndAdd, xmlChildren, saveXML, xmlRoot, xpathApply, compareXMLDocs, append.XMLNode, xmlSchemaValidate, xmlSApply) +importClassFrom(XML, XMLInternalDocument, XMLAbstractNode, XMLNode, HTMLInternalDocument) + +import("sp") +import(rgdal) +import(stringr) +import(colorRamps) +import(aqp) +importClassFrom(spacetime, STTDF, STIDF) + +exportClasses(SpatialMetadata, + sp.palette, + SpatialPhotoOverlay, + SpatialPredictions, + SpatialVectorsSimulations, + RasterBrickSimulations, + RasterBrickTimeSeries, + SpatialMaxEntOutput, + SpatialSamplingPattern) +exportMethods( + getCRS, + GetNames, + GetPalette, + kml, + kml_layer, + kml_metadata, + reproject, + spMetadata, + metadata2SLD, + plotKML, + vect2rast, + summary, + plot) +S3method(plot, SpatialPredictions) +export(check_projection, parse_proj4) +exportPattern("^[^\\.]") diff --git a/pkg/R/AAA-classes.R b/pkg/R/AAA-classes.R index 2f0a400..32fd549 100644 --- a/pkg/R/AAA-classes.R +++ b/pkg/R/AAA-classes.R @@ -1,189 +1,198 @@ -## Color palette: -setClass("sp.palette", representation(type = 'character', bounds = 'vector', color = 'character', names = 'character', icons = 'character'), validity = function(object) { - if(!class(object@bounds)=="numeric") - return('Vector with upper and lower limits required') - if((length(object@bounds)-1)!=length(object@color)|(length(object@bounds)-1)!=length(object@names)) - return('Size of bounds (-1), colors and element names must be equal') - if(any(nchar(object@color)<7|nchar(object@color)>9)) - return('Colors in the hex system required') -}) - -## A new class for SpatialMetadata: -setClass("SpatialMetadata", representation(xml = "XMLInternalDocument", field.names = "character", palette = "sp.palette", sp = "Spatial"), validity = function(object) { - if(!(xmlName(xmlRoot(object@xml))=="metadata"|xmlName(xmlRoot(object@xml))=="MD_Metadata")) - return("XML file tagged 'metadata' or 'MD_Metadata' not found") - ## check the metadata names: - ny <- unlist(xmlToList(object@xml)) - met <- data.frame(metadata=names(ny), value=paste(ny)) - mdnames <- read.csv(system.file("mdnames.csv", package="plotKML")) - field_names <- merge(met, mdnames[,c("metadata","field.names")], by="metadata", all.x=TRUE, all.y=FALSE)[,"field.names"] - if(!any(field_names %in% object@field.names)) - return("Field names do not match the column names in the xml slot") - if(!class(object@field.names)=="character") - return("Field names as character vector required") -}) - -## A new class for SpatialPhoto: -setClass("SpatialPhotoOverlay", representation(filename = "character", pixmap = "pixmapRGB", exif.info = "list", PhotoOverlay = "list", sp = "SpatialPoints"), validity = function(object) { - if(length(object@filename)==0&is.null(object@pixmap)){ - return("Either 'pixmap' slot or 'filename' need to be specified.") - } - if(length(object@sp)>1){ - return("'SpatialPoints' object of length 1 required.") - } - - # minimum info [https://exiftool.org/]: - exif.sel <- c("DateTime", "ExposureTime", "FocalLength", "Flash") - for(i in 1:length(exif.sel)){ - if(length(which(names(object@exif.info) %in% exif.sel[i]))==0) - return(paste("'", exif.sel[i], "' field required.", sep="")) - } - - # minimum info [http://code.google.com/apis/kml/documentation/kmlreference.html#photooverlay]: - geo.sel <- c("rotation", "leftFov", "rightFov", "bottomFov", "topFov", "near", "shape", "range", "tilt", "heading") - for(i in 1:length(geo.sel)){ - if(length(which(names(object@PhotoOverlay) %in% geo.sel[i]))==0) - return(paste("'", geo.sel[i], "' field required.", sep="")) - } - - if(object@PhotoOverlay$rotation < 0 | object@PhotoOverlay$rotation > 180){ - return("Check KML validity: kml:angle180") - } - if(object@PhotoOverlay$leftFov < -180 | object@PhotoOverlay$leftFov > 0){ - return("Check KML validity: kml:angle180") - } - if(object@PhotoOverlay$rightFov < 0 | object@PhotoOverlay$rightFov > 180){ - return("Check KML validity: kml:angle180") - } - if(object@PhotoOverlay$bottomFov < -90 | object@PhotoOverlay$bottomFov > 0){ - return("Check KML validity: kml:angle90") - } - if(object@PhotoOverlay$topFov < 0 | object@PhotoOverlay$topFov > 90){ - return("Check KML validity: kml:angle90") - } - if(!(object@PhotoOverlay$shape %in% c("rectangle", "cylinder", "sphere"))){ - return("Shape can be only one of the following: 'rectangle', 'cylinder', 'sphere'.") - } - if(object@PhotoOverlay$range < 0){ - return("Check KML validity: positive value required") - } - if(object@PhotoOverlay$tilt < 0 | object@PhotoOverlay$tilt > 90){ - return("Check KML validity: kml:angle90") - } - if(object@PhotoOverlay$heading < 0 | object@PhotoOverlay$heading > 360){ - return("Check KML validity: kml:angle360") - } -}) - -## A new class for SpatialPredictions: -setClass("SpatialPredictions", representation(variable = "character", observed = "SpatialPointsDataFrame", regModel.summary = "ANY", vgmModel = "data.frame", predicted = "SpatialPixelsDataFrame", validation = "SpatialPointsDataFrame"), validity = function(object) { - if(any(!(object@variable %in% names(object@observed@data)))){ - return("Variable name not available in the 'data' slot") - } - if(any(!(object@variable %in% names(object@predicted@data)))){ - return("Variable name not available in the 'predicted' slot") - } - if(length(object@validation) <50){ - return("Validation data critically small (<50) for reliable validation") - } -}) - -## New classes for SpatialSimulations: -setClass("SpatialVectorsSimulations", representation(realizations = "list", summaries = "SpatialGridDataFrame"), validity = function(object) { - require(sp) - object.ov <- over(y=object@summaries, x=as(object@realizations[[1]], "SpatialPoints")) - if(length(object.ov)==0) - return("'Realizations' and 'summaries' objects do not overlap spatially") - if(length(names(object@summaries))<2) - return("The 'summaries' slot should contain at least two layers (aggregate values and information entropy)") -}) - -setClass("RasterBrickSimulations", representation(variable = "character", sampled = "SpatialLines", realizations = "RasterBrick"), validity = function(object) { - require(raster) - object.ov <- extract(object@realizations, as(object@sampled, "SpatialPoints")) - if(length(object.ov)==0) - return("'Realizations' and 'sampled' objects do not overlap spatially") -}) - - -## A new class for SamplingPatterns: -setClass("SpatialSamplingPattern", representation(method = "character", pattern = "SpatialPoints", sp.domain = "SpatialPolygonsDataFrame"), validity = function(object) { - ov <- over(y=object@sp.domain, x=object@pattern) - if(length(ov)==0) - return("'Pattern' and 'sp.domain' do not overlap spatially") -}) - -## A new class for RasterBrickTimeSeries: -setClass("RasterBrickTimeSeries", representation(variable = "character", sampled = "SpatialPointsDataFrame", rasters = "RasterBrick", TimeSpan.begin = "POSIXct", TimeSpan.end = "POSIXct"), validity = function(object) { - sel <- !is.na(object@TimeSpan.begin)&!is.na(object@TimeSpan.end) - if(any(object@TimeSpan.begin[sel] > object@TimeSpan.end[sel])) - return("'TimeSpan.begin' must indicate time before or equal to 'TimeSpan.end'") - if(!(length(object@TimeSpan.begin)==length(object@TimeSpan.end)&length(object@TimeSpan.begin)==nlayers(object@rasters))) - return("Length of the 'TimeSpan.begin' and 'TimeSpan.end' slots and the total number of rasters do not match") - ov <- extract(object@rasters, object@sampled) - if(!nrow(ov)==length(object@sampled)){ - return("Not all points can be overlaid using the data in the @rasters slot") - } -}) - -### A new class for SpeciesDistributionMap: -setClass("SpatialMaxEntOutput", representation(sciname = "character", occurrences = "SpatialPoints", TimeSpan.begin = "POSIXct", TimeSpan.end = "POSIXct", maxent = "MaxEnt", sp.domain = "Spatial", predicted = "RasterLayer"), validity = function(object) { - if(object@TimeSpan.begin > object@TimeSpan.end) - return("'TimeSpan.begin' must indicate time before or equal to 'TimeSpan.end'") - if(length(object@occurrences) <5) - return("Occurences critically small (<5) for reliable validation") - object.ov <- extract(x=object@predicted, y=object@occurrences) - if(length(object.ov)==0) - return("'Occurences' and 'rasters' do not overlap spatially") - if(is.na(object@predicted@crs@projargs)) - return("Proj4 string must be specified") -}) - - - -################## generic functions ############## - - -if (!isGeneric("spMetadata")){ - setGeneric("spMetadata", function(obj, ...){standardGeneric("spMetadata")}) -} - -if (!isGeneric("GetNames")){ - setGeneric("GetNames", function(obj){standardGeneric("GetNames")}) -} - -if (!isGeneric("GetPalette")){ - setGeneric("GetPalette", function(obj){standardGeneric("GetPalette")}) -} - -if (!isGeneric("metadata2SLD")){ - setGeneric("metadata2SLD", function(obj, ...){standardGeneric("metadata2SLD")}) -} - -if (!isGeneric("kml_layer")){ - setGeneric("kml_layer", function(obj, ...){standardGeneric("kml_layer")}) -} - -if (!isGeneric("kml_metadata")){ - setGeneric("kml_metadata", function(obj, ...){standardGeneric("kml_metadata")}) -} - -if (!isGeneric("kml")){ - setGeneric("kml", function(obj, ...){standardGeneric("kml")}) -} - -if (!isGeneric("getCRS")){ - setGeneric("getCRS", function(obj, ...){standardGeneric("getCRS")}) -} - -if (!isGeneric("reproject")){ - setGeneric("reproject", function(obj, ...){standardGeneric("reproject")}) -} - -if (!isGeneric("vect2rast")){ - setGeneric("vect2rast", function(obj, ...){standardGeneric("vect2rast")}) -} - -if (!isGeneric("plotKML")){ - setGeneric("plotKML", function(obj, ...){standardGeneric("plotKML")}) -} +# Purpose : NEW plotKML CLASSES; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl) +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Dylan Beaudette (debeaudette@ucdavis.edu); +# Dev Status : Pre-Alpha +# Note : for more info see [http://cran.r-project.org/doc/manuals/R-exts.html]; + + +## Color palette: +setClass("sp.palette", representation(type = 'character', bounds = 'vector', color = 'character', names = 'character', icons = 'character'), validity = function(object) { + if(!class(object@bounds)=="numeric") + return('Vector with upper and lower limits required') + if((length(object@bounds)-1)!=length(object@color)|(length(object@bounds)-1)!=length(object@names)) + return('Size of bounds (-1), colors and element names must be equal') + if(any(nchar(object@color)<7|nchar(object@color)>9)) + return('Colors in the hex system required') +}) + +## A new class for SpatialMetadata: +setClass("SpatialMetadata", representation(xml = "XMLInternalDocument", field.names = "character", palette = "sp.palette", sp = "Spatial"), validity = function(object) { + if(!(xmlName(xmlRoot(object@xml))=="metadata"|xmlName(xmlRoot(object@xml))=="MD_Metadata")) + return("XML file tagged 'metadata' or 'MD_Metadata' not found") + ## check the metadata names: + ny <- unlist(xmlToList(object@xml)) + met <- data.frame(metadata=names(ny), value=paste(ny)) + mdnames <- read.csv(system.file("mdnames.csv", package="plotKML")) + field_names <- merge(met, mdnames[,c("metadata","field.names")], by="metadata", all.x=TRUE, all.y=FALSE)[,"field.names"] + if(!any(field_names %in% object@field.names)) + return("Field names do not match the column names in the xml slot") + if(!class(object@field.names)=="character") + return("Field names as character vector required") +}) + +## A new class for SpatialPhoto: +setClass("SpatialPhotoOverlay", representation(filename = "character", pixmap = "pixmapRGB", exif.info = "list", PhotoOverlay = "list", sp = "SpatialPoints"), validity = function(object) { + if(length(object@filename)==0&is.null(object@pixmap)){ + return("Either 'pixmap' slot or 'filename' need to be specified.") + } + if(length(object@sp)>1){ + return("'SpatialPoints' object of length 1 required.") + } + + # minimum info [http://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/EXIF.html]: + exif.sel <- c("DateTime", "ExposureTime", "FocalLength", "Flash") + for(i in 1:length(exif.sel)){ + if(length(which(names(object@exif.info) %in% exif.sel[i]))==0) + return(paste("'", exif.sel[i], "' field required.", sep="")) + } + + # minimum info [http://code.google.com/apis/kml/documentation/kmlreference.html#photooverlay]: + geo.sel <- c("rotation", "leftFov", "rightFov", "bottomFov", "topFov", "near", "shape", "range", "tilt", "heading") + for(i in 1:length(geo.sel)){ + if(length(which(names(object@PhotoOverlay) %in% geo.sel[i]))==0) + return(paste("'", geo.sel[i], "' field required.", sep="")) + } + + if(object@PhotoOverlay$rotation < 0 | object@PhotoOverlay$rotation > 180){ + return("Check KML validity: kml:angle180") + } + if(object@PhotoOverlay$leftFov < -180 | object@PhotoOverlay$leftFov > 0){ + return("Check KML validity: kml:angle180") + } + if(object@PhotoOverlay$rightFov < 0 | object@PhotoOverlay$rightFov > 180){ + return("Check KML validity: kml:angle180") + } + if(object@PhotoOverlay$bottomFov < -90 | object@PhotoOverlay$bottomFov > 0){ + return("Check KML validity: kml:angle90") + } + if(object@PhotoOverlay$topFov < 0 | object@PhotoOverlay$topFov > 90){ + return("Check KML validity: kml:angle90") + } + if(!(object@PhotoOverlay$shape %in% c("rectangle", "cylinder", "sphere"))){ + return("Shape can be only one of the following: 'rectangle', 'cylinder', 'sphere'.") + } + if(object@PhotoOverlay$range < 0){ + return("Check KML validity: positive value required") + } + if(object@PhotoOverlay$tilt < 0 | object@PhotoOverlay$tilt > 90){ + return("Check KML validity: kml:angle90") + } + if(object@PhotoOverlay$heading < 0 | object@PhotoOverlay$heading > 360){ + return("Check KML validity: kml:angle360") + } +}) + +## A new class for SpatialPredictions: +setClass("SpatialPredictions", representation(variable = "character", observed = "SpatialPointsDataFrame", regModel.summary = "ANY", vgmModel = "data.frame", predicted = "SpatialPixelsDataFrame", validation = "SpatialPointsDataFrame"), validity = function(object) { + if(any(!(object@variable %in% names(object@observed@data)))){ + return("Variable name not available in the 'data' slot") + } + if(any(!(object@variable %in% names(object@predicted@data)))){ + return("Variable name not available in the 'predicted' slot") + } + if(length(object@validation) <50){ + return("Validation data critically small (<50) for reliable validation") + } +}) + +## New classes for SpatialSimulations: +setClass("SpatialVectorsSimulations", representation(realizations = "list", summaries = "SpatialGridDataFrame"), validity = function(object) { + require(sp) + object.ov <- over(y=object@summaries, x=as(object@realizations[[1]], "SpatialPoints")) + if(length(object.ov)==0) + return("'Realizations' and 'summaries' objects do not overlap spatially") + if(length(names(object@summaries))<2) + return("The 'summaries' slot should contain at least two layers (aggregate values and information entropy)") +}) + +setClass("RasterBrickSimulations", representation(variable = "character", sampled = "SpatialLines", realizations = "RasterBrick"), validity = function(object) { + require(raster) + object.ov <- extract(object@realizations, as(object@sampled, "SpatialPoints")) + if(length(object.ov)==0) + return("'Realizations' and 'sampled' objects do not overlap spatially") +}) + + +## A new class for SamplingPatterns: +setClass("SpatialSamplingPattern", representation(method = "character", pattern = "SpatialPoints", sp.domain = "SpatialPolygonsDataFrame"), validity = function(object) { + ov <- over(y=object@sp.domain, x=object@pattern) + if(length(ov)==0) + return("'Pattern' and 'sp.domain' do not overlap spatially") +}) + +## A new class for RasterBrickTimeSeries: +setClass("RasterBrickTimeSeries", representation(variable = "character", sampled = "SpatialPointsDataFrame", rasters = "RasterBrick", TimeSpan.begin = "POSIXct", TimeSpan.end = "POSIXct"), validity = function(object) { + sel <- !is.na(object@TimeSpan.begin)&!is.na(object@TimeSpan.end) + if(any(object@TimeSpan.begin[sel] > object@TimeSpan.end[sel])) + return("'TimeSpan.begin' must indicate time before or equal to 'TimeSpan.end'") + if(!(length(object@TimeSpan.begin)==length(object@TimeSpan.end)&length(object@TimeSpan.begin)==nlayers(object@rasters))) + return("Length of the 'TimeSpan.begin' and 'TimeSpan.end' slots and the total number of rasters do not match") + ov <- extract(object@rasters, object@sampled) + if(!nrow(ov)==length(object@sampled)){ + return("Not all points can be overlaid using the data in the @rasters slot") + } +}) + +### A new class for SpeciesDistributionMap: +setClass("SpatialMaxEntOutput", representation(sciname = "character", occurrences = "SpatialPoints", TimeSpan.begin = "POSIXct", TimeSpan.end = "POSIXct", maxent = "MaxEnt", sp.domain = "Spatial", predicted = "RasterLayer"), validity = function(object) { + if(object@TimeSpan.begin > object@TimeSpan.end) + return("'TimeSpan.begin' must indicate time before or equal to 'TimeSpan.end'") + if(length(object@occurrences) <5) + return("Occurences critically small (<5) for reliable validation") + object.ov <- extract(x=object@predicted, y=object@occurrences) + if(length(object.ov)==0) + return("'Occurences' and 'rasters' do not overlap spatially") + if(is.na(object@predicted@crs@projargs)) + return("Proj4 string must be specified") +}) + + + +################## generic functions ############## + + +if (!isGeneric("spMetadata")){ + setGeneric("spMetadata", function(obj, ...){standardGeneric("spMetadata")}) +} + +if (!isGeneric("GetNames")){ + setGeneric("GetNames", function(obj){standardGeneric("GetNames")}) +} + +if (!isGeneric("GetPalette")){ + setGeneric("GetPalette", function(obj){standardGeneric("GetPalette")}) +} + +if (!isGeneric("metadata2SLD")){ + setGeneric("metadata2SLD", function(obj, ...){standardGeneric("metadata2SLD")}) +} + +if (!isGeneric("kml_layer")){ + setGeneric("kml_layer", function(obj, ...){standardGeneric("kml_layer")}) +} + +if (!isGeneric("kml_metadata")){ + setGeneric("kml_metadata", function(obj, ...){standardGeneric("kml_metadata")}) +} + +if (!isGeneric("kml")){ + setGeneric("kml", function(obj, ...){standardGeneric("kml")}) +} + +if (!isGeneric("getCRS")){ + setGeneric("getCRS", function(obj, ...){standardGeneric("getCRS")}) +} + +if (!isGeneric("reproject")){ + setGeneric("reproject", function(obj, ...){standardGeneric("reproject")}) +} + +if (!isGeneric("vect2rast")){ + setGeneric("vect2rast", function(obj, ...){standardGeneric("vect2rast")}) +} + +if (!isGeneric("plotKML")){ + setGeneric("plotKML", function(obj, ...){standardGeneric("plotKML")}) + } + +# end of script; \ No newline at end of file diff --git a/pkg/R/AAA-md.R b/pkg/R/AAA-md.R index e3bdc7f..a3b4596 100644 --- a/pkg/R/AAA-md.R +++ b/pkg/R/AAA-md.R @@ -1,359 +1,363 @@ -# Contributions: Michael Blaschek (blaschek@geographie.uni-kiel.de) and Eloi Ribeiro (eloi.carvalhoribeiro@wur.nl); - -metadata <- new.env(hash=TRUE, parent = parent.frame()) - -metadata.env <- function( - ## INSPIRE: - UUID = "", - Language_code = "eng", - MD_Character_set_code = "eng", - MD_scope_code = "dataset", - CI_Organisation_name = paste(Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), - CI_Electronic_mail_address = "", - CI_Role = "pointOfContact", - Date_stamp = Sys.Date(), - MD_Standard_name = "ISO 19115", - MD_Standard_version = "2003/Cor.1:2006", - CI_Citation_title = "", - CI_Citation_date = Sys.Date(), - CI_Citation_date_type = "publication", - CI_Unique_name = "", - CI_RS_identifier = "", - MD_Abstract = "", - MD_Organisation_name = paste(Sys.getenv(c("COMPUTERNAME"))[[1]], "(computer name) at", Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), - MD_Electronic_mail_address = "", - MD_contact_URL = "", - MD_Role = "author", - MD_Keyword = "", - MD_Thesaurus_name = "GEMET - INSPIRE themes, version 1.0", - MD_Thesaurus_date = as.Date("2008-03-16", format="%Y-%m-%d"), - MD_Thesaurus_date_type = "publication", - MD_Use_limitations = "", - MD_Access_constraints = "otherRestrictions", - MD_Other_restrictions = get("license_url", envir = plotKML.opts), - MD_Equivalent_scale = "", - MD_Resolution = "", - MD_Language_code = Language_code, - MD_Topic_category_code = "geoscientificInformation", - Extent_West_Longitude = "", - Extent_East_Longitude = "", - Extent_South_Latitude = "", - Extent_North_Latitude = "", - Time_period_begin = "", - Time_period_end = "", - CI_Online_resource_URL = "", - DQ_Scope_code = "", - DQ_Citation_title = "Commission Regulation (EU) No 1089/2010 of 23 November 2010 implementing Directive 2007/2/EC of the European Parliament and of the Council as regards interoperability of spatial data sets and services", - DQ_Citation_date = "2010-12-08", - DQ_Citation_date_type = "publication", - DQ_Conformance_result = "", - DQ_Conformance_result_pass = "", - DQ_Lineage_statement = "", - MD_ReferenceSystem_Identifier = "", - MD_ReferenceSystem_type = "", - ## FGDC: - Attribute_accuracy_report = '', - Completeness_Report = '', - Process_Date = Sys.Date(), - Process_Description = '', - Online_Linkage = '', - Data_Quality_Citation_Originator = '', - Data_Quality_Publication_Date = '', - Data_Quality_Citation_Title = '', - Data_Quality_Citation_Abbreviation = '', - Data_Quality_Contribution = '', - Source_Scale_Denominator = '', - Source_Currentness_Reference = '', - Source_Date_of_Content = '', - Type_of_Source_Media = "online", - Logical_Consistency_Report = '', - Horizontal_accuracy_report = '', - Vertical_accuracy_report = '', - Distribution_Liability = get("license_url", envir = plotKML.opts), - Distributor_address = '', - Distributor_address_type = '', - Distributor_city = '', - Distributor_country = '', - Distributior_postal = '', - Distributor_state = '', - Data_Distributing_Organization = '', - Distributor_Name = '', - Distributor_Telephone = '', - Resource_Description = '', - File_Decompression_Technique = '', - Format_Information_Content = '', - Format_Name = '', - Format_Version_Number = '', - Transfer_Size = '', - Access_Instructions = '', - Data_Order_URL = '', - Online_Computer = '', - Order_fees = '', - Attribute_Definition = '', - Attribute_Definition_Source = '', - Attribute_Measurement_Resolution = '', - Attribute_Units_of_Measure = '', - Range_Domain_Maximum = '', - Range_Domain_Minimum = '', - Attribute_Label = '', - Attribute_Measurement_Frequency = '', - Attribute_Value_Accuracy = '', - Attribute_Value_Accuracy_Explanation = '', - Beginning_Date_of_Attribute_Values = '', - Ending_Date_of_Attribute_Values = '', - Entity_Type_Definition = '', - Entity_Type_Definition_Source = '', - Entity_Type_Label = '', - Entity_and_Attribute_Detail_Citation = '', - Entity_and_Attribute_Overview = '', - Access_Constraints = '', - Browse_Graphic_File_Description = '', - Browse_Graphic_File_Name = '', - Browse_Graphic_File_Type = '', - Geospatial_Data_Presentation_Form = "map", - Citation_URL = '', - Citation_Originator = paste(Sys.getenv(c("COMPUTERNAME"))[[1]], "(computer name) at", Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), - Other_Citation_Details = '', - Publication_Date = '', - Citation_Publisher = '', - Publication_Place = '', - Citation_title = '', - Data_Set_Credit = Citation_Originator, - Abstract = '', - Purpose = '', - Supplemental_Information = '', - Theme_Keyword = '', - Theme_Keyword_Thesaurus = '', - Native_Data_Set_Environment = paste(R.version$version.string, "running on", Sys.info()[["sysname"]], Sys.info()[["release"]]), - Contact_Information_Address = '', - Contact_Address_Type = '', - Contact_Information_City = '', - Contact_Information_Country = '', - Contact_Information_Postal = '', - Contact_Information_State = '', - Contact_Information_Organization = '', - Contact_Information_Person = paste(Sys.getenv(c("COMPUTERNAME"))[[1]], "(computer name) at", Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), - Contact_Information_Telephone = '', - East_Bounding_Coordinate = '', - North_Bounding_Coordinate = '', - South_Bounding_Coordinate = '', - West_Bounding_Coordinate = '', - Status_Progress = "In work", - Maintenance_and_Update_Frequency = "Unknown", - Currentness_Reference = '', - Beginning_Date = '', - Ending_Date = '', - Use_Constraints = get("license_url", envir = plotKML.opts), - Metadata_Access_Constraints = '', - Metadata_Contact_Address = '', - Metadata_Contact_Address_Type = '', - Metadata_Contact_City = '', - Metadata_Contact_Country = '', - Metadata_Contact_Postal = '', - Metadata_Contact_State = '', - Metadata_Contact_Organization = '', - Metadata_Contact_Position = '', - Metadata_Contact_Telephone = '', - Metadata_Date = Sys.Date(), - Metadata_Classification = '', - Metadata_Security_Classification_System = '', - Metadata_Restrictions = '', - Metadata_Standard_Name = "FGDC-STD-001-1998", - Metadata_Standard_Version = '', - Metadata_Use_Constraints = '', - Direct_Spatial_Reference_Method = '', - Indirect_Spatial_Reference = '', - Object_Count = '', - SDTS_Point_and_Vector_Object_Type = '', - Denominator_of_Flattening_Ratio = '', - Ellipsoid_Name = '', - Horizontal_Datum_Name = '', - Semi_major_Axis = '', - Geographic_Coordinate_Units = '', - Latitude_Resolution = '', - Longitude_Resolution = '', - show.env = FALSE, - ... - ) - { - - md.lst <- list( - ## INSPIRE: - UUID = UUID, - Language_code = Language_code, - MD_Character_set_code = MD_Character_set_code, - MD_scope_code = MD_scope_code, - CI_Organisation_name = CI_Organisation_name, - CI_Electronic_mail_address = CI_Electronic_mail_address, - CI_Role = CI_Role, - Date_stamp = Date_stamp, - MD_Standard_name = MD_Standard_name, - MD_Standard_version = MD_Standard_version, - CI_Citation_title = CI_Citation_title, - CI_Citation_date = CI_Citation_date, - CI_Citation_date_type = CI_Citation_date_type, - CI_Unique_name = CI_Unique_name, - CI_RS_identifier = CI_RS_identifier, - MD_Abstract = MD_Abstract, - MD_Organisation_name = MD_Organisation_name, - MD_Electronic_mail_address = MD_Electronic_mail_address, - MD_contact_URL = MD_contact_URL, - MD_Role = MD_Role, - MD_Keyword = MD_Keyword, - MD_Thesaurus_name = MD_Thesaurus_name, - MD_Thesaurus_date = MD_Thesaurus_date, - MD_Thesaurus_date_type = MD_Thesaurus_date_type, - MD_Use_limitations = MD_Use_limitations, - MD_Access_constraints = MD_Access_constraints, - MD_Other_restrictions = MD_Other_restrictions, - MD_Equivalent_scale = MD_Equivalent_scale, - MD_Resolution = MD_Resolution, - MD_Language_code = MD_Language_code, - MD_Topic_category_code = MD_Topic_category_code, - Extent_West_Longitude = Extent_West_Longitude, - Extent_East_Longitude = Extent_East_Longitude, - Extent_South_Latitude = Extent_South_Latitude, - Extent_North_Latitude = Extent_North_Latitude, - Time_period_begin = Time_period_begin, - Time_period_end = Time_period_end, - CI_Online_resource_URL = CI_Online_resource_URL, - DQ_Scope_code = DQ_Scope_code, - DQ_Citation_title = DQ_Citation_title, - DQ_Citation_date = DQ_Citation_date, - DQ_Citation_date_type = DQ_Citation_date_type, - DQ_Conformance_result = DQ_Conformance_result, - DQ_Conformance_result_pass = DQ_Conformance_result_pass, - DQ_Lineage_statement = DQ_Lineage_statement, - MD_ReferenceSystem_Identifier = MD_ReferenceSystem_Identifier, - MD_ReferenceSystem_type = MD_ReferenceSystem_type, - ##FGDC - Attribute_accuracy_report = Attribute_accuracy_report, - Completeness_Report = Completeness_Report, - Process_Date = Process_Date, - Process_Description = Process_Description, - Online_Linkage = Online_Linkage, - Data_Quality_Citation_Originator = Data_Quality_Citation_Originator, - Data_Quality_Publication_Date = Data_Quality_Publication_Date, - Data_Quality_Citation_Title = Data_Quality_Citation_Title, - Data_Quality_Citation_Abbreviation = Data_Quality_Citation_Abbreviation, - Data_Quality_Contribution = Data_Quality_Contribution, - Source_Scale_Denominator = Source_Scale_Denominator, - Source_Currentness_Reference = Source_Currentness_Reference, - Source_Date_of_Content = Source_Date_of_Content, - Type_of_Source_Media = Type_of_Source_Media, - Logical_Consistency_Report = Logical_Consistency_Report, - Horizontal_accuracy_report = Horizontal_accuracy_report, - Vertical_accuracy_report = Vertical_accuracy_report, - Distribution_Liability = Distribution_Liability, - Distributor_address = Distributor_address, - Distributor_address_type = Distributor_address_type, - Distributor_city = Distributor_city, - Distributor_country = Distributor_country, - Distributior_postal = Distributior_postal, - Distributor_state = Distributor_state, - Data_Distributing_Organization = Data_Distributing_Organization, - Distributor_Name = Distributor_Name, - Distributor_Telephone = Distributor_Telephone, - Resource_Description = Resource_Description, - File_Decompression_Technique = File_Decompression_Technique, - Format_Information_Content = Format_Information_Content, - Format_Name = Format_Name, - Format_Version_Number = Format_Version_Number, - Transfer_Size = Transfer_Size, - Access_Instructions = Access_Instructions, - Data_Order_URL = Data_Order_URL, - Online_Computer = Online_Computer, - Order_fees = Order_fees, - Attribute_Definition = Attribute_Definition, - Attribute_Definition_Source = Attribute_Definition_Source, - Attribute_Measurement_Resolution = Attribute_Measurement_Resolution, - Attribute_Units_of_Measure = Attribute_Units_of_Measure, - Range_Domain_Maximum = Range_Domain_Maximum, - Range_Domain_Minimum = Range_Domain_Minimum, - Attribute_Label = Attribute_Label, - Attribute_Measurement_Frequency = Attribute_Measurement_Frequency, - Attribute_Value_Accuracy = Attribute_Value_Accuracy, - Attribute_Value_Accuracy_Explanation = Attribute_Value_Accuracy_Explanation, - Beginning_Date_of_Attribute_Values = Beginning_Date_of_Attribute_Values, - Ending_Date_of_Attribute_Values = Ending_Date_of_Attribute_Values, - Entity_Type_Definition = Entity_Type_Definition, - Entity_Type_Definition_Source = Entity_Type_Definition_Source, - Entity_Type_Label = Entity_Type_Label, - Entity_and_Attribute_Detail_Citation = Entity_and_Attribute_Detail_Citation, - Entity_and_Attribute_Overview = Entity_and_Attribute_Overview, - Access_Constraints = Access_Constraints, - Browse_Graphic_File_Description = Browse_Graphic_File_Description, - Browse_Graphic_File_Name = Browse_Graphic_File_Name, - Browse_Graphic_File_Type = Browse_Graphic_File_Type, - Geospatial_Data_Presentation_Form = Geospatial_Data_Presentation_Form, - Citation_URL = Citation_URL, - Citation_Originator = Citation_Originator, - Other_Citation_Details = Other_Citation_Details, - Publication_Date = Publication_Date, - Citation_Publisher = Citation_Publisher, - Publication_Place = Publication_Place, - Citation_title = Citation_title, - Data_Set_Credit = Data_Set_Credit, - Abstract = Abstract, - Purpose = Purpose, - Supplemental_Information = Supplemental_Information, - Theme_Keyword = Theme_Keyword, - Theme_Keyword_Thesaurus = Theme_Keyword_Thesaurus, - Native_Data_Set_Environment = Native_Data_Set_Environment, - Contact_Information_Address = Contact_Information_Address, - Contact_Address_Type = Contact_Address_Type, - Contact_Information_City = Contact_Information_City, - Contact_Information_Country = Contact_Information_Country, - Contact_Information_Postal = Contact_Information_Postal, - Contact_Information_State = Contact_Information_State, - Contact_Information_Organization = Contact_Information_Organization, - Contact_Information_Person = Contact_Information_Person, - Contact_Information_Telephone = Contact_Information_Telephone, - East_Bounding_Coordinate = East_Bounding_Coordinate, - North_Bounding_Coordinate = North_Bounding_Coordinate, - South_Bounding_Coordinate = South_Bounding_Coordinate, - West_Bounding_Coordinate = West_Bounding_Coordinate, - Status_Progress = Status_Progress, - Maintenance_and_Update_Frequency = Maintenance_and_Update_Frequency, - Currentness_Reference = Currentness_Reference, - Beginning_Date = Beginning_Date, - Ending_Date = Ending_Date, - Use_Constraints = Use_Constraints, - Metadata_Access_Constraints = Metadata_Access_Constraints, - Metadata_Contact_Address = Metadata_Contact_Address, - Metadata_Contact_Address_Type = Metadata_Contact_Address_Type, - Metadata_Contact_City = Metadata_Contact_City, - Metadata_Contact_Country = Metadata_Contact_Country, - Metadata_Contact_Postal = Metadata_Contact_Postal, - Metadata_Contact_State = Metadata_Contact_State, - Metadata_Contact_Organization = Metadata_Contact_Organization, - Metadata_Contact_Position = Metadata_Contact_Position, - Metadata_Contact_Telephone = Metadata_Contact_Telephone, - Metadata_Date = Metadata_Date, - Metadata_Classification = Metadata_Classification, - Metadata_Security_Classification_System = Metadata_Security_Classification_System, - Metadata_Restrictions = Metadata_Restrictions, - Metadata_Standard_Name = Metadata_Standard_Name, - Metadata_Standard_Version = Metadata_Standard_Version, - Metadata_Use_Constraints = Metadata_Use_Constraints, - Direct_Spatial_Reference_Method = Direct_Spatial_Reference_Method, - Indirect_Spatial_Reference = Indirect_Spatial_Reference, - Object_Count = Object_Count, - SDTS_Point_and_Vector_Object_Type = SDTS_Point_and_Vector_Object_Type, - Denominator_of_Flattening_Ratio = Denominator_of_Flattening_Ratio, - Ellipsoid_Name = Ellipsoid_Name, - Horizontal_Datum_Name = Horizontal_Datum_Name, - Semi_major_Axis = Semi_major_Axis, - Geographic_Coordinate_Units = Geographic_Coordinate_Units, - Latitude_Resolution = Latitude_Resolution, - Longitude_Resolution = Longitude_Resolution - ) - - x <- lapply(names(md.lst), function(x){ assign(x, md.lst[[x]], envir=metadata) }) - if(show.env){ - message("Generaring static metadata based on the computer configuration.\nSee '?spMetadata' for more details.") - return(metadata) - } -} - -## end of script; +# Purpose : Generate standard metadata fields; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl) +# Contributions : Michael Blaschek (blaschek@geographie.uni-kiel.de) and Eloi Ribeiro (eloi.carvalhoribeiro@wur.nl); +# Dev Status : Pre-Alpha +# Note : Human-readable field names suggested by the authors; + +metadata <- new.env(hash=TRUE, parent = parent.frame()) + +metadata.env <- function( + ## INSPIRE: + UUID = "", + Language_code = "eng", + MD_Character_set_code = "eng", + MD_scope_code = "dataset", + CI_Organisation_name = paste(Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), + CI_Electronic_mail_address = "", + CI_Role = "pointOfContact", + Date_stamp = Sys.Date(), + MD_Standard_name = "ISO 19115", + MD_Standard_version = "2003/Cor.1:2006", + CI_Citation_title = "", + CI_Citation_date = Sys.Date(), + CI_Citation_date_type = "publication", + CI_Unique_name = "", + CI_RS_identifier = "", + MD_Abstract = "", + MD_Organisation_name = paste(Sys.getenv(c("COMPUTERNAME"))[[1]], "(computer name) at", Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), + MD_Electronic_mail_address = "", + MD_contact_URL = "", + MD_Role = "author", + MD_Keyword = "", + MD_Thesaurus_name = "GEMET - INSPIRE themes, version 1.0", + MD_Thesaurus_date = as.Date("2008-03-16", format="%Y-%m-%d"), + MD_Thesaurus_date_type = "publication", + MD_Use_limitations = "", + MD_Access_constraints = "otherRestrictions", + MD_Other_restrictions = get("license_url", envir = plotKML.opts), + MD_Equivalent_scale = "", + MD_Resolution = "", + MD_Language_code = Language_code, + MD_Topic_category_code = "geoscientificInformation", + Extent_West_Longitude = "", + Extent_East_Longitude = "", + Extent_South_Latitude = "", + Extent_North_Latitude = "", + Time_period_begin = "", + Time_period_end = "", + CI_Online_resource_URL = "", + DQ_Scope_code = "", + DQ_Citation_title = "Commission Regulation (EU) No 1089/2010 of 23 November 2010 implementing Directive 2007/2/EC of the European Parliament and of the Council as regards interoperability of spatial data sets and services", + DQ_Citation_date = "2010-12-08", + DQ_Citation_date_type = "publication", + DQ_Conformance_result = "", + DQ_Conformance_result_pass = "", + DQ_Lineage_statement = "", + MD_ReferenceSystem_Identifier = "", + MD_ReferenceSystem_type = "", + ## FGDC: + Attribute_accuracy_report = '', + Completeness_Report = '', + Process_Date = Sys.Date(), + Process_Description = '', + Online_Linkage = '', + Data_Quality_Citation_Originator = '', + Data_Quality_Publication_Date = '', + Data_Quality_Citation_Title = '', + Data_Quality_Citation_Abbreviation = '', + Data_Quality_Contribution = '', + Source_Scale_Denominator = '', + Source_Currentness_Reference = '', + Source_Date_of_Content = '', + Type_of_Source_Media = "online", + Logical_Consistency_Report = '', + Horizontal_accuracy_report = '', + Vertical_accuracy_report = '', + Distribution_Liability = get("license_url", envir = plotKML.opts), + Distributor_address = '', + Distributor_address_type = '', + Distributor_city = '', + Distributor_country = '', + Distributior_postal = '', + Distributor_state = '', + Data_Distributing_Organization = '', + Distributor_Name = '', + Distributor_Telephone = '', + Resource_Description = '', + File_Decompression_Technique = '', + Format_Information_Content = '', + Format_Name = '', + Format_Version_Number = '', + Transfer_Size = '', + Access_Instructions = '', + Data_Order_URL = '', + Online_Computer = '', + Order_fees = '', + Attribute_Definition = '', + Attribute_Definition_Source = '', + Attribute_Measurement_Resolution = '', + Attribute_Units_of_Measure = '', + Range_Domain_Maximum = '', + Range_Domain_Minimum = '', + Attribute_Label = '', + Attribute_Measurement_Frequency = '', + Attribute_Value_Accuracy = '', + Attribute_Value_Accuracy_Explanation = '', + Beginning_Date_of_Attribute_Values = '', + Ending_Date_of_Attribute_Values = '', + Entity_Type_Definition = '', + Entity_Type_Definition_Source = '', + Entity_Type_Label = '', + Entity_and_Attribute_Detail_Citation = '', + Entity_and_Attribute_Overview = '', + Access_Constraints = '', + Browse_Graphic_File_Description = '', + Browse_Graphic_File_Name = '', + Browse_Graphic_File_Type = '', + Geospatial_Data_Presentation_Form = "map", + Citation_URL = '', + Citation_Originator = paste(Sys.getenv(c("COMPUTERNAME"))[[1]], "(computer name) at", Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), + Other_Citation_Details = '', + Publication_Date = '', + Citation_Publisher = '', + Publication_Place = '', + Citation_title = '', + Data_Set_Credit = Citation_Originator, + Abstract = '', + Purpose = '', + Supplemental_Information = '', + Theme_Keyword = '', + Theme_Keyword_Thesaurus = '', + Native_Data_Set_Environment = paste(R.version$version.string, "running on", Sys.info()[["sysname"]], Sys.info()[["release"]]), + Contact_Information_Address = '', + Contact_Address_Type = '', + Contact_Information_City = '', + Contact_Information_Country = '', + Contact_Information_Postal = '', + Contact_Information_State = '', + Contact_Information_Organization = '', + Contact_Information_Person = paste(Sys.getenv(c("COMPUTERNAME"))[[1]], "(computer name) at", Sys.getenv(c("USERDNSDOMAIN"))[[1]], "(domain)"), + Contact_Information_Telephone = '', + East_Bounding_Coordinate = '', + North_Bounding_Coordinate = '', + South_Bounding_Coordinate = '', + West_Bounding_Coordinate = '', + Status_Progress = "In work", + Maintenance_and_Update_Frequency = "Unknown", + Currentness_Reference = '', + Beginning_Date = '', + Ending_Date = '', + Use_Constraints = get("license_url", envir = plotKML.opts), + Metadata_Access_Constraints = '', + Metadata_Contact_Address = '', + Metadata_Contact_Address_Type = '', + Metadata_Contact_City = '', + Metadata_Contact_Country = '', + Metadata_Contact_Postal = '', + Metadata_Contact_State = '', + Metadata_Contact_Organization = '', + Metadata_Contact_Position = '', + Metadata_Contact_Telephone = '', + Metadata_Date = Sys.Date(), + Metadata_Classification = '', + Metadata_Security_Classification_System = '', + Metadata_Restrictions = '', + Metadata_Standard_Name = "FGDC-STD-001-1998", + Metadata_Standard_Version = '', + Metadata_Use_Constraints = '', + Direct_Spatial_Reference_Method = '', + Indirect_Spatial_Reference = '', + Object_Count = '', + SDTS_Point_and_Vector_Object_Type = '', + Denominator_of_Flattening_Ratio = '', + Ellipsoid_Name = '', + Horizontal_Datum_Name = '', + Semi_major_Axis = '', + Geographic_Coordinate_Units = '', + Latitude_Resolution = '', + Longitude_Resolution = '', + show.env = FALSE, + ... + ) + { + + md.lst <- list( + ## INSPIRE: + UUID = UUID, + Language_code = Language_code, + MD_Character_set_code = MD_Character_set_code, + MD_scope_code = MD_scope_code, + CI_Organisation_name = CI_Organisation_name, + CI_Electronic_mail_address = CI_Electronic_mail_address, + CI_Role = CI_Role, + Date_stamp = Date_stamp, + MD_Standard_name = MD_Standard_name, + MD_Standard_version = MD_Standard_version, + CI_Citation_title = CI_Citation_title, + CI_Citation_date = CI_Citation_date, + CI_Citation_date_type = CI_Citation_date_type, + CI_Unique_name = CI_Unique_name, + CI_RS_identifier = CI_RS_identifier, + MD_Abstract = MD_Abstract, + MD_Organisation_name = MD_Organisation_name, + MD_Electronic_mail_address = MD_Electronic_mail_address, + MD_contact_URL = MD_contact_URL, + MD_Role = MD_Role, + MD_Keyword = MD_Keyword, + MD_Thesaurus_name = MD_Thesaurus_name, + MD_Thesaurus_date = MD_Thesaurus_date, + MD_Thesaurus_date_type = MD_Thesaurus_date_type, + MD_Use_limitations = MD_Use_limitations, + MD_Access_constraints = MD_Access_constraints, + MD_Other_restrictions = MD_Other_restrictions, + MD_Equivalent_scale = MD_Equivalent_scale, + MD_Resolution = MD_Resolution, + MD_Language_code = MD_Language_code, + MD_Topic_category_code = MD_Topic_category_code, + Extent_West_Longitude = Extent_West_Longitude, + Extent_East_Longitude = Extent_East_Longitude, + Extent_South_Latitude = Extent_South_Latitude, + Extent_North_Latitude = Extent_North_Latitude, + Time_period_begin = Time_period_begin, + Time_period_end = Time_period_end, + CI_Online_resource_URL = CI_Online_resource_URL, + DQ_Scope_code = DQ_Scope_code, + DQ_Citation_title = DQ_Citation_title, + DQ_Citation_date = DQ_Citation_date, + DQ_Citation_date_type = DQ_Citation_date_type, + DQ_Conformance_result = DQ_Conformance_result, + DQ_Conformance_result_pass = DQ_Conformance_result_pass, + DQ_Lineage_statement = DQ_Lineage_statement, + MD_ReferenceSystem_Identifier = MD_ReferenceSystem_Identifier, + MD_ReferenceSystem_type = MD_ReferenceSystem_type, + ##FGDC + Attribute_accuracy_report = Attribute_accuracy_report, + Completeness_Report = Completeness_Report, + Process_Date = Process_Date, + Process_Description = Process_Description, + Online_Linkage = Online_Linkage, + Data_Quality_Citation_Originator = Data_Quality_Citation_Originator, + Data_Quality_Publication_Date = Data_Quality_Publication_Date, + Data_Quality_Citation_Title = Data_Quality_Citation_Title, + Data_Quality_Citation_Abbreviation = Data_Quality_Citation_Abbreviation, + Data_Quality_Contribution = Data_Quality_Contribution, + Source_Scale_Denominator = Source_Scale_Denominator, + Source_Currentness_Reference = Source_Currentness_Reference, + Source_Date_of_Content = Source_Date_of_Content, + Type_of_Source_Media = Type_of_Source_Media, + Logical_Consistency_Report = Logical_Consistency_Report, + Horizontal_accuracy_report = Horizontal_accuracy_report, + Vertical_accuracy_report = Vertical_accuracy_report, + Distribution_Liability = Distribution_Liability, + Distributor_address = Distributor_address, + Distributor_address_type = Distributor_address_type, + Distributor_city = Distributor_city, + Distributor_country = Distributor_country, + Distributior_postal = Distributior_postal, + Distributor_state = Distributor_state, + Data_Distributing_Organization = Data_Distributing_Organization, + Distributor_Name = Distributor_Name, + Distributor_Telephone = Distributor_Telephone, + Resource_Description = Resource_Description, + File_Decompression_Technique = File_Decompression_Technique, + Format_Information_Content = Format_Information_Content, + Format_Name = Format_Name, + Format_Version_Number = Format_Version_Number, + Transfer_Size = Transfer_Size, + Access_Instructions = Access_Instructions, + Data_Order_URL = Data_Order_URL, + Online_Computer = Online_Computer, + Order_fees = Order_fees, + Attribute_Definition = Attribute_Definition, + Attribute_Definition_Source = Attribute_Definition_Source, + Attribute_Measurement_Resolution = Attribute_Measurement_Resolution, + Attribute_Units_of_Measure = Attribute_Units_of_Measure, + Range_Domain_Maximum = Range_Domain_Maximum, + Range_Domain_Minimum = Range_Domain_Minimum, + Attribute_Label = Attribute_Label, + Attribute_Measurement_Frequency = Attribute_Measurement_Frequency, + Attribute_Value_Accuracy = Attribute_Value_Accuracy, + Attribute_Value_Accuracy_Explanation = Attribute_Value_Accuracy_Explanation, + Beginning_Date_of_Attribute_Values = Beginning_Date_of_Attribute_Values, + Ending_Date_of_Attribute_Values = Ending_Date_of_Attribute_Values, + Entity_Type_Definition = Entity_Type_Definition, + Entity_Type_Definition_Source = Entity_Type_Definition_Source, + Entity_Type_Label = Entity_Type_Label, + Entity_and_Attribute_Detail_Citation = Entity_and_Attribute_Detail_Citation, + Entity_and_Attribute_Overview = Entity_and_Attribute_Overview, + Access_Constraints = Access_Constraints, + Browse_Graphic_File_Description = Browse_Graphic_File_Description, + Browse_Graphic_File_Name = Browse_Graphic_File_Name, + Browse_Graphic_File_Type = Browse_Graphic_File_Type, + Geospatial_Data_Presentation_Form = Geospatial_Data_Presentation_Form, + Citation_URL = Citation_URL, + Citation_Originator = Citation_Originator, + Other_Citation_Details = Other_Citation_Details, + Publication_Date = Publication_Date, + Citation_Publisher = Citation_Publisher, + Publication_Place = Publication_Place, + Citation_title = Citation_title, + Data_Set_Credit = Data_Set_Credit, + Abstract = Abstract, + Purpose = Purpose, + Supplemental_Information = Supplemental_Information, + Theme_Keyword = Theme_Keyword, + Theme_Keyword_Thesaurus = Theme_Keyword_Thesaurus, + Native_Data_Set_Environment = Native_Data_Set_Environment, + Contact_Information_Address = Contact_Information_Address, + Contact_Address_Type = Contact_Address_Type, + Contact_Information_City = Contact_Information_City, + Contact_Information_Country = Contact_Information_Country, + Contact_Information_Postal = Contact_Information_Postal, + Contact_Information_State = Contact_Information_State, + Contact_Information_Organization = Contact_Information_Organization, + Contact_Information_Person = Contact_Information_Person, + Contact_Information_Telephone = Contact_Information_Telephone, + East_Bounding_Coordinate = East_Bounding_Coordinate, + North_Bounding_Coordinate = North_Bounding_Coordinate, + South_Bounding_Coordinate = South_Bounding_Coordinate, + West_Bounding_Coordinate = West_Bounding_Coordinate, + Status_Progress = Status_Progress, + Maintenance_and_Update_Frequency = Maintenance_and_Update_Frequency, + Currentness_Reference = Currentness_Reference, + Beginning_Date = Beginning_Date, + Ending_Date = Ending_Date, + Use_Constraints = Use_Constraints, + Metadata_Access_Constraints = Metadata_Access_Constraints, + Metadata_Contact_Address = Metadata_Contact_Address, + Metadata_Contact_Address_Type = Metadata_Contact_Address_Type, + Metadata_Contact_City = Metadata_Contact_City, + Metadata_Contact_Country = Metadata_Contact_Country, + Metadata_Contact_Postal = Metadata_Contact_Postal, + Metadata_Contact_State = Metadata_Contact_State, + Metadata_Contact_Organization = Metadata_Contact_Organization, + Metadata_Contact_Position = Metadata_Contact_Position, + Metadata_Contact_Telephone = Metadata_Contact_Telephone, + Metadata_Date = Metadata_Date, + Metadata_Classification = Metadata_Classification, + Metadata_Security_Classification_System = Metadata_Security_Classification_System, + Metadata_Restrictions = Metadata_Restrictions, + Metadata_Standard_Name = Metadata_Standard_Name, + Metadata_Standard_Version = Metadata_Standard_Version, + Metadata_Use_Constraints = Metadata_Use_Constraints, + Direct_Spatial_Reference_Method = Direct_Spatial_Reference_Method, + Indirect_Spatial_Reference = Indirect_Spatial_Reference, + Object_Count = Object_Count, + SDTS_Point_and_Vector_Object_Type = SDTS_Point_and_Vector_Object_Type, + Denominator_of_Flattening_Ratio = Denominator_of_Flattening_Ratio, + Ellipsoid_Name = Ellipsoid_Name, + Horizontal_Datum_Name = Horizontal_Datum_Name, + Semi_major_Axis = Semi_major_Axis, + Geographic_Coordinate_Units = Geographic_Coordinate_Units, + Latitude_Resolution = Latitude_Resolution, + Longitude_Resolution = Longitude_Resolution + ) + + x <- lapply(names(md.lst), function(x){ assign(x, md.lst[[x]], envir=metadata) }) + if(show.env){ + message("Generaring static metadata based on the computer configuration.\nSee '?spMetadata' for more details.") + return(metadata) + } +} + +## end of script; diff --git a/pkg/R/AAAA.R b/pkg/R/AAAA.R index 571fd5e..97fd32d 100644 --- a/pkg/R/AAAA.R +++ b/pkg/R/AAAA.R @@ -1,3 +1,9 @@ +# Purpose : Initial settings; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl) +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Dylan Beaudette (debeaudette@ucdavis.edu); +# Dev Status : Pre-Alpha +# Note : for more info see [http://cran.r-project.org/doc/manuals/R-exts.html]; this code was prepared for SAGA GIS 2.0.8 + ################## STANDARD ENVIRONMENTS ############## @@ -13,15 +19,15 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " ## Try locating SAGA GIS (R default setting)... if(saga_cmd==""){ #require(RSAGA) - if(!inherits(try( suppressWarnings( x <- RSAGA::rsaga.env() ), silent = TRUE), "try-error")){ + if(!inherits(try( suppressWarnings( x <- rsaga.env() ), silent = TRUE), "try-error")){ if(!is.null(x)){ if(.Platform$OS.type == "windows") { - suppressWarnings( saga_cmd <- utils::shortPathName(normalizePath(paste(x$path, x$cmd, sep="/"))) ) + suppressWarnings( saga_cmd <- utils::shortPathName(normalizePath(paste(rsaga.env()$path, rsaga.env()$cmd, sep="/"))) ) } else { - saga_cmd <- paste(x$path, x$cmd, sep="/") + suppressWarnings( saga_cmd <- paste(rsaga.env()$path, rsaga.env()$cmd, sep="/") ) } if(nzchar(saga_cmd)){ - suppressWarnings( saga.version <- RSAGA::rsaga.get.version() ) + suppressWarnings( saga.version <- rsaga.get.version() ) } } else { saga.version <- "" @@ -32,13 +38,13 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " ## Try locating path to ImageMagick (R default setting)... if(convert==""){ if(requireNamespace("animation", quietly = TRUE)){ - convert <- animation::ani.options('convert') # magick::magick_config() + convert <- animation::ani.options("convert") } ## If it does not work, try getting the path from the OS: - if(!is.null(convert)){ + if(is.null(convert)){ im.dir <- NULL - if(.Platform$OS.type == "windows"){ + if(.Platform$OS.type == "windows") { ## get paths and check for ImageMagick paths <- strsplit(Sys.getenv('PATH')[[1]], ";")[[1]] x <- grep(paths, pattern="Magick", ignore.case = TRUE) @@ -46,9 +52,9 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " ## if present if(!length(x) == 0) { im.dir <- paths[grep(paths, pattern="Magick", ignore.case = TRUE)[1]] - convert <- shQuote(utils::shortPathName(normalizePath(file.path(im.dir, "convert.exe")))) + convert = shQuote(utils::shortPathName(normalizePath(file.path(im.dir, "convert.exe")))) if(show.paths&file.exists(convert)){ - try( om <- system(convert, show.output.on.console = FALSE, intern = TRUE)[1] ) + try( om <- system(convert, show.output.on.console = FALSE, intern = TRUE)[1] ) if(!class(.Last.value)[1]=="try-error"){ message( paste(om) ) } else { @@ -78,13 +84,13 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " if(is.null(im.dir)){ if(silent==FALSE){ - warning("Install ImageMagick and add to PATH. See https://imagemagick.org for more info.") + warning("Install ImageMagick and add to PATH. See http://imagemagick.org for more info.") } convert = "" } } else { if(show.paths&file.exists(convert)){ - try( om <- system(convert, show.output.on.console = FALSE, intern = TRUE)[1] ) + try( om <- system(convert, show.output.on.console = FALSE, intern = TRUE)[1] ) if(!class(.Last.value)[1]=="try-error"){ message( paste(om) ) } else { @@ -95,7 +101,7 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " } ## try to locate GDAL / Patyhon: - if(.Platform$OS.type == "windows"){ + if(.Platform$OS.type == "windows") { if(gdalwarp==""|gdal_translate==""){ if(requireNamespace("gdalUtils", quietly = TRUE)){ gdalUtils::gdal_setInstallation(search_path=gdal.dir, rescan=FALSE) @@ -105,7 +111,7 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " gdal_translate = shQuote(utils::shortPathName(normalizePath(file.path(x[[1]]$path, "gdal_translate.exe")))) }} else { if(silent==FALSE){ - warning("Could not locate GDAL! Install program and add it to the Windows registry. See https://gdal.org/ for more info.") + warning("Could not locate GDAL! Install program and add it to the Windows registry. See http://www.gdal.org/ for more info.") } gdalwarp = "" gdal_translate = "" @@ -140,6 +146,46 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " } } + } + + ## 2nd chance to try to locate SAGA GIS (if not on a standard path): + if(saga_cmd==""){ + if(!nzchar(saga_cmd)&!nzchar(saga.version)){ + if(nzchar(prog <- Sys.getenv("ProgramFiles")) && + length(saga.dir <- list.files(prog, "^SAGA*"))>0 && + length(saga_cmd <- list.files(file.path(prog, saga.dir), pattern = "^saga_cmd\\.exe$", full.names = TRUE, recursive = TRUE))>0 + ){ + if(suppressWarnings(!is.null(myenv <- rsaga.env(path=shQuote(normalizePath(saga.dir[1])))))){ + saga_cmd <- utils::shortPathName(normalizePath(paste(myenv$path, myenv$cmd, sep="/"))) + saga.version <- myenv$version + if(show.paths){ + message(paste("Located SAGA GIS ", saga.version, " from the 'Program Files' directory: \"", utils::shortPathName(saga_cmd), "\"", sep="")) + } + }} else{ if(nzchar(prog <- Sys.getenv("ProgramFiles(x86)")) && + length(saga.dir <- list.files(prog, "^SAGA*"))>0 && + length(saga_cmd <- list.files(file.path(prog, saga.dir), pattern = "^saga_cmd\\.exe$", full.names = TRUE, recursive = TRUE))>0 + ) { + if(suppressWarnings(!is.null(myenv <- rsaga.env(path=shQuote(normalizePath(saga.dir[1])))))){ + saga_cmd <- utils::shortPathName(normalizePath(paste(myenv$path, myenv$cmd, sep="/"))) + saga.version <- myenv$version + if(show.paths){ + message(paste("Located SAGA GIS ", saga.version, " from the 'Program Files' directory: \"", utils::shortPathName(saga_cmd), "\"", sep="")) + } + }} + } + + if(!nzchar(saga_cmd)){ + if(silent==FALSE){ + warning("Could not locate SAGA GIS! Install program and add it to the Windows registry. See http://www.saga-gis.org/en/ for more info.") + } + saga_vc = "" + } + } + else { + if(show.paths){ + message(paste("Located SAGA GIS ", saga.version, " from the 'Program Files' directory: \"", utils::shortPathName(saga_cmd), "\"", sep="")) + } + } } } @@ -157,7 +203,7 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " } else { if(silent==FALSE){ - warning("Install GDAL and add to PATH. See https://gdal.org/ for more info.") + warning("Install GDAL and add to PATH. See http://www.gdal.org/ for more info.") } gdalwarp = "" gdal_translate = "" @@ -172,7 +218,7 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " } else { if(silent==FALSE){ - warning("Install Python and add to PATH. See https://www.python.org for more info.") + warning("Install Python and add to PATH. See http://python.org for more info.") } python = "" } @@ -182,7 +228,7 @@ paths <- function(gdalwarp = "", gdal_translate = "", convert = "", saga_cmd = " im.dir <- paths[grep(paths, pattern="Magick", ignore.case=TRUE)[1]] if(is.null(im.dir)){ if(silent==FALSE){ - warning("Install ImageMagick and add to PATH. See https://imagemagick.org for more info.") + warning("Install ImageMagick and add to PATH. See http://imagemagick.org for more info.") } convert = "" } @@ -239,20 +285,20 @@ plotKML.env <- function( brewer3 = c("#FEEDDE","#FDBE85","#FD8D3C","#E6550D","#A63603") #if(missing(colour_scale_svar)) { colour_scale_svar <- brewer.pal(n = 5, name = "Oranges") } if(missing(colour_scale_svar)) { colour_scale_svar <- brewer3 } - if(missing(ref_CRS)) { ref_CRS <- CRSargs(CRS("EPSG:4326")) } + if(missing(ref_CRS)) { ref_CRS <- "+proj=longlat +datum=WGS84" } if(missing(NAflag)) { NAflag <- -99999 } if(missing(icon)) { icon <- "icon3.png" } # "http://maps.google.com/mapfiles/kml/shapes/donut.png" if(missing(LabelScale)) { LabelScale <- .5 } if(missing(size_range)) { size_range <- c(0.25, 2.5) } - if(missing(license_url)) { license_url <- "http://creativecommons.org/licenses/by/4.0/" } + if(missing(license_url)) { license_url <- "http://creativecommons.org/licenses/by/3.0/" } if(missing(metadata_sel)) { metadata_sel <- c("idinfo.citation.citeinfo.title", "idinfo.descript.abstract", "spdoinfo.ptvctinf.sdtsterm.ptvctcnt", "idinfo.timeperd.timeinfo.rngdates.begdate", "idinfo.timeperd.timeinfo.rngdates.enddate", "distinfo.stdorder.digform.digtopt.onlinopt.computer.networka.networkr", "idinfo.citation.citeinfo.othercit", "idinfo.citation.citeinfo.onlink", "idinfo.datacred", "distinfo.distrib.cntinfo.cntorgp.cntorg", "distinfo.stdorder.digform.digtinfo.formcont", "idinfo.native") } if(missing(kmz)) { kmz <- FALSE } - if(missing(kml_xsd)) { kml_xsd <- "https://schemas.opengis.net/kml/2.2.0/ogckml22.xsd" } - if(missing(kml_url)) { kml_url <- "https://www.opengis.net/kml/2.2/" } - if(missing(kml_gx)) { kml_gx <- "https://www.google.com/kml/ext/2.2" } - if(missing(gpx_xsd)) { gpx_xsd <- "https://www.topografix.com/GPX/1/1/gpx.xsd" } - if(missing(fgdc_xsd)) { fgdc_xsd <- "https://fgdcxml.sourceforge.net/schema/fgdc-std-012-2002/fgdc-std-012-2002.xsd" } - if(missing(inspire_xsd)) { inspire_xsd <- "https://inspire.ec.europa.eu/schemas/common/1.0/common.xsd" } + if(missing(kml_xsd)) { kml_xsd <- "http://schemas.opengis.net/kml/2.2.0/ogckml22.xsd" } + if(missing(kml_url)) { kml_url <- "http://www.opengis.net/kml/2.2/" } + if(missing(kml_gx)) { kml_gx <- "http://www.google.com/kml/ext/2.2" } + if(missing(gpx_xsd)) { gpx_xsd <- "http://www.topografix.com/GPX/1/1/gpx.xsd" } + if(missing(fgdc_xsd)) { fgdc_xsd <- "http://fgdcxml.sourceforge.net/schema/fgdc-std-012-2002/fgdc-std-012-2002.xsd" } + if(missing(inspire_xsd)) { inspire_xsd <- "http://inspire.ec.europa.eu/schemas/common/1.0/common.xsd" } if(silent == FALSE){ pts <- paths(show.paths = TRUE) @@ -265,7 +311,7 @@ plotKML.env <- function( if(missing(gdalwarp)) { gdalwarp <- pts$gdalwarp[[1]] } if(missing(gdal_translate)) { gdal_translate <- pts$gdal_translate[[1]] } if(missing(python)) { python <- pts$python[[1]] } - if(missing(home_url)) { home_url <- "https://plotkml.r-forge.r-project.org/" } + if(missing(home_url)) { home_url <- "http://plotkml.r-forge.r-project.org/" } ## Create a list and assing it to plotKML.env: pl.lst <- list( @@ -302,3 +348,4 @@ plotKML.env <- function( ## generate all environmental settings: plotKML.env(show.env = FALSE) +# end of script; diff --git a/pkg/R/ZZZ.R b/pkg/R/ZZZ.R index a02eb98..a98b5d3 100644 --- a/pkg/R/ZZZ.R +++ b/pkg/R/ZZZ.R @@ -1,25 +1,29 @@ -# Note: for more info see [http://cran.r-project.org/doc/manuals/R-exts.html]; - -.onLoad <- function(libname, pkgname) { - data("SAGA_pal", "R_pal", package=pkgname, envir=parent.env(environment())) -} - -.onAttach <- function(libname, pkgname) { - - ## print on start-up: - pkg.info <- drop(read.dcf(file=system.file("DESCRIPTION", package=pkgname, lib.loc=libname), fields=c("Version","Date"))) - packageStartupMessage(paste(pkgname, " version ", pkg.info["Version"], " (", pkg.info["Date"], ")", sep="")) - - tst <- try( removeTmpFiles(), silent=TRUE ) - - ## create env variables: - plotKML.env(show.env = FALSE, silent = TRUE) - metadata.env() - - packageStartupMessage("URL: https://github.com/Envirometrix/plotKML/") - - return(invisible(0)) - -} - +# Purpose : Clean up / closing settings; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Status : pre-alpha +# Note : for more info see [http://cran.r-project.org/doc/manuals/R-exts.html]; + +.onLoad <- function(libname, pkgname) { + data("SAGA_pal", "R_pal", package=pkgname, envir=parent.env(environment())) +} + +.onAttach <- function(libname, pkgname) { + + ## print on start-up: + pkg.info <- drop(read.dcf(file=system.file("DESCRIPTION", package=pkgname, lib.loc=libname), fields=c("Version","Date"))) + packageStartupMessage(paste(pkgname, " version ", pkg.info["Version"], " (", pkg.info["Date"], ")", sep="")) + + tst <- try( removeTmpFiles(), silent=TRUE ) + + ## create env variables: + plotKML.env(show.env = FALSE, silent = TRUE) + metadata.env() + + packageStartupMessage(paste("URL:", get("home_url", envir = plotKML.opts))) + + return(invisible(0)) + +} + # end of script; \ No newline at end of file diff --git a/pkg/R/aesthetics.R b/pkg/R/aesthetics.R index 0914c48..46ade13 100644 --- a/pkg/R/aesthetics.R +++ b/pkg/R/aesthetics.R @@ -1,534 +1,419 @@ -.all_kml_aesthetics <- list( - colour = "black", - fill = "white", - shape = paste(get("home_url", envir = plotKML.opts), get("icon", envir = plotKML.opts), sep=""), - whitening = "", - alpha = 1, - size = get("LabelScale", envir = plotKML.opts), - width = 1, - labels = "", - altitude = 0, - altitudeMode = "", - balloon = FALSE -) - -# Parsing a call -# -.parse_call_for_aes <- function(call) { - called_options <- names(call) - ind_aes <- charmatch(called_options, names(.all_kml_aesthetics)) - - names(.all_kml_aesthetics)[ind_aes[!is.na(ind_aes)]] -} - -# Applying aesthetics -# -# AG: kml_aes function should be used to process both sf, sfc and sp objects, so -# I defined two new functions (called .data_sp_sf_sfc and .length_sp_sf) that -# are use to extract the data component and the length/nrow of obj. - -# AG: eval obj@data for sf and sp objects. The problem is that obj@data works -# only for sp objects while, for sf/sfc objects, I simpy need to return obj. -.data_sp_sf_sfc <- function(obj) { - if (inherits(obj, c("sf", "sfc"))) { - obj - } else if (isS4(obj)) { - obj@data - } else { - stop("Error, obj is neither sf object or sp object with data") - } -} -# AG: length() for sp/sfc objects should be nrow() for sf objects -.length_sp_sf <- function(obj) { - if (inherits(obj, "sf")) { - nrow(obj) - } else if (isS4(obj) || inherits(obj, "sfc")) { - length(obj) - } else { - stop("Error, obj is neither sf object or sp object with data") - } -} -kml_aes <- function(obj, ...) { - - # Getting parent call - parent_call <- substitute(list(...)) - parent_call <- as.list(parent_call)[-1] - - # Parse the current call - called_aes <- .parse_call_for_aes(parent_call) - aes <- list() - - # Names - if ("labels" %in% called_aes) { - # If labels defined using a column of data - if (is.name(parent_call[['labels']])) { - aes[['labels']] <- as.character(obj[[as.character(parent_call[['labels']])]]) - } - # if labels given as a vector - else { - labels <- eval(parent_call[['labels']]) - if (length(labels) == .length_sp_sf(obj)) { - aes[['labels']] <- as.character(labels) - } - else { - aes[['labels']] <- rep(as.character(labels), length.out = length(obj)) - } - } - } - else { - # AG: I had to modify the following code since sf objects are not S4 so that - # check doesn't work - if ( - (isS4(obj) && "data" %in% slotNames(obj)) || - inherits(obj, "sf") - ) { - # If only one data column is represented, we use its values as labels - if (length(called_aes) == 1L) { - # If its the name of a column - if (is.name(parent_call[[called_aes]])) { - # If the column is numeric - if (is.numeric(obj[[as.character(parent_call[[called_aes]])]])) { - aes[['labels']] <- as.character(round( - obj[[as.character(parent_call[[called_aes]])]], - digits = 3 - )) - } - # Otherwise - else { - aes[['labels']] <- as.character(obj[[as.character(parent_call[[called_aes]])]]) - } - } - # If its a call we have to evaluate it first - else if (is.call(parent_call[[called_aes]])) { - aes[['labels']] <- as.character(format( - eval(parent_call[[called_aes]], .data_sp_sf_sfc(obj)), - digits = 3 - )) - } - # default behaviour is just numbering using the N first integers - else { - aes[['labels']] <- as.character(seq_len(.length_sp_sf(obj))) - } - } - else { - aes[['labels']] <- rownames(.data_sp_sf_sfc(obj)) - } - } - else { - # default behaviour is just numbering using the N first integers - aes[['labels']] <- as.character(seq_len(.length_sp_sf(obj))) - } - } - - # Colour - if ("colour" %in% called_aes) { - - # If a column name as been used - if ( - is.name(parent_call[['colour']]) | - is.call(parent_call[['colour']]) & - # AG: I had to modify the following code since sf objects are not S4 so that - # check doesn't work - ( - (isS4(obj) && "data" %in% slotNames(obj)) || - inherits(obj, "sf") - ) - ) { - - # Trying to get the colour ramp - if ("colour_scale" %in% names(parent_call)) { - if ("z.lim" %in% names(parent_call)) { - aes[['colour']] <- kml_colour( - obj, - colour = parent_call[['colour']], - colour_scale = parent_call[['colour_scale']], - z.lim = eval(parent_call[['z.lim']]) - ) - } else { - aes[['colour']] <- kml_colour( - obj, - colour = parent_call[['colour']], - colour_scale = parent_call[['colour_scale']] - ) - } - } - # Otherwise use the default colour ramp - else { - if ("z.lim" %in% names(parent_call)) { - aes[['colour']] <- kml_colour( - obj, - colour = parent_call[['colour']], - z.lim = eval(parent_call[['z.lim']]) - ) - } else { - aes[['colour']] <- kml_colour( - obj, - colour = parent_call[['colour']] - ) - } - } - } - - # Otherwise it is interpreted as a colour to use - else { - aes[['colour']] <- rep(col2kml(parent_call[['colour']]), length.out = .length_sp_sf(obj)) - } - } - # using the default value - else { - aes[['colour']] <- rep(col2kml(.all_kml_aesthetics[["colour"]]), length.out = .length_sp_sf(obj)) - } - - # Alpha - if ("alpha" %in% called_aes) { - aes[['colour']] <- kml_alpha( - obj, - alpha = eval(parent_call[['alpha']], .data_sp_sf_sfc(obj)), - colours = aes[['colour']] - ) - } -# else { -# aes[['alpha']] <- rep(.all_kml_aesthetics[["alpha"]], length.out = length(obj)) -# } - - # Whitening -# if ("whitening" %in% called_aes) { -# aes[['colour']] <- kml_whitening(obj, whitening, aes[['colour']], ...) -# } - - # Shape - if ("shape" %in% called_aes) { - aes[["shape"]] <- kml_shape(obj, ...) - } - else { - aes[["shape"]] <- rep( - .all_kml_aesthetics[["shape"]], - length.out = .length_sp_sf(obj) - ) - } - - # Size - if ("size" %in% called_aes) { - # If a column name has been used - if (is.name(parent_call[['size']])) { - aes[['size']] <- kml_size(obj, size = as.character(parent_call[['size']])) - } - # Otherwise it is interpreted as a vector - else { - aes[['size']] <- rep(parent_call[['size']], length.out = .length_sp_sf(obj)) - } - } - else { - aes[['size']] <- rep(.all_kml_aesthetics[["size"]], length.out = .length_sp_sf(obj)) - } - - # Width - if ("width" %in% called_aes) { - # If a column name has been used - if (is.call(parent_call[['width']])) { - aes[['width']] <- eval(parent_call[['width']]) - } else { - if (is.name(parent_call[['width']])) { - aes[['width']] <- kml_width( - obj, - width = as.character(parent_call[['width']]) - ) - } - # Otherwise it is interpreted as a vector - else { - aes[['width']] <- rep(parent_call[['width']], length.out = .length_sp_sf(obj)) - } - }} - else { - aes[['width']] <- rep(.all_kml_aesthetics[["width"]], length.out = .length_sp_sf(obj)) - } - - # Altitude - if ("altitude" %in% called_aes) { - aes[['altitude']] <- kml_altitude( - obj, - altitude = eval(parent_call[['altitude']], .data_sp_sf_sfc(obj)) - ) - } - else { - aes[['altitude']] <- kml_altitude(obj) - } - - # AltitudeMode - if ("altitudeMode" %in% called_aes) { - aes[["altitudeMode"]] <- parent_call[['altitudeMode']] - } - else { - aes[["altitudeMode"]] <- kml_altitude_mode(aes[['altitude']]) - } - - # Balloon (pop ups) - if ("balloon" %in% called_aes) { - aes[['balloon']] <- eval(parent_call[['balloon']]) - } - else { - aes[['balloon']] <- .all_kml_aesthetics[["balloon"]] - } - - aes -} - - -.getColourScale <- function(data, z.lim, colour_scale = NULL) { - - ## default colour palettes - .colour_scale_numeric = get("colour_scale_numeric", envir = plotKML.opts) - .colour_scale_factor = get("colour_scale_factor", envir = plotKML.opts) - - if (is.null(colour_scale)) { - # If data is numeric - if (is.numeric(data)) { - colour_scale <- .colour_scale_numeric - } - # If data is a factor - else { - colour_scale <- .colour_scale_factor - } - } - else { - colour_scale <- eval(colour_scale) - } - - # creates pal function - pal <- colorRamp(colour_scale, space = "rgb", interpolate = "linear") - - if (is.numeric(data)) { - if(missing(z.lim)) { z.lim <- range(data, na.rm = TRUE, finite = TRUE) } - data <- scales::rescale(data, from=z.lim) - data <- ifelse(data<0, 0, ifelse(data>1, 1, data)) - cols <- rep("#FFFFFF", length(data)) - cols[!(is.na(data)|is.nan(data))] <- rgb(pal(data[!(is.na(data)|is.nan(data))]) / 255) - } - - # factor variable: - else { - # if it is not numeric, it must be a factor: - data <- as.factor(data) - values <- 1:length(levels(data)) - cols <- rep("#FFFFFF", length(values)) - values <- scales::rescale(values) # putting values between 0 and 1 - cols[!(is.na(values)|is.nan(values))] <- rgb(pal(values[!(is.na(values)|is.nan(values))]) / 255) - # In case of a factor variable, reclassify each level by its corresponding colour: - levels(data) <- cols - cols <- as.character(data) - } - - cols -} - - -# Colour (points, polygons, lines, raster) -##---------------- -kml_colour <- function(obj, colour, colour_scale = NULL, ...) { - - # Getting the vector of values to scale - # AG: I had to modify the following code to take into account that obj is not - # necessary sp - x <- eval(colour, envir = .data_sp_sf_sfc(obj)) - - # Retrieving colour scale - cols <- .getColourScale(data = x, colour_scale = colour_scale, ...) - cols <- col2kml(cols) - - return(cols) -} - - -## Shape (points) -##---------------- -kml_shape <- function(obj, shape, ...) { - # Simple implementation if a URL is given - # AG: I had to modify the following code since obj could be sf - rep(shape, length.out = .length_sp_sf(obj)) -} - -# modification of the colours using that alpha value -.includeAlphaInColourRamp <- function(colours, alpha, RGBA = FALSE) { - # colours is a vector of characters describing the colour ramp values - # alpha is a value between 0 and 255 - # RGBA is set to flase if for kml colour, true for RGBA colours - - # Conversion to hex mode - alpha <- sprintf("%X", alpha) - - colours <- str_sub(colours, 2, str_length(colours)) - - if (RGBA) - b <- cbind("#", colours, alpha) - else - b <- cbind('#', alpha, aaply(colours, 1, function(x) str_sub(x, 3, 9))) - - res <- apply(b, 1, function(x) paste(x, collapse = "")) - - if (RGBA) - res <- toupper(res) - else - res <- tolower(res) - - res -} - -# Opacity (points, polygons, lines, raster) -# -# This function modifies the vector of KML colours -kml_alpha <- function(obj, alpha, colours, RGBA = FALSE, ...) { - - # Alpha is constant or continuous - if (is.numeric(alpha)) { - # rescaling data if continuous case - if (length(alpha) > 1) - alpha <- scales::rescale(alpha) - - alpha <- round(255*alpha, digits = 0) - cols <- .includeAlphaInColourRamp(colours, alpha, RGBA) - -# # Constant transparency -# if (length(alpha) == 1) { -# # modification of the KML colours using that alpha value -# if (RGBA) { -# # Conversion to hex mode -# alpha <- sprintf("%X", alpha) -# # Adding hex A (alpha) to a RGB hex string -# cols <- aaply(colours, 1, function(x) paste(x, alpha, sep = "")) -# } -# else { -# # Conversion to hex mode -# alpha <- sprintf("%x", alpha) -# cols <- aaply(colours, 1, function(x) paste("#", alpha, str_sub(x, 4, 9), sep = "")) -# } -# } -# # transparency as an aesthetic -# else { - -# } - } - # Categorical data - else { - - if (is.numeric(obj)) { - limits <- range(obj, na.rm = TRUE, finite = TRUE) - brks <- seq(limits[1], limits[2], length.out = length(colours)) - grps <- cut(obj, breaks = brks, include.lowest = TRUE) - } - else - stop("Transparency is only available for numeric data.") - } - - cols -} - -# Whitening of a given coloured layer (update of the colour vector) -# kml_whitening <- function(obj, whitening, col.vect){ -# -# } - -# Size (points) -kml_size <- function( - obj, - size, - size.min = get("size_range", envir = plotKML.opts)[1], - size.max = get("size_range", envir = plotKML.opts)[2], - size.default = 1 -) { - if ( - !is.na(size) & - # AG: I modified the following call to take into account that obj may be sf - (inherits(obj, "sf") || (isS4(obj) && "data" %in% slotNames(obj))) - ) { - ## If data is numeric - if (is.numeric(obj[[size]])) { - max.value <- max(obj[[size]], na.rm = TRUE) - # AG: I'm not 100% sure but I think the following call should be - # size.min + (size.max - size.min) * rescale - size.values <- size.min + size.max * scales::rescale( - obj[[size]], - from = range(obj[[size]], na.rm = TRUE) - ) - ## fix the missing values: - size.values[is.na(size.values)] <- size.default - } - # Otherwise: factor, character, logical, ... - else { - if (!is.factor(obj[[size]])) { - obj[[size]] <- factor(obj[[size]]) - } - - ## compute number of levels - nl <- nlevels(obj[[size]]) - ## compute the different size values - sizes.levels <- seq(size.min, size.max, length.out = nl) - ## assign them to different classes: - sizes.values <- cut( - as.integer(obj[[size]]), - breaks = seq(1, nl + 1, by = 1), - labels = sizes.levels, - include.lowest = TRUE - ) - size.values <- as.numeric(levels(sizes.values))[sizes.values] - ## fix the missing values: - size.values[is.na(size.values)] <- size.default - } - - } else { - ## If no size aesthetic is asked, or if no data slot - size.values <- rep(size.default, length.out = .length_sp_sf(obj)) - } - - size.values -} - -# Width (lines) -kml_width <- function( - obj, - width, - width.min = 1, - width.max = 6, - width.default = 1 -) { - - if ( - !is.na(width) & - # AG: I modified the following call to take into account that obj may be sf - (inherits(obj, "sf") || (isS4(obj) && "data" %in% slotNames(obj))) - ) { - # If data is numeric - if (is.numeric(obj[[width]])) { - max.value <- max(obj[[width]], na.rm = TRUE) - # AG: I'm not 100 % sure but I think the following call should be - # width.min + (width.max - width.min) * rescale - width.values <- round(width.min + scales::rescale(obj[[width]]) * width.max, 0) - } - # Otherwise: factor, character, logical, ... - else { - if (!is.factor(obj[[width]])) { - obj[[width]] <- factor(obj[[width]]) - } - - # compute number of levels - nl <- nlevels(obj[[width]]) - # compute the different size values - width.levels <- seq(width.min, width.max, length.out = nl) - # affect them to the factor - width.values <- cut( - obj[[width]], - breaks = quantile(obj[[width]], probs=seq(0, 1, length.out = nl + 1)), - labels = width.levels, - include.lowest = TRUE - ) - width.values <- as.numeric(as.character(width.values)) - } - } - # If no size aesthetic is asked, or if no data slot - else { - width.values <- rep(width.default, length.out = .length_sp_sf(obj)) - } - - width.values -} - +# Purpose : List of available aesthetics is given .all_kml_aesthetics along with their default values +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Dev Status : Pre-Alpha +# Note : Functionality for constant transparency under development; + + +.all_kml_aesthetics <- list( + colour = "black", + fill = "white", + shape = paste(get("home_url", envir = plotKML.opts), get("icon", envir = plotKML.opts), sep=""), + whitening = "", + alpha = 1, + size = get("LabelScale", envir = plotKML.opts), + width = 1, + labels = "", + altitude = 0, + altitudeMode = "", + balloon = FALSE +) + +# Parsing a call +# +.parse_call_for_aes <- function(call) { + called_options <- names(call) + ind_aes <- charmatch(called_options, names(.all_kml_aesthetics)) + + names(.all_kml_aesthetics)[ind_aes[!is.na(ind_aes)]] +} + +# Applying aesthetics +# +kml_aes <- function(obj, ...) { + + # Getting parent call + parent_call <- substitute(list(...)) + parent_call <- as.list(parent_call)[-1] + + # Parse the current call + called_aes <- .parse_call_for_aes(parent_call) + aes <- list() + + # Names + if ("labels" %in% called_aes) { + # If labels defined using a column of data + if (is.name(parent_call[['labels']])){ + aes[['labels']] <- as.character(obj[[as.character(parent_call[['labels']])]]) + } + # if labels given as a vector + else { + labels <- eval(parent_call[['labels']]) + if (length(labels) == length(obj)) + aes[['labels']] <- as.character(labels) + else + aes[['labels']] <- rep(as.character(labels), length.out = length(obj)) + } + } + else { + if ("data" %in% slotNames(obj)) { + + # If only one data column is represented, we use its values as labels + if (length(called_aes) == 1) { + # If its the name of a column + if (is.name(parent_call[[called_aes]])) { + # If the column is numeric + if (is.numeric(obj[[as.character(parent_call[[called_aes]])]])) + aes[['labels']] <- as.character(round(obj[[as.character(parent_call[[called_aes]])]], digits = 3)) + # Otherwise + else + aes[['labels']] <- as.character(obj[[as.character(parent_call[[called_aes]])]]) + } + # If its a call we have to evaluate it first + else if (is.call(parent_call[[called_aes]])) + aes[['labels']] <- as.character(format(eval(parent_call[[called_aes]], obj@data), digits = 3)) + # default behaviour is just numbering using the N first integers + else + aes[['labels']] <- as.character(1:length(obj)) + } + else + aes[['labels']] <- rownames(obj@data) + } + else + # default behaviour is just numbering using the N first integers + aes[['labels']] <- as.character(1:length(obj)) + } + + # Colour + if ("colour" %in% called_aes) { + + # If a column name as been used + if (is.name(parent_call[['colour']]) | is.call(parent_call[['colour']]) & "data" %in% slotNames(obj)) { + + # Trying to get the colour ramp + if ("colour_scale" %in% names(parent_call)){ + if("z.lim" %in% names(parent_call)){ + aes[['colour']] <- kml_colour(obj, colour = parent_call[['colour']], colour_scale = parent_call[['colour_scale']], z.lim = eval(parent_call[['z.lim']])) + } else { + aes[['colour']] <- kml_colour(obj, colour = parent_call[['colour']], colour_scale = parent_call[['colour_scale']]) + } + } + # Otherwise use the default colour ramp + else { + if("z.lim" %in% names(parent_call)){ + aes[['colour']] <- kml_colour(obj, colour = parent_call[['colour']], z.lim = eval(parent_call[['z.lim']])) + } else { + aes[['colour']] <- kml_colour(obj, colour = parent_call[['colour']]) + } + } + } + + # Otherwise it is interpreted as a colour to use + else { + aes[['colour']] <- rep(col2kml(parent_call[['colour']]), length.out = length(obj)) + } + } + # using the default value + else { + aes[['colour']] <- rep(col2kml(.all_kml_aesthetics[["colour"]]), length.out = length(obj)) + } + + # Alpha + if ("alpha" %in% called_aes) { + aes[['colour']] <- kml_alpha(obj, alpha = eval(parent_call[['alpha']], obj@data), colours = aes[['colour']]) + } +# else { +# aes[['alpha']] <- rep(.all_kml_aesthetics[["alpha"]], length.out = length(obj)) +# } + + # Whitening +# if ("whitening" %in% called_aes) { +# aes[['colour']] <- kml_whitening(obj, whitening, aes[['colour']], ...) +# } + + # Shape + if ("shape" %in% called_aes) { + aes[["shape"]] <- kml_shape(obj, ...) + } + else { + aes[["shape"]] <- rep(.all_kml_aesthetics[["shape"]], length.out = length(obj)) + } + + # Size + if ("size" %in% called_aes) { + # If a column name has been used + if (is.name(parent_call[['size']])){ + aes[['size']] <- kml_size(obj, size = as.character(parent_call[['size']])) + } + # Otherwise it is interpreted as a vector + else { + aes[['size']] <- rep(parent_call[['size']], length.out = length(obj)) + } + } + else { + aes[['size']] <- rep(.all_kml_aesthetics[["size"]], length.out = length(obj)) + } + + # Width + if ("width" %in% called_aes) { + # If a column name has been used + if(is.call(parent_call[['width']])){ + aes[['width']] <- eval(parent_call[['width']]) + } else { + if (is.name(parent_call[['width']])){ + aes[['width']] <- kml_width(obj, width = as.character(parent_call[['width']])) + } + # Otherwise it is interpreted as a vector + else { + aes[['width']] <- rep(parent_call[['width']], length.out = length(obj)) + } + }} + else { + aes[['width']] <- rep(.all_kml_aesthetics[["width"]], length.out = length(obj)) + } + + # Altitude + if ("altitude" %in% called_aes) { + aes[['altitude']] <- kml_altitude(obj, altitude = eval(parent_call[['altitude']], obj@data)) + } + else { + aes[['altitude']] <- kml_altitude(obj) + } + + # AltitudeMode + if ("altitudeMode" %in% called_aes) { + aes[["altitudeMode"]] <- parent_call[['altitudeMode']] + } + else { + aes[["altitudeMode"]] <- kml_altitude_mode(aes[['altitude']]) + } + + # Balloon (pop ups) + if ("balloon" %in% called_aes) { + aes[['balloon']] <- eval(parent_call[['balloon']]) + } + else { + aes[['balloon']] <- .all_kml_aesthetics[["balloon"]] + } + + aes +} + + +.getColourScale <- function(data, z.lim, colour_scale = NULL) { + + ## default colour palettes + .colour_scale_numeric = get("colour_scale_numeric", envir = plotKML.opts) + .colour_scale_factor = get("colour_scale_factor", envir = plotKML.opts) + + if (is.null(colour_scale)) { + # If data is numeric + if (is.numeric(data)) { + colour_scale <- .colour_scale_numeric + } + # If data is a factor + else { + colour_scale <- .colour_scale_factor + } + } + else { + colour_scale <- eval(colour_scale) + } + + # creates pal function + pal <- colorRamp(colour_scale, space = "rgb", interpolate = "linear") + + if (is.numeric(data)) { + if(missing(z.lim)) { z.lim <- range(data, na.rm = TRUE, finite = TRUE) } + data <- scales::rescale(data, from=z.lim) + data <- ifelse(data<0, 0, ifelse(data>1, 1, data)) + cols <- rep("#FFFFFF", length(data)) + cols[!(is.na(data)|is.nan(data))] <- rgb(pal(data[!(is.na(data)|is.nan(data))]) / 255) + } + + # factor variable: + else { + # if it is not numeric, it must be a factor: + data <- as.factor(data) + values <- 1:length(levels(data)) + cols <- rep("#FFFFFF", length(values)) + values <- scales::rescale(values) # putting values between 0 and 1 + cols[!(is.na(values)|is.nan(values))] <- rgb(pal(values[!(is.na(values)|is.nan(values))]) / 255) + # In case of a factor variable, reclassify each level by its corresponding colour: + levels(data) <- cols + cols <- as.character(data) + } + + cols +} + + +# Colour (points, polygons, lines, raster) +##---------------- +kml_colour <- function(obj, colour, colour_scale = NULL, ...){ + + # Getting the vector of values to scale + x <- eval(colour, envir = obj@data) + + # Retrieving colour scale + cols <- .getColourScale(data = x, colour_scale = colour_scale, ...) + cols <- col2kml(cols) + + return(cols) +} + + +## Shape (points) +##---------------- +kml_shape <- function(obj, shape, ...){ + # Simple implementation if a URL is given + rep(shape, length.out = length(obj)) +} + +# modification of the colours using that alpha value +.includeAlphaInColourRamp <- function(colours, alpha, RGBA = FALSE) { + # colours is a vector of characters describing the colour ramp values + # alpha is a value between 0 and 255 + # RGBA is set to flase if for kml colour, true for RGBA colours + + # Conversion to hex mode + alpha <- sprintf("%X", alpha) + + colours <- str_sub(colours, 2, str_length(colours)) + + if (RGBA) + b <- cbind("#", colours, alpha) + else + b <- cbind('#', alpha, aaply(colours, 1, function(x) str_sub(x, 3, 9))) + + res <- apply(b, 1, function(x) paste(x, collapse = "")) + + if (RGBA) + res <- toupper(res) + else + res <- tolower(res) + + res +} + +# Opacity (points, polygons, lines, raster) +# +# This function modifies the vector of KML colours +kml_alpha <- function(obj, alpha, colours, RGBA = FALSE, ...){ + + # Alpha is constant or continuous + if (is.numeric(alpha)) { + # rescaling data if continuous case + if (length(alpha) > 1) + alpha <- scales::rescale(alpha) + + alpha <- round(255*alpha, digits = 0) + cols <- .includeAlphaInColourRamp(colours, alpha, RGBA) + +# # Constant transparency +# if (length(alpha) == 1) { +# # modification of the KML colours using that alpha value +# if (RGBA) { +# # Conversion to hex mode +# alpha <- sprintf("%X", alpha) +# # Adding hex A (alpha) to a RGB hex string +# cols <- aaply(colours, 1, function(x) paste(x, alpha, sep = "")) +# } +# else { +# # Conversion to hex mode +# alpha <- sprintf("%x", alpha) +# cols <- aaply(colours, 1, function(x) paste("#", alpha, str_sub(x, 4, 9), sep = "")) +# } +# } +# # transparency as an aesthetic +# else { + +# } + } + # Categorical data + else { + + if (is.numeric(obj)) { + limits <- range(obj, na.rm = TRUE, finite = TRUE) + brks <- seq(limits[1], limits[2], length.out = length(colours)) + grps <- cut(obj, breaks = brks, include.lowest = TRUE) + } + else + stop("Transparency is only available for numeric data.") + } + + cols +} + +# Whitening of a given coloured layer (update of the colour vector) +# kml_whitening <- function(obj, whitening, col.vect){ +# +# } + +# Size (points) +kml_size <- function(obj, size, size.min = get("size_range", envir = plotKML.opts)[1], size.max = get("size_range", envir = plotKML.opts)[2], size.default = 1){ + + if (!is.na(size) & "data" %in% slotNames(obj)) { + ## If data is numeric + if (is.numeric(obj[[size]])) { + max.value <- max(obj[[size]], na.rm = TRUE) + size.values <- size.min + scales::rescale(obj[[size]], from = range(obj[[size]], na.rm = TRUE)) * size.max + ## fix the missing values: + size.values[is.na(size.values)] <- size.default + } + # Otherwise: factor, character, logical, ... + else { + if (!is.factor(obj[[size]])){ + obj[[size]] <- factor(obj[[size]]) + } + + ## compute number of levels + nl <- nlevels(obj[[size]]) + ## compute the different size values + sizes.levels <- seq(size.min, size.max, length.out = nl) + ## assign them to different classes: + sizes.values <- cut(as.integer(obj[[size]]), breaks = seq(1, nl + 1, by=1), labels = sizes.levels, include.lowest = TRUE) + size.values <- as.numeric(as.character(sizes.values)) + ## fix the missing values: + size.values[is.na(size.values)] <- size.default + } + + } else { + ## If no size aesthetic is asked, or if no data slot + size.values <- rep(size.default, length.out = length(obj)) + } + + return(size.values) +} + +# Width (lines) +kml_width <- function(obj, width, width.min = 1, width.max = 6, width.default = 1){ + + if (!is.na(width) & "data" %in% slotNames(obj)) { + # If data is numeric + if (is.numeric(obj[[width]])) { + max.value <- max(obj[[width]], na.rm = TRUE) + width.values <- round(width.min + scales::rescale(obj[[width]]) * width.max, 0) + } + # Otherwise: factor, character, logical, ... + else { + if (!is.factor(obj[[width]])) + obj[[width]] <- factor(obj[[width]]) + + # compute number of levels + nl <- nlevels(obj[[width]]) + # compute the different size values + width.levels <- seq(width.min, width.max, length.out = nl) + # affect them to the factor + width.values <- cut(obj[[width]], breaks = quantile(obj[[width]], probs=seq(0, 1, length.out = nl + 1)), labels = width.levels, include.lowest = TRUE) + width.values <- as.numeric(as.character(width.values)) + } + } + # If no size aesthetic is asked, or if no data slot + else + width.values <- rep(width.default, length.out = length(obj)) + + width.values +} + # end of script; \ No newline at end of file diff --git a/pkg/R/altitude.R b/pkg/R/altitude.R index ec489ee..1fa20a3 100644 --- a/pkg/R/altitude.R +++ b/pkg/R/altitude.R @@ -1,3 +1,9 @@ +# Purpose : Returns an altitude vector and a altitudeMode string; +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz) +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : Altitude (points, polygons, lines, raster); + kml_altitude <- function(obj, altitude = NULL) { @@ -8,25 +14,23 @@ kml_altitude <- function(obj, altitude = NULL) { } else if (is.numeric(altitude)) { # If it is numeric this is a single altitude for all points - # AG: .length_sp_sf is used to generalize length to sp, sf and sfc - altitude <- rep(altitude, length.out = .length_sp_sf(obj)) + altitude <- rep(altitude, length.out = length(obj)) } else if (is.null(altitude)) { - altitude <- rep(.all_kml_aesthetics[["altitude"]], length.out = .length_sp_sf(obj)) + altitude <- rep(.all_kml_aesthetics[["altitude"]], length.out = length(obj)) } - else { + else stop("Incorrect altitude value") - } altitude } # Guesses the appropriate altitudeMode tag -kml_altitude_mode <- function(altitude, GroundOverlay = FALSE){ +kml_altitude_mode <- function(altitude, GroundOverlay=FALSE){ altitude = as.numeric(altitude) if (all(altitude[!is.na(altitude)] > 0)) { - if (GroundOverlay) { + if(GroundOverlay == TRUE){ altitude_mode <- "absolute" } else { altitude_mode <- "relativeToGround" diff --git a/pkg/R/attributes.R b/pkg/R/attributes.R index 0044fa6..4d1d07f 100644 --- a/pkg/R/attributes.R +++ b/pkg/R/attributes.R @@ -1,59 +1,32 @@ - -.df2htmltable <- function(x, fix.enc = TRUE, columns = TRUE) { - - # if the user passed in TRUE, then we want all of the columns - # AG: AFAIK, we shouldn't use class(x) == "something" to test for class - # Maybe: if (is.logical(columns)) ? - if (class(columns) == 'logical'){ - columns <- seq_len(ncol(x)) # use all columns from the dataframe row - } - else { # otherwise, keep only requested columns - x <- x[, columns] - } - - # fix encoding: - if (fix.enc) { - x <- data.frame(lapply(x, iconv, to = "UTF8")) - } - - # get selected table data: - # AG: AFAIK, sapply shouldn't be used in a package since it's not type-safe. - # I would use vapply(..., FUN.VALUE = character(1)) - att.names <- sapply( - names(x), - function(i) { - paste( - '', - as.character(i), - ": ", - sep = "" - ) - } - ) - att.values <- as.vector( - t( - sapply( - x, - function(i) { - paste( - '', - as.character(i), - "
", - sep = "" - ) - } - ) - ) - ) - # combine by interleaving: - att <- matrix( - paste(att.names, att.values, sep = "\n"), - ncol = length(names(x)), - byrow = TRUE - ) - html.table <- apply(att, 1, paste, collapse="\n") - - html.table -} - -# end of script; +# Purpose : Convert an attribute table associated with spatial data into an HTML bubble +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Tomislav Hengl (tom.hengl@wur.nl); +# Status : ready for R-forge +# Note : required by KML writing functions; + +.df2htmltable <- function(x, fix.enc = TRUE, columns = TRUE) { + + # if the user passed in TRUE, then we want all of the columns + if(class(columns) == 'logical'){ + columns <- 1:ncol(x) # use all columns from the dataframe row + } + else{ # otherwise, keep only requested columns + x <- x[, columns] + } + + # fix encoding: + if(fix.enc==TRUE){ + x <- data.frame(lapply(x, iconv, to = "UTF8")) + } + + # get selected table data: + att.names <- sapply(names(x), function(i) { paste('', as.character(i), ': ', sep = '') } ) + att.values <- as.vector(t(sapply(x, function(i) { paste('', as.character(i), '
', sep = '') }))) + # combine by interleaving: + att <- matrix(paste(att.names, att.values, sep="\n"), ncol=length(names(x)), byrow=TRUE) + html.table <- apply(att, 1, paste, collapse="\n") + + return(html.table) +} + +# end of script; diff --git a/pkg/R/check_projection.R b/pkg/R/check_projection.R index 4994f44..c8d9ada 100644 --- a/pkg/R/check_projection.R +++ b/pkg/R/check_projection.R @@ -1,126 +1,134 @@ -# Note: p4s_parameters list of proj4 parameter/value strings; Uses the string parsing functionality from the 'plyr' package; - -extractProjValue <- function(p4s_parameters, param){ - - # Locating the current PROJ4 parameter - query <- plyr::ldply(p4s_parameters, stringr::str_locate, pattern = param) - idx <- which(!is.na(query[, 1]) & !is.na(query[, 2])) - - # If the PROJ4 parameter is found we extract its value - if (length(idx) > 0) { - # Selecting the good param string - param_value <- p4s_parameters[idx] - # Extract the parameter value - value <- strsplit(param_value, param)[[1]] - value <- value[value != ""] - return(value) - } else { - value <- NA - #warning(paste("Proj4string does not contain", param, "parameter.\n Consider converting to the referent CRS", get("ref_CRS", envir = plotKML.opts),"manually.")) - } -} - - -## parse string: -parse_proj4 <- function(p4s, params){ - - if(missing(params)) { - ref_CRS = get("ref_CRS", envir = plotKML.opts) - value <- strsplit(ref_CRS, "\\+")[[1]] - value <- value[value != ""] - param_names <- sapply(strsplit(value, "="), function(x){x[1]}) - params <- as.list(paste("\\+", sapply(strsplit(value, "="), function(x){x[1]}), "=", sep="")) - } - - # Splitting the whole PROJ4 string - p4s_parameters <- stringr::str_split(p4s, " ")[[1]] - # Extraction of the values of parameters specified above - x <- plyr::laply(params, extractProjValue, p4s_parameters = p4s_parameters) - # colnames for better looking result - value <- sapply(sapply(params, strsplit, "\\+"), function(x){x[2]}) - param_names <- sapply(strsplit(value, "="), function(x){x[1]}) - names(x) <- param_names - - return(x) -} - -## Get proj4string from an object -getCRS.Spatial <- function(obj) { - CRSargs(CRS(proj4string(obj))) -} - -setMethod("getCRS", "Spatial", getCRS.Spatial) - -getCRS.Raster <- function(obj) { - CRSargs(projection(obj, asText = FALSE)) -} - -setMethod("getCRS", "Raster", getCRS.Raster) - - -## check projection for Raster objects -setMethod("is.projected", signature(obj = "Raster"), - function(obj) { - p4str <- getCRS(obj) - if (is.na(p4str) || nchar(p4str) == 0) - - return(as.logical(NA)) - else { - - x <- grep("longlat", p4str, fixed=TRUE) - - if (length(x) == 0) - return(TRUE) - else - return(FALSE) - } - } -) - -## check proj4string -check_projection <- function(obj, control = TRUE, ref_CRS = get("ref_CRS", envir = plotKML.opts)){ - - if(is.na(proj4string(obj))){ - stop("Proj4 string missing") - } - - # First, check if it is in the metric system or unprojected: - if(is.projected(obj)){ - ret = FALSE - } else { - # Using PROJ.4 to get the PROJ4 string - p4s <- getCRS(obj) - - # Parsing the PROJ4 string for proj and datum values - params <- parse_proj4(p4s) - - # the default target proj4 string: - value <- strsplit(ref_CRS, "\\+")[[1]] - value <- value[value != ""] - target_params <- stringr::str_trim(sapply(strsplit(value, "="), function(x){x[2]})) - names(target_params) <- sapply(strsplit(value, "="), function(x){x[1]}) - - # if already projection type is missing the string is invalid - if(params["proj"] != ""){ - # If test fails - if (sum(is.na(match(params, target_params)))>0) { - if (control==FALSE) - stop(paste("'", ref_CRS, "' coordinate system required")) - else - ret <- FALSE - } - # If test succeed - else { - ret <- TRUE - } - } - - else { - stop("A valid proj4string required. See 'CRS-methods' for more details.") - } - } - - return(ret) -} - -# end of script; +# Purpose : Extracts PROJ4 parameters and checks if they are compatible with ref_CRS +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Dev Status : Alpha +# Note : p4s_parameters list of proj4 parameter/value strings; Uses the string parsing functionality from the 'plyr' package; + +extractProjValue <- function(p4s_parameters, param){ + + # Locating the current PROJ4 parameter + query <- ldply(p4s_parameters, str_locate, pattern = param) + idx <- which(!is.na(query[, 1]) & !is.na(query[, 2])) + + # If the PROJ4 parameter is found we extract its value + if (length(idx) > 0) { + # Selecting the good param string + param_value <- p4s_parameters[idx] + # Extract the parameter value + value <- strsplit(param_value, param)[[1]] + value <- value[value != ""] + } + else { stop(paste("Proj4string does not contain", param, "parameter.\n Consider converting to the referent CRS", get("ref_CRS", envir = plotKML.opts),"manually.")) + } + + return(value) +} + + +## parse string: +parse_proj4 <- function(p4s, params){ + + if(missing(params)) { + ref_CRS = get("ref_CRS", envir = plotKML.opts) + value <- strsplit(ref_CRS, "\\+")[[1]] + value <- value[value != ""] + param_names <- sapply(strsplit(value, "="), function(x){x[1]}) + params <- as.list(paste("\\+", sapply(strsplit(value, "="), function(x){x[1]}), "=", sep="")) + } + + # Splitting the whole PROJ4 string + p4s_parameters <- str_split(p4s, " ")[[1]] + # Extraction of the values of parameters specified above + x <- laply(params, extractProjValue, p4s_parameters = p4s_parameters) + # colnames for better looking result + value <- sapply(sapply(params, strsplit, "\\+"), function(x){x[2]}) + param_names <- sapply(strsplit(value, "="), function(x){x[1]}) + names(x) <- param_names + + return(x) +} + +## Get proj4string from an object +getCRS.Spatial <- function(obj) { + CRSargs(CRS(proj4string(obj))) +} + +setMethod("getCRS", "Spatial", getCRS.Spatial) + +getCRS.Raster <- function(obj) { + CRSargs(projection(obj, asText = FALSE)) +} + +setMethod("getCRS", "Raster", getCRS.Raster) + + +## check projection for Raster objects +setMethod("is.projected", signature(obj = "Raster"), + function(obj) { + p4str <- getCRS(obj) + if (is.na(p4str) || nchar(p4str) == 0) + + return(as.logical(NA)) + else { + + x <- grep("longlat", p4str, fixed=TRUE) + + if (length(x) == 0) + return(TRUE) + else + return(FALSE) + } + } +) + +## check proj4string +check_projection <- function(obj, control = TRUE, ref_CRS = get("ref_CRS", envir = plotKML.opts)){ + + if(is.na(proj4string(obj))){ + stop("Proj4 string missing") + } + + # First, check if it is in the metric system or unprojected: + if(ref_CRS=="+proj=longlat +datum=WGS84"&is.projected(obj)){ + ret = FALSE + } + + else { + + # Using PROJ.4 to get the PROJ4 string + p4s <- getCRS(obj) + + # Parsing the PROJ4 string for proj and datum values + params <- parse_proj4(p4s) + + # the default target proj4 string: + value <- strsplit(ref_CRS, "\\+")[[1]] + value <- value[value != ""] + target_params <- stringr::str_trim(sapply(strsplit(value, "="), function(x){x[2]})) + names(target_params) <- sapply(strsplit(value, "="), function(x){x[1]}) + + # if already projection type is missing the string is invalid + if(params["proj"] != ""){ + + # If test fails + if (sum(is.na(match(params, target_params)))>0) { + if (control==FALSE) + stop(paste("'", ref_CRS, "' coordinate system required")) + else + ret <- FALSE + } + # If test succeed + else { + ret <- TRUE + } + } + + else { + stop("A valid proj4string required. See 'CRS-methods' for more details.") + } + } + + return(ret) +} + +# end of script; diff --git a/pkg/R/col2kml.R b/pkg/R/col2kml.R index 47591a3..e3ac2bb 100644 --- a/pkg/R/col2kml.R +++ b/pkg/R/col2kml.R @@ -1,52 +1,59 @@ -## KML colour follow the scheme #aabbggrr -col2kml <- function(colour){ - - # Getting the HEX code - res <- rgb(t(col2rgb(colour, alpha = TRUE))/255, alpha = TRUE) - # Converting from HEX to KML - res <- hex2kml(res) - - res -} - -## Convert hex colours to KML specs -hex2kml <- function(hex){ - - res <- aaply(hex, 1, function(hex){ - if (str_length(hex) == 9) # if alpha is present - res <- paste("#", str_sub(tolower(hex), 8, 9), str_sub(tolower(hex), 6, 7), str_sub(tolower(hex), 4, 5), str_sub(tolower(hex), 2, 3), sep = "") - else - res <- paste("#ff", str_sub(tolower(hex), 6, 7), str_sub(tolower(hex), 4, 5), str_sub(tolower(hex), 2, 3), sep = "") - res - } - ) - - as.vector(res) -} - -## KML spec is alpha-BGR -kml2hex <- function(kml) { - - res <- aaply(kml, 1, function(x){ - res <- paste("#", str_sub(toupper(x), 8, 9), str_sub(toupper(x), 6, 7), str_sub(toupper(x), 4, 5), str_sub(toupper(x), 2, 3), sep = "") - res - } - ) - - as.vector(res) -} - -## From Munsell colour codes to FBGR codes: -munsell2kml <- function( - the_hue, - the_chroma, - the_value, - alpha = 1 - ){ - - res <- hex2kml(aqp::munsell2rgb(the_hue, the_value, the_chroma, alpha=alpha)) - - return(res) -} - -# end of script; +# Purpose : Color conversion functions +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Dev Status : Alpha +# Note : Converts from HEX to KML and back; + + +## KML colour follow the scheme #aabbggrr +col2kml <- function(colour){ + + # Getting the HEX code + res <- rgb(t(col2rgb(colour, alpha = TRUE))/255, alpha = TRUE) + # Converting from HEX to KML + res <- hex2kml(res) + + res +} + +## Convert hex colours to KML specs +hex2kml <- function(hex){ + + res <- aaply(hex, 1, function(hex){ + if (str_length(hex) == 9) # if alpha is present + res <- paste("#", str_sub(tolower(hex), 8, 9), str_sub(tolower(hex), 6, 7), str_sub(tolower(hex), 4, 5), str_sub(tolower(hex), 2, 3), sep = "") + else + res <- paste("#ff", str_sub(tolower(hex), 6, 7), str_sub(tolower(hex), 4, 5), str_sub(tolower(hex), 2, 3), sep = "") + res + } + ) + + as.vector(res) +} + +## KML spec is alpha-BGR +kml2hex <- function(kml) { + + res <- aaply(kml, 1, function(x){ + res <- paste("#", str_sub(toupper(x), 8, 9), str_sub(toupper(x), 6, 7), str_sub(toupper(x), 4, 5), str_sub(toupper(x), 2, 3), sep = "") + res + } + ) + + as.vector(res) +} + +## From Munsell colour codes to FBGR codes: +munsell2kml <- function( + the_hue, + the_chroma, + the_value, + alpha = 1 + ){ + + res <- hex2kml(aqp::munsell2rgb(the_hue, the_value, the_chroma, alpha=alpha)) + + return(res) +} + +# end of script; diff --git a/pkg/R/color_palettes.R b/pkg/R/color_palettes.R index 13fb230..7fdc08c 100644 --- a/pkg/R/color_palettes.R +++ b/pkg/R/color_palettes.R @@ -1,36 +1,41 @@ -# Note: a gallery of color palettes is available at [http://plotkml.r-forge.r-project.org/]; - -# Display default palettes: -display.pal <- function(pal, sel=1:length(pal), names=FALSE) { - - if(length(pal)>10) { sel <- 1:10 } - - if(names==FALSE){ - dev.new(width=2.1, height=length(sel)) - ## not needed - # fin=c(2.1, length(sel)*.9), - par(mfrow=c(length(sel),1), mar=c(1.5,.8,1.5,.5)) - # plot palettes above each other: - for(j in sel){ - plot(y=rep(1, length(pal[[j]])), x=1:length(pal[[j]]), axes=FALSE, xlab='', ylab='', pch=15, cex=1.5, col=pal[[j]]) - mtext(names(pal)[j], cex=.5, side=3) - } - } # names == TRUE: - else { - sel <- sel[1] # take only the first pallette from the list - pal.name <- names(pal)[sel] - pal <- pal[[sel]] - - # used to compute plotting region, not figure size - leg.width <- (max(nchar(names(pal)))*20+150)/100 - leg.height <- length(pal) - - par(mar=c(.5,0,1.5,1)) - # plot palette and class names: - plot(x=rep(1, length(pal)), y=1:length(pal), axes=FALSE, xlab='', ylab='', pch=15, cex=1.5, col=pal, xlim=c(0,.6*leg.width), asp=.6) - text(x=rep(1, length(pal)), y=1:length(pal), labels=names(pal), cex=.5, pos=4, offset=1) - mtext(pal.name, cex=.8, side=3) - } -} - +# Purpose : Color palettes for visualization of numeric (continuous, binary, ordinary) and categorical variables; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Status : pre-alpha +# Note : a gallery of color palettes is available at [http://plotkml.r-forge.r-project.org/]; + + +# Display default palettes: +display.pal <- function(pal, sel=1:length(pal), names=FALSE) { + + if(length(pal)>10) { sel <- 1:10 } + + if(names==FALSE){ + dev.new(width=2.1, height=length(sel)) + ## not needed + # fin=c(2.1, length(sel)*.9), + par(mfrow=c(length(sel),1), mar=c(1.5,.8,1.5,.5)) + # plot palettes above each other: + for(j in sel){ + plot(y=rep(1, length(pal[[j]])), x=1:length(pal[[j]]), axes=FALSE, xlab='', ylab='', pch=15, cex=1.5, col=pal[[j]]) + mtext(names(pal)[j], cex=.5, side=3) + } + } # names == TRUE: + else { + sel <- sel[1] # take only the first pallette from the list + pal.name <- names(pal)[sel] + pal <- pal[[sel]] + + # used to compute plotting region, not figure size + leg.width <- (max(nchar(names(pal)))*20+150)/100 + leg.height <- length(pal) + + par(mar=c(.5,0,1.5,1)) + # plot palette and class names: + plot(x=rep(1, length(pal)), y=1:length(pal), axes=FALSE, xlab='', ylab='', pch=15, cex=1.5, col=pal, xlim=c(0,.6*leg.width), asp=.6) + text(x=rep(1, length(pal)), y=1:length(pal), labels=names(pal), cex=.5, pos=4, offset=1) + mtext(pal.name, cex=.8, side=3) + } +} + # end of script; \ No newline at end of file diff --git a/pkg/R/count.R b/pkg/R/count.R index 3da03c0..c26d0d4 100644 --- a/pkg/R/count.R +++ b/pkg/R/count.R @@ -1,24 +1,31 @@ -## get a summary of an object for a list of lines: -count.GridTopology <- function(x, vectL, ...){ - if(any(class(x)=="GridTopology")){ - # rasterize each line separately: - sg <- SpatialGridDataFrame(x, proj4string = vectL[[1]]@proj4string, data=data.frame(observed=rep(NA, x@cells.dim[1]*x@cells.dim[2]), observed.sd=rep(NA, x@cells.dim[1]*x@cells.dim[2]))) - xv <- NULL - for(i in 1:length(vectL)){ - vv <- vectL[[i]] - vv$x <- rep(1, nrow(vv)) - xv[[i]] <- vect2rast(vv, fname="x", cell.size=sg@grid@cellsize[1], bbox=sg@bbox, ...)@data - } - # bind all rasters: - xv <- do.call(cbind, xv) - - sg$observed <- rowSums(xv, na.rm=T, dims=1)/length(xv) - sg$observed.sd <- ifelse(sg$observed==0|sg$observed==1, 0, -sg$observed*log2(sg$observed)-(1-sg$observed)*log2(1-sg$observed)) ## information entropy (H) of a Bernoulli trial - out = new("SpatialVectorsSimulations", realizations = vectL, summaries = sg) - return(out) - } else { - stop("Object of class 'GridTopology' required") - } -} - +# Purpose : Count the number of vector objects for some GridTopology +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Edzer Pebesma (edzer.pebesma@uni-muenster.de); +# Dev Status : Alpha +# Note : Compare with aggregate in utils, sp, and spacetime; + + +## get a summary of an object for a list of lines: +count.GridTopology <- function(x, vectL, ...){ + if(any(class(x)=="GridTopology")){ + # rasterize each line separately: + sg <- SpatialGridDataFrame(x, proj4string = vectL[[1]]@proj4string, data=data.frame(observed=rep(NA, x@cells.dim[1]*x@cells.dim[2]), observed.sd=rep(NA, x@cells.dim[1]*x@cells.dim[2]))) + xv <- NULL + for(i in 1:length(vectL)){ + vv <- vectL[[i]] + vv$x <- rep(1, nrow(vv)) + xv[[i]] <- vect2rast(vv, fname="x", cell.size=sg@grid@cellsize[1], bbox=sg@bbox, ...)@data + } + # bind all rasters: + xv <- do.call(cbind, xv) + + sg$observed <- rowSums(xv, na.rm=T, dims=1)/length(xv) + sg$observed.sd <- ifelse(sg$observed==0|sg$observed==1, 0, -sg$observed*log2(sg$observed)-(1-sg$observed)*log2(1-sg$observed)) ## information entropy (H) of a Bernoulli trial + out = new("SpatialVectorsSimulations", realizations = vectL, summaries = sg) + return(out) + } else { + stop("Object of class 'GridTopology' required") + } +} + ## end of script; \ No newline at end of file diff --git a/pkg/R/export_metadata.R b/pkg/R/export_metadata.R index 3320bf2..e033dc0 100644 --- a/pkg/R/export_metadata.R +++ b/pkg/R/export_metadata.R @@ -1,65 +1,71 @@ -# Note : Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/], which can be converted to "ISO 19139" XML schema; -## Generate a SLD file (using the default legend): -# [https://docs.geoserver.org/stable/en/user/styling/sld-introduction.html] - -metadata2SLD.Spatial <- function(obj, ...){ - - if(xmlValue(obj@xml[["//formcont"]]) == "SpatialPixelsDataFrame"){ - metadata2SLD.SpatialPixels(obj, ...) - } - # ... - ## to be continued - else { - stop("Format_Information_Content field in 'obj@xml' must specify an applicable sp class.") - } -} - -metadata2SLD.SpatialPixels <- function( - obj, # SpatialMetadata - Format_Information_Content = xmlValue(obj@xml[["//formcont"]]), - obj.name = normalizeFilename(deparse(substitute(obj))), - sld.file = set.file.extension(obj.name, ".sld"), - Citation_title = xmlValue(obj@xml[["//title"]]), - ColorMap_type = "intervals", - opacity = 1, - brw.trg = 'Greys', # color scheme, according to www.colorbrewer2.org; default to 'Greys' - target.var, # target variable, used to calculate the class-intervals - ... -){ - l1 = newXMLNode("StyledLayerDescriptor", attrs=c("xsi:schemaLocation" = "http://www.opengis.net/sld StyledLayerDescriptor.xsd", version="1.0.0"), namespaceDefinitions=c("http://www.opengis.net/sld", "xsi" = "http://www.w3.org/2001/XMLSchema-instance", "ogc" = "http://www.opengis.net/ogc", "gml" = "http://www.opengis.net/gml")) - l2 <- newXMLNode("NamedLayer", parent = l1) - l3 <- newXMLNode("Name", paste(Citation_title, "(", Format_Information_Content, ")"), parent = l2) - l3b <- newXMLNode("UserStyle", parent = l2) - l4 <- newXMLNode("Title", paste(obj.name, "style", sep="_"), parent = l3b) - l4b <- newXMLNode("FeatureTypeStyle", parent = l3b) - l5 <- newXMLNode("Rule", parent = l4b) - l6 <- newXMLNode("RasterSymbolizer", parent = l5) - l7 <- newXMLNode("ColorMap", attrs=c(type=ColorMap_type), parent = l6) - ## MB: if no target variable is provided, the original ColorMapEntries (defined by spMetadata-call) are used.. - if(missing(target.var)) { - txt <- sprintf('', obj@palette@color, obj@palette@bounds[-1], obj@palette@names, rep(opacity, length(obj@palette@color))) - } else { - mm <- classIntervals(target.var, ...) - brew.p <- brewer.pal(n = length(mm$brks) - 1, name = brw.trg) - op <- findColours(mm, pal = brew.p, under = 'under', over = 'over', between = '-', cutlabels = F) - txt <- sprintf('', attr(op, 'palette'), mm$brks[-1], attr(attr(op, 'table'), 'dimnames')[[1]], rep(opacity, length(mm$brks[-1]))) - } - parseXMLAndAdd(txt, l7) - saveXML(l1, sld.file) -} - - -## Write the metadata dataframe to Geonetwork MEF format as specified at [http://geonetwork-opensource.org/manuals/2.6.3/developer/mef/] -# -# metadata2MEF <- function( -# xml, # metadata slot - -# ) -# { - -# } - -# connect all methods and classes: -setMethod("metadata2SLD", "SpatialMetadata", metadata2SLD.Spatial) - -# end of script; +# Purpose : Export of (spatial) metadata +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Michael Blaschek (blaschek@geographie.uni-kiel.de); +# Dev Status : Pre-Alpha +# Note : Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/], which can be converted to "ISO 19139" XML schema; + + +## Generate a SLD file (using the default legend): +# [http://docs.geoserver.org/stable/en/user/styling/sld-introduction.html] + +metadata2SLD.Spatial <- function(obj, ...){ + + if(xmlValue(obj@xml[["//formcont"]]) == "SpatialPixelsDataFrame"){ + metadata2SLD.SpatialPixels(obj, ...) + } + # ... + ## to be continued + else { + stop("Format_Information_Content field in 'obj@xml' must specify an applicable sp class.") + } +} + +metadata2SLD.SpatialPixels <- function( + obj, # SpatialMetadata + Format_Information_Content = xmlValue(obj@xml[["//formcont"]]), + obj.name = normalizeFilename(deparse(substitute(obj))), + sld.file = set.file.extension(obj.name, ".sld"), + Citation_title = xmlValue(obj@xml[["//title"]]), + ColorMap_type = "intervals", + opacity = 1, + brw.trg = 'Greys', # color scheme, according to www.colorbrewer2.org; default to 'Greys' + target.var, # target variable, used to calculate the class-intervals + ... +){ + l1 = newXMLNode("StyledLayerDescriptor", attrs=c("xsi:schemaLocation" = "http://www.opengis.net/sld StyledLayerDescriptor.xsd", version="1.0.0"), namespaceDefinitions=c("http://www.opengis.net/sld", "xsi" = "http://www.w3.org/2001/XMLSchema-instance", "ogc" = "http://www.opengis.net/ogc", "gml" = "http://www.opengis.net/gml")) + l2 <- newXMLNode("NamedLayer", parent = l1) + l3 <- newXMLNode("Name", paste(Citation_title, "(", Format_Information_Content, ")"), parent = l2) + l3b <- newXMLNode("UserStyle", parent = l2) + l4 <- newXMLNode("Title", paste(obj.name, "style", sep="_"), parent = l3b) + l4b <- newXMLNode("FeatureTypeStyle", parent = l3b) + l5 <- newXMLNode("Rule", parent = l4b) + l6 <- newXMLNode("RasterSymbolizer", parent = l5) + l7 <- newXMLNode("ColorMap", attrs=c(type=ColorMap_type), parent = l6) + ## MB: if no target variable is provided, the original ColorMapEntries (defined by spMetadata-call) are used.. + if(missing(target.var)) { + txt <- sprintf('', obj@palette@color, obj@palette@bounds[-1], obj@palette@names, rep(opacity, length(obj@palette@color))) + } else { + mm <- classIntervals(target.var, ...) + brew.p <- brewer.pal(n = length(mm$brks) - 1, name = brw.trg) + op <- findColours(mm, pal = brew.p, under = 'under', over = 'over', between = '-', cutlabels = F) + txt <- sprintf('', attr(op, 'palette'), mm$brks[-1], attr(attr(op, 'table'), 'dimnames')[[1]], rep(opacity, length(mm$brks[-1]))) + } + parseXMLAndAdd(txt, l7) + saveXML(l1, sld.file) +} + + +## Write the metadata dataframe to Geonetwork MEF format as specified at [http://geonetwork-opensource.org/manuals/2.6.3/developer/mef/] +# +# metadata2MEF <- function( +# xml, # metadata slot + +# ) +# { + +# } + +# connect all methods and classes: +setMethod("metadata2SLD", "SpatialMetadata", metadata2SLD.Spatial) + +# end of script; diff --git a/pkg/R/geopath.R b/pkg/R/geopath.R index 892cbf4..62ed02d 100644 --- a/pkg/R/geopath.R +++ b/pkg/R/geopath.R @@ -1,40 +1,46 @@ -geopath <- function(lon1, lon2, lat1, lat2, ID, n.points, print.geo = FALSE) { - if(requireNamespace("fossil", quietly = TRUE)){ - ## Haversine Formula for Great Circle distance - ## lon / lat = geographical coordinates on WGS84 - ## n.points = number of intermediate points - - p.1 <- matrix(c(lon1, lat1), ncol=2, dimnames=list(1,c("lon","lat"))) # source - p.2 <- matrix(c(lon2, lat2), ncol=2, dimnames=list(1,c("lon","lat"))) # destination - distc <- fossil::deg.dist(lat1=p.1[,2], long1=p.1[,1], lat2=p.2[,2], long2=p.2[,1]) # in km - bearingc <- fossil::earth.bear(lat1=p.1[,2], long1=p.1[,1], lat2=p.2[,2], long2=p.2[,1]) # bearing in degrees from north - # estimate the number of points based on the distance (the higher the distance, less points we need): - if(missing(ID)) { ID <- paste(ifelse(lon1<0, "W", "E"), abs(round(lon1,0)), ifelse(lat1<0, "S", "N"), abs(round(lat1,0)), ifelse(lon2<0, "W", "E"), abs(round(lon2,0)), ifelse(lat2<0, "S", "N"), abs(round(lat2,0)), sep="") } - if(missing(n.points)) { - n.points <- round(sqrt(distc)/sqrt(2), 0) - } - if(!is.nan(n.points)) { if(n.points>0) { - pnts <- t(sapply(1:n.points/(n.points+1)*distc, FUN=fossil::new.lat.long, lat=p.1[,2], lon=p.1[,1], bearing=bearingc))[,c(2,1)] # intermediate points - # some lines are crossing the whole globe (>180 or <-180 longitudes) and need to be split in two: - if(is.matrix(pnts)){ if(max(LineLength(pnts, sum=FALSE))>100) { - breakp <- which.max(abs(pnts[,1]-c(pnts[-1,1], pnts[length(pnts[,1]),1]))) - pnts1 <- pnts[1:breakp,] - pnts2 <- pnts[(breakp+1):length(pnts[,1]),] - routes <- Lines(list(Line(matrix(rbind(p.1, pnts1),ncol=2)), Line(matrix(rbind(pnts2, p.2),ncol=2))), ID=as.character(ID)) - } - - else { - routes <- Lines(list(Line(matrix(rbind(p.1, pnts, p.2),ncol=2))), ID=as.character(ID)) } - } } - # create SpatialLines: - path <- SpatialLines(list(routes), CRS("+proj=longlat +datum=WGS84")) - } - if(print.geo==TRUE) { - print(paste("Distance:", round(distc,1))) - print(paste("Bearing:", round(bearingc,1))) - } - return(path) - } -} - +# Purpose : shortest path between two points on WGS84 ellipsoid; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : usefull for plotting airroutes or networks between geographically distant places; + +geopath <- function(lon1, lon2, lat1, lat2, ID, n.points, print.geo = FALSE) { + if(requireNamespace("fossil", quietly = TRUE)){ + ## Haversine Formula for Great Circle distance + ## lon / lat = geographical coordinates on WGS84 + ## n.points = number of intermediate points + + p.1 <- matrix(c(lon1, lat1), ncol=2, dimnames=list(1,c("lon","lat"))) # source + p.2 <- matrix(c(lon2, lat2), ncol=2, dimnames=list(1,c("lon","lat"))) # destination + distc <- fossil::deg.dist(lat1=p.1[,2], long1=p.1[,1], lat2=p.2[,2], long2=p.2[,1]) # in km + bearingc <- fossil::earth.bear(lat1=p.1[,2], long1=p.1[,1], lat2=p.2[,2], long2=p.2[,1]) # bearing in degrees from north + # estimate the number of points based on the distance (the higher the distance, less points we need): + if(missing(ID)) { ID <- paste(ifelse(lon1<0, "W", "E"), abs(round(lon1,0)), ifelse(lat1<0, "S", "N"), abs(round(lat1,0)), ifelse(lon2<0, "W", "E"), abs(round(lon2,0)), ifelse(lat2<0, "S", "N"), abs(round(lat2,0)), sep="") } + if(missing(n.points)) { + n.points <- round(sqrt(distc)/sqrt(2), 0) + } + if(!is.nan(n.points)) { if(n.points>0) { + pnts <- t(sapply(1:n.points/(n.points+1)*distc, FUN=fossil::new.lat.long, lat=p.1[,2], lon=p.1[,1], bearing=bearingc))[,c(2,1)] # intermediate points + # some lines are crossing the whole globe (>180 or <-180 longitudes) and need to be split in two: + if(is.matrix(pnts)){ if(max(LineLength(pnts, sum=FALSE))>100) { + breakp <- which.max(abs(pnts[,1]-c(pnts[-1,1], pnts[length(pnts[,1]),1]))) + pnts1 <- pnts[1:breakp,] + pnts2 <- pnts[(breakp+1):length(pnts[,1]),] + routes <- Lines(list(Line(matrix(rbind(p.1, pnts1),ncol=2)), Line(matrix(rbind(pnts2, p.2),ncol=2))), ID=as.character(ID)) + } + + else { + routes <- Lines(list(Line(matrix(rbind(p.1, pnts, p.2),ncol=2))), ID=as.character(ID)) } + } } + # create SpatialLines: + path <- SpatialLines(list(routes), CRS("+proj=longlat +datum=WGS84")) + } + if(print.geo==TRUE) { + print(paste("Distance:", round(distc,1))) + print(paste("Bearing:", round(bearingc,1))) + } + return(path) + } +} + # end of script; \ No newline at end of file diff --git a/pkg/R/getWikiMedia.ImageInfo.R b/pkg/R/getWikiMedia.ImageInfo.R index ff5bf60..056c2d9 100644 --- a/pkg/R/getWikiMedia.ImageInfo.R +++ b/pkg/R/getWikiMedia.ImageInfo.R @@ -1,75 +1,82 @@ -getWikiMedia.ImageInfo <- function(imagename, APIsource = "https://commons.wikimedia.org/w/api.php", module = "imageinfo", details = c("url", "metadata", "size", "extlinks"), testURL = TRUE){ - - if(!requireNamespace("RCurl", quietly = TRUE)){ - stop('package "RCurl" required but missing') - } - - if(testURL == TRUE){ - z <- RCurl::getURI(paste("https://commons.wikimedia.org/wiki/File:", imagename, sep=""), .opts=RCurl::curlOptions(header=TRUE, nobody=TRUE, transfertext=TRUE, failonerror=FALSE, ssl.verifypeer = FALSE)) - if(!length(x <- grep(z, pattern="404 Not Found"))==0){ - stop(paste("File", imagename, "could not be located at https://commons.wikimedia.org")) - } - } - - options(warn = -1) - # Get the image URL: - xml.lst <- NULL - for(j in 1:length(details)){ - if(details[j]=="url"|details[j]=="metadata"|details[j]=="size"){ - xml.api <- xmlParse(RCurl::getURL(paste0(APIsource, "?action=query&titles=File:", imagename, "&prop=", module, "&iiprop=", details[j], "&format=xml"), ssl.verifypeer = FALSE)) - x <- xmlToList(xml.api[["//ii"]]) - if(any(names(x)=="metadata")){ - exif.info <- sapply(xml.api["//metadata[@value]"], xmlGetAttr, "value") - names(exif.info) <- sapply(xml.api["//metadata[@name]"], xmlGetAttr, "name") - xml.lst[[j]] <- as.list(data.frame(as.list(exif.info), stringsAsFactors=FALSE)) - } else { - xml.lst[[j]] <- as.list(x) - } - } - else { - if(details[j]=="extlinks"){ - xml.api <- xmlParse(RCurl::getURL(paste0(APIsource, "?action=query&titles=File:", imagename, "&prop=", details[j], "&format=xml"), ssl.verifypeer = FALSE)) - geo.tag <- sapply(xml.api["//extlinks/el"], xmlValue) - if(!length(geo.tag)==0){ - ## Try to determine coordinates from google maps URL: - geo.tag1 <- geo.tag[grep(geo.tag, pattern="maps.google")] - if(!length(geo.tag1)==0){ - ll1 <- strsplit(strsplit(geo.tag1, "ll=")[[1]][2], "&")[[1]][1] - ## manually enterred coordinates: - Longitude <- strsplit(ll1, ",")[[1]][2] - Latitude <- strsplit(ll1, ",")[[1]][1] - } else { - geo.tag2 <- geo.tag[grep(geo.tag, pattern=glob2rx("*lat=*lon=*"))] - if(!length(geo.tag2)==0){ - x <- unlist(strsplit(geo.tag2, "&")) - Longitude <- as.numeric(unlist(strsplit(x[grep(x, pattern="lon=")], "lon="))[2]) - Latitude <- as.numeric(unlist(strsplit(x[grep(x, pattern="lat=")], "lat="))[2]) - } else { - Longitude <- NA - Latitude <- NA - } - } - xml.lst[[j]] <- as.list(geo.tag) - names(xml.lst[[j]]) <- paste("url", 1:length(geo.tag), sep="") - } else { - xml.lst[[j]] <- NA - } - } - else { - stop("Currently reads only 'url', 'metadata' and 'extlinks' information.") - } - } - - names(xml.lst)[[j]] <- details[j] - } - - # rewrite metadata with the Wikimedia specs (more reliable): - xml.lst[["metadata"]]$GPSLongitude <- Longitude - xml.lst[["metadata"]]$GPSLatitude <- Latitude - xml.lst[["metadata"]]$ImageWidth <- xml.lst[["size"]]$width - xml.lst[["metadata"]]$ImageHeight <- xml.lst[["size"]]$height - - return(xml.lst) -} - +# Purpose : Get EXIF info from Wikimedia +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Dev Status : Pre-Alpha +# Note : The URLs might change in the near future; + + +getWikiMedia.ImageInfo <- function(imagename, APIsource = "https://commons.wikimedia.org/w/api.php", module = "imageinfo", details = c("url", "metadata", "size", "extlinks"), testURL = TRUE){ + + if(!requireNamespace("RCurl", quietly = TRUE)){ + stop('package "RCurl" required but missing') + } + + if(testURL == TRUE){ + z <- RCurl::getURI(paste("http://commons.wikimedia.org/wiki/File:", imagename, sep=""), .opts=RCurl::curlOptions(header=TRUE, nobody=TRUE, transfertext=TRUE, failonerror=FALSE, ssl.verifypeer = FALSE)) + if(!length(x <- grep(z, pattern="404 Not Found"))==0){ + stop(paste("File", imagename, "could not be located at http://commons.wikimedia.org")) + } + } + + options(warn = -1) + # Get the image URL: + xml.lst <- NULL + for(j in 1:length(details)){ + if(details[j]=="url"|details[j]=="metadata"|details[j]=="size"){ + xml.api <- xmlParse(RCurl::getURL(paste0(APIsource, "?action=query&titles=File:", imagename, "&prop=", module, "&iiprop=", details[j], "&format=xml"), ssl.verifypeer = FALSE)) + x <- xmlToList(xml.api[["//ii"]]) + if(any(names(x)=="metadata")){ + exif.info <- sapply(xml.api["//metadata[@value]"], xmlGetAttr, "value") + names(exif.info) <- sapply(xml.api["//metadata[@name]"], xmlGetAttr, "name") + xml.lst[[j]] <- as.list(data.frame(as.list(exif.info), stringsAsFactors=FALSE)) + } else { + xml.lst[[j]] <- as.list(x) + } + } + else { + if(details[j]=="extlinks"){ + xml.api <- xmlParse(RCurl::getURL(paste0(APIsource, "?action=query&titles=File:", imagename, "&prop=", details[j], "&format=xml"), ssl.verifypeer = FALSE)) + geo.tag <- sapply(xml.api["//extlinks/el"], xmlValue) + if(!length(geo.tag)==0){ + ## Try to determine coordinates from google maps URL: + geo.tag1 <- geo.tag[grep(geo.tag, pattern="maps.google")] + if(!length(geo.tag1)==0){ + ll1 <- strsplit(strsplit(geo.tag1, "ll=")[[1]][2], "&")[[1]][1] + ## manually enterred coordinates: + Longitude <- strsplit(ll1, ",")[[1]][2] + Latitude <- strsplit(ll1, ",")[[1]][1] + } else { + geo.tag2 <- geo.tag[grep(geo.tag, pattern=glob2rx("*lat=*lon=*"))] + if(!length(geo.tag2)==0){ + x <- unlist(strsplit(geo.tag2, "&")) + Longitude <- as.numeric(unlist(strsplit(x[grep(x, pattern="lon=")], "lon="))[2]) + Latitude <- as.numeric(unlist(strsplit(x[grep(x, pattern="lat=")], "lat="))[2]) + } else { + Longitude <- NA + Latitude <- NA + } + } + xml.lst[[j]] <- as.list(geo.tag) + names(xml.lst[[j]]) <- paste("url", 1:length(geo.tag), sep="") + } else { + xml.lst[[j]] <- NA + } + } + else { + stop("Currently reads only 'url', 'metadata' and 'extlinks' information.") + } + } + + names(xml.lst)[[j]] <- details[j] + } + + # rewrite metadata with the Wikimedia specs (more reliable): + xml.lst[["metadata"]]$GPSLongitude <- Longitude + xml.lst[["metadata"]]$GPSLatitude <- Latitude + xml.lst[["metadata"]]$ImageWidth <- xml.lst[["size"]]$width + xml.lst[["metadata"]]$ImageHeight <- xml.lst[["size"]]$height + + return(xml.lst) +} + # end of script; \ No newline at end of file diff --git a/pkg/R/grid2poly.R b/pkg/R/grid2poly.R index b319bcd..2561c67 100644 --- a/pkg/R/grid2poly.R +++ b/pkg/R/grid2poly.R @@ -1,3 +1,9 @@ +# Purpose : Convert SGDF/raster map to a polygon map (grid cells); +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Status : working version +# Note : Not recommended for large grids; + grid2poly <- function(obj, var.name = names(obj)[1], reproject = TRUE, method = c("sp", "raster", "RSAGA")[1], tmp.file = TRUE, saga_lib = "shapes_grid", saga_module = 3, silent = FALSE, ...){ # print warning: @@ -35,12 +41,13 @@ grid2poly <- function(obj, var.name = names(obj)[1], reproject = TRUE, method = else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } } - else { + + else { obj <- as(obj[var.name], "SpatialPixelsDataFrame") # pol <- as.SpatialPolygons.SpatialPixels(obj) # EJP: deprecated # pol <- SpatialPolygonsDataFrame(pol, data=data.frame(var.name = obj@data[,var.name]), match.ID=FALSE) pol = as(obj, "SpatialPolygonsDataFrame") - } + } } # Checking projection: diff --git a/pkg/R/kml.R b/pkg/R/kml.R index c2995ae..d2def74 100644 --- a/pkg/R/kml.R +++ b/pkg/R/kml.R @@ -1,3 +1,8 @@ +# Purpose : Generic methods to produce a KML from a sp/raster-type objects +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Tomislav Hengl (tom.hengl@wur.nl); +# Dev Status : Alpha +# Note : kml.Spatial function can only be called on a single spatial object; kml.Spatial <- function( obj, diff --git a/pkg/R/kml.tiles.R b/pkg/R/kml.tiles.R index 9385335..a55f259 100644 --- a/pkg/R/kml.tiles.R +++ b/pkg/R/kml.tiles.R @@ -1,105 +1,110 @@ - -kml.tiles <- function(obj, - folder.name, - file.name, - block.x, - kml.logo, - cpus, - home.url=".", - desc=NULL, - open.kml=TRUE, - return.list=FALSE, - ...){ - - if(missing(folder.name)){ folder.name <- normalizeFilename(deparse(substitute(obj))) } - if(missing(file.name)){ file.name <- paste(normalizeFilename(deparse(substitute(obj))), ".kml", sep="") } - - ## check class of object: - if(any(!(class(obj)=="SpatialPointsDataFrame"|class(obj)=="SpatialLinesDataFrame"|class(obj)=="SpatialPolygonsDataFrame"))){ - stop("Object of class SpatialPoints*, SpatialLines*, SpatialPolygons* expected") - } - ## reproject if necessary: - prj.check <- check_projection(obj, control = TRUE) - if(!prj.check) { suppressMessages( obj <- reproject(obj) ) } - ## tile object: - if(requireNamespace("landmap", quietly = TRUE)){ - if(any(class(obj)=="SpatialPointsDataFrame")){ - obj.lst <- landmap::tile(obj, block.x=block.x) - } else { - obj.lst <- landmap::tile(obj, block.x=block.x, tmp.file = TRUE) - } - ## some tiles might be empty and need to be removed... - obj.lst <- obj.lst[sapply(obj.lst, length)>0] - } else { - stop("Install and load package 'landmap'") - } - ## list of bounding boxes: - file.lst <- sapply(1:length(obj.lst), function(j){paste0(folder.name, "_T", j, ".kml")}) - folder.lst <- sapply(1:length(obj.lst), function(j){paste0(folder.name, "_T", j)}) - if(any(class(obj)=="SpatialPointsDataFrame")){ - north <- sapply(obj.lst, function(j){max(slot(j, "coords")[,2])}) - south <- sapply(obj.lst, function(j){min(slot(j, "coords")[,2])}) - east <- sapply(obj.lst, function(j){max(slot(j, "coords")[,1])}) - west <- sapply(obj.lst, function(j){min(slot(j, "coords")[,1])}) - } else { - north <- sapply(obj.lst, function(j){j@bbox[2,2]}) - south <- sapply(obj.lst, function(j){j@bbox[2,1]}) - east <- sapply(obj.lst, function(j){j@bbox[1,2]}) - west <- sapply(obj.lst, function(j){j@bbox[1,1]}) - } - ## write all tiles to KML: - if(requireNamespace("snowfall", quietly = TRUE)&requireNamespace("parallel", quietly = TRUE)){ - if(missing(cpus)){ cpus <- parallel::detectCores(all.tests = FALSE, logical = FALSE) } - snowfall::sfInit(parallel=TRUE, cpus=cpus) - ## this might take a lot of RAM... - snowfall::sfExportAll() - snowfall::sfLibrary(package="rgdal", character.only=TRUE) - snowfall::sfLibrary(package="sp", character.only=TRUE) - snowfall::sfLibrary(package="plotKML", character.only=TRUE) - snowfall::sfLibrary(package="XML", character.only=TRUE) - x <- snowfall::sfLapply(1:length(obj.lst), function(j){kml(obj.lst[[j]], file.name=file.lst[j], ...)}) - snowfall::sfStop() - } else { - x <- lapply(1:length(obj.lst), function(j){kml(obj.lst[j], folder.name=folder.lst[j], file.name=file.lst[j], ...)}) - } - lst <- data.frame(kml.tile=file.lst, north=north, south=south, east=east, west=west) - - kml_open(file.name) - kml.out <- get("kml.out", envir=plotKML.fileIO) - - ## add description: - if(!is.null(desc)){ - description_txt <- sprintf('', desc) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - } - ## Region and network link section: - network_txt <- sprintf(' - - %s - - - 128-1 - - - %.5f%.5f - %.5f%.5f - - - - %s - onRegion - - ', unlist(lst[["kml.tile"]]), unlist(lst[["north"]]), unlist(lst[["south"]]), unlist(lst[["east"]]), unlist(lst[["west"]]), paste(home.url, unlist(lst[["kml.tile"]]), sep="/")) - parseXMLAndAdd(network_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - if(!missing(kml.logo)){ kml_screen(image.file = kml.logo, position = "UR", sname = "logo") } - kml_close(file.name) - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - if(return.list==TRUE){ - return(obj.lst) - } +# Purpose : Generic methods to plot large vectors; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : Implemented for parallel processing; + +kml.tiles <- function(obj, + folder.name, + file.name, + block.x, + kml.logo, + cpus, + home.url=".", + desc=NULL, + open.kml=TRUE, + return.list=FALSE, + ...){ + + if(missing(folder.name)){ folder.name <- normalizeFilename(deparse(substitute(obj))) } + if(missing(file.name)){ file.name <- paste(normalizeFilename(deparse(substitute(obj))), ".kml", sep="") } + + ## check class of object: + if(any(!(class(obj)=="SpatialPointsDataFrame"|class(obj)=="SpatialLinesDataFrame"|class(obj)=="SpatialPolygonsDataFrame"))){ + stop("Object of class SpatialPoints*, SpatialLines*, SpatialPolygons* expected") + } + ## reproject if necessary: + prj.check <- check_projection(obj, control = TRUE) + if(!prj.check) { suppressMessages( obj <- reproject(obj) ) } + ## tile object: + if(requireNamespace("GSIF", quietly = TRUE)){ + if(any(class(obj)=="SpatialPointsDataFrame")){ + obj.lst <- GSIF::tile(obj, block.x=block.x) + } else { + obj.lst <- GSIF::tile(obj, block.x=block.x, tmp.file = TRUE) + } + ## some tiles might be empty and need to be removed... + obj.lst <- obj.lst[sapply(obj.lst, length)>0] + } else { + stop("Install and load package 'GSIF'") + } + ## list of bounding boxes: + file.lst <- sapply(1:length(obj.lst), function(j){paste0(folder.name, "_T", j, ".kml")}) + folder.lst <- sapply(1:length(obj.lst), function(j){paste0(folder.name, "_T", j)}) + if(any(class(obj)=="SpatialPointsDataFrame")){ + north <- sapply(obj.lst, function(j){max(slot(j, "coords")[,2])}) + south <- sapply(obj.lst, function(j){min(slot(j, "coords")[,2])}) + east <- sapply(obj.lst, function(j){max(slot(j, "coords")[,1])}) + west <- sapply(obj.lst, function(j){min(slot(j, "coords")[,1])}) + } else { + north <- sapply(obj.lst, function(j){j@bbox[2,2]}) + south <- sapply(obj.lst, function(j){j@bbox[2,1]}) + east <- sapply(obj.lst, function(j){j@bbox[1,2]}) + west <- sapply(obj.lst, function(j){j@bbox[1,1]}) + } + ## write all tiles to KML: + if(requireNamespace("snowfall", quietly = TRUE)&requireNamespace("parallel", quietly = TRUE)){ + if(missing(cpus)){ cpus <- parallel::detectCores(all.tests = FALSE, logical = FALSE) } + snowfall::sfInit(parallel=TRUE, cpus=cpus) + ## this might take a lot of RAM... + snowfall::sfExportAll() + snowfall::sfLibrary(package="rgdal", character.only=TRUE) + snowfall::sfLibrary(package="sp", character.only=TRUE) + snowfall::sfLibrary(package="plotKML", character.only=TRUE) + snowfall::sfLibrary(package="XML", character.only=TRUE) + x <- snowfall::sfLapply(1:length(obj.lst), function(j){kml(obj.lst[[j]], file.name=file.lst[j], ...)}) + snowfall::sfStop() + } else { + x <- lapply(1:length(obj.lst), function(j){kml(obj.lst[j], folder.name=folder.lst[j], file.name=file.lst[j], ...)}) + } + lst <- data.frame(kml.tile=file.lst, north=north, south=south, east=east, west=west) + + kml_open(file.name) + kml.out <- get("kml.out", envir=plotKML.fileIO) + + ## add description: + if(!is.null(desc)){ + description_txt <- sprintf('', desc) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + } + ## Region and network link section: + network_txt <- sprintf(' + + %s + + + 128-1 + + + %.5f%.5f + %.5f%.5f + + + + %s + onRegion + + ', unlist(lst[["kml.tile"]]), unlist(lst[["north"]]), unlist(lst[["south"]]), unlist(lst[["east"]]), unlist(lst[["west"]]), paste(home.url, unlist(lst[["kml.tile"]]), sep="/")) + parseXMLAndAdd(network_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + if(!missing(kml.logo)){ kml_screen(image.file = kml.logo, position = "UR", sname = "logo") } + kml_close(file.name) + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + if(return.list==TRUE){ + return(obj.lst) + } } \ No newline at end of file diff --git a/pkg/R/kml_compress.R b/pkg/R/kml_compress.R index d015c22..0fb12c6 100644 --- a/pkg/R/kml_compress.R +++ b/pkg/R/kml_compress.R @@ -1,16 +1,18 @@ +# Purpose : Compresses KML file using the system zip program; +# Maintainer : Dylan Beaudette (debeaudette@ucdavis.edu); +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Tomislav Hengl (tom.hengl@wur.nl); +# Status : pre-alpha +# Note : requires an internal or external ZIP program (If it is missing, then you need to install zip program and add a path to the zipping command line exe in "/etc/Renviron"); + kml_compress <- function(file.name, zip = Sys.getenv("R_ZIPCMD", "zip"), files = "", rm = FALSE, ...){ # Changing the extension to KMZ - extension <- tools::file_ext(file.name) - kmz <- stringr::str_replace(file.name, extension, "kmz") # switch the extension to kmz + extension <- file_ext(file.name) + kmz <- str_replace(file.name, extension, "kmz") # switch the extension to kmz # use R's zip wrapper - if(.Platform$OS.type == "windows") { - try( x <- zip(zipfile = utils::shortPathName(kmz), files= utils::shortPathName(file.name), zip = zip) ) - } else { - try( x <- zip(zipfile = kmz, files= file.name, zip = zip) ) - } + try(x <- zip(zipfile=paste(getwd(), kmz, sep='/'), files=paste(getwd(), file.name, sep='/'), zip=zip)) # Error handling if(is(.Last.value, "try-error")| x==127) { if(zip==""|!nzchar(zip)){ @@ -23,7 +25,7 @@ kml_compress <- function(file.name, zip = Sys.getenv("R_ZIPCMD", "zip"), files = # clean-up if (file.exists(kmz) & rm==TRUE) { x <- file.remove(file.name, files) - } + } } diff --git a/pkg/R/kml_description.R b/pkg/R/kml_description.R index 9cbeb0b..be98a91 100644 --- a/pkg/R/kml_description.R +++ b/pkg/R/kml_description.R @@ -1,39 +1,44 @@ -# Note: Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/]; - -## Write metadata to a KML file: -kml_description <- function( - x, # data.frame - iframe = NULL, - caption = "Object summary", - fix.enc = TRUE, - cwidth = 150, - twidth = 300, - delim.sign = "_", - asText = FALSE - ){ - - if(!is.null(iframe)){ - l1 <- newXMLNode("iframe", attrs=c(src = iframe, width=twidth*2)) - } - else { - - if(ncol(x)>2){ warning("Only first two columns will be printed in the description tag") } - - # write to html: - l1 <- newXMLNode("table", attrs=c(width=twidth, border="0", cellspacing="5", cellpadding="10")) - l2 <- newXMLNode("caption", caption, parent = l1) - txt <- sprintf('
%s:
%s
', rep(cwidth, nrow(x)), paste(x[,1]), paste(x[,2])) - parseXMLAndAdd(txt, l1) - } - - if(asText==TRUE){ - md.txt <- saveXML(l1) - return(md.txt) - } - else { - return(l1) - } - -} - +# Purpose : Insertion of table data into a KML file (HTML text) +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Dev Status : Pre-Alpha +# Note : Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/]; + + +## Write metadata to a KML file: +kml_description <- function( + x, # data.frame + iframe = NULL, + caption = "Object summary", + fix.enc = TRUE, + cwidth = 150, + twidth = 300, + delim.sign = "_", + asText = FALSE + ){ + + if(!is.null(iframe)){ + l1 <- newXMLNode("iframe", attrs=c(src = iframe, width=twidth*2)) + } + else { + + if(ncol(x)>2){ warning("Only first two columns will be printed in the description tag") } + + # write to html: + l1 <- newXMLNode("table", attrs=c(width=twidth, border="0", cellspacing="5", cellpadding="10")) + l2 <- newXMLNode("caption", caption, parent = l1) + txt <- sprintf('
%s:
%s
', rep(cwidth, nrow(x)), paste(x[,1]), paste(x[,2])) + parseXMLAndAdd(txt, l1) + } + + if(asText==TRUE){ + md.txt <- saveXML(l1) + return(md.txt) + } + else { + return(l1) + } + +} + # end of script; \ No newline at end of file diff --git a/pkg/R/kml_metadata.R b/pkg/R/kml_metadata.R index 78fb53e..3a96d2a 100644 --- a/pkg/R/kml_metadata.R +++ b/pkg/R/kml_metadata.R @@ -1,63 +1,67 @@ -# Note: Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/]; - -## summary for an object of type "SpatialMetadata": -.summary.metadata <- function(object, sel, fix.enc = TRUE, full.names = "", delim.sign){ - - if(full.names == ""){ - full.names = read.csv(system.file("mdnames.csv", package="plotKML")) - } - - nx <- unlist(xmlToList(object@xml)) - ## convert to a table: - if(!missing(delim.sign)){ - nxn <- gsub("\\.", delim.sign, attr(nx, "names")) - } else { - nxn <- attr(nx, "names") - } - met <- data.frame(metadata=nxn, value=paste(nx), stringsAsFactors = FALSE) - ## add more friendly names: - metm <- merge(x=met, y=full.names[,c("metadata","field.names")], by="metadata", all.x=TRUE) - - ## selected columns: - if(missing(sel)) { - sel = get("metadata_sel", envir = plotKML.opts) - } - selm <- data.frame(metadata = sel, order.no=1:length(sel)) - md <- merge(selm, metm, by="metadata", all.x=TRUE) - md <- md[order(md$order.no),] - - ## fix encoding: - if(fix.enc==TRUE){ - md <- data.frame(lapply(md, iconv, to = "UTF8")) - } - - return(md) -} - -setMethod("summary", signature(object = "SpatialMetadata"), definition=.summary.metadata) - - -## Write metadata to a KML file: -setMethod("kml_metadata", signature(obj = "SpatialMetadata"), function(obj, cwidth = 150, twidth = 500, asText = FALSE){ - - md <- .summary.metadata(obj) - if(!nrow(md)==0){ - # write to html: - l1 <- newXMLNode("table", attrs=c(width=twidth, border="0", cellspacing="5", cellpadding="10")) - l2 <- newXMLNode("caption", "Spatial metadata summary:", parent = l1) - txt <- sprintf('
%s
%s
', rep(cwidth, nrow(md)), paste(md$field.names), paste(md$value)) - parseXMLAndAdd(txt, l1) - - if(asText==TRUE){ - md.txt <- saveXML(l1) - return(md.txt) - } - else { - return(l1) - } - } else { - warning("Metadata contains no elements. See 'spMetadata-method' for more info.") - } -}) - +# Purpose : Insertion of metadata into a KML file +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Pre-Alpha +# Note : Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/]; + +## summary for an object of type "SpatialMetadata": +.summary.metadata <- function(object, sel, fix.enc = TRUE, full.names = "", delim.sign){ + + if(full.names == ""){ + full.names = read.csv(system.file("mdnames.csv", package="plotKML")) + } + + nx <- unlist(xmlToList(object@xml)) + ## convert to a table: + if(!missing(delim.sign)){ + nxn <- gsub("\\.", delim.sign, attr(nx, "names")) + } else { + nxn <- attr(nx, "names") + } + met <- data.frame(metadata=nxn, value=paste(nx), stringsAsFactors = FALSE) + ## add more friendly names: + metm <- merge(x=met, y=full.names[,c("metadata","field.names")], by="metadata", all.x=TRUE) + + ## selected columns: + if(missing(sel)) { + sel = get("metadata_sel", envir = plotKML.opts) + } + selm <- data.frame(metadata = sel, order.no=1:length(sel)) + md <- merge(selm, metm, by="metadata", all.x=TRUE) + md <- md[order(md$order.no),] + + ## fix encoding: + if(fix.enc==TRUE){ + md <- data.frame(lapply(md, iconv, to = "UTF8")) + } + + return(md) +} + +setMethod("summary", signature(object = "SpatialMetadata"), definition=.summary.metadata) + + +## Write metadata to a KML file: +setMethod("kml_metadata", signature(obj = "SpatialMetadata"), function(obj, cwidth = 150, twidth = 500, asText = FALSE){ + + md <- .summary.metadata(obj) + if(!nrow(md)==0){ + # write to html: + l1 <- newXMLNode("table", attrs=c(width=twidth, border="0", cellspacing="5", cellpadding="10")) + l2 <- newXMLNode("caption", "Spatial metadata summary:", parent = l1) + txt <- sprintf('
%s
%s
', rep(cwidth, nrow(md)), paste(md$field.names), paste(md$value)) + parseXMLAndAdd(txt, l1) + + if(asText==TRUE){ + md.txt <- saveXML(l1) + return(md.txt) + } + else { + return(l1) + } + } else { + warning("Metadata contains no elements. See 'spMetadata-method' for more info.") + } +}) + # end of script; \ No newline at end of file diff --git a/pkg/R/kml_open.R b/pkg/R/kml_open.R index 9d70434..485a1b9 100644 --- a/pkg/R/kml_open.R +++ b/pkg/R/kml_open.R @@ -1,3 +1,8 @@ +# Purpose : Open and close KML file; +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Tomislav Hengl (tom.hengl@wur.nl); +# Status : tested (but not on the MacOS / Linux) +# Note : See [http://code.google.com/apis/kml/documentation/kmlreference.html] for more info. kml_open <- function( file.name, @@ -53,7 +58,7 @@ kml_View <- function(file.name){ x <- NULL # set default value for error checking if(!inherits(try({ x <- utils::readRegistry(ext, hive="HCR") }, silent = TRUE), "try-error")){ if(! is.null(x[which(names(x) %in% c('Content Type', '(Default)'))])){ - system(paste("open ", utils::shortPathName(file.name), sep="")) + system(paste("open ", utils::shortPathName(normalizePath(paste(getwd(), "/", file.name, sep=""))), sep="")) } } else{ @@ -63,16 +68,17 @@ kml_View <- function(file.name){ else { if(length(grep("mac.binary", .Platform$pkgType))>0){ - if(inherits( try(system(paste("open ", utils::shortPathName(file.name), sep="")), silent = TRUE), "try-error")){ + if(inherits( try(system(paste("open ", normalizePath(paste(getwd(), "/", file.name, sep="")), sep="")), silent = TRUE), "try-error")){ warning(paste("'open' resulted in a try-error. Consider re-installing the default", ext, "browser.")) } } else{ ## http://askubuntu.com/questions/101965/what-is-the-replacement-for-gnome-open-in-gnome - if(inherits( try(system(paste("xdg-open ", file.name, sep="")), silent = TRUE), "try-error")){ + if(inherits( try(system(paste("xdg-open ", normalizePath(paste(getwd(), "/", file.name, sep="")), sep="")), silent = TRUE), "try-error")){ warning(paste("'xdg-open' resulted in a try-error. Consider re-installing the default", ext, "browser.")) } } } } +# end of script; diff --git a/pkg/R/kml_screen.R b/pkg/R/kml_screen.R index f8f2e12..c8e16c6 100644 --- a/pkg/R/kml_screen.R +++ b/pkg/R/kml_screen.R @@ -1,46 +1,51 @@ -# Note: for more info see [http://code.google.com/apis/kml/documentation/kmlreference.html#screenoverlay]; - -kml_screen <- function( - image.file, - sname = "", - position = c("UL","ML","LL","BC","LR","MR","UR","TC")[1], - overlayXY, - screenXY, - xyunits = c("fraction", "pixels", "insetPixels")[1], - rotation = 0, - size = c(0,0) - ){ - - # get our invisible file connection from custom evnrionment - kml.out <- get("kml.out", envir=plotKML.fileIO) - - # if nothing is specified estimate position of the overlay based on "position": - if(position=="UL"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0" y="1"'; screenXY = 'x="0" y="1"' } - if(position=="ML"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0" y="0.5"'; screenXY = 'x="0" y="0.5"' } - if(position=="LL"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0" y="0"'; screenXY = 'x="0" y="0"' } - if(position=="BC"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0.5" y="0"'; screenXY = 'x="0.5" y="0"' } - if(position=="LR"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="1" y="0"'; screenXY = 'x="1" y="0"' } - if(position=="MR"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="1" y="0.5"'; screenXY = 'x="1" y="0.5"' } - if(position=="UR"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="1" y="1"'; screenXY = 'x="1" y="1"' } - if(position=="TC"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0.5" y="1"'; screenXY = 'x="0.5" y="1"' } - - # Parse KML code: - if(size[1] == 0&size[2] == 0&rotation == 0){ - screen_txt <- sprintf('%s%s', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits) - } - else { if(size[1] == 0&size[2] == 0&rotation != 0){ - screen_txt <- sprintf('%s%s%.1f', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits, rotation) - } - else { if(size[1] != 0&size[2] != 0&rotation == 0){ - screen_txt <- sprintf('%s%s', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits, size[1], size[2], xyunits, xyunits) - } - else { - screen_txt <- sprintf('%s%s%.1f', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits, size[1], size[2], xyunits, xyunits, rotation) - }}} - - parseXMLAndAdd(screen_txt, parent=kml.out[["Document"]]) - - # save to a connection: - assign('kml.out', kml.out, envir=plotKML.fileIO) - +# Purpose : Adds different types of screen overlays to KML; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl) +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : for more info see [http://code.google.com/apis/kml/documentation/kmlreference.html#screenoverlay]; + + +kml_screen <- function( + image.file, + sname = "", + position = c("UL","ML","LL","BC","LR","MR","UR","TC")[1], + overlayXY, + screenXY, + xyunits = c("fraction", "pixels", "insetPixels")[1], + rotation = 0, + size = c(0,0) + ){ + + # get our invisible file connection from custom evnrionment + kml.out <- get("kml.out", envir=plotKML.fileIO) + + # if nothing is specified estimate position of the overlay based on "position": + if(position=="UL"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0" y="1"'; screenXY = 'x="0" y="1"' } + if(position=="ML"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0" y="0.5"'; screenXY = 'x="0" y="0.5"' } + if(position=="LL"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0" y="0"'; screenXY = 'x="0" y="0"' } + if(position=="BC"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0.5" y="0"'; screenXY = 'x="0.5" y="0"' } + if(position=="LR"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="1" y="0"'; screenXY = 'x="1" y="0"' } + if(position=="MR"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="1" y="0.5"'; screenXY = 'x="1" y="0.5"' } + if(position=="UR"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="1" y="1"'; screenXY = 'x="1" y="1"' } + if(position=="TC"&missing(screenXY)&missing(overlayXY)){ overlayXY = 'x="0.5" y="1"'; screenXY = 'x="0.5" y="1"' } + + # Parse KML code: + if(size[1] == 0&size[2] == 0&rotation == 0){ + screen_txt <- sprintf('%s%s', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits) + } + else { if(size[1] == 0&size[2] == 0&rotation != 0){ + screen_txt <- sprintf('%s%s%.1f', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits, rotation) + } + else { if(size[1] != 0&size[2] != 0&rotation == 0){ + screen_txt <- sprintf('%s%s', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits, size[1], size[2], xyunits, xyunits) + } + else { + screen_txt <- sprintf('%s%s%.1f', sname, image.file, overlayXY, xyunits, xyunits, screenXY, xyunits, xyunits, size[1], size[2], xyunits, xyunits, rotation) + }}} + + parseXMLAndAdd(screen_txt, parent=kml.out[["Document"]]) + + # save to a connection: + assign('kml.out', kml.out, envir=plotKML.fileIO) + } \ No newline at end of file diff --git a/pkg/R/layer.Raster.R b/pkg/R/layer.Raster.R index 04fdf73..a54f1b9 100755 --- a/pkg/R/layer.Raster.R +++ b/pkg/R/layer.Raster.R @@ -1,3 +1,8 @@ +# Purpose : Write a raster layer to KML; +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : Rasters can also be written as polygons; see "?grid2poly"; kml_layer.Raster <- function( obj, @@ -16,14 +21,10 @@ kml_layer.Raster <- function( ){ ## PNG type if(missing(png.type)){ - if(capabilities('cairo')){ - if(.Platform$OS.type == "windows") { - png.type = "cairo-png" - } else { - png.type = "cairo" - } + if(.Platform$OS.type == "windows") { + png.type = "cairo-png" } else { - png.type = "quartz" + png.type = "cairo" } } @@ -139,11 +140,11 @@ kml_layer.Raster <- function( dev.off() ## There is a bug in Google Earth that does not allow transparency of PNGs: - # https://groups.google.com/group/earth-free/browse_thread/thread/1cd6bc29a2b6eb76/62724be63547fab7 + # http://groups.google.com/group/earth-free/browse_thread/thread/1cd6bc29a2b6eb76/62724be63547fab7 # Solution: add transparency using ImageMagick: convert <- get("convert", envir = plotKML.opts) if(nchar(convert)==0){ - plotKML.env(show.env = FALSE) + plotKML.env(silent = FALSE, show.env = FALSE) convert <- get("convert", envir = plotKML.opts) } else { # if it does manages to find ImageMagick: diff --git a/pkg/R/layer.RasterBrick.R b/pkg/R/layer.RasterBrick.R index 4cb4a50..dfa795d 100644 --- a/pkg/R/layer.RasterBrick.R +++ b/pkg/R/layer.RasterBrick.R @@ -1,4 +1,8 @@ -# Note: this function is only suitable for writing time-series of data i.e. multiple realizations of the same variables; we assume that the time dimension is set via the @zvalue slot; +# Purpose : Writes a time series of rasters to a KML (all with the same legend); +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : this function is only suitable for writing time-series of data i.e. multiple realizations of the same variables; we assume that the time dimension is set via the @zvalue slot; kml_layer.RasterBrick <- function( obj, @@ -20,16 +24,13 @@ kml_layer.RasterBrick <- function( ){ ## PNG type if(missing(png.type)){ - if(capabilities('cairo')){ - if(.Platform$OS.type == "windows") { - png.type = "cairo-png" - } else { - png.type = "cairo" - } + if(.Platform$OS.type == "windows") { + png.type = "cairo-png" } else { - png.type = "quartz" + png.type = "cairo" } } + if(!is.numeric(obj@data@values)){ stop('Values of class "numeric" required.') } diff --git a/pkg/R/layer.STIDF.R b/pkg/R/layer.STIDF.R index dc30e32..c9a51b9 100644 --- a/pkg/R/layer.STIDF.R +++ b/pkg/R/layer.STIDF.R @@ -1,54 +1,58 @@ -# Note: This method works only with the Space time irregular data frame class objects from the spacetime package; - -kml_layer.STIDF <- function( - obj, - dtime, - ... - ){ - - ## Format the time slot for writing to KML: - TimeSpan.begin = format(time(obj@time), "%Y-%m-%dT%H:%M:%SZ") - if(missing(dtime)){ - TimeSpan.end = format(obj@endTime, "%Y-%m-%dT%H:%M:%SZ") ## time support BG: all ST* objects now have a slot "endTime" - } else { - TimeSpan.end <- format(as.POSIXct(unclass(as.POSIXct(time(obj@time))) + dtime, origin="1970-01-01"), "%Y-%m-%dT%H:%M:%SZ") - } - - # Check the data type: - if(is(obj@sp, "SpatialPixels")) { - ## construct stack of rasters: - r <- brick(lapply(unique(index(obj@time)), - function(x) { - raster(obj[,index(obj@time) %in% x, drop=TRUE]) - })) - r <- setZ(r, as.character(unique(index(obj@time)))) - if(missing(dtime)){ - dtime <- unique(index(obj@time)) - unique(as.Date(obj@endTime)) - units(dtime) <- "secs" - } - kml_layer.RasterBrick(obj = r, dtime=as.numeric(dtime), ...) - } else { - if(is(obj@sp, "SpatialPoints")) { - sp <- SpatialPointsDataFrame(obj@sp, obj@data) - kml_layer.SpatialPoints(obj = sp, TimeSpan.begin = TimeSpan.begin, TimeSpan.end = TimeSpan.end, ...) - } else { - if(class(obj@sp)=="SpatialPolygons"|class(obj@sp)=="SpatialPolygonsDataFrame"){ - sp <- SpatialPolygonsDataFrame(obj@sp, obj@data) - kml_layer.SpatialPolygons(obj = sp, TimeSpan.begin = TimeSpan.begin, TimeSpan.end = TimeSpan.end, ...) - } else { - if(class(obj@sp)=="SpatialLines"|class(obj@sp)=="SpatialLinesDataFrame"){ - sp <- SpatialLinesDataFrame(obj@sp, obj@data) - kml_layer.SpatialLines(obj = sp, TimeSpan.begin = TimeSpan.begin, TimeSpan.end = TimeSpan.end, ...) - } else { - stop("The 'sp' slot of the ST-object does not extend SpatialPoints*, SpatialLines* or SpatialPolygons*") - } - } - } - } -} - -setMethod("kml_layer", "STIDF", kml_layer.STIDF) -setMethod("kml_layer", "STFDF", function(obj, ...) kml_layer.STIDF(as(obj, "STIDF"), ...)) -setMethod("kml_layer", "STSDF", function(obj, ...) kml_layer.STIDF(as(obj, "STIDF"), ...)) - +# Purpose : Writing of irregular space-time objects to KML +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Benedikt Graeler (ben.graeler@uni-muenster.de), Pierre Roudier (pierre.roudier@landcare.nz); Edzer Pebesma (edzer.pebesma@uni-muenster.de); +# Status : Alpha +# Note : This method works only with the Space time irregular data frame class objects from the spacetime package; + +kml_layer.STIDF <- function( + obj, + dtime, + ... + ){ + + ## Format the time slot for writing to KML: + TimeSpan.begin = format(time(obj@time), "%Y-%m-%dT%H:%M:%SZ") + if(missing(dtime)){ + TimeSpan.end = format(obj@endTime, "%Y-%m-%dT%H:%M:%SZ") ## time support BG: all ST* objects now have a slot "endTime" + } else { + TimeSpan.end <- format(as.POSIXct(unclass(as.POSIXct(time(obj@time))) + dtime, origin="1970-01-01"), "%Y-%m-%dT%H:%M:%SZ") + } + + # Check the data type: + if(is(obj@sp, "SpatialPixels")) { + ## construct stack of rasters: + r <- brick(lapply(unique(index(obj@time)), + function(x) { + raster(obj[,index(obj@time) %in% x, drop=TRUE]) + })) + r <- setZ(r, as.character(unique(index(obj@time)))) + if(missing(dtime)){ + dtime <- unique(index(obj@time)) - unique(as.Date(obj@endTime)) + units(dtime) <- "secs" + } + kml_layer.RasterBrick(obj = r, dtime=as.numeric(dtime), ...) + } else { + if(is(obj@sp, "SpatialPoints")) { + sp <- SpatialPointsDataFrame(obj@sp, obj@data) + kml_layer.SpatialPoints(obj = sp, TimeSpan.begin = TimeSpan.begin, TimeSpan.end = TimeSpan.end, ...) + } else { + if(class(obj@sp)=="SpatialPolygons"|class(obj@sp)=="SpatialPolygonsDataFrame"){ + sp <- SpatialPolygonsDataFrame(obj@sp, obj@data) + kml_layer.SpatialPolygons(obj = sp, TimeSpan.begin = TimeSpan.begin, TimeSpan.end = TimeSpan.end, ...) + } else { + if(class(obj@sp)=="SpatialLines"|class(obj@sp)=="SpatialLinesDataFrame"){ + sp <- SpatialLinesDataFrame(obj@sp, obj@data) + kml_layer.SpatialLines(obj = sp, TimeSpan.begin = TimeSpan.begin, TimeSpan.end = TimeSpan.end, ...) + } else { + stop("The 'sp' slot of the ST-object does not extend SpatialPoints*, SpatialLines* or SpatialPolygons*") + } + } + } + } +} + +setMethod("kml_layer", "STIDF", kml_layer.STIDF) +setMethod("kml_layer", "STFDF", function(obj, ...) kml_layer.STIDF(as(obj, "STIDF"), ...)) +setMethod("kml_layer", "STSDF", function(obj, ...) kml_layer.STIDF(as(obj, "STIDF"), ...)) + # end of script; \ No newline at end of file diff --git a/pkg/R/layer.STTDF.R b/pkg/R/layer.STTDF.R index 94314bd..2e22568 100644 --- a/pkg/R/layer.STTDF.R +++ b/pkg/R/layer.STTDF.R @@ -1,160 +1,164 @@ -# Note: This method works only with the Space time irregular data frame class objects from the spacetime package; see also how Time Stamps work at [http://kml-samples.googlecode.com] - -kml_layer.STTDF <- function( - obj, - id.name = names(obj@data)[which(names(obj@data)=="burst")], # trajectory ID column - ## TH: Normally we should be able to pass the ID column via "labels" - dtime, # time support - extrude = FALSE, - # tessellate = FALSE, - start.icon = paste(get("home_url", envir = plotKML.opts), "3Dballyellow.png", sep=""), - end.icon = paste(get("home_url", envir = plotKML.opts), "golfhole.png", sep=""), - LabelScale = .8*get("LabelScale", envir = plotKML.opts), - z.scale = 1, - metadata = NULL, - html.table = NULL, - ... - ){ - - # Get our invisible file connection from custom environment - kml.out <- get('kml.out', envir=plotKML.fileIO) - - # Checking the projection is geo - prj.check <- check_projection(obj@sp, control = TRUE) - - # Trying to reproject data if the check was not successful - if (!prj.check) { obj@sp <- reproject(obj@sp) } - - # Parsing the call for aesthetics - aes <- kml_aes(obj, ...) - - # Read the relevant aesthetics: - lines_names <- aes[["labels"]] - colours <- aes[["colour"]] - width <- aes[["width"]] - altitudeMode <- aes[["altitudeMode"]] - balloon <- aes[["balloon"]] - - # object ID names: - lv <- levels(as.factor(obj@data[,id.name])) - line.colours <- hex2kml(brewer.pal(n=2+length(lv), name = "Set1")) - ## names of the coordinate columns: - nc <- lapply(obj@traj, FUN=function(x){attr(x@sp@coords, "dimname")[[2]]}) - ## strip times: - xt <- as.POSIXct(unlist(lapply(lapply(obj@traj, slot, "time"), time)), origin="1970-01-01") - - ## Format the time slot for writing to KML: - if(missing(dtime)) { - when <- format(xt, "%Y-%m-%dT%H:%M:%SZ") - dtime = 0 - } else { - ## Begin end times: - TimeSpan.begin <- format(xt, "%Y-%m-%dT%H:%M:%SZ") - TimeSpan.end <- format(as.POSIXct(unclass(xt) + dtime, origin="1970-01-01"), "%Y-%m-%dT%H:%M:%SZ") - } - - # Parse ATTRIBUTE TABLE (for each placemark): - if (balloon & ("data" %in% slotNames(obj))){ - html.table <- .df2htmltable(obj@data) - } - - # Name of the object - pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) - - # Insert metadata: - if(!is.null(metadata)){ - md.txt <- kml_metadata(metadata, asText = TRUE) - txt <- sprintf('', md.txt) - parseXMLAndAdd(txt, parent=pl1) - } - - # Sorting lines - # ============= - - current.line.coords <- NULL - ldist <- NULL - coords <- NULL - - for (i.line in 1:length(lv)) { # for each line - - cfd <- data.frame(coordinates(obj@traj[[i.line]])) - # convert to line objects (this assumes that the points are sorted chronologically!) - cl <- Line(cfd) - # line length: - ldist[[i.line]] <- LineLength(cl, longlat=TRUE, sum=TRUE) - current.line.coords[[i.line]] <- cfd[,nc[[i.line]]] - if(length(nc[[i.line]])<3){ - current.line.coords[[i.line]][,3] <- rep(0, length(cfd[,1])) - } - current.line.coords[[i.line]][,3] <- current.line.coords[[i.line]][,3] * z.scale - # parse coordinates: - coords[[i.line]] <- paste(current.line.coords[[i.line]][, 1], ',', current.line.coords[[i.line]][, 2], ',', current.line.coords[[i.line]][,3], collapse='\n ', sep = "") - } - - # Styles - lines: - # ====== - message("Writing to KML...") - txts <- sprintf('', 1:length(lv), line.colours[1:length(lv)], width[1:length(lv)]) - parseXMLAndAdd(txts, parent=pl1) - - # Styles - points: - # ====== - nt <- sapply(current.line.coords, nrow) - - nx <- 0 - for (i.line in 1:length(lv)) { - # for each line: - nx <- nx + nt[i.line] - n1 <- nx - nt[i.line] - txtsp <- sprintf('', (n1+1):(nx-1), colours[(n1+1):(nx-1)], rep(LabelScale, nt[i.line]-1), rep(start.icon, nt[i.line]-1)) - parseXMLAndAdd(txtsp, parent=pl1) - # the last point: - txtspl <- sprintf('', nx, colours[nx], LabelScale*2.5, end.icon) - parseXMLAndAdd(txtspl, parent=pl1) - } - - # Writing observed vertices - # ============= - - # for each line: - nx <- 0 - - for (i.line in 1:length(lv)) { - pl2 = newXMLNode("Folder", parent=pl1) - pl3 <- newXMLNode("name", lv[i.line], parent = pl2) - - nx <- nx + nt[i.line] - n1 <- nx - nt[i.line] - # Parse point coordinates: - ## TH: I do not know how to make the following code more compact. - if(length(html.table)>0 & all(dtime==0)){ # with attributes / point temporal support - txtl <- sprintf('#pnt_%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, html.table[(n1+1):nx], when[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) - } - else { - if(length(html.table)>0 & any(!dtime==0)){ # with attributes / block temporal support - txtl <- sprintf('#pnt_%s%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, html.table[(n1+1):nx], TimeSpan.begin[(n1+1):nx], TimeSpan.end[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) - } - else { - if(is.null(html.table) & any(!dtime==0)){ # no attributes / block temporal support - txtl <- sprintf('#pnt_%s%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, TimeSpan.begin[(n1+1):nx], TimeSpan.end[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) - } - else { # no attributes / point temporal support - txtl <- sprintf('#pnt_%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, when[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) - }}} - - parseXMLAndAdd(txtl, parent=pl2) - } - - # Writing Lines - # ============= - txtl <- sprintf('length: %.2f#line_%s%s%s', unlist(ldist), 1:length(lv), rep(altitudeMode, length(lv)), paste(unlist(coords))) - - parseXMLAndAdd(txtl, parent=pl1) - - # save results: - assign('kml.out', kml.out, envir=plotKML.fileIO) -} - -setMethod("kml_layer", "STTDF", kml_layer.STTDF) - -# end of script; +# Purpose : Writing of Trajectory-type objects to KML +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : Alpha +# Note : This method works only with the Space time irregular data frame class objects from the spacetime package; see also how Time Stamps work at [http://kml-samples.googlecode.com] + +kml_layer.STTDF <- function( + obj, + id.name = names(obj@data)[which(names(obj@data)=="burst")], # trajectory ID column + ## TH: Normally we should be able to pass the ID column via "labels" + dtime, # time support + extrude = FALSE, + # tessellate = FALSE, + start.icon = paste(get("home_url", envir = plotKML.opts), "3Dballyellow.png", sep=""), + end.icon = paste(get("home_url", envir = plotKML.opts), "golfhole.png", sep=""), + LabelScale = .8*get("LabelScale", envir = plotKML.opts), + z.scale = 1, + metadata = NULL, + html.table = NULL, + ... + ){ + + # Get our invisible file connection from custom environment + kml.out <- get('kml.out', envir=plotKML.fileIO) + + # Checking the projection is geo + prj.check <- check_projection(obj@sp, control = TRUE) + + # Trying to reproject data if the check was not successful + if (!prj.check) { obj@sp <- reproject(obj@sp) } + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics: + lines_names <- aes[["labels"]] + colours <- aes[["colour"]] + width <- aes[["width"]] + altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # object ID names: + lv <- levels(as.factor(obj@data[,id.name])) + line.colours <- hex2kml(brewer.pal(n=2+length(lv), name = "Set1")) + ## names of the coordinate columns: + nc <- lapply(obj@traj, FUN=function(x){attr(x@sp@coords, "dimname")[[2]]}) + ## strip times: + xt <- as.POSIXct(unlist(lapply(lapply(obj@traj, slot, "time"), time)), origin="1970-01-01") + + ## Format the time slot for writing to KML: + if(missing(dtime)) { + when <- format(xt, "%Y-%m-%dT%H:%M:%SZ") + dtime = 0 + } else { + ## Begin end times: + TimeSpan.begin <- format(xt, "%Y-%m-%dT%H:%M:%SZ") + TimeSpan.end <- format(as.POSIXct(unclass(xt) + dtime, origin="1970-01-01"), "%Y-%m-%dT%H:%M:%SZ") + } + + # Parse ATTRIBUTE TABLE (for each placemark): + if (balloon & ("data" %in% slotNames(obj))){ + html.table <- .df2htmltable(obj@data) + } + + # Name of the object + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + + # Insert metadata: + if(!is.null(metadata)){ + md.txt <- kml_metadata(metadata, asText = TRUE) + txt <- sprintf('', md.txt) + parseXMLAndAdd(txt, parent=pl1) + } + + # Sorting lines + # ============= + + current.line.coords <- NULL + ldist <- NULL + coords <- NULL + + for (i.line in 1:length(lv)) { # for each line + + cfd <- data.frame(coordinates(obj@traj[[i.line]])) + # convert to line objects (this assumes that the points are sorted chronologically!) + cl <- Line(cfd) + # line length: + ldist[[i.line]] <- LineLength(cl, longlat=TRUE, sum=TRUE) + current.line.coords[[i.line]] <- cfd[,nc[[i.line]]] + if(length(nc[[i.line]])<3){ + current.line.coords[[i.line]][,3] <- rep(0, length(cfd[,1])) + } + current.line.coords[[i.line]][,3] <- current.line.coords[[i.line]][,3] * z.scale + # parse coordinates: + coords[[i.line]] <- paste(current.line.coords[[i.line]][, 1], ',', current.line.coords[[i.line]][, 2], ',', current.line.coords[[i.line]][,3], collapse='\n ', sep = "") + } + + # Styles - lines: + # ====== + message("Writing to KML...") + txts <- sprintf('', 1:length(lv), line.colours[1:length(lv)], width[1:length(lv)]) + parseXMLAndAdd(txts, parent=pl1) + + # Styles - points: + # ====== + nt <- sapply(current.line.coords, nrow) + + nx <- 0 + for (i.line in 1:length(lv)) { + # for each line: + nx <- nx + nt[i.line] + n1 <- nx - nt[i.line] + txtsp <- sprintf('', (n1+1):(nx-1), colours[(n1+1):(nx-1)], rep(LabelScale, nt[i.line]-1), rep(start.icon, nt[i.line]-1)) + parseXMLAndAdd(txtsp, parent=pl1) + # the last point: + txtspl <- sprintf('', nx, colours[nx], LabelScale*2.5, end.icon) + parseXMLAndAdd(txtspl, parent=pl1) + } + + # Writing observed vertices + # ============= + + # for each line: + nx <- 0 + + for (i.line in 1:length(lv)) { + pl2 = newXMLNode("Folder", parent=pl1) + pl3 <- newXMLNode("name", lv[i.line], parent = pl2) + + nx <- nx + nt[i.line] + n1 <- nx - nt[i.line] + # Parse point coordinates: + ## TH: I do not know how to make the following code more compact. + if(length(html.table)>0 & all(dtime==0)){ # with attributes / point temporal support + txtl <- sprintf('#pnt_%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, html.table[(n1+1):nx], when[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + } + else { + if(length(html.table)>0 & any(!dtime==0)){ # with attributes / block temporal support + txtl <- sprintf('#pnt_%s%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, html.table[(n1+1):nx], TimeSpan.begin[(n1+1):nx], TimeSpan.end[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + } + else { + if(is.null(html.table) & any(!dtime==0)){ # no attributes / block temporal support + txtl <- sprintf('#pnt_%s%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, TimeSpan.begin[(n1+1):nx], TimeSpan.end[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + } + else { # no attributes / point temporal support + txtl <- sprintf('#pnt_%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, when[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + }}} + + parseXMLAndAdd(txtl, parent=pl2) + } + + # Writing Lines + # ============= + txtl <- sprintf('length: %.2f#line_%s%s%s', unlist(ldist), 1:length(lv), rep(altitudeMode, length(lv)), paste(unlist(coords))) + + parseXMLAndAdd(txtl, parent=pl1) + + # save results: + assign('kml.out', kml.out, envir=plotKML.fileIO) +} + +setMethod("kml_layer", "STTDF", kml_layer.STTDF) + +# end of script; diff --git a/pkg/R/layer.SoilProfileCollection.R b/pkg/R/layer.SoilProfileCollection.R index 98c7def..9deddbd 100644 --- a/pkg/R/layer.SoilProfileCollection.R +++ b/pkg/R/layer.SoilProfileCollection.R @@ -1,292 +1,298 @@ - -## TODO: finish and integrate this into kml_layer.SoilProfileCollection -.SPC_to_images <- function(obj) { - #require(Cairo) - - # make container dir - cd <- 'images' - dir.create(cd) - - # pre-compute some values outside of the loop - ids <- profile_id(obj) - fn <- paste('soil-', ids, '.png', sep='') - fp <- paste(cd, fn, sep='/') - - # make links to images - image.links <- paste('', sep='') - - # iterate over profiles and save images - for(i in seq_along(ids)) { -# CairoPNG(file=fp[i], height=300, width=150) - png(filename=fp[i], height=300, width=150) - par(mar=c(0, 1, 0.5, 1.5)) - plot(obj[i, ], cex.names=0.75, width=0.4) - dev.off() - } - - # clean-up - unlink(cd, recursive=TRUE) -} - - -kml_layer.SoilProfileCollection <- function( - obj, - var.name, - var.min = 0, - var.scale, - site_names = profile_id(obj), - method = c("soil_block", "depth_function")[1], - block.size = 100, # in m - color.name, - z.scale = 1, - x.min, - max.depth = 300, - plot.points = TRUE, - LabelScale = get("LabelScale", envir = plotKML.opts)*.7, - IconColor = "#ff0000ff", - shape = paste(get("home_url", envir = plotKML.opts), "circlesquare.png", sep=""), - outline = TRUE, - visibility = TRUE, - extrude = TRUE, - tessellate = TRUE, - altitudeMode = "relativeToGround", - camera.distance = .01, - tilt = 90, - heading = 0, - roll = 0, - metadata = NULL, - html.table = NULL, - plot.scalebar = TRUE, - scalebar = paste(get("home_url", envir = plotKML.opts), "soilprofile_scalebar.png", sep=""), - ...) { - - # deconstruct object - h <- horizons(obj) - s <- site(obj) - sp <- as(obj, 'SpatialPoints') - - # TH: this function at the moment works only with numeric variables: - if(method=="depth_functions" & !is.numeric(h[, var.name])) { - stop('numeric variable required') - } - - # get our invisible file connection from custom evnrionment - kml.out <- get("kml.out", envir=plotKML.fileIO) - - # check the projection: - prj.check <- check_projection(sp, control = TRUE) - - # Trying to reproject data if the check was not successful - if (!prj.check){ - sp <- reproject(sp) - } - - # extract coordinates... for scale estimation - LON <- as.vector(coordinates(sp)[,1]) - LAT <- as.vector(coordinates(sp)[,2]) - - # library to estimate scaling factor - if(requireNamespace("fossil", quietly = TRUE)){ - # convert meters to decimal degrees: - new.ll <- fossil::new.lat.long(long = mean(LON), lat = mean(LAT), bearing = 90, distance = block.size/1000) - block.size <- new.ll[2] - mean(LON) - } else { - block.size <- 1/240 - warning("Failed estimating 'block.size'. Install and load package 'fossil'") - } - if(missing(x.min)){ - x.min = block.size/100 - } - - if(missing(var.scale)) { # scaling factor in x direction (estimate automatically) - var.range <- range(h[, var.name], na.rm = TRUE, finite = TRUE) - var.scale <- 0.003/diff(var.range) - if(missing(var.min)){ - var.min <- var.range[1] - (diff(var.range)/100) - } - } - - # Parsing the call for aesthetics - aes <- kml_aes(obj, ...) - - # Read the relevant aesthetics - # altitudeMode <- aes[["altitudeMode"]] - balloon <- aes[["balloon"]] - - # Folder and name of the points folder - pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) - pl2 <- newXMLNode("name", paste(class(obj)), parent = pl1) - - pl2c = newXMLNode("Folder", parent=pl1) - pl3c <- newXMLNode("name", "sites", parent = pl2c) - - # Insert metadata: - if(!is.null(metadata)){ - md.txt <- kml_metadata(metadata, asText = TRUE) - txt <- sprintf('', md.txt) - parseXMLAndAdd(txt, parent=pl1) - } - message("Writing KML...") - - if(plot.points==TRUE){ - pl2b = newXMLNode("Folder", parent=pl1) - pl3b <- newXMLNode("name", var.name, parent = pl2b) - } - - # Calculate 3D coordinates - # ========================== - - # for each site: - prof.na <- list(NULL) - coords <- as.list(rep("", length(obj))) - coords.pol <- as.list(rep("", length(obj))) - coordsB <- as.list(rep("", length(obj))) - points_names <- as.list(rep("", length(obj))) - soil_color <- as.list(rep("", length(obj))) - - for(i.site in 1:length(obj)) { - - # select columns of interest / mask out NA horizons: - prof.na[[i.site]] <- which(h[[idname(obj)]] == site_names[i.site]) - if(is.integer(prof.na[[i.site]])){ - xval <- h[prof.na[[i.site]], var.name] - htop <- h[prof.na[[i.site]], horizonDepths(obj)[1]] - hbot <- h[prof.na[[i.site]], horizonDepths(obj)[2]] - if(!(all(!is.na(htop))&all(!is.na(hbot))&!all(is.na(xval)))){ - warning(paste("Site '", site_names[i.site], "' missing upper and/or lower limits for one of the horizons", sep=""), immediate.=TRUE) - } - - if(plot.points==TRUE){ - points_names[[i.site]] <- signif(xval, 3) - - # if no color is specified use standard colors: - if(missing(color.name)){ - pal <- colorRampPalette(c("chocolate4", "darkgoldenrod1", "cornsilk")) - soil_color[[i.site]] <- col2kml(pal(length(xval))) - } - else { - soil_color[[i.site]] <- col2kml(h[prof.na[[i.site]], color.name]) - } - - # horizon centre: - Z <- max.depth - (htop+(hbot-htop)/2) - - if(method=="soil_block"){ - X <- LON[i.site] - Y <- LAT[i.site]+((block.size/2)*sqrt(2)+x.min) - } - else { - X <- round(LON[i.site]+var.scale*(xval-var.min), 6) - Y <- rep(LAT[i.site], length(prof.na[[i.site]])) - } - - coords[[i.site]] <- paste(X, ',', Y, ',', z.scale*Z, collapse='\n ', sep = "") - } - - # horizon polygons: - if(method=="soil_block"){ - Xp <- list(NULL) - Yp <- list(NULL) - Zp <- list(NULL) - XYZp <- list(NULL) - - if(length(xval)>0){ - for(i in 1:length(xval)){ - Xp[[i]] <- c(LON[i.site]-block.size/2, LON[i.site]+block.size/2, LON[i.site]+block.size/2, LON[i.site]-block.size/2, LON[i.site]-block.size/2) - Yp[[i]] <- c(LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min)) - Zp[[i]] <- c(max.depth-htop[i], max.depth-htop[i], max.depth-hbot[i], max.depth-hbot[i], max.depth-htop[i]) - XYZp[[i]] <- paste(Xp[[i]], ',', Yp[[i]], ',', z.scale*Zp[[i]], collapse='\n ', sep = "") - } - coords.pol[[i.site]] <- unlist(XYZp) - - # skyscraper: - XB <- c(LON[i.site]-block.size/2, LON[i.site]+block.size/2, LON[i.site]+block.size/2, LON[i.site]-block.size/2, LON[i.site]-block.size/2) - YB <- c(LAT[i.site]-(block.size/2)*sqrt(2), LAT[i.site]-(block.size/2)*sqrt(2), LAT[i.site]+(block.size/2)*sqrt(2), LAT[i.site]+(block.size/2)*sqrt(2), LAT[i.site]-(block.size/2)*sqrt(2)) - ZB <- rep(max.depth, 5) - coordsB[[i.site]] <- paste(XB, ',', YB, ',', z.scale*ZB, collapse='\n ', sep = "") - } - } - - else { - Xp <- round(c(as.vector(t(matrix(rep(LON[i.site]+var.scale*(xval-var.min), 2), ncol=2))), rep(LON[i.site], 2), LON[i.site]+var.scale*(xval[1]-var.min)), 6) - Yp <- rep(LAT[i.site], length(Xp)+1) - Zp <- c(as.vector(t(matrix(c(max.depth-htop, max.depth-hbot), ncol=2))), max.depth-hbot[length(hbot)], max.depth-htop[1], max.depth-htop[1]) - coords.pol[[i.site]] <- paste(Xp, ',', Yp, ',', z.scale*Zp, collapse='\n ', sep = "") - } - - } - } - - ## Parse ATTRIBUTE TABLE (for each placemark): - if ((balloon == TRUE | class(balloon) %in% c('character','numeric')) & ("horizons" %in% slotNames(obj))){ - html.table <- .df2htmltable(h[unlist(prof.na),]) - } - - if(plot.points==TRUE){ - # Point styles - # ===================== - selp <- !sapply(prof.na, function(x){length(x)==0}) - lp <- length(unlist(prof.na)) - - txts <- sprintf('', paste(1:lp), rep(LabelScale, lp), rep(IconColor, lp), rep(LabelScale, lp), rep(shape, lp)) - parseXMLAndAdd(txts, parent=pl2b) - - # Coordinates of points - # ========================== - txtc <- sprintf('%s#pnt%s%.0f%s%s', paste(unlist(points_names)), paste(1:lp), html.table, rep(as.numeric(extrude), lp), rep(altitudeMode, lp), unlist(strsplit(unlist(coords[selp]), "\n"))) - parseXMLAndAdd(txtc, parent=pl2b) - } - - # Scale bar - 59 x 2272 pixels PNG! - # =========================== - if(plot.scalebar==TRUE & method=="depth_function"){ - scalebar.size = 200*59/2272 - X1 = scalebar.size/2; X2 = -scalebar.size/2; X3 = scalebar.size/2; X4 = -scalebar.size/2 - Y1 = 0; Y2 = 0; Y3 = 0; Y4 = 0 - ALT1 = max.depth; ALT2 = max.depth; ALT3 = max.depth-200; ALT4 = max.depth-200 - coords.dae <- matrix(c(X=c(X1, X2, X3, X4), Z=c(ALT1, ALT2, ALT3, ALT4), Y=c(Y1, Y2, Y3, Y4)), ncol=3) - - # make a COLLADA file: - makeCOLLADA.rectangle(filename = "scalebar.dae", coords = coords.dae, href = scalebar) - - # locate the scale bar in space: - txtv <- sprintf('%.6f%.6f%f%.1f%.1f%.1f', LON[1], LAT[1]-camera.distance, max.depth, heading, tilt, roll) - txtm <- sprintf('monolithrelativeToGround%.5f%.5f%.0f%.1f%.1f%.1f111%s"once"%s%s', paste("scalebar", 1:length(LON), sep="_"), LON-x.min*10, LAT, rep(max.depth+100, length(LON)), rep(heading, length(LON)), rep(tilt, length(LON)), rep(roll, length(LON)), rep("scalebar.dae", length(LON)), rep(scalebar, length(LON)), rep(scalebar, length(LON))) - parseXMLAndAdd(txtm, parent=pl1) - } - - if(method=="soil_block"){ - # Polygon styles - # ===================== - txts <- sprintf('', paste(1:lp), paste(unlist(soil_color[selp])), rep(as.numeric(outline), lp)) - parseXMLAndAdd(txts, parent=pl2c) - - # Write Polygons (for each horizon) - # ========================== - txtp <- sprintf('%s#poly%s%s%s%s%s', paste(unlist(points_names)), paste(1:lp), rep(as.numeric(visibility), lp), rep(as.numeric(tessellate), lp), rep(altitudeMode, lp), paste(unlist(coords.pol[selp]))) - parseXMLAndAdd(txtp, parent=pl2c) - # tessellated Block: - txtB <- sprintf('%s%s11%s%s', site_names, rep(as.numeric(visibility), length(site_names)), rep(altitudeMode, length(site_names)), paste(unlist(coordsB))) - parseXMLAndAdd(txtB, parent=pl2c) - } - - else { - # Write Polygons (for each site) - txt <- sprintf('%s%s%s%s%s', site_names, rep(as.numeric(visibility), length(site_names)), rep(as.numeric(tessellate), length(site_names)), rep(altitudeMode, length(site_names)), paste(unlist(coords.pol))) - parseXMLAndAdd(txt, parent=pl2c) - } - - - # Add a Camera view location: - # ========================== - txtv <- sprintf('%.6f%.6f%f%.1f%.1f%.1f', LON[1], LAT[1]-camera.distance, max.depth, heading, tilt, roll) - parseXMLAndAdd(txtv, parent=pl1) - - # save results: - assign("kml.out", kml.out, envir=plotKML.fileIO) -} - - -setMethod("kml_layer", "SoilProfileCollection", kml_layer.SoilProfileCollection) - -# end of script; +# Purpose : Parsing "SoilProfileCollection" objects to KML +# Maintainer : Dylan Beaudette (debeaudette@ucdavis.edu) +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Pierre Roudier (pierre.roudier@landcare.nz); +# Status : not tested yet +# Note : plots either a histogram or blocks (horizons); + + +## TODO: finish and integrate this into kml_layer.SoilProfileCollection +.SPC_to_images <- function(obj) { + #require(Cairo) + + # make container dir + cd <- 'images' + dir.create(cd) + + # pre-compute some values outside of the loop + ids <- profile_id(obj) + fn <- paste('soil-', ids, '.png', sep='') + fp <- paste(cd, fn, sep='/') + + # make links to images + image.links <- paste('', sep='') + + # iterate over profiles and save images + for(i in seq_along(ids)) { +# CairoPNG(file=fp[i], height=300, width=150) + png(filename=fp[i], height=300, width=150) + par(mar=c(0, 1, 0.5, 1.5)) + plot(obj[i, ], cex.names=0.75, width=0.4) + dev.off() + } + + # clean-up + unlink(cd, recursive=TRUE) +} + + +kml_layer.SoilProfileCollection <- function( + obj, + var.name, + var.min = 0, + var.scale, + site_names = profile_id(obj), + method = c("soil_block", "depth_function")[1], + block.size = 100, # in m + color.name, + z.scale = 1, + x.min, + max.depth = 300, + plot.points = TRUE, + LabelScale = get("LabelScale", envir = plotKML.opts)*.7, + IconColor = "#ff0000ff", + shape = paste(get("home_url", envir = plotKML.opts), "circlesquare.png", sep=""), + outline = TRUE, + visibility = TRUE, + extrude = TRUE, + tessellate = TRUE, + altitudeMode = "relativeToGround", + camera.distance = .01, + tilt = 90, + heading = 0, + roll = 0, + metadata = NULL, + html.table = NULL, + plot.scalebar = TRUE, + scalebar = paste(get("home_url", envir = plotKML.opts), "soilprofile_scalebar.png", sep=""), + ...) { + + # deconstruct object + h <- horizons(obj) + s <- site(obj) + sp <- as(obj, 'SpatialPoints') + + # TH: this function at the moment works only with numeric variables: + if(method=="depth_functions" & !is.numeric(h[, var.name])) { + stop('numeric variable required') + } + + # get our invisible file connection from custom evnrionment + kml.out <- get("kml.out", envir=plotKML.fileIO) + + # check the projection: + prj.check <- check_projection(sp, control = TRUE) + + # Trying to reproject data if the check was not successful + if (!prj.check){ + sp <- reproject(sp) + } + + # extract coordinates... for scale estimation + LON <- as.vector(coordinates(sp)[,1]) + LAT <- as.vector(coordinates(sp)[,2]) + + # library to estimate scaling factor + if(requireNamespace("fossil", quietly = TRUE)){ + # convert meters to decimal degrees: + new.ll <- fossil::new.lat.long(long = mean(LON), lat = mean(LAT), bearing = 90, distance = block.size/1000) + block.size <- new.ll[2] - mean(LON) + } else { + block.size <- 1/240 + warning("Failed estimating 'block.size'. Install and load package 'fossil'") + } + if(missing(x.min)){ + x.min = block.size/100 + } + + if(missing(var.scale)) { # scaling factor in x direction (estimate automatically) + var.range <- range(h[, var.name], na.rm = TRUE, finite = TRUE) + var.scale <- 0.003/diff(var.range) + if(missing(var.min)){ + var.min <- var.range[1] - (diff(var.range)/100) + } + } + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics + # altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # Folder and name of the points folder + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + pl2 <- newXMLNode("name", paste(class(obj)), parent = pl1) + + pl2c = newXMLNode("Folder", parent=pl1) + pl3c <- newXMLNode("name", "sites", parent = pl2c) + + # Insert metadata: + if(!is.null(metadata)){ + md.txt <- kml_metadata(metadata, asText = TRUE) + txt <- sprintf('', md.txt) + parseXMLAndAdd(txt, parent=pl1) + } + message("Writing KML...") + + if(plot.points==TRUE){ + pl2b = newXMLNode("Folder", parent=pl1) + pl3b <- newXMLNode("name", var.name, parent = pl2b) + } + + # Calculate 3D coordinates + # ========================== + + # for each site: + prof.na <- list(NULL) + coords <- as.list(rep("", length(obj))) + coords.pol <- as.list(rep("", length(obj))) + coordsB <- as.list(rep("", length(obj))) + points_names <- as.list(rep("", length(obj))) + soil_color <- as.list(rep("", length(obj))) + + for(i.site in 1:length(obj)) { + + # select columns of interest / mask out NA horizons: + prof.na[[i.site]] <- which(h[[idname(obj)]] == site_names[i.site]) + if(is.integer(prof.na[[i.site]])){ + xval <- h[prof.na[[i.site]], var.name] + htop <- h[prof.na[[i.site]], horizonDepths(obj)[1]] + hbot <- h[prof.na[[i.site]], horizonDepths(obj)[2]] + if(!(all(!is.na(htop))&all(!is.na(hbot))&!all(is.na(xval)))){ + warning(paste("Site '", site_names[i.site], "' missing upper and/or lower limits for one of the horizons", sep=""), immediate.=TRUE) + } + + if(plot.points==TRUE){ + points_names[[i.site]] <- signif(xval, 3) + + # if no color is specified use standard colors: + if(missing(color.name)){ + pal <- colorRampPalette(c("chocolate4", "darkgoldenrod1", "cornsilk")) + soil_color[[i.site]] <- col2kml(pal(length(xval))) + } + else { + soil_color[[i.site]] <- col2kml(h[prof.na[[i.site]], color.name]) + } + + # horizon centre: + Z <- max.depth - (htop+(hbot-htop)/2) + + if(method=="soil_block"){ + X <- LON[i.site] + Y <- LAT[i.site]+((block.size/2)*sqrt(2)+x.min) + } + else { + X <- round(LON[i.site]+var.scale*(xval-var.min), 6) + Y <- rep(LAT[i.site], length(prof.na[[i.site]])) + } + + coords[[i.site]] <- paste(X, ',', Y, ',', z.scale*Z, collapse='\n ', sep = "") + } + + # horizon polygons: + if(method=="soil_block"){ + Xp <- list(NULL) + Yp <- list(NULL) + Zp <- list(NULL) + XYZp <- list(NULL) + + if(length(xval)>0){ + for(i in 1:length(xval)){ + Xp[[i]] <- c(LON[i.site]-block.size/2, LON[i.site]+block.size/2, LON[i.site]+block.size/2, LON[i.site]-block.size/2, LON[i.site]-block.size/2) + Yp[[i]] <- c(LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min), LAT[i.site]+((block.size/2)*sqrt(2)+x.min)) + Zp[[i]] <- c(max.depth-htop[i], max.depth-htop[i], max.depth-hbot[i], max.depth-hbot[i], max.depth-htop[i]) + XYZp[[i]] <- paste(Xp[[i]], ',', Yp[[i]], ',', z.scale*Zp[[i]], collapse='\n ', sep = "") + } + coords.pol[[i.site]] <- unlist(XYZp) + + # skyscraper: + XB <- c(LON[i.site]-block.size/2, LON[i.site]+block.size/2, LON[i.site]+block.size/2, LON[i.site]-block.size/2, LON[i.site]-block.size/2) + YB <- c(LAT[i.site]-(block.size/2)*sqrt(2), LAT[i.site]-(block.size/2)*sqrt(2), LAT[i.site]+(block.size/2)*sqrt(2), LAT[i.site]+(block.size/2)*sqrt(2), LAT[i.site]-(block.size/2)*sqrt(2)) + ZB <- rep(max.depth, 5) + coordsB[[i.site]] <- paste(XB, ',', YB, ',', z.scale*ZB, collapse='\n ', sep = "") + } + } + + else { + Xp <- round(c(as.vector(t(matrix(rep(LON[i.site]+var.scale*(xval-var.min), 2), ncol=2))), rep(LON[i.site], 2), LON[i.site]+var.scale*(xval[1]-var.min)), 6) + Yp <- rep(LAT[i.site], length(Xp)+1) + Zp <- c(as.vector(t(matrix(c(max.depth-htop, max.depth-hbot), ncol=2))), max.depth-hbot[length(hbot)], max.depth-htop[1], max.depth-htop[1]) + coords.pol[[i.site]] <- paste(Xp, ',', Yp, ',', z.scale*Zp, collapse='\n ', sep = "") + } + + } + } + + ## Parse ATTRIBUTE TABLE (for each placemark): + if ((balloon == TRUE | class(balloon) %in% c('character','numeric')) & ("horizons" %in% slotNames(obj))){ + html.table <- .df2htmltable(h[unlist(prof.na),]) + } + + if(plot.points==TRUE){ + # Point styles + # ===================== + selp <- !sapply(prof.na, function(x){length(x)==0}) + lp <- length(unlist(prof.na)) + + txts <- sprintf('', paste(1:lp), rep(LabelScale, lp), rep(IconColor, lp), rep(LabelScale, lp), rep(shape, lp)) + parseXMLAndAdd(txts, parent=pl2b) + + # Coordinates of points + # ========================== + txtc <- sprintf('%s#pnt%s%.0f%s%s', paste(unlist(points_names)), paste(1:lp), html.table, rep(as.numeric(extrude), lp), rep(altitudeMode, lp), unlist(strsplit(unlist(coords[selp]), "\n"))) + parseXMLAndAdd(txtc, parent=pl2b) + } + + # Scale bar - 59 x 2272 pixels PNG! + # =========================== + if(plot.scalebar==TRUE & method=="depth_function"){ + scalebar.size = 200*59/2272 + X1 = scalebar.size/2; X2 = -scalebar.size/2; X3 = scalebar.size/2; X4 = -scalebar.size/2 + Y1 = 0; Y2 = 0; Y3 = 0; Y4 = 0 + ALT1 = max.depth; ALT2 = max.depth; ALT3 = max.depth-200; ALT4 = max.depth-200 + coords.dae <- matrix(c(X=c(X1, X2, X3, X4), Z=c(ALT1, ALT2, ALT3, ALT4), Y=c(Y1, Y2, Y3, Y4)), ncol=3) + + # make a COLLADA file: + makeCOLLADA.rectangle(filename = "scalebar.dae", coords = coords.dae, href = scalebar) + + # locate the scale bar in space: + txtv <- sprintf('%.6f%.6f%f%.1f%.1f%.1f', LON[1], LAT[1]-camera.distance, max.depth, heading, tilt, roll) + txtm <- sprintf('monolithrelativeToGround%.5f%.5f%.0f%.1f%.1f%.1f111%s"once"%s%s', paste("scalebar", 1:length(LON), sep="_"), LON-x.min*10, LAT, rep(max.depth+100, length(LON)), rep(heading, length(LON)), rep(tilt, length(LON)), rep(roll, length(LON)), rep("scalebar.dae", length(LON)), rep(scalebar, length(LON)), rep(scalebar, length(LON))) + parseXMLAndAdd(txtm, parent=pl1) + } + + if(method=="soil_block"){ + # Polygon styles + # ===================== + txts <- sprintf('', paste(1:lp), paste(unlist(soil_color[selp])), rep(as.numeric(outline), lp)) + parseXMLAndAdd(txts, parent=pl2c) + + # Write Polygons (for each horizon) + # ========================== + txtp <- sprintf('%s#poly%s%s%s%s%s', paste(unlist(points_names)), paste(1:lp), rep(as.numeric(visibility), lp), rep(as.numeric(tessellate), lp), rep(altitudeMode, lp), paste(unlist(coords.pol[selp]))) + parseXMLAndAdd(txtp, parent=pl2c) + # tessellated Block: + txtB <- sprintf('%s%s11%s%s', site_names, rep(as.numeric(visibility), length(site_names)), rep(altitudeMode, length(site_names)), paste(unlist(coordsB))) + parseXMLAndAdd(txtB, parent=pl2c) + } + + else { + # Write Polygons (for each site) + txt <- sprintf('%s%s%s%s%s', site_names, rep(as.numeric(visibility), length(site_names)), rep(as.numeric(tessellate), length(site_names)), rep(altitudeMode, length(site_names)), paste(unlist(coords.pol))) + parseXMLAndAdd(txt, parent=pl2c) + } + + + # Add a Camera view location: + # ========================== + txtv <- sprintf('%.6f%.6f%f%.1f%.1f%.1f', LON[1], LAT[1]-camera.distance, max.depth, heading, tilt, roll) + parseXMLAndAdd(txtv, parent=pl1) + + # save results: + assign("kml.out", kml.out, envir=plotKML.fileIO) +} + + +setMethod("kml_layer", "SoilProfileCollection", kml_layer.SoilProfileCollection) + +# end of script; diff --git a/pkg/R/layer.SpatialLines.R b/pkg/R/layer.SpatialLines.R index 59ac25e..bea9343 100644 --- a/pkg/R/layer.SpatialLines.R +++ b/pkg/R/layer.SpatialLines.R @@ -1,115 +1,120 @@ - -kml_layer.SpatialLines <- function( - obj, - subfolder.name = paste(class(obj)), - extrude = FALSE, - z.scale = 1, - metadata = NULL, - html.table = NULL, - TimeSpan.begin = "", - TimeSpan.end = "", - ... - ){ - - # invisible file connection - kml.out <- get("kml.out", envir=plotKML.fileIO) - - # Checking the projection is geo - prj.check <- check_projection(obj, control = TRUE) - - # Trying to reproject data if the check was not successful - if (!prj.check) { obj <- reproject(obj) } - - # Parsing the call for aesthetics - aes <- kml_aes(obj, ...) - - # Read the relevant aesthetics - lines_names <- aes[["labels"]] - colours <- aes[["colour"]] - widths <- aes[["width"]] - altitude <- aes[["altitude"]] - altitudeMode <- aes[["altitudeMode"]] - balloon <- aes[["balloon"]] - - # Parse ATTRIBUTE TABLE (for each placemark): - if(balloon & ("data" %in% slotNames(obj))){ - html.table <- .df2htmltable(obj@data) - } - - message("Writing to KML...") - # Folder name / name of the points folder - pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) - pl2 <- newXMLNode("name", subfolder.name, parent = pl1) - - # Insert metadata: - if(!is.null(metadata)){ - md.txt <- kml_metadata(metadata, asText = TRUE) - txtm <- sprintf('', md.txt) - parseXMLAndAdd(txtm, parent=pl1) - } - - # process lines: - lv <- length(obj@lines) - coords <- NULL - for (i.line in 1:lv) { - xyz <- slot(slot(obj@lines[[i.line]], "Lines")[[1]], "coords") - if(ncol(xyz)==2){ xyz <- cbind(xyz, rep(altitude[i.line], nrow(xyz))) } - coords[[i.line]] <- paste(xyz[,1], ',', xyz[,2], ',', xyz[,3], collapse='\n ', sep = "") - } - - # Line styles - # ============ - txts <- sprintf('', 1:lv, colours, widths) - parseXMLAndAdd(txts, parent=pl1) - - # Writing lines - # ============= - - # with attributes: - if(length(html.table)>0){ - if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ - if(identical(TimeSpan.begin, TimeSpan.end)){ - when = TimeSpan.begin - if(length(when)==1){ when = rep(when, lv) } - txt <- sprintf('%s#line%s%s%.0f%s%s', lines_names, 1:lv, when, html.table, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) - } - else{ - if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, lv) } - if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, lv) } - txt <- sprintf('%s#line%s%s%s%.0f%s%s', lines_names, 1:lv, TimeSpan.begin, TimeSpan.end, html.table, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) - } - } - else{ - txt <- sprintf('%s#line%s%.0f%s%s', lines_names, 1:lv, html.table, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) - } - } - - # without attributes: - else{ - if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ - if(identical(TimeSpan.begin, TimeSpan.end)){ - when = TimeSpan.begin - if(length(when)==1){ when = rep(when, lv) } - txt <- sprintf('%s#line%s%s%.0f%s%s', lines_names, 1:lv, when, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) - } - else { - if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, lv) } - if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, lv) } - txt <- sprintf('%s#line%s%s%s%.0f%s%s', lines_names, 1:lv, TimeSpan.begin, TimeSpan.end, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) - } - } - else{ - txt <- sprintf('%s#line%s%.0f%s%s', lines_names, 1:lv, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) - } - } - - parseXMLAndAdd(txt, parent=pl1) - - # save results: - assign('kml.out', kml.out, envir=plotKML.fileIO) - -} - -setMethod("kml_layer", "SpatialLines", kml_layer.SpatialLines) - +# Purpose : Write line-objects (SpatialLines) to KML; +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : only 2-3 aesthetics can be used - color, width and names; + +kml_layer.SpatialLines <- function( + obj, + subfolder.name = paste(class(obj)), + extrude = FALSE, + z.scale = 1, + metadata = NULL, + html.table = NULL, + TimeSpan.begin = "", + TimeSpan.end = "", + ... + ){ + + # invisible file connection + kml.out <- get("kml.out", envir=plotKML.fileIO) + + # Checking the projection is geo + prj.check <- check_projection(obj, control = TRUE) + + # Trying to reproject data if the check was not successful + if (!prj.check) { obj <- reproject(obj) } + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics + lines_names <- aes[["labels"]] + colours <- aes[["colour"]] + widths <- aes[["width"]] + altitude <- aes[["altitude"]] + altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # Parse ATTRIBUTE TABLE (for each placemark): + if(balloon & ("data" %in% slotNames(obj))){ + html.table <- .df2htmltable(obj@data) + } + + message("Writing to KML...") + # Folder name / name of the points folder + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + pl2 <- newXMLNode("name", subfolder.name, parent = pl1) + + # Insert metadata: + if(!is.null(metadata)){ + md.txt <- kml_metadata(metadata, asText = TRUE) + txtm <- sprintf('', md.txt) + parseXMLAndAdd(txtm, parent=pl1) + } + + # process lines: + lv <- length(obj@lines) + coords <- NULL + for (i.line in 1:lv) { + xyz <- slot(slot(obj@lines[[i.line]], "Lines")[[1]], "coords") + if(ncol(xyz)==2){ xyz <- cbind(xyz, rep(altitude[i.line], nrow(xyz))) } + coords[[i.line]] <- paste(xyz[,1], ',', xyz[,2], ',', xyz[,3], collapse='\n ', sep = "") + } + + # Line styles + # ============ + txts <- sprintf('', 1:lv, colours, widths) + parseXMLAndAdd(txts, parent=pl1) + + # Writing lines + # ============= + + # with attributes: + if(length(html.table)>0){ + if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ + if(identical(TimeSpan.begin, TimeSpan.end)){ + when = TimeSpan.begin + if(length(when)==1){ when = rep(when, lv) } + txt <- sprintf('%s#line%s%s%.0f%s%s', lines_names, 1:lv, when, html.table, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) + } + else{ + if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, lv) } + if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, lv) } + txt <- sprintf('%s#line%s%s%s%.0f%s%s', lines_names, 1:lv, TimeSpan.begin, TimeSpan.end, html.table, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) + } + } + else{ + txt <- sprintf('%s#line%s%.0f%s%s', lines_names, 1:lv, html.table, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) + } + } + + # without attributes: + else{ + if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ + if(identical(TimeSpan.begin, TimeSpan.end)){ + when = TimeSpan.begin + if(length(when)==1){ when = rep(when, lv) } + txt <- sprintf('%s#line%s%s%.0f%s%s', lines_names, 1:lv, when, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) + } + else { + if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, lv) } + if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, lv) } + txt <- sprintf('%s#line%s%s%s%.0f%s%s', lines_names, 1:lv, TimeSpan.begin, TimeSpan.end, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) + } + } + else{ + txt <- sprintf('%s#line%s%.0f%s%s', lines_names, 1:lv, rep(as.numeric(extrude), lv), rep(altitudeMode, lv), paste(unlist(coords))) + } + } + + parseXMLAndAdd(txt, parent=pl1) + + # save results: + assign('kml.out', kml.out, envir=plotKML.fileIO) + +} + +setMethod("kml_layer", "SpatialLines", kml_layer.SpatialLines) + # end of script; \ No newline at end of file diff --git a/pkg/R/layer.SpatialPhotoOverlay.R b/pkg/R/layer.SpatialPhotoOverlay.R index 8a1d86f..9806cf5 100644 --- a/pkg/R/layer.SpatialPhotoOverlay.R +++ b/pkg/R/layer.SpatialPhotoOverlay.R @@ -1,177 +1,182 @@ -# Note: plots either a PhotoOverlay or a monolith (COLLADA model); - -kml_layer.SpatialPhotoOverlay <- function( - obj, - method = c("PhotoOverlay", "monolith")[1], - PhotoOverlay.shape = obj@PhotoOverlay$shape, - href = obj@filename, - coords, - dae.name = "", - heading = obj@PhotoOverlay$heading, - tilt = obj@PhotoOverlay$tilt, - roll = obj@PhotoOverlay$roll, - near = obj@PhotoOverlay$near, - range = obj@PhotoOverlay$range, - leftFov = obj@PhotoOverlay$leftFov, - rightFov = obj@PhotoOverlay$rightFov, - bottomFov = obj@PhotoOverlay$bottomFov, - topFov = obj@PhotoOverlay$topFov, - altitudeMode = "clampToGround", - block.size = 100, # about 3-arcsecs - max.depth = 300, - scale.x = 1, - scale.y = 1, - scale.z = 1, - refreshMode = "once", - html.table = NULL, - ... - ){ - - # get our invisible file connection from custom evnrionment - kml.out <- get("kml.out", envir=plotKML.fileIO) - - # check the projection: - prj.check <- check_projection(obj@sp, control = TRUE) - - # Trying to reproject data if the check was not successful - if (!prj.check) { obj@sp <- reproject(obj@sp) } - - when <- obj@exif.info[["DateTime"]] - LON <- as.vector(coordinates(obj@sp)[,1]) - LAT <- as.vector(coordinates(obj@sp)[,2]) - ALT <- as.vector(coordinates(obj@sp)[,3]) - if(ALT == 0|is.na(ALT)) { ALT = 10 } - else { - altitudeMode = "absolute" - } - - # unique image ID: - x <- strsplit(obj@filename, "/")[[1]] - image.id <- x[length(x)] - - # Parsing the call for aesthetics - aes <- kml_aes(obj, ...) - - # Read the relevant aesthetics - # altitudeMode <- aes[["altitudeMode"]] - balloon <- aes[["balloon"]] - - # Parse ATTRIBUTE TABLE (EXIF data): - if ((is.logical(balloon) | class(balloon) %in% c('character','numeric')) & ("exif.info" %in% slotNames(obj))){ - html.table <- .df2htmltable(data.frame(obj@exif.info)) - } - - # Simple PhotoOverlay - if(method == "PhotoOverlay"){ - - # Object name: - pl1 = newXMLNode("PhotoOverlay", attrs = c("id" = image.id), parent=kml.out[["Document"]]) - pl2 <- newXMLNode("name", image.id, parent = pl1) - pl2b <- newXMLNode("TimeStamp", parent = pl1) - pl3b <- newXMLNode("when", when, parent = pl2b) - # description: - txtd <- sprintf('', html.table) - parseXMLAndAdd(txtd, parent=pl1) - - # Add a Camera view location: - # ========================== - txtv <- sprintf('%.6f%.6f%f%.1f%.1f%.1f', LON, LAT, ALT, heading, tilt, roll) - parseXMLAndAdd(txtv, parent=pl1) - - pl3 <- newXMLNode("Icon", parent = pl1) - pl4 <- newXMLNode("href", href, parent = pl3) - - # Add ViewVolume info: - # ========================== - txtw <- sprintf('%s%s%s%s%s', leftFov, rightFov, bottomFov, topFov, near) - parseXMLAndAdd(txtw, parent=pl1) - - # Location of the camera - # ========================== - txtc <- sprintf('%s%.5f,%.5f,%.0f', altitudeMode, LAT, LON, ALT) - parseXMLAndAdd(txtc, parent=pl1) - - # Display type: - pl5 <- newXMLNode("shape", PhotoOverlay.shape, parent = pl1) - } - - # Block model - if(method == "monolith"){ - - # derive required input pars: - asp = obj@exif.info$ImageWidth / obj@exif.info$ImageHeight - block.height = block.size / asp - if(dae.name==""){ - dae.name = gsub(x=image.id, "\\.", "_") - } - - # make a COLLADA file: - if(missing(coords)){ - X1 = block.size/2; X2 = -block.size/2; X3 = block.size/2; X4 = -block.size/2 - Y1 = 0; Y2 = 0; Y3 = 0; Y4 = 0 - ALT1 = max.depth; ALT2 = max.depth; ALT3 = max.depth-block.height; ALT4 = max.depth-block.height - coords <- matrix(c(X=c(X1, X2, X3, X4), Z=c(ALT1, ALT2, ALT3, ALT4), Y=c(Y1, Y2, Y3, Y4)), ncol=3) - } - - makeCOLLADA.rectangle(filename = set.file.extension(dae.name, ".dae"), coords = coords, href = href) - - # Object name: - pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) - pl2 <- newXMLNode("name", image.id, parent = pl1) - # description: - txtd <- sprintf('', html.table) - parseXMLAndAdd(txtd, parent=pl1) - txtl <- sprintf('%.5f%.5f%.1f%.1f%.1f%.5frelativeToGround', LON, LAT, max.depth/2, heading, tilt, range) - parseXMLAndAdd(txtl, parent=pl1) - - # Parse the placemark: - txtm <- sprintf('monolith%srelativeToGround%.5f%.5f%.0f%.1f%.1f%.1f%.1f%.1f%.1f%s%s%s%s', when, dae.name, LON, LAT, max.depth, heading, tilt, roll, scale.x, scale.y, scale.z, set.file.extension(dae.name, ".dae"), refreshMode, href, href) - parseXMLAndAdd(txtm, parent=pl1) - } - - # save results: - assign("kml.out", kml.out, envir=plotKML.fileIO) -} - -setMethod("kml_layer", "SpatialPhotoOverlay", kml_layer.SpatialPhotoOverlay) - - -## Create a block model: -makeCOLLADA.rectangle <- function(coords, filename, href, DateTime, up_axis = "Z_UP", authoring_tool = "plotKML", technique_profile = "GOOGLEEARTH", double_sided = TRUE){ - - # coordinates of the bbox: - pnts = paste(signif(as.vector(t(coords)), 5), collapse=" ") - if(missing(DateTime)) { DateTime <- format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ") } - - # file header: - doc = newXMLDoc() - dae.out <- newXMLNode("COLLADA", attrs=c(version="1.5.0"), namespaceDefinitions = c("xmlns"="http://www.collada.org/2008/03/COLLADASchema"), parent=doc) - txta <- sprintf('%s%s%s%s', authoring_tool, DateTime, DateTime, up_axis) - parseXMLAndAdd(txta, parent=dae.out) - - # library visual scenes: - txts <- sprintf(' ', authoring_tool, DateTime, DateTime, up_axis) - parseXMLAndAdd(txts, parent=dae.out) - - # library geometries: - txtg <- sprintf('%s0 0 -1 0 0 1 -1 1

0 0 1 1 2 2 3 3 2 2 1 1

', pnts) - parseXMLAndAdd(txtg, parent=dae.out) - - # library materials: - txtm <- sprintf('') - parseXMLAndAdd(txtm, parent=dae.out) - - # library effects: - txte <- sprintf('ID5ID6%s', technique_profile, as.numeric(double_sided)) - parseXMLAndAdd(txte, parent=dae.out) - - # library images: - txti <- sprintf('%s ', href) - parseXMLAndAdd(txti, parent=dae.out) - - saveXML(doc, filename) - message(paste("Creating", filename)) - -} - +# Purpose : Parsing "SoilPhotoOverlay" objects to KML +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl) +# Contributions : ; +# Status : alpha version +# Note : plots either a PhotoOverlay or a monolith (COLLADA model); + + +kml_layer.SpatialPhotoOverlay <- function( + obj, + method = c("PhotoOverlay", "monolith")[1], + PhotoOverlay.shape = obj@PhotoOverlay$shape, + href = obj@filename, + coords, + dae.name = "", + heading = obj@PhotoOverlay$heading, + tilt = obj@PhotoOverlay$tilt, + roll = obj@PhotoOverlay$roll, + near = obj@PhotoOverlay$near, + range = obj@PhotoOverlay$range, + leftFov = obj@PhotoOverlay$leftFov, + rightFov = obj@PhotoOverlay$rightFov, + bottomFov = obj@PhotoOverlay$bottomFov, + topFov = obj@PhotoOverlay$topFov, + altitudeMode = "clampToGround", + block.size = 100, # about 3-arcsecs + max.depth = 300, + scale.x = 1, + scale.y = 1, + scale.z = 1, + refreshMode = "once", + html.table = NULL, + ... + ){ + + # get our invisible file connection from custom evnrionment + kml.out <- get("kml.out", envir=plotKML.fileIO) + + # check the projection: + prj.check <- check_projection(obj@sp, control = TRUE) + + # Trying to reproject data if the check was not successful + if (!prj.check) { obj@sp <- reproject(obj@sp) } + + when <- obj@exif.info[["DateTime"]] + LON <- as.vector(coordinates(obj@sp)[,1]) + LAT <- as.vector(coordinates(obj@sp)[,2]) + ALT <- as.vector(coordinates(obj@sp)[,3]) + if(ALT == 0|is.na(ALT)) { ALT = 10 } + else { + altitudeMode = "absolute" + } + + # unique image ID: + x <- strsplit(obj@filename, "/")[[1]] + image.id <- x[length(x)] + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics + # altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # Parse ATTRIBUTE TABLE (EXIF data): + if ((is.logical(balloon) | class(balloon) %in% c('character','numeric')) & ("exif.info" %in% slotNames(obj))){ + html.table <- .df2htmltable(data.frame(obj@exif.info)) + } + + # Simple PhotoOverlay + if(method == "PhotoOverlay"){ + + # Object name: + pl1 = newXMLNode("PhotoOverlay", attrs = c("id" = image.id), parent=kml.out[["Document"]]) + pl2 <- newXMLNode("name", image.id, parent = pl1) + pl2b <- newXMLNode("TimeStamp", parent = pl1) + pl3b <- newXMLNode("when", when, parent = pl2b) + # description: + txtd <- sprintf('', html.table) + parseXMLAndAdd(txtd, parent=pl1) + + # Add a Camera view location: + # ========================== + txtv <- sprintf('%.6f%.6f%f%.1f%.1f%.1f', LON, LAT, ALT, heading, tilt, roll) + parseXMLAndAdd(txtv, parent=pl1) + + pl3 <- newXMLNode("Icon", parent = pl1) + pl4 <- newXMLNode("href", href, parent = pl3) + + # Add ViewVolume info: + # ========================== + txtw <- sprintf('%s%s%s%s%s', leftFov, rightFov, bottomFov, topFov, near) + parseXMLAndAdd(txtw, parent=pl1) + + # Location of the camera + # ========================== + txtc <- sprintf('%s%.5f,%.5f,%.0f', altitudeMode, LAT, LON, ALT) + parseXMLAndAdd(txtc, parent=pl1) + + # Display type: + pl5 <- newXMLNode("shape", PhotoOverlay.shape, parent = pl1) + } + + # Block model + if(method == "monolith"){ + + # derive required input pars: + asp = obj@exif.info$ImageWidth / obj@exif.info$ImageHeight + block.height = block.size / asp + if(dae.name==""){ + dae.name = gsub(x=image.id, "\\.", "_") + } + + # make a COLLADA file: + if(missing(coords)){ + X1 = block.size/2; X2 = -block.size/2; X3 = block.size/2; X4 = -block.size/2 + Y1 = 0; Y2 = 0; Y3 = 0; Y4 = 0 + ALT1 = max.depth; ALT2 = max.depth; ALT3 = max.depth-block.height; ALT4 = max.depth-block.height + coords <- matrix(c(X=c(X1, X2, X3, X4), Z=c(ALT1, ALT2, ALT3, ALT4), Y=c(Y1, Y2, Y3, Y4)), ncol=3) + } + + makeCOLLADA.rectangle(filename = set.file.extension(dae.name, ".dae"), coords = coords, href = href) + + # Object name: + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + pl2 <- newXMLNode("name", image.id, parent = pl1) + # description: + txtd <- sprintf('', html.table) + parseXMLAndAdd(txtd, parent=pl1) + txtl <- sprintf('%.5f%.5f%.1f%.1f%.1f%.5frelativeToGround', LON, LAT, max.depth/2, heading, tilt, range) + parseXMLAndAdd(txtl, parent=pl1) + + # Parse the placemark: + txtm <- sprintf('monolith%srelativeToGround%.5f%.5f%.0f%.1f%.1f%.1f%.1f%.1f%.1f%s%s%s%s', when, dae.name, LON, LAT, max.depth, heading, tilt, roll, scale.x, scale.y, scale.z, set.file.extension(dae.name, ".dae"), refreshMode, href, href) + parseXMLAndAdd(txtm, parent=pl1) + } + + # save results: + assign("kml.out", kml.out, envir=plotKML.fileIO) +} + +setMethod("kml_layer", "SpatialPhotoOverlay", kml_layer.SpatialPhotoOverlay) + + +## Create a block model: +makeCOLLADA.rectangle <- function(coords, filename, href, DateTime, up_axis = "Z_UP", authoring_tool = "plotKML", technique_profile = "GOOGLEEARTH", double_sided = TRUE){ + + # coordinates of the bbox: + pnts = paste(signif(as.vector(t(coords)), 5), collapse=" ") + if(missing(DateTime)) { DateTime <- format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ") } + + # file header: + doc = newXMLDoc() + dae.out <- newXMLNode("COLLADA", attrs=c(version="1.5.0"), namespaceDefinitions = c("xmlns"="http://www.collada.org/2008/03/COLLADASchema"), parent=doc) + txta <- sprintf('%s%s%s%s', authoring_tool, DateTime, DateTime, up_axis) + parseXMLAndAdd(txta, parent=dae.out) + + # library visual scenes: + txts <- sprintf(' ', authoring_tool, DateTime, DateTime, up_axis) + parseXMLAndAdd(txts, parent=dae.out) + + # library geometries: + txtg <- sprintf('%s0 0 -1 0 0 1 -1 1

0 0 1 1 2 2 3 3 2 2 1 1

', pnts) + parseXMLAndAdd(txtg, parent=dae.out) + + # library materials: + txtm <- sprintf('') + parseXMLAndAdd(txtm, parent=dae.out) + + # library effects: + txte <- sprintf('ID5ID6%s', technique_profile, as.numeric(double_sided)) + parseXMLAndAdd(txte, parent=dae.out) + + # library images: + txti <- sprintf('%s ', href) + parseXMLAndAdd(txti, parent=dae.out) + + saveXML(doc, filename) + message(paste("Creating", filename)) + +} + # end of script; \ No newline at end of file diff --git a/pkg/R/layer.SpatialPixels.R b/pkg/R/layer.SpatialPixels.R index 410c7cc..89e97df 100644 --- a/pkg/R/layer.SpatialPixels.R +++ b/pkg/R/layer.SpatialPixels.R @@ -1,3 +1,8 @@ +# Purpose : Write a SpatialPixels object to KML; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Status : pre-alpha +# Note : ; kml_layer.SpatialPixels <- function( obj, @@ -16,14 +21,10 @@ kml_layer.SpatialPixels <- function( ){ ## PNG type if(missing(png.type)){ - if(capabilities('cairo')){ - if(.Platform$OS.type == "windows") { - png.type = "cairo-png" - } else { - png.type = "cairo" - } + if(.Platform$OS.type == "windows") { + png.type = "cairo-png" } else { - png.type = "quartz" + png.type = "cairo" } } ## get our invisible file connection from custom evnrionment @@ -129,11 +130,11 @@ kml_layer.SpatialPixels <- function( dev.off() ## There is a bug in Google Earth that does not allow transparency of PNGs: - ## https://groups.google.com/group/earth-free/browse_thread/thread/1cd6bc29a2b6eb76/62724be63547fab7 + ## http://groups.google.com/group/earth-free/browse_thread/thread/1cd6bc29a2b6eb76/62724be63547fab7 ## Solution: add transparency using ImageMagick: convert <- get("convert", envir = plotKML.opts) if(nchar(convert)==0){ - plotKML.env(show.env = FALSE) + plotKML.env(silent = FALSE, show.env = FALSE) convert <- get("convert", envir = plotKML.opts) } else { ## if it does manages to find ImageMagick: diff --git a/pkg/R/layer.SpatialPoints.R b/pkg/R/layer.SpatialPoints.R index 36fbb15..9c64cec 100644 --- a/pkg/R/layer.SpatialPoints.R +++ b/pkg/R/layer.SpatialPoints.R @@ -1,110 +1,116 @@ - -kml_layer.SpatialPoints <- function( - obj, - subfolder.name = paste(class(obj)), - extrude = TRUE, - z.scale = 1, - LabelScale = get("LabelScale", envir = plotKML.opts), - metadata = NULL, - html.table = NULL, - TimeSpan.begin = "", - TimeSpan.end = "", - points_names, - ... - ){ - - # invisible file connection - kml.out <- get('kml.out', envir=plotKML.fileIO) - - # Checking the projection - prj.check <- check_projection(obj, control = TRUE) - - # Trying to reproject data if the check was not successful - if(prj.check==FALSE) { obj <- reproject(obj) } - - # Parsing the call for aesthetics - aes <- kml_aes(obj, ...) - - # Read the relevant aesthetics - if(missing(points_names)){ points_names <- aes[["labels"]] } - colours <- aes[["colour"]] - shapes <- aes[["shape"]] - sizes <- aes[["size"]] - altitude <- aes[["altitude"]] - altitudeMode <- aes[["altitudeMode"]] - balloon <- aes[["balloon"]] - - # Parse ATTRIBUTE TABLE (for each placemark): - if(is.null(html.table)){ - if((balloon==TRUE | class(balloon) %in% c('character','numeric')) & ("data" %in% slotNames(obj))){ - html.table <- .df2htmltable(obj@data) - }} - - # Folder and name of the points folder - pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) - pl2 <- newXMLNode("name", subfolder.name, parent = pl1) - - # Insert metadata: - if(!is.null(metadata)){ - md.txt <- kml_metadata(metadata, asText = TRUE) - txt <- sprintf('', md.txt) - parseXMLAndAdd(txt, parent=pl1) - } - message("Writing to KML...") - - # Writing points styles - # ===================== - txts <- sprintf('', 1:length(obj), rep(LabelScale, length(obj)), colours, sizes, shapes) - parseXMLAndAdd(txts, parent=pl1) - - # Writing points coordinates - # ========================== - - # with attributes: - if(length(html.table)>0){ - if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ - if(identical(TimeSpan.begin, TimeSpan.end)){ - when = TimeSpan.begin - if(length(when)==1){ when = rep(when, length(obj)) } - txtc <- sprintf('%s#pnt%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), when, html.table, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) - } - else{ - if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, length(obj)) } - if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, length(obj)) } - txtc <- sprintf('%s#pnt%s%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), TimeSpan.begin, TimeSpan.end, html.table, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) - } - } - else{ - txtc <- sprintf('%s#pnt%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), html.table, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) - } - } - - # without attributes: - else{ - if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ - if(identical(TimeSpan.begin, TimeSpan.end)){ - when = TimeSpan.begin - if(length(when)==1){ when = rep(when, length(obj)) } - txtc <- sprintf('%s#pnt%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), when, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) - } - else { - if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, length(obj)) } - if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, length(obj)) } - txtc <- sprintf('%s#pnt%s%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), TimeSpan.begin, TimeSpan.end, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) - } - } - else{ - txtc <- sprintf('%s#pnt%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) - } - } - - parseXMLAndAdd(txtc, parent=pl1) - - # save results: - assign('kml.out', kml.out, envir=plotKML.fileIO) - -} - -setMethod("kml_layer", "SpatialPoints", kml_layer.SpatialPoints) - -# end of script; +# Purpose : Parsing SpatialPoints layer to KML +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : Pre-alpha +# Note : This file gathers the layer() methods. kml.compress(), kml.open() and kml.close(); + + +kml_layer.SpatialPoints <- function( + obj, + subfolder.name = paste(class(obj)), + extrude = TRUE, + z.scale = 1, + LabelScale = get("LabelScale", envir = plotKML.opts), + metadata = NULL, + html.table = NULL, + TimeSpan.begin = "", + TimeSpan.end = "", + points_names, + ... + ){ + + # invisible file connection + kml.out <- get('kml.out', envir=plotKML.fileIO) + + # Checking the projection + prj.check <- check_projection(obj, control = TRUE) + + # Trying to reproject data if the check was not successful + if(prj.check==FALSE) { obj <- reproject(obj) } + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics + if(missing(points_names)){ points_names <- aes[["labels"]] } + colours <- aes[["colour"]] + shapes <- aes[["shape"]] + sizes <- aes[["size"]] + altitude <- aes[["altitude"]] + altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # Parse ATTRIBUTE TABLE (for each placemark): + if(is.null(html.table)){ + if((balloon==TRUE | class(balloon) %in% c('character','numeric')) & ("data" %in% slotNames(obj))){ + html.table <- .df2htmltable(obj@data) + }} + + # Folder and name of the points folder + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + pl2 <- newXMLNode("name", subfolder.name, parent = pl1) + + # Insert metadata: + if(!is.null(metadata)){ + md.txt <- kml_metadata(metadata, asText = TRUE) + txt <- sprintf('', md.txt) + parseXMLAndAdd(txt, parent=pl1) + } + message("Writing to KML...") + + # Writing points styles + # ===================== + txts <- sprintf('', 1:length(obj), rep(LabelScale, length(obj)), colours, sizes, shapes) + parseXMLAndAdd(txts, parent=pl1) + + # Writing points coordinates + # ========================== + + # with attributes: + if(length(html.table)>0){ + if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ + if(identical(TimeSpan.begin, TimeSpan.end)){ + when = TimeSpan.begin + if(length(when)==1){ when = rep(when, length(obj)) } + txtc <- sprintf('%s#pnt%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), when, html.table, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) + } + else{ + if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, length(obj)) } + if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, length(obj)) } + txtc <- sprintf('%s#pnt%s%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), TimeSpan.begin, TimeSpan.end, html.table, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) + } + } + else{ + txtc <- sprintf('%s#pnt%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), html.table, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) + } + } + + # without attributes: + else{ + if(nzchar(TimeSpan.begin[1])&nzchar(TimeSpan.end[1])){ + if(identical(TimeSpan.begin, TimeSpan.end)){ + when = TimeSpan.begin + if(length(when)==1){ when = rep(when, length(obj)) } + txtc <- sprintf('%s#pnt%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), when, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) + } + else { + if(length(TimeSpan.begin)==1){ TimeSpan.begin = rep(TimeSpan.begin, length(obj)) } + if(length(TimeSpan.end)==1){ TimeSpan.end = rep(TimeSpan.end, length(obj)) } + txtc <- sprintf('%s#pnt%s%s%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), TimeSpan.begin, TimeSpan.end, rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) + } + } + else{ + txtc <- sprintf('%s#pnt%s%.0f%s%.5f,%.5f,%.0f', points_names, 1:length(obj), rep(as.numeric(extrude), length(obj)), rep(altitudeMode, length(obj)), coordinates(obj)[, 1], coordinates(obj)[, 2], altitude) + } + } + + parseXMLAndAdd(txtc, parent=pl1) + + # save results: + assign('kml.out', kml.out, envir=plotKML.fileIO) + +} + +setMethod("kml_layer", "SpatialPoints", kml_layer.SpatialPoints) + +# end of script; diff --git a/pkg/R/layer.SpatialPolygons.R b/pkg/R/layer.SpatialPolygons.R index 74c5c55..f156af7 100644 --- a/pkg/R/layer.SpatialPolygons.R +++ b/pkg/R/layer.SpatialPolygons.R @@ -1,189 +1,194 @@ - -kml_layer.SpatialPolygons <- function( - obj, - subfolder.name = paste(class(obj)), - extrude = TRUE, - tessellate = FALSE, - outline = TRUE, - plot.labpt = FALSE, - z.scale = 1, - LabelScale = get("LabelScale", envir = plotKML.opts), - metadata = NULL, - html.table = NULL, - TimeSpan.begin = "", - TimeSpan.end = "", - colorMode = "normal", - ... - ){ - - # invisible file connection - kml.out <- get("kml.out", envir=plotKML.fileIO) - - # Checking the projection is geo - prj.check <- check_projection(obj, control = TRUE) - - # Trying to reproject data if the check was not successful - if (!prj.check) { obj <- reproject(obj) } - - # Parsing the call for aesthetics - aes <- kml_aes(obj, ...) - - # Read the relevant aesthetics - poly_names <- aes[["labels"]] - colours <- aes[["colour"]] - sizes <- aes[["size"]] - shapes <- aes[["shape"]] - altitude <- aes[["altitude"]] # this only works if the altitudes have not been defined in the original sp class - altitudeMode <- aes[["altitudeMode"]] - balloon <- aes[["balloon"]] - - # Parse ATTRIBUTE TABLE (for each placemark): - if((balloon==TRUE | class(balloon) %in% c('character','numeric')) & ("data" %in% slotNames(obj))){ - html.table <- .df2htmltable(obj@data) - } - - # Folder and name of the points folder - pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) - pl2 <- newXMLNode("name", subfolder.name, parent = pl1) - - if(plot.labpt==TRUE){ - pl1b = newXMLNode("Folder", parent=kml.out[["Document"]]) - pl2b <- newXMLNode("name", "labpt", parent = pl1b) - } - - # Insert metadata: - if(!is.null(metadata)){ - md.txt <- kml_metadata(metadata, asText = TRUE) - txt <- sprintf('', md.txt) - parseXMLAndAdd(txt, parent=pl1) - } - message("Writing to KML...") - - # Prepare data for writing - # ============== - - # number of polygons: - pv <- length(obj@polygons) - # number of Polygons: - pvn <- lapply(lapply(obj@polygons, slot, "Polygons"), length) - # parse coordinates: - coords <- rep(list(NULL), pv) - hole <- rep(list(NULL), pv) - labpt <- rep(list(NULL), pv) - for(i.poly in 1:pv) { - for(i.Poly in 1:pvn[[i.poly]]){ - # get coordinates / hole definition: - xyz <- slot(slot(obj@polygons[[i.poly]], "Polygons")[[i.Poly]], "coords") - cxyz <- slot(slot(obj@polygons[[i.poly]], "Polygons")[[i.Poly]], "labpt") - # if altitude is missing, add the default altitudes: - if(ncol(xyz)==2){ xyz <- cbind(xyz, rep(altitude[i.poly], nrow(xyz))) } - # format coords for writing to KML [https://developers.google.com/kml/documentation/kmlreference#polygon]: - hole[[i.poly]][[i.Poly]] <- slot(slot(obj@polygons[[i.poly]], "Polygons")[[i.Poly]], "hole") - coords[[i.poly]][[i.Poly]] <- paste(xyz[,1], ',', xyz[,2], ',', xyz[,3], collapse='\n ', sep = "") - labpt[[i.poly]][[i.Poly]] <- paste(cxyz[1], ',', cxyz[2], ',', altitude[i.poly], collapse='\n ', sep = "") - } - } - - # reformatted aesthetics (one "polygons" can have multiple "Polygons"): - poly_names.l <- list(NULL) - for(i.poly in 1:pv){ poly_names.l[[i.poly]] <- as.vector(rep(poly_names[i.poly], pvn[[i.poly]])) } - # polygon times (if applicable) - TimeSpan.begin.l <- list(NULL) - TimeSpan.end.l <- list(NULL) - when.l <- list(NULL) - # check if time span has been defined: - if(all(nzchar(TimeSpan.begin))&all(nzchar(TimeSpan.end))){ - if(identical(TimeSpan.begin, TimeSpan.end)){ - if(length(TimeSpan.begin)==1){ - when.l = rep(TimeSpan.begin, sum(unlist(pvn))) - } else { - for(i.poly in 1:pv){ when.l[[i.poly]] <- as.vector(rep(TimeSpan.begin[i.poly], pvn[[i.poly]])) } - }} else { - for(i.poly in 1:pv){ TimeSpan.begin.l[[i.poly]] <- as.vector(rep(TimeSpan.begin[i.poly], pvn[[i.poly]])) } - for(i.poly in 1:pv){ TimeSpan.end.l[[i.poly]] <- as.vector(rep(TimeSpan.end[i.poly], pvn[[i.poly]])) } - } - } - - # Polygon styles - # ============== - if(!length(unique(colours))==1|colorMode=="normal"){ - colours.l <- list(NULL) - for(i.poly in 1:pv){ colours.l[[i.poly]] <- as.vector(rep(colours[i.poly], pvn[[i.poly]])) } - txts <- sprintf('', 1:sum(unlist(pvn)), unlist(colours.l), rep(as.numeric(outline), sum(unlist(pvn))), as.numeric(!(unlist(hole)))) - parseXMLAndAdd(txts, parent=pl1) - } else { - # random colours: - txts <- sprintf('', 1:sum(unlist(pvn)), rep(as.numeric(outline), sum(unlist(pvn))), as.numeric(!(unlist(hole)))) - parseXMLAndAdd(txts, parent=pl1) - } - - # Point styles - # ============== - if(plot.labpt == TRUE){ - sizes.l <- list(NULL) - shapes.l <- list(NULL) - # reformat size / shapes: - for(i.poly in 1:pv){sizes.l[[i.poly]] <- as.vector(rep(sizes[i.poly], pvn[[i.poly]])) } - for(i.poly in 1:pv){shapes.l[[i.poly]] <- as.vector(rep(shapes[i.poly], pvn[[i.poly]])) } - txtsp <- sprintf('', 1:sum(unlist(pvn)), rep(LabelScale, sum(unlist(pvn))), unlist(sizes.l), unlist(shapes.l)) - parseXMLAndAdd(txtsp, parent=pl1b) - - # Writing labpt - # ================ - if(all(is.null(unlist(TimeSpan.begin.l))) & all(is.null(unlist(TimeSpan.end.l)))){ - if(all(is.null(unlist(when.l)))){ - # time span undefined: - txtc <- sprintf('%s#pnt%s%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), rep(as.numeric(extrude), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(labpt))) - } else { - txtc <- sprintf('%s#pnt%s%s%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(when.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(labpt))) - } } else{ - # fixed begin/end times: - txtc <- sprintf('%s#pnt%s%s%s%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(TimeSpan.begin.l), unlist(TimeSpan.end.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(labpt))) - } - - parseXMLAndAdd(txtc, parent=pl1b) - } - # finished writing the labels - - # Writing polygons - # ================ - - if(length(html.table)>0){ - html.table.l <- list(NULL) - for(i.poly in 1:pv){ html.table.l[[i.poly]] <- as.vector(rep(html.table[i.poly], pvn[[i.poly]])) } - - # with attributes: - if(all(is.null(unlist(TimeSpan.begin.l))) & all(is.null(unlist(TimeSpan.end.l)))){ - if(all(is.null(unlist(when.l)))){ - # time span undefined: - txt <- sprintf('%s#poly%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(html.table.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) - } else { - txt <- sprintf('%s#poly%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(when.l), unlist(html.table.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) - }} else { - txt <- sprintf('%s#poly%s%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(TimeSpan.begin.l), unlist(TimeSpan.end.l), unlist(html.table.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) - } - } - - # without attributes: - else{ - if(all(is.null(unlist(TimeSpan.begin.l))) & all(is.null(unlist(TimeSpan.end.l)))){ - if(all(is.null(unlist(when.l)))){ - # time span undefined: - txt <- sprintf('%s#poly%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) - } else { - txt <- sprintf('%s#poly%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(when.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) - }} else { - txt <- sprintf('%s#poly%s%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), TimeSpan.begin, TimeSpan.end, rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) - } - } - - parseXMLAndAdd(txt, parent=pl1) - - # save results: - assign("kml.out", kml.out, envir=plotKML.fileIO) - -} - -setMethod("kml_layer", "SpatialPolygons", kml_layer.SpatialPolygons) - +# Purpose : Write polygon-objects (SpatialPolygons) to KML; +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : this operation can be time consuming for large grids!; + +kml_layer.SpatialPolygons <- function( + obj, + subfolder.name = paste(class(obj)), + extrude = TRUE, + tessellate = FALSE, + outline = TRUE, + plot.labpt = FALSE, + z.scale = 1, + LabelScale = get("LabelScale", envir = plotKML.opts), + metadata = NULL, + html.table = NULL, + TimeSpan.begin = "", + TimeSpan.end = "", + colorMode = "normal", + ... + ){ + + # invisible file connection + kml.out <- get("kml.out", envir=plotKML.fileIO) + + # Checking the projection is geo + prj.check <- check_projection(obj, control = TRUE) + + # Trying to reproject data if the check was not successful + if (!prj.check) { obj <- reproject(obj) } + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics + poly_names <- aes[["labels"]] + colours <- aes[["colour"]] + sizes <- aes[["size"]] + shapes <- aes[["shape"]] + altitude <- aes[["altitude"]] # this only works if the altitudes have not been defined in the original sp class + altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # Parse ATTRIBUTE TABLE (for each placemark): + if((balloon==TRUE | class(balloon) %in% c('character','numeric')) & ("data" %in% slotNames(obj))){ + html.table <- .df2htmltable(obj@data) + } + + # Folder and name of the points folder + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + pl2 <- newXMLNode("name", subfolder.name, parent = pl1) + + if(plot.labpt==TRUE){ + pl1b = newXMLNode("Folder", parent=kml.out[["Document"]]) + pl2b <- newXMLNode("name", "labpt", parent = pl1b) + } + + # Insert metadata: + if(!is.null(metadata)){ + md.txt <- kml_metadata(metadata, asText = TRUE) + txt <- sprintf('', md.txt) + parseXMLAndAdd(txt, parent=pl1) + } + message("Writing to KML...") + + # Prepare data for writing + # ============== + + # number of polygons: + pv <- length(obj@polygons) + # number of Polygons: + pvn <- lapply(lapply(obj@polygons, slot, "Polygons"), length) + # parse coordinates: + coords <- rep(list(NULL), pv) + hole <- rep(list(NULL), pv) + labpt <- rep(list(NULL), pv) + for(i.poly in 1:pv) { + for(i.Poly in 1:pvn[[i.poly]]){ + # get coordinates / hole definition: + xyz <- slot(slot(obj@polygons[[i.poly]], "Polygons")[[i.Poly]], "coords") + cxyz <- slot(slot(obj@polygons[[i.poly]], "Polygons")[[i.Poly]], "labpt") + # if altitude is missing, add the default altitudes: + if(ncol(xyz)==2){ xyz <- cbind(xyz, rep(altitude[i.poly], nrow(xyz))) } + # format coords for writing to KML [https://developers.google.com/kml/documentation/kmlreference#polygon]: + hole[[i.poly]][[i.Poly]] <- slot(slot(obj@polygons[[i.poly]], "Polygons")[[i.Poly]], "hole") + coords[[i.poly]][[i.Poly]] <- paste(xyz[,1], ',', xyz[,2], ',', xyz[,3], collapse='\n ', sep = "") + labpt[[i.poly]][[i.Poly]] <- paste(cxyz[1], ',', cxyz[2], ',', altitude[i.poly], collapse='\n ', sep = "") + } + } + + # reformatted aesthetics (one "polygons" can have multiple "Polygons"): + poly_names.l <- list(NULL) + for(i.poly in 1:pv){ poly_names.l[[i.poly]] <- as.vector(rep(poly_names[i.poly], pvn[[i.poly]])) } + # polygon times (if applicable) + TimeSpan.begin.l <- list(NULL) + TimeSpan.end.l <- list(NULL) + when.l <- list(NULL) + # check if time span has been defined: + if(all(nzchar(TimeSpan.begin))&all(nzchar(TimeSpan.end))){ + if(identical(TimeSpan.begin, TimeSpan.end)){ + if(length(TimeSpan.begin)==1){ + when.l = rep(TimeSpan.begin, sum(unlist(pvn))) + } else { + for(i.poly in 1:pv){ when.l[[i.poly]] <- as.vector(rep(TimeSpan.begin[i.poly], pvn[[i.poly]])) } + }} else { + for(i.poly in 1:pv){ TimeSpan.begin.l[[i.poly]] <- as.vector(rep(TimeSpan.begin[i.poly], pvn[[i.poly]])) } + for(i.poly in 1:pv){ TimeSpan.end.l[[i.poly]] <- as.vector(rep(TimeSpan.end[i.poly], pvn[[i.poly]])) } + } + } + + # Polygon styles + # ============== + if(!length(unique(colours))==1|colorMode=="normal"){ + colours.l <- list(NULL) + for(i.poly in 1:pv){ colours.l[[i.poly]] <- as.vector(rep(colours[i.poly], pvn[[i.poly]])) } + txts <- sprintf('', 1:sum(unlist(pvn)), unlist(colours.l), rep(as.numeric(outline), sum(unlist(pvn))), as.numeric(!(unlist(hole)))) + parseXMLAndAdd(txts, parent=pl1) + } else { + # random colours: + txts <- sprintf('', 1:sum(unlist(pvn)), rep(as.numeric(outline), sum(unlist(pvn))), as.numeric(!(unlist(hole)))) + parseXMLAndAdd(txts, parent=pl1) + } + + # Point styles + # ============== + if(plot.labpt == TRUE){ + sizes.l <- list(NULL) + shapes.l <- list(NULL) + # reformat size / shapes: + for(i.poly in 1:pv){sizes.l[[i.poly]] <- as.vector(rep(sizes[i.poly], pvn[[i.poly]])) } + for(i.poly in 1:pv){shapes.l[[i.poly]] <- as.vector(rep(shapes[i.poly], pvn[[i.poly]])) } + txtsp <- sprintf('', 1:sum(unlist(pvn)), rep(LabelScale, sum(unlist(pvn))), unlist(sizes.l), unlist(shapes.l)) + parseXMLAndAdd(txtsp, parent=pl1b) + + # Writing labpt + # ================ + if(all(is.null(unlist(TimeSpan.begin.l))) & all(is.null(unlist(TimeSpan.end.l)))){ + if(all(is.null(unlist(when.l)))){ + # time span undefined: + txtc <- sprintf('%s#pnt%s%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), rep(as.numeric(extrude), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(labpt))) + } else { + txtc <- sprintf('%s#pnt%s%s%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(when.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(labpt))) + } } else{ + # fixed begin/end times: + txtc <- sprintf('%s#pnt%s%s%s%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(TimeSpan.begin.l), unlist(TimeSpan.end.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(labpt))) + } + + parseXMLAndAdd(txtc, parent=pl1b) + } + # finished writing the labels + + # Writing polygons + # ================ + + if(length(html.table)>0){ + html.table.l <- list(NULL) + for(i.poly in 1:pv){ html.table.l[[i.poly]] <- as.vector(rep(html.table[i.poly], pvn[[i.poly]])) } + + # with attributes: + if(all(is.null(unlist(TimeSpan.begin.l))) & all(is.null(unlist(TimeSpan.end.l)))){ + if(all(is.null(unlist(when.l)))){ + # time span undefined: + txt <- sprintf('%s#poly%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(html.table.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) + } else { + txt <- sprintf('%s#poly%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(when.l), unlist(html.table.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) + }} else { + txt <- sprintf('%s#poly%s%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(TimeSpan.begin.l), unlist(TimeSpan.end.l), unlist(html.table.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) + } + } + + # without attributes: + else{ + if(all(is.null(unlist(TimeSpan.begin.l))) & all(is.null(unlist(TimeSpan.end.l)))){ + if(all(is.null(unlist(when.l)))){ + # time span undefined: + txt <- sprintf('%s#poly%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) + } else { + txt <- sprintf('%s#poly%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), unlist(when.l), rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) + }} else { + txt <- sprintf('%s#poly%s%s%s%.0f%.0f%s%s', unlist(poly_names.l), 1:sum(unlist(pvn)), TimeSpan.begin, TimeSpan.end, rep(as.numeric(extrude), sum(unlist(pvn))), rep(as.numeric(tessellate), sum(unlist(pvn))), rep(altitudeMode, sum(unlist(pvn))), paste(unlist(coords))) + } + } + + parseXMLAndAdd(txt, parent=pl1) + + # save results: + assign("kml.out", kml.out, envir=plotKML.fileIO) + +} + +setMethod("kml_layer", "SpatialPolygons", kml_layer.SpatialPolygons) + # end of script; \ No newline at end of file diff --git a/pkg/R/layer.trip.R b/pkg/R/layer.trip.R new file mode 100644 index 0000000..ec248b0 --- /dev/null +++ b/pkg/R/layer.trip.R @@ -0,0 +1,223 @@ +## Trips: +## TODO: +## * check features available by default +## * add man/ documentation +## * + + +setMethod("plotKML", "trip", function(obj, + folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), + file.name = paste(folder.name, ".kml", sep=""), + colour, + start.icon = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", + kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # Guess aesthetics if missing: + if(missing(colour)){ + obj@data[,"colour"] <- obj@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@data[,"colour"] <- eval(colour, obj@data) + } else { + obj@data[,"colour"] <- obj@data[,as.character(colour)] + } + } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + kml_layer.trip(obj, colour = colour, start.icon = start.icon, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + + +kml_layer.trip <- function( + obj, + id.name = obj@TOR.columns[2L], # trajectory ID column + ## TH: Normally we should be able to pass the ID column via "labels" + dtime, # time support + extrude = FALSE, + # tessellate = FALSE, + start.icon = paste(get("home_url", envir = plotKML.opts), "3Dballyellow.png", sep=""), + end.icon = paste(get("home_url", envir = plotKML.opts), "golfhole.png", sep=""), + LabelScale = .8*get("LabelScale", envir = plotKML.opts), + z.scale = 1, + metadata = NULL, + html.table = NULL, + ... +){ + + # Get our invisible file connection from custom environment + kml.out <- get('kml.out', envir=plotKML.fileIO) + + # Checking the projection is geo + prj.check <- check_projection(obj, control = TRUE) + + # Trying to reproject data if the check was not successful + if (!prj.check) { obj <- reproject(obj) } + + # Parsing the call for aesthetics + aes <- kml_aes(obj, ...) + + # Read the relevant aesthetics: + lines_names <- aes[["labels"]] + colours <- aes[["colour"]] + width <- aes[["width"]] + altitudeMode <- aes[["altitudeMode"]] + balloon <- aes[["balloon"]] + + # object ID names: + lv <- levels(as.factor(obj@data[,id.name])) + line.colours <- hex2kml(rainbow(n=2+length(lv))) ## brewer.pal can't do many colours so choose this bad one for now + ## names of the coordinate columns: + nc <- replicate(length(lv), attr(obj@coords, "dimname")[[2]], simplify = FALSE) + ## strip times: + xt <- obj[[obj@TOR.columns[1L]]] + + ## Format the time slot for writing to KML: + if(missing(dtime)) { + when <- format(xt, "%Y-%m-%dT%H:%M:%SZ") + dtime = 0 + } else { + ## Begin end times: + TimeSpan.begin <- format(xt, "%Y-%m-%dT%H:%M:%SZ") + TimeSpan.end <- format(as.POSIXct(unclass(xt) + dtime, origin="1970-01-01"), "%Y-%m-%dT%H:%M:%SZ") + } + + # Parse ATTRIBUTE TABLE (for each placemark): + if (balloon & ("data" %in% slotNames(obj))){ + html.table <- .df2htmltable(obj@data) + } + + # Name of the object + pl1 = newXMLNode("Folder", parent=kml.out[["Document"]]) + + # Insert metadata: + if(!is.null(metadata)){ + md.txt <- kml_metadata(metadata, asText = TRUE) + txt <- sprintf('', md.txt) + parseXMLAndAdd(txt, parent=pl1) + } + + # Sorting lines + # ============= + + current.line.coords <- NULL + ldist <- NULL + coords <- NULL + + objxy <- split(obj, as.character(obj[[id.name]]))[unique(as.character(obj[[id.name]]))] ## don't fall for lex-sort trap + for (i.line in 1:length(lv)) { # for each line + + cfd <- data.frame(coordinates(objxy[[i.line]])) + # convert to line objects (this assumes that the points are sorted chronologically!) + cl <- Line(cfd) + # line length: + ldist[[i.line]] <- LineLength(cl, longlat=TRUE, sum=TRUE) + current.line.coords[[i.line]] <- cfd[,nc[[i.line]]] + if(length(nc[[i.line]])<3){ + current.line.coords[[i.line]][,3] <- rep(0, length(cfd[,1])) + } + current.line.coords[[i.line]][,3] <- current.line.coords[[i.line]][,3] * z.scale + # parse coordinates: + coords[[i.line]] <- paste(current.line.coords[[i.line]][, 1], ',', current.line.coords[[i.line]][, 2], ',', current.line.coords[[i.line]][,3], collapse='\n ', sep = "") + } + + # Styles - lines: + # ====== + message("Writing to KML...") + txts <- sprintf('', 1:length(lv), line.colours[1:length(lv)], width[1:length(lv)]) + parseXMLAndAdd(txts, parent=pl1) + + # Styles - points: + # ====== + nt <- sapply(current.line.coords, nrow) + + nx <- 0 + for (i.line in 1:length(lv)) { + # for each line: + nx <- nx + nt[i.line] + n1 <- nx - nt[i.line] + txtsp <- sprintf('', (n1+1):(nx-1), colours[(n1+1):(nx-1)], rep(LabelScale, nt[i.line]-1), rep(start.icon, nt[i.line]-1)) + parseXMLAndAdd(txtsp, parent=pl1) + # the last point: + txtspl <- sprintf('', nx, colours[nx], LabelScale*2.5, end.icon) + parseXMLAndAdd(txtspl, parent=pl1) + } + + # Writing observed vertices + # ============= + + # for each line: + nx <- 0 + for (i.line in 1:length(lv)) { + pl2 = newXMLNode("Folder", parent=pl1) + pl3 <- newXMLNode("name", lv[i.line], parent = pl2) + #browser() + nx <- nx + nt[i.line] + n1 <- nx - nt[i.line] + # Parse point coordinates: + ## TH: I do not know how to make the following code more compact. + if(length(html.table)>0 & all(dtime==0)){ # with attributes / point temporal support + txtl <- sprintf('#pnt_%s%s%.0f%s%.5f,%.5f,%.0f', + (n1+1):nx, html.table[(n1+1):nx], when[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + } + else { + if(length(html.table)>0 & any(!dtime==0)){ # with attributes / block temporal support + txtl <- sprintf('#pnt_%s%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, html.table[(n1+1):nx], TimeSpan.begin[(n1+1):nx], TimeSpan.end[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + } + else { + if(is.null(html.table) & any(!dtime==0)){ # no attributes / block temporal support + txtl <- sprintf('#pnt_%s%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, TimeSpan.begin[(n1+1):nx], TimeSpan.end[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + } + else { # no attributes / point temporal support + txtl <- sprintf('#pnt_%s%s%.0f%s%.5f,%.5f,%.0f', (n1+1):nx, when[(n1+1):nx], rep(as.integer(extrude), nt[i.line]), rep(altitudeMode, nt[i.line]), current.line.coords[[i.line]][,1], current.line.coords[[i.line]][,2], current.line.coords[[i.line]][,3]) + }}} + + parseXMLAndAdd(txtl, parent=pl2) + } + + # Writing Lines + # ============= + #txtl <- sprintf('length: %.2f#line_%s%s%s', unlist(ldist), 1:length(lv), rep(altitudeMode, length(lv)), paste(unlist(coords))) + xsegs <- trip::explode(tr) + coords_segs <- unlist(lapply(xsegs@lines, function(a) lapply(a@Lines, slot, "coords")), recursive = FALSE) + coords_txt <- lapply(coords_segs, function(x) paste(t(cbind(x, 0)), collapse = ",")) ## will need the get Z and/or M for sf + tripID <- xsegs[["id"]] + linesegID <- unlist(lapply(split(tripID, tripID), seq_along)) + segbegin <- format(xsegs[["starttime"]], "%Y-%m-%dT%H:%M:%S+00:00") + segend <- format(xsegs[["endtime"]], "%Y-%m-%dT%H:%M:%S+00:00") + + txtl <- sprintf('%s#line_%s%s%s%s%s', + paste(tripID, linesegID, sep = "_") , + "$line_1", + segbegin, + segend, + "clampToGround", + paste(unlist(coords_txt))) + + + parseXMLAndAdd(txtl, parent=pl1) + + # save results: + assign('kml.out', kml.out, envir=plotKML.fileIO) +} + +setMethod("kml_layer", "trip", kml_layer.trip) + +# end of script; \ No newline at end of file diff --git a/pkg/R/legend.bar.R b/pkg/R/legend.bar.R index 3588817..90fa14e 100644 --- a/pkg/R/legend.bar.R +++ b/pkg/R/legend.bar.R @@ -1,81 +1,75 @@ - -kml_legend.bar <- function(x, width, height, pointsize = 14, legend.file, legend.pal, z.lim = range(x, na.rm = TRUE, finite = TRUE), factor.labels, png.type){ - - if(missing(png.type)){ - if(capabilities('cairo')){ - if(.Platform$OS.type == "windows") { - png.type = "cairo-png" - } else { - png.type = "cairo" - } - } else { - png.type = "quartz" - } - } - - ## Factor-type variables: - if(class(x) == "factor" | class(x) == "character") { - - z.lim <- NA - if(missing(factor.labels)){ - col.no <- length(levels(as.factor(x))) - } else { - col.no <- length(factor.labels) - } - - if(missing(factor.labels)) { - ### NOTE : This is a not a perfect implementation for a factor with a lot of categories! - if(missing(width)) { - width <- max(nchar(levels(as.factor(x))))*5+70 - } # 5 pix per character - - if(missing(height)) { - height <- length(levels(as.factor(x)))*40 - } # 20 pix per class - } - - else { - if(missing(width)) { - width <- max(nchar(factor.labels))*5+70 - } # 10 pix per character - if(missing(height)) { - height <- length(factor.labels)*40 - } # 20 pix per class - } - - png(filename=legend.file, width=width, height=height, bg="transparent", pointsize=pointsize, type=png.type) - # c(bottom, left, top, right) - par(mar=c(.5,0,.5,1)) - plot(x=rep(1, col.no), y=1:col.no, axes=FALSE, xlab='', ylab='', pch=15, cex=4, col=legend.pal, xlim=c(0,.6*width)) - - if(missing(factor.labels)) { - text(x=rep(1, col.no), y=1:col.no, labels=levels(as.factor(x)), cex=.8, pos=4, offset=1, col=rgb(0.99,0.99,0.99)) - } else { - text(x=rep(1, col.no), y=1:col.no, labels=factor.labels, cex=.8, pos=4, offset=1, col=rgb(0.99,0.99,0.99)) - } - - dev.off() - } - - ### Numeric-type variables: - else { - if(is.numeric(x)) { - - if(missing(width)) { width <- 120 } - if(missing(height)) { height <- 240 } - png(filename=legend.file, width=width, height=height, bg="transparent", pointsize=pointsize) - par(mar=c(.5,0,.5,4)) - plot(x=0:5, y=0:5, asp=3, type="n", axes=FALSE, xlab='', ylab='') - # get the 2-4 significant digits - col.labels <- signif(c(z.lim[1], mean(z.lim), z.lim[2]), 2) - color.legend(xl=0, yb=0, xr=5, yt=5, legend=col.labels, rect.col=legend.pal, gradient="y", align="rb", cex=1.4, col=rgb(0.99,0.99,0.99)) - - dev.off() - } - else { - stop("Vector of type 'numeric' or 'factor' expected") - } - } -} - -# end of script; +# Purpose : Plot a legend bar for numeric or factor variable; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl) +# Contributions : Pierre Roudier (pierre.roudier@landcare.nz); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : 1D legend with min max and avg values; + + +kml_legend.bar <- function(x, width, height, pointsize = 14, legend.file, legend.pal, z.lim = range(x, na.rm = TRUE, finite = TRUE), factor.labels, png.type = "cairo-png"){ + + ## Factor-type variables: + if(class(x) == "factor" | class(x) == "character") { + + z.lim <- NA + if(missing(factor.labels)){ + col.no <- length(levels(as.factor(x))) + } else { + col.no <- length(factor.labels) + } + + if(missing(factor.labels)) { + ### NOTE : This is a not a perfect implementation for a factor with a lot of categories! + if(missing(width)) { + width <- max(nchar(levels(as.factor(x))))*5+70 + } # 5 pix per character + + if(missing(height)) { + height <- length(levels(as.factor(x)))*40 + } # 20 pix per class + } + + else { + if(missing(width)) { + width <- max(nchar(factor.labels))*5+70 + } # 10 pix per character + if(missing(height)) { + height <- length(factor.labels)*40 + } # 20 pix per class + } + + png(filename=legend.file, width=width, height=height, bg="transparent", pointsize=pointsize, type=png.type) + # c(bottom, left, top, right) + par(mar=c(.5,0,.5,1)) + plot(x=rep(1, col.no), y=1:col.no, axes=FALSE, xlab='', ylab='', pch=15, cex=4, col=legend.pal, xlim=c(0,.6*width)) + + if(missing(factor.labels)) { + text(x=rep(1, col.no), y=1:col.no, labels=levels(as.factor(x)), cex=.8, pos=4, offset=1, col=rgb(0.99,0.99,0.99)) + } else { + text(x=rep(1, col.no), y=1:col.no, labels=factor.labels, cex=.8, pos=4, offset=1, col=rgb(0.99,0.99,0.99)) + } + + dev.off() + } + + ### Numeric-type variables: + else { + if(is.numeric(x)) { + + if(missing(width)) { width <- 120 } + if(missing(height)) { height <- 240 } + png(filename=legend.file, width=width, height=height, bg="transparent", pointsize=pointsize) + par(mar=c(.5,0,.5,4)) + plot(x=0:5, y=0:5, asp=3, type="n", axes=FALSE, xlab='', ylab='') + # get the 2-4 significant digits + col.labels <- signif(c(z.lim[1], mean(z.lim), z.lim[2]), 2) + color.legend(xl=0, yb=0, xr=5, yt=5, legend=col.labels, rect.col=legend.pal, gradient="y", align="rb", cex=1.4, col=rgb(0.99,0.99,0.99)) + + dev.off() + } + else { + stop("Vector of type 'numeric' or 'factor' expected") + } + } +} + +# end of script; diff --git a/pkg/R/legend.whitening.R b/pkg/R/legend.whitening.R index 16c16b8..94370ae 100644 --- a/pkg/R/legend.whitening.R +++ b/pkg/R/legend.whitening.R @@ -1,56 +1,49 @@ - -kml_legend.whitening <- function(legend.res = 0.01, width=120, height=300, pointsize = 14, x.lim, e.lim, leg.asp = 0.3*width/height, legend.file = "whitening_legend.png", matte = FALSE, png.type){ - - if(missing(png.type)){ - if(capabilities('cairo')){ - if(.Platform$OS.type == "windows") { - png.type = "cairo-png" - } else { - png.type = "cairo" - } - } else { - png.type = "quartz" - } - } - - xlg <- seq(.01,1,by=legend.res) - ylg <- seq(.01,1,by=legend.res) - # empty grid - leg <- expand.grid(xlg, ylg, KEEP.OUT.ATTRS=FALSE) - # Hues - f1 <- -90-leg[,2]*300 - f2 <- ifelse(f1<=-360, f1+360, f1) - H <- ifelse(f2>=0, f2, (f2+360)) - # Saturation - S <- 1-leg[,1] - # Intensity - V <- 0.5+leg[,1]/2 - HSV <- as.vector(t(matrix(hex(HSV(rev(H), S, V)), nrow=length(ylg), ncol=length(xlg)))) - leg.plt <- pixmapIndexed(data=1:length(HSV), nrow=length(ylg), ncol=length(xlg), bbox=c(e.lim[1], x.lim[1], e.lim[2], x.lim[2]), col=HSV) - # par(las = 0) - - png(filename=legend.file, width=width, height=height, bg="transparent", pointsize=pointsize, type=png.type) - par(mar=c(2.5,2.5,0.5,0)) - plot(leg.plt, axes=FALSE, col.lab=rgb(0.99,0.99,0.99), bg=NA, asp=leg.asp) - axis(side=1, at=e.lim, cex=.8, col.axis=rgb(0.99,0.99,0.99), col.lab=rgb(0.99,0.99,0.99)) - axis(side=2, at=signif(x.lim, 3), cex=.8, col.axis=rgb(0.99,0.99,0.99), col.lab=rgb(0.99,0.99,0.99)) - dev.off() - - ## Force transparency (requires ImageMagick): - if(matte==TRUE){ - convert <- get("convert", envir = plotKML.opts) - if(nchar(convert)==0){ - plotKML.env(show.env = FALSE) - convert <- get("convert", envir = plotKML.opts) - if(!nchar(convert)==0){ - system(paste(convert, ' ', legend.file, ' -matte -transparent "#FFFFFF" ', legend.file, sep="")) - } - } - else { - warning("PNG transparency possibly ineffective. Install ImageMagick and add to PATH. See '?kml_legend.whitening' for more info.") - } - } - -} - -# end of script; +# Purpose : Produce a PNG legend file for whitening; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : this technique requires a special 2D legend; + +kml_legend.whitening <- function(legend.res = 0.01, width=120, height=300, pointsize = 14, x.lim, e.lim, leg.asp = 0.3*width/height, legend.file = "whitening_legend.png", matte = FALSE, png.type="cairo-png"){ + + xlg <- seq(.01,1,by=legend.res) + ylg <- seq(.01,1,by=legend.res) + # empty grid + leg <- expand.grid(xlg, ylg, KEEP.OUT.ATTRS=FALSE) + # Hues + f1 <- -90-leg[,2]*300 + f2 <- ifelse(f1<=-360, f1+360, f1) + H <- ifelse(f2>=0, f2, (f2+360)) + # Saturation + S <- 1-leg[,1] + # Intensity + V <- 0.5+leg[,1]/2 + HSV <- as.vector(t(matrix(hex(HSV(rev(H), S, V)), nrow=length(ylg), ncol=length(xlg)))) + leg.plt <- pixmapIndexed(data=1:length(HSV), nrow=length(ylg), ncol=length(xlg), bbox=c(e.lim[1], x.lim[1], e.lim[2], x.lim[2]), col=HSV) + # par(las = 0) + + png(filename=legend.file, width=width, height=height, bg="transparent", pointsize=pointsize, type=png.type) + par(mar=c(2.5,2.5,0.5,0)) + plot(leg.plt, axes=FALSE, col.lab=rgb(0.99,0.99,0.99), bg=NA, asp=leg.asp) + axis(side=1, at=e.lim, cex=.8, col.axis=rgb(0.99,0.99,0.99), col.lab=rgb(0.99,0.99,0.99)) + axis(side=2, at=signif(x.lim, 3), cex=.8, col.axis=rgb(0.99,0.99,0.99), col.lab=rgb(0.99,0.99,0.99)) + dev.off() + + ## Force transparency (requires ImageMagick): + if(matte==TRUE){ + convert <- get("convert", envir = plotKML.opts) + if(nchar(convert)==0){ + plotKML.env(silent = FALSE, show.env = FALSE) + convert <- get("convert", envir = plotKML.opts) + if(!nchar(convert)==0){ + system(paste(convert, ' ', legend.file, ' -matte -transparent "#FFFFFF" ', legend.file, sep="")) + } + } + else { + warning("PNG transparency possibly ineffective. Install ImageMagick and add to PATH. See '?kml_legend.whitening' for more info.") + } + } + +} + +# end of script; diff --git a/pkg/R/normalizeFilename.R b/pkg/R/normalizeFilename.R index 07c3c46..b812d8e 100644 --- a/pkg/R/normalizeFilename.R +++ b/pkg/R/normalizeFilename.R @@ -1,23 +1,29 @@ - -## Fix characters following the naming conventions [http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx]: -normalizeFilename <- function(x, form = c("default", "8.3")[1], fix.encoding = TRUE, sub.sign = "_"){ - - # reserved characters: - sel = c("<", ">", ":", '\\"', "/", "\\|", "\\?", "\\*", "[[:space:]]", "\\s+$", "\\[", "\\]") - for(i in sel){ - x <- gsub(pattern=i, replacement=sub.sign, x) - } - # shorten the path: - if(form == "8.3"){ - if(.Platform$OS.type == "windows") { - x <- utils::shortPathName(x) - } - } - if(fix.encoding==TRUE){ - x <- iconv(x, to = "UTF8") - } - - return(x) -} - -# end of script; +# Purpose : User-friendly characters for "filename" +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Status : Pre-alpha +# Note : see also: R.utils and utils packages; + + +## Fix characters following the naming conventions [http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx]: +normalizeFilename <- function(x, form = c("default", "8.3")[1], fix.encoding = TRUE, sub.sign = "_"){ + + # reserved characters: + sel = c("<", ">", ":", '\\"', "/", "\\|", "\\?", "\\*", "[[:space:]]", "\\s+$", "\\[", "\\]") + for(i in sel){ + x <- gsub(pattern=i, replacement=sub.sign, x) + } + # shorten the path: + if(form == "8.3"){ + if(.Platform$OS.type == "windows") { + x <- utils::shortPathName(x) + } + } + if(fix.encoding==TRUE){ + x <- iconv(x, to = "UTF8") + } + + return(x) +} + +# end of script; diff --git a/pkg/R/plot.SpatialPredictions.R b/pkg/R/plot.SpatialPredictions.R index 16c7d48..ab4f0a5 100644 --- a/pkg/R/plot.SpatialPredictions.R +++ b/pkg/R/plot.SpatialPredictions.R @@ -1,46 +1,51 @@ - -plot.SpatialPredictions <- function(x, plot.predictions=TRUE, vertical=FALSE, col=SAGA_pal[[1]], ...){ - if(plot.predictions==TRUE){ - par(mfrow=c(2,2)) - } else { if(vertical==TRUE){ - par(mfrow=c(3,1)) - } else { - par(mfrow=c(1,3)) - } - } - par(mar=c(4.5,4.5,.8,.8)) - - if(plot.predictions==TRUE){ - if(any(names(x@predicted) %in% x@variable)){ - plot(raster(x@predicted[x@variable]), col=col) - } else { - plot(raster(x@predicted[1]), col=col) - } - points(x@observed, pch="+", cex=.8) - } - if(sum(!is.na(x@validation$residual))>2){ - plot(y=x@validation$var1.pred, x=x@validation$observed, pch=19, asp=1, col = "red", xlab='observed (CV)', col.main = rgb(0.99,0.99,0.99), ylab='predicted (CV)', ...) - abline(a=0, b=1, lwd=2) - } else { - plot(y=x@observed@data[,paste(x@variable, "modelFit", sep=".")], x=x@observed@data[,paste(x@variable)], pch=19, asp=1, col = "red", xlab='observed', col.main = rgb(0.99,0.99,0.99), ylab='predicted', ...) - abline(a=0, b=1, lwd=2) - } - vv <- variogram(as.formula("observed~1"), x@validation) - plot(x=vv$dist, y=vv$gamma, pch="+", col = "green", xlab='distance', cex=1.4, ylab='gamma', ylim = c(0, max(vv$gamma))) - lines(x=c(0, vv$dist), y=rep(var(x@validation$observed), length(vv$dist)+1), lty=2) - ## Residuals (only if available): - vgmmodel = x@vgmModel - class(vgmmodel) <- c("variogramModel", "data.frame") - vvres <- variogram(as.formula(paste(paste(x@variable, "residual", sep="."), "~ 1")), x@observed[paste(x@variable, "residual", sep=".")]) # model residuals - if(sum(!is.na(x@validation$residual))>2){ - vve <- variogram(residual ~ 1, x@validation["residual"]) # validation residuals - plot(x=vvres$dist, y=vvres$gamma, pch="+", col = "green", xlab='distance', cex=1.4, ylab='gamma', ylim = c(0, max(vv$gamma))) - points(x=vve$dist, y=vve$gamma, pch="+", col = "red", cex=1.4) - vline <- variogramLine(vgmmodel, maxdist=max(vvres$dist), n=length(vvres$dist)) - lines(x=vline$dist, y=vline$gamma, col = "green", lwd=2) - } else { - plot(x=c(0, vv$dist), y=rep(var(x@validation$observed), length(vv$dist)+1), xlab='distance', ylab='gamma', lty=2, type="l", ylim = c(0, max(vv$gamma))) - } -} - +# Purpose : Standard plots of a geostatistical model; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : pre-Alpha +# Note : ; + +plot.SpatialPredictions <- function(x, plot.predictions=TRUE, vertical=FALSE, col=SAGA_pal[[1]], ...){ + if(plot.predictions==TRUE){ + par(mfrow=c(2,2)) + } else { if(vertical==TRUE){ + par(mfrow=c(3,1)) + } else { + par(mfrow=c(1,3)) + } + } + par(mar=c(4.5,4.5,.8,.8)) + + if(plot.predictions==TRUE){ + if(any(names(x@predicted) %in% x@variable)){ + plot(raster(x@predicted[x@variable]), col=col) + } else { + plot(raster(x@predicted[1]), col=col) + } + points(x@observed, pch="+", cex=.8) + } + if(sum(!is.na(x@validation$residual))>2){ + plot(y=x@validation$var1.pred, x=x@validation$observed, pch=19, asp=1, col = "red", xlab='observed (CV)', col.main = rgb(0.99,0.99,0.99), ylab='predicted (CV)', ...) + abline(a=0, b=1, lwd=2) + } else { + plot(y=x@observed@data[,paste(x@variable, "modelFit", sep=".")], x=x@observed@data[,paste(x@variable)], pch=19, asp=1, col = "red", xlab='observed', col.main = rgb(0.99,0.99,0.99), ylab='predicted', ...) + abline(a=0, b=1, lwd=2) + } + vv <- variogram(as.formula("observed~1"), x@validation) + plot(x=vv$dist, y=vv$gamma, pch="+", col = "green", xlab='distance', cex=1.4, ylab='gamma', ylim = c(0, max(vv$gamma))) + lines(x=c(0, vv$dist), y=rep(var(x@validation$observed), length(vv$dist)+1), lty=2) + ## Residuals (only if available): + vgmmodel = x@vgmModel + class(vgmmodel) <- c("variogramModel", "data.frame") + vvres <- variogram(as.formula(paste(paste(x@variable, "residual", sep="."), "~ 1")), x@observed[paste(x@variable, "residual", sep=".")]) # model residuals + if(sum(!is.na(x@validation$residual))>2){ + vve <- variogram(residual ~ 1, x@validation["residual"]) # validation residuals + plot(x=vvres$dist, y=vvres$gamma, pch="+", col = "green", xlab='distance', cex=1.4, ylab='gamma', ylim = c(0, max(vv$gamma))) + points(x=vve$dist, y=vve$gamma, pch="+", col = "red", cex=1.4) + vline <- variogramLine(vgmmodel, maxdist=max(vvres$dist), n=length(vvres$dist)) + lines(x=vline$dist, y=vline$gamma, col = "green", lwd=2) + } else { + plot(x=c(0, vv$dist), y=rep(var(x@validation$observed), length(vv$dist)+1), xlab='distance', ylab='gamma', lty=2, type="l", ylim = c(0, max(vv$gamma))) + } +} + setMethod("plot", signature("SpatialPredictions"), plot.SpatialPredictions) \ No newline at end of file diff --git a/pkg/R/plotKML.GDALobj.R b/pkg/R/plotKML.GDALobj.R index 0fe686c..34e0b72 100644 --- a/pkg/R/plotKML.GDALobj.R +++ b/pkg/R/plotKML.GDALobj.R @@ -1,152 +1,157 @@ -# Note: Implemented for parallel processing. SuperOverlay file (https://developers.google.com/kml/documentation/kml_21tutorial?csw=1#superoverlays); - -plotKML.GDALobj <- function(obj, file.name, block.x, tiles=NULL, tiles.sel=NULL, altitude=0, altitudeMode="relativeToGround", colour_scale, z.lim=NULL, breaks.lst=NULL, kml.logo, overwrite=TRUE, cpus, home.url=".", desc=NULL, open.kml=TRUE, CRS=attr(obj, "projection"), plot.legend=TRUE){ - - if(!class(obj)=="GDALobj"){ - stop("Object of class \"GDALobj\" required.") - } - if(missing(colour_scale)){ - colour_scale <- SAGA_pal[[1]] - } - if(missing(z.lim)&is.null(breaks.lst)){ - try( z.lim <- c(attr(obj, "df")$Bmin, attr(obj, "df")$Bmax) ) - if(!is.numeric(z.lim)&length(z.lim)==2){ stop("Please specify 'z.lim' argument") } - } - if(!is.null(breaks.lst)&length(breaks.lst)<15){ - stop("'breaks.lst' must contain at least 15 elements") - } - if(is.na(CRS)){ - stop("'projection' missing or 'NA'") - } - - if(!length(colour_scale)==(length(breaks.lst)-1)&!is.null(breaks.lst)){ stop("'length(colour_scale)' and 'length(breaks.lst)-1' of equal length required") } - GDALobj.file <- attr(obj, "file") - if(is.null(tiles)){ - if(requireNamespace("landmap", quietly = TRUE)){ - ## if missing get tiling system using block.x: - tiles <- landmap::getSpatialTiles(obj, block.x = block.x, return.SpatialPolygons = FALSE) - } - } - if(is.null(tiles.sel)){ - ## if missing do all tiles: - tiles.sel <- 1:nrow(tiles) - } - if(min(tiles.sel)<1|max(tiles.sel)>nrow(tiles)|!is.integer(tiles.sel)){ stop("'tiles.sel' must be: integer within the range of tile numbers (see ?getSpatialTiles)") } - ## write all tiles: - if(requireNamespace("parallel", quietly = TRUE)&requireNamespace("snowfall", quietly = TRUE)){ - if(missing(cpus)){ cpus <- parallel::detectCores(all.tests = FALSE, logical = FALSE) } - snowfall::sfInit(parallel=TRUE, cpus=cpus) - snowfall::sfExport("GDALobj.file", "tiles", "tiles.sel", "breaks.lst", "altitude", "altitudeMode", "colour_scale", "z.lim", "overwrite", "CRS") - snowfall::sfLibrary(package="rgdal", character.only=TRUE) - snowfall::sfLibrary(package="sp", character.only=TRUE) - snowfall::sfLibrary(package="plotKML", character.only=TRUE) - snowfall::sfLibrary(package="XML", character.only=TRUE) - snowfall::sfLibrary(package="RSAGA", character.only=TRUE) - snowfall::sfLibrary(package="raster", character.only=TRUE) - lst <- snowfall::sfLapply(tiles.sel, .kml_SpatialGrid_tile, GDALobj.file=GDALobj.file, tiles=tiles, altitude=altitude, altitudeMode=altitudeMode, colour_scale=colour_scale, breaks.lst=breaks.lst, z.lim=z.lim, overwrite=overwrite, CRS=CRS) - snowfall::sfStop() - lst <- do.call(rbind, lst) - } else { - warning("To speed up writing of tiles install and load package 'snowfall'") - lst <- list(NULL) - for(i in 1:length(tiles.sel)){ - lst[[i]] <- .kml_SpatialGrid_tile(i, GDALobj.file=GDALobj.file, tiles=tiles, altitude=altitude, altitudeMode=altitudeMode, colour_scale=colour_scale, breaks.lst=breaks.lst, z.lim=z.lim, overwrite=overwrite) - } - } - - if(missing(file.name)){ - file.name <- set.file.extension(basename(GDALobj.file), ".kml") - } - kml_open(file.name) - kml.out <- get("kml.out", envir=plotKML.fileIO) - - ## add description: - if(!is.null(desc)){ - description_txt <- sprintf('', desc) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - } - ## Region and network link section: - network_txt <- sprintf(' - - %s - - - 128-1 - - - %.5f%.5f - %.5f%.5f - - - - %s - onRegion - - ', unlist(lst[["kml.tile"]]), unlist(lst[["north"]]), unlist(lst[["south"]]), unlist(lst[["east"]]), unlist(lst[["west"]]), paste(home.url, unlist(lst[["kml.tile"]]), sep="/")) - parseXMLAndAdd(network_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - ## add legend and/or logo: - if(plot.legend==TRUE){ - kml.legend <- paste0(strsplit(file.name, ".kml")[[1]][1], "_legend.png") - if(is.null(breaks.lst)){ - kml_legend.bar(x=signif(seq(z.lim[1], z.lim[2], length.out=25), 3), legend.file=kml.legend, legend.pal=colour_scale) - } else { - breaks.s <- seq(1, length(breaks.lst), length.out=15) - kml_legend.bar(x=as.factor(signif(breaks.lst[breaks.s], 2)), legend.file=kml.legend, legend.pal=colour_scale[breaks.s]) - } - kml_screen(image.file = kml.legend, position = "UL", sname = "legend") - } - if(!missing(kml.logo)){ kml_screen(image.file = kml.logo, position = "UR", sname = "logo") } - kml_close(file.name) - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } -} - -## auxiliary function: -.kml_SpatialGrid_tile <- function(i, GDALobj.file, colour, tiles, breaks.lst, colour_scale, altitude, altitudeMode, z.lim, N.min=4, overwrite, CRS){ - if(any(!c("offset.x", "offset.y", "region.dim.x", "region.dim.y") %in% names(tiles))){ stop("Missing columns in the 'tiles' object. See ?landmap::tile") } - kml.tile <- set.file.extension(paste0(strsplit(basename(GDALobj.file), "\\.")[[1]][1], "_T", i), ".kml") - raster_name = set.file.extension(paste0(strsplit(basename(GDALobj.file), "\\.")[[1]][1], "_T", i), ".png") - r <- readGDAL(GDALobj.file, offset=c(tiles$offset.y[i], tiles$offset.x[i]), region.dim=c(tiles$region.dim.y[i], tiles$region.dim.x[i]), silent=TRUE) - proj4string(r) = CRS - if(sum(!is.na(r@data[,1]))>N.min){ - prj.check <- check_projection(r, control = TRUE) - if(!prj.check) { suppressMessages( r <- reproject(r) ) } - if(is.numeric(r@data[,1])){ - if(!is.null(breaks.lst)){ - if(missing(colour)){ - r@data[,"colour"] <- cut(r@data[,1], breaks=breaks.lst, include.lowest=TRUE, right=FALSE) - } - } else { - names(r)[1] <- "colour" - } - pw = r@grid@cells.dim[1]*3 - ph = r@grid@cells.dim[2]*3 - ## get the bounding box: - north <- r@bbox[2,2] - south <- r@bbox[2,1] - east <- r@bbox[1,2] - west <- r@bbox[1,1] - if(!(overwrite==FALSE&file.exists(raster_name))){ - kml_open(kml.tile) - if(!is.null(z.lim)){ - suppressMessages( kml_layer(r, colour=colour, colour_scale=colour_scale, altitude=altitude, altitudeMode=altitudeMode, raster_name=raster_name, plot.legend=FALSE, png.width=pw, png.height=ph, z.lim=z.lim) ) - } else { - suppressMessages( kml_layer(r, colour=colour, colour_scale=colour_scale, altitude=altitude, altitudeMode=altitudeMode, raster_name=raster_name, plot.legend=FALSE, png.width=pw, png.height=ph) ) - } - kml_close(kml.tile) - } - } else { - kml.tile <- NULL - north <- NULL - south <- NULL - east <- NULL - west <- NULL - } - out <- data.frame(kml.tile=kml.tile, north=north, south=south, east=east, west=west) - return(out) - } -} +# Purpose : Generic methods to plot large rasters; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : Implemented for parallel processing. SuperOverlay file (https://developers.google.com/kml/documentation/kml_21tutorial?csw=1#superoverlays); + + +plotKML.GDALobj <- function(obj, file.name, block.x, tiles=NULL, tiles.sel=NULL, altitude=0, altitudeMode="relativeToGround", colour_scale, z.lim=NULL, breaks.lst=NULL, kml.logo, overwrite=TRUE, cpus, home.url=".", desc=NULL, open.kml=TRUE, CRS=attr(obj, "projection"), plot.legend=TRUE){ + + if(!class(obj)=="GDALobj"){ + stop("Object of class \"GDALobj\" required.") + } + if(missing(colour_scale)){ + colour_scale <- SAGA_pal[[1]] + } + if(missing(z.lim)&is.null(breaks.lst)){ + try( z.lim <- c(attr(obj, "df")$Bmin, attr(obj, "df")$Bmax) ) + if(!is.numeric(z.lim)&length(z.lim)==2){ stop("Please specify 'z.lim' argument") } + } + if(!is.null(breaks.lst)&length(breaks.lst)<15){ + stop("'breaks.lst' must contain at least 15 elements") + } + if(is.na(CRS)){ + stop("'projection' missing or 'NA'") + } + + if(!length(colour_scale)==(length(breaks.lst)-1)&!is.null(breaks.lst)){ stop("'length(colour_scale)' and 'length(breaks.lst)-1' of equal length required") } + GDALobj.file <- attr(obj, "file") + if(is.null(tiles)){ + if(requireNamespace("GSIF", quietly = TRUE)){ + ## if missing get tiling system using block.x: + tiles <- GSIF::getSpatialTiles(obj, block.x = block.x, return.SpatialPolygons = FALSE) + } + } + if(is.null(tiles.sel)){ + ## if missing do all tiles: + tiles.sel <- 1:nrow(tiles) + } + if(min(tiles.sel)<1|max(tiles.sel)>nrow(tiles)|!is.integer(tiles.sel)){ stop("'tiles.sel' must be: integer within the range of tile numbers (see ?getSpatialTiles)") } + ## write all tiles: + if(requireNamespace("parallel", quietly = TRUE)&requireNamespace("snowfall", quietly = TRUE)){ + if(missing(cpus)){ cpus <- parallel::detectCores(all.tests = FALSE, logical = FALSE) } + snowfall::sfInit(parallel=TRUE, cpus=cpus) + snowfall::sfExport("GDALobj.file", "tiles", "tiles.sel", "breaks.lst", "altitude", "altitudeMode", "colour_scale", "z.lim", "overwrite", "CRS") + snowfall::sfLibrary(package="rgdal", character.only=TRUE) + snowfall::sfLibrary(package="sp", character.only=TRUE) + snowfall::sfLibrary(package="plotKML", character.only=TRUE) + snowfall::sfLibrary(package="XML", character.only=TRUE) + snowfall::sfLibrary(package="RSAGA", character.only=TRUE) + snowfall::sfLibrary(package="raster", character.only=TRUE) + lst <- snowfall::sfLapply(tiles.sel, .kml_SpatialGrid_tile, GDALobj.file=GDALobj.file, tiles=tiles, altitude=altitude, altitudeMode=altitudeMode, colour_scale=colour_scale, breaks.lst=breaks.lst, z.lim=z.lim, overwrite=overwrite, CRS=CRS) + snowfall::sfStop() + lst <- do.call(rbind, lst) + } else { + warning("To speed up writing of tiles install and load package 'snowfall'") + lst <- list(NULL) + for(i in 1:length(tiles.sel)){ + lst[[i]] <- .kml_SpatialGrid_tile(i, GDALobj.file=GDALobj.file, tiles=tiles, altitude=altitude, altitudeMode=altitudeMode, colour_scale=colour_scale, breaks.lst=breaks.lst, z.lim=z.lim, overwrite=overwrite) + } + } + + if(missing(file.name)){ + file.name <- set.file.extension(basename(GDALobj.file), ".kml") + } + kml_open(file.name) + kml.out <- get("kml.out", envir=plotKML.fileIO) + + ## add description: + if(!is.null(desc)){ + description_txt <- sprintf('', desc) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + } + ## Region and network link section: + network_txt <- sprintf(' + + %s + + + 128-1 + + + %.5f%.5f + %.5f%.5f + + + + %s + onRegion + + ', unlist(lst[["kml.tile"]]), unlist(lst[["north"]]), unlist(lst[["south"]]), unlist(lst[["east"]]), unlist(lst[["west"]]), paste(home.url, unlist(lst[["kml.tile"]]), sep="/")) + parseXMLAndAdd(network_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + ## add legend and/or logo: + if(plot.legend==TRUE){ + kml.legend <- paste0(strsplit(file.name, ".kml")[[1]][1], "_legend.png") + if(is.null(breaks.lst)){ + kml_legend.bar(x=signif(seq(z.lim[1], z.lim[2], length.out=25), 3), legend.file=kml.legend, legend.pal=colour_scale) + } else { + breaks.s <- seq(1, length(breaks.lst), length.out=15) + kml_legend.bar(x=as.factor(signif(breaks.lst[breaks.s], 2)), legend.file=kml.legend, legend.pal=colour_scale[breaks.s]) + } + kml_screen(image.file = kml.legend, position = "UL", sname = "legend") + } + if(!missing(kml.logo)){ kml_screen(image.file = kml.logo, position = "UR", sname = "logo") } + kml_close(file.name) + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } +} + +## auxiliary function: +.kml_SpatialGrid_tile <- function(i, GDALobj.file, colour, tiles, breaks.lst, colour_scale, altitude, altitudeMode, z.lim, N.min=4, overwrite, CRS){ + if(any(!c("offset.x", "offset.y", "region.dim.x", "region.dim.y") %in% names(tiles))){ stop("Missing columns in the 'tiles' object. See ?GSIF::tile") } + kml.tile <- set.file.extension(paste0(strsplit(basename(GDALobj.file), "\\.")[[1]][1], "_T", i), ".kml") + raster_name = set.file.extension(paste0(strsplit(basename(GDALobj.file), "\\.")[[1]][1], "_T", i), ".png") + r <- readGDAL(GDALobj.file, offset=c(tiles$offset.y[i], tiles$offset.x[i]), region.dim=c(tiles$region.dim.y[i], tiles$region.dim.x[i]), silent=TRUE) + proj4string(r) = CRS + if(sum(!is.na(r@data[,1]))>N.min){ + prj.check <- check_projection(r, control = TRUE) + if(!prj.check) { suppressMessages( r <- reproject(r) ) } + if(is.numeric(r@data[,1])){ + if(!is.null(breaks.lst)){ + if(missing(colour)){ + r@data[,"colour"] <- cut(r@data[,1], breaks=breaks.lst, include.lowest=TRUE, right=FALSE) + } + } else { + names(r)[1] <- "colour" + } + pw = r@grid@cells.dim[1]*3 + ph = r@grid@cells.dim[2]*3 + ## get the bounding box: + north <- r@bbox[2,2] + south <- r@bbox[2,1] + east <- r@bbox[1,2] + west <- r@bbox[1,1] + if(!(overwrite==FALSE&file.exists(raster_name))){ + kml_open(kml.tile) + if(!is.null(z.lim)){ + suppressMessages( kml_layer(r, colour=colour, colour_scale=colour_scale, altitude=altitude, altitudeMode=altitudeMode, raster_name=raster_name, plot.legend=FALSE, png.width=pw, png.height=ph, z.lim=z.lim) ) + } else { + suppressMessages( kml_layer(r, colour=colour, colour_scale=colour_scale, altitude=altitude, altitudeMode=altitudeMode, raster_name=raster_name, plot.legend=FALSE, png.width=pw, png.height=ph) ) + } + kml_close(kml.tile) + } + } else { + kml.tile <- NULL + north <- NULL + south <- NULL + east <- NULL + west <- NULL + } + out <- data.frame(kml.tile=kml.tile, north=north, south=south, east=east, west=west) + return(out) + } +} diff --git a/pkg/R/plotKML.RasterBrickSimulations.R b/pkg/R/plotKML.RasterBrickSimulations.R index 7b6de69..9a7383f 100644 --- a/pkg/R/plotKML.RasterBrickSimulations.R +++ b/pkg/R/plotKML.RasterBrickSimulations.R @@ -1,71 +1,77 @@ - -setMethod("plotKML", "RasterBrickSimulations", function( - obj, - folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), - file.name = paste(folder.name, ".kml", sep=""), - obj.summary = TRUE, - pngwidth = 680, - pngheight = 200, - pngpointsize = 14, - kmz = get("kmz", envir = plotKML.opts), - open.kml = TRUE, - ... -){ - - ## objects to plot: - varname <- paste(obj@variable) - prj <- obj@sampled@proj4string - - ## summary properties of the RK model: - if(obj.summary==TRUE){ - md <- data.frame(Names=c("variable", "N.realizations", "cellsize.x", "cellsize.y", "Min.value", "Max.value"), Values=c(varname, nlayers(obj@realizations), res(obj@realizations)[1], res(obj@realizations)[2], signif(min(obj@realizations@data@min), 3), signif(max(obj@realizations@data@max), 3)), stringsAsFactors = FALSE) - html <- kml_description(md, asText = TRUE, cwidth = 120, twidth = 240) - } - - kml_open(folder.name = folder.name, file.name = file.name) - - ## add a description for the whole folder: - kml.out <- get("kml.out", envir=plotKML.fileIO) - description_txt <- sprintf('', html) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - - kml_layer(obj = obj@realizations, ...) - - ## densify coordinates: - tl <- spsample(obj@sampled, n=100, "regular") - tl <- SpatialLines(list(Lines(list(Line(coordinates(tl))), ID="t")), prj) - ## parse the transect: - kml_layer.SpatialLines(obj = tl, colours = rep(rgb(0,0,0), length(obj)), extrude = TRUE) - - ## plot cross section: - png(filename=paste(varname, "_cross_section.png", sep=""), width=pngwidth, height=pngheight, bg="white", pointsize=pngpointsize) - par(mar=c(4.5,4.5,.8,.8)) - ## extract values at the transect: - ov <- extract(obj@realizations, obj@sampled) - plot(1:length(ov[[1]][,1]), ov[[1]][,1], type="l", xlab="pixel index", ylab=varname, col="grey", lwd=2) - for(i in 2:(length(ov[[1]][1,])-1)){ - lines(1:length(ov[[1]][,i]), ov[[1]][,i], col="grey", lwd=2) - } - lines(1:length(ov[[1]][,1]), ov[[1]][,length(ov[[1]][1,])], lwd=2) - dev.off() - - ## add the cross section plot: - kml_screen(image.file = paste(varname, "_cross_section.png", sep=""), position = "LL", sname = "Transect with confidence limits") - - ## close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - ## open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - +# Purpose : Generic methods to plot RasterBricks in Google Earth (simulations / Time Series) +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : it basically works only with a single variable; + + +setMethod("plotKML", "RasterBrickSimulations", function( + obj, + folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), + file.name = paste(folder.name, ".kml", sep=""), + obj.summary = TRUE, + pngwidth = 680, + pngheight = 200, + pngpointsize = 14, + kmz = get("kmz", envir = plotKML.opts), + open.kml = TRUE, + ... +){ + + ## objects to plot: + varname <- paste(obj@variable) + prj <- obj@sampled@proj4string + + ## summary properties of the RK model: + if(obj.summary==TRUE){ + md <- data.frame(Names=c("variable", "N.realizations", "cellsize.x", "cellsize.y", "Min.value", "Max.value"), Values=c(varname, nlayers(obj@realizations), res(obj@realizations)[1], res(obj@realizations)[2], signif(min(obj@realizations@data@min), 3), signif(max(obj@realizations@data@max), 3)), stringsAsFactors = FALSE) + html <- kml_description(md, asText = TRUE, cwidth = 120, twidth = 240) + } + + kml_open(folder.name = folder.name, file.name = file.name) + + ## add a description for the whole folder: + kml.out <- get("kml.out", envir=plotKML.fileIO) + description_txt <- sprintf('', html) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + + kml_layer(obj = obj@realizations, ...) + + ## densify coordinates: + tl <- spsample(obj@sampled, n=100, "regular") + tl <- SpatialLines(list(Lines(list(Line(coordinates(tl))), ID="t")), prj) + ## parse the transect: + kml_layer.SpatialLines(obj = tl, colours = rep(rgb(0,0,0), length(obj)), extrude = TRUE) + + ## plot cross section: + png(filename=paste(varname, "_cross_section.png", sep=""), width=pngwidth, height=pngheight, bg="white", pointsize=pngpointsize) + par(mar=c(4.5,4.5,.8,.8)) + ## extract values at the transect: + ov <- extract(obj@realizations, obj@sampled) + plot(1:length(ov[[1]][,1]), ov[[1]][,1], type="l", xlab="pixel index", ylab=varname, col="grey", lwd=2) + for(i in 2:(length(ov[[1]][1,])-1)){ + lines(1:length(ov[[1]][,i]), ov[[1]][,i], col="grey", lwd=2) + } + lines(1:length(ov[[1]][,1]), ov[[1]][,length(ov[[1]][1,])], lwd=2) + dev.off() + + ## add the cross section plot: + kml_screen(image.file = paste(varname, "_cross_section.png", sep=""), position = "LL", sname = "Transect with confidence limits") + + ## close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + ## open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + # end of script; \ No newline at end of file diff --git a/pkg/R/plotKML.RasterBrickTimeSeries.R b/pkg/R/plotKML.RasterBrickTimeSeries.R index f649f23..25d3cf5 100644 --- a/pkg/R/plotKML.RasterBrickTimeSeries.R +++ b/pkg/R/plotKML.RasterBrickTimeSeries.R @@ -1,69 +1,74 @@ - -setMethod("plotKML", "RasterBrickTimeSeries", function( - obj, - folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), - file.name = paste(folder.name, ".kml", sep=""), - pngwidth = 680, - pngheight = 180, - pngpointsize = 14, - kmz = get("kmz", envir = plotKML.opts), - open.kml = TRUE, - ... -){ - - ## sampling locations: - if(!("data" %in% slotNames(obj@sampled))){ - labs <- paste(obj@sampled@data[,1]) - } else { - labs <- paste(1:length(obj@sampled)) - } - ## Begin end times: - TimeSpan.begin <- obj@TimeSpan.begin - TimeSpan.end <- obj@TimeSpan.end - ## copy mean times: - obj@rasters <- setZ(obj@rasters, paste(as.POSIXct(unclass(as.POSIXct(TimeSpan.begin))+(unclass(as.POSIXct(TimeSpan.end))-unclass(as.POSIXct(TimeSpan.begin)))/2, origin="1970-01-01"))) - dtime = unclass(as.POSIXct(TimeSpan.end)) - unclass(as.POSIXct(TimeSpan.begin)) - - ## open KML for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - ## add a description for the whole folder: - kml.out <- get("kml.out", envir=plotKML.fileIO) - description_txt <- sprintf('%s', obj@rasters@title) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - - ## extract values at point locations: - ov <- extract(obj@rasters, obj@sampled) - png_names <- paste(obj@variable, "_timeseries_", 1:nrow(ov), ".png", sep="") - html.table <- paste('', sep = '') - kml_layer.SpatialPoints(obj = obj@sampled, points_names = labs, html.table = html.table) - - ## plot rasters: - kml_layer(obj = obj@rasters, dtime=dtime, ...) - - ## plot the time-series data: - for(i in 1:nrow(ov)){ - png(filename=png_names[i], width=pngwidth, height=pngheight, bg="white", pointsize=pngpointsize) - par(mar=c(4.5,4.5,.8,.8)) - plot(as.Date(as.POSIXct(getZ(obj@rasters))), ov[i,], type="l", xlab="Date", ylab=obj@variable, col="grey", lwd=2) - points(as.Date(as.POSIXct(getZ(obj@rasters))), ov[i,], pch="+", cex=.6) - dev.off() - } - - ## close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - ## open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - +# Purpose : Generic method to plot time-series data in Google Earth +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : plots are in the description tag; + +setMethod("plotKML", "RasterBrickTimeSeries", function( + obj, + folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), + file.name = paste(folder.name, ".kml", sep=""), + pngwidth = 680, + pngheight = 180, + pngpointsize = 14, + kmz = get("kmz", envir = plotKML.opts), + open.kml = TRUE, + ... +){ + + ## sampling locations: + if(!("data" %in% slotNames(obj@sampled))){ + labs <- paste(obj@sampled@data[,1]) + } else { + labs <- paste(1:length(obj@sampled)) + } + ## Begin end times: + TimeSpan.begin <- obj@TimeSpan.begin + TimeSpan.end <- obj@TimeSpan.end + ## copy mean times: + obj@rasters <- setZ(obj@rasters, paste(as.POSIXct(unclass(as.POSIXct(TimeSpan.begin))+(unclass(as.POSIXct(TimeSpan.end))-unclass(as.POSIXct(TimeSpan.begin)))/2, origin="1970-01-01"))) + dtime = unclass(as.POSIXct(TimeSpan.end)) - unclass(as.POSIXct(TimeSpan.begin)) + + ## open KML for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + ## add a description for the whole folder: + kml.out <- get("kml.out", envir=plotKML.fileIO) + description_txt <- sprintf('%s', obj@rasters@title) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + + ## extract values at point locations: + ov <- extract(obj@rasters, obj@sampled) + png_names <- paste(obj@variable, "_timeseries_", 1:nrow(ov), ".png", sep="") + html.table <- paste('', sep = '') + kml_layer.SpatialPoints(obj = obj@sampled, points_names = labs, html.table = html.table) + + ## plot rasters: + kml_layer(obj = obj@rasters, dtime=dtime, ...) + + ## plot the time-series data: + for(i in 1:nrow(ov)){ + png(filename=png_names[i], width=pngwidth, height=pngheight, bg="white", pointsize=pngpointsize) + par(mar=c(4.5,4.5,.8,.8)) + plot(as.Date(as.POSIXct(getZ(obj@rasters))), ov[i,], type="l", xlab="Date", ylab=obj@variable, col="grey", lwd=2) + points(as.Date(as.POSIXct(getZ(obj@rasters))), ov[i,], pch="+", cex=.6) + dev.off() + } + + ## close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + ## open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + # end of script; \ No newline at end of file diff --git a/pkg/R/plotKML.SpatialMaxEntOutput.R b/pkg/R/plotKML.SpatialMaxEntOutput.R index 66a3223..80f8d67 100644 --- a/pkg/R/plotKML.SpatialMaxEntOutput.R +++ b/pkg/R/plotKML.SpatialMaxEntOutput.R @@ -1,3 +1,8 @@ +# Purpose : Generic method to plot Species distribution models in Google Earth +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : Only Google Earth 5.0 (and later) supports plain text content, as well as full HTML and JavaScript, within description balloons; setMethod("plotKML", "SpatialMaxEntOutput", function( obj, diff --git a/pkg/R/plotKML.SpatialPredictions.R b/pkg/R/plotKML.SpatialPredictions.R index 83a2f4a..5ca0ea5 100644 --- a/pkg/R/plotKML.SpatialPredictions.R +++ b/pkg/R/plotKML.SpatialPredictions.R @@ -1,97 +1,104 @@ - -setMethod("plotKML", "SpatialPredictions", function( - obj, - folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), - file.name = paste(folder.name, ".kml", sep=""), - colour, - grid2poly = FALSE, - obj.summary = FALSE, - plot.svar = FALSE, - pngwidth = 210, - pngheight = 580, - pngpointsize = 14, - metadata = NULL, - kmz = get("kmz", envir = plotKML.opts), - open.kml = TRUE, - ... -){ - - ## Guess aesthetics if missing: - varname <- paste(obj@variable) - if(missing(colour)){ - obj@predicted@data[,"colour"] <- obj@predicted@data[,varname] - } else { - if(is.name(colour)|is.call(colour)){ - obj@predicted@data[,"colour"] <- eval(colour, obj@predicted@data) - } else { - obj@predicted@data[,"colour"] <- obj@predicted@data[,as.character(colour)] - } - } - pred <- obj@predicted["colour"] - - ## sampling locations: - locs <- obj@observed - labs <- paste(signif(locs@data[,varname], 3)) - - ## summary properties of the RK model: - if(obj.summary==TRUE){ - xx <- summary(obj) - xd <- unlist(xx[!names(xx) %in% c("bonds", "breaks")]) - md <- data.frame(Names=attr(xd, "names"), Values=xd, stringsAsFactors = FALSE) - html <- kml_description(md, asText = TRUE, cwidth = 120, twidth = 240) - } - - if(grid2poly == TRUE){ - pol <- grid2poly(pred) - } - - kml_open(folder.name = folder.name, file.name = file.name) - - if(obj.summary==TRUE){ - ## add a description for the whole folder: - kml.out <- get("kml.out", envir=plotKML.fileIO) - description_txt <- sprintf('', html) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - } - - if(grid2poly == TRUE){ - kml_layer(pol, colour = colour, ...) - } else { - kml_layer(pred, colour = colour, raster_name = paste(varname, "_predicted.png", sep=""), metadata = metadata, ...) - } - - if(plot.svar==TRUE){ - ## plot the prediction variance? - svarname <- paste(obj@variable, ".", "svar", sep="") - svar <- obj@predicted[svarname] - names(svar) <- "colour" - kml_layer(svar, colour = colour, colour_scale = get("colour_scale_svar", envir = plotKML.opts), raster_name = paste(svarname, "_svar.png", sep=""), plot.legend = FALSE) - } - - kml_layer(obj = locs, points_names = labs) - - ## plot the correlation graph and variogram: - if(any(names(obj@validation) %in% "var1.pred")){ - if(all(!is.na(obj@validation$var1.pred)) & all(!is.na(obj@validation$observed))){ - png(filename=paste(varname, "_gstatplots.png", sep=""), width=pngwidth, height=pngheight, bg="white", pointsize=pngpointsize) - plot.SpatialPredictions(obj, plot.predictions=FALSE, vertical=TRUE) - dev.off() - - ## add the SpatialPredictions plot: - kml_screen(image.file = paste(varname, "_gstatplots.png", sep=""), position = "LL", sname = "gstatModel summary plot") - } - } - - ## close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - ## open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } -}) +# Purpose : Generic methods to plot geostatistical mapping views in KML (a combination of objects) +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Dev Status : Alpha +# Note : standard geostat plot; + + +setMethod("plotKML", "SpatialPredictions", function( + obj, + folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), + file.name = paste(folder.name, ".kml", sep=""), + colour, + grid2poly = FALSE, + obj.summary = TRUE, + plot.svar = FALSE, + pngwidth = 210, + pngheight = 580, + pngpointsize = 14, + metadata = NULL, + kmz = get("kmz", envir = plotKML.opts), + open.kml = TRUE, + ... +){ + + ## Guess aesthetics if missing: + varname <- paste(obj@variable) + if(missing(colour)){ + obj@predicted@data[,"colour"] <- obj@predicted@data[,varname] + } else { + if(is.name(colour)|is.call(colour)){ + obj@predicted@data[,"colour"] <- eval(colour, obj@predicted@data) + } else { + obj@predicted@data[,"colour"] <- obj@predicted@data[,as.character(colour)] + } + } + pred <- obj@predicted["colour"] + + ## sampling locations: + locs <- obj@observed + labs <- paste(signif(locs@data[,varname], 3)) + + ## summary properties of the RK model: + if(obj.summary==TRUE){ + xx <- summary(obj) + xd <- unlist(xx[!names(xx) %in% c("bonds", "breaks")]) + md <- data.frame(Names=attr(xd, "names"), Values=xd, stringsAsFactors = FALSE) + html <- kml_description(md, asText = TRUE, cwidth = 120, twidth = 240) + } + + if(grid2poly == TRUE){ + pol <- grid2poly(pred) + } + + kml_open(folder.name = folder.name, file.name = file.name) + + if(obj.summary==TRUE){ + ## add a description for the whole folder: + kml.out <- get("kml.out", envir=plotKML.fileIO) + description_txt <- sprintf('', html) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + } + + if(grid2poly == TRUE){ + kml_layer(pol, colour = colour, ...) + } else { + kml_layer(pred, colour = colour, raster_name = paste(varname, "_predicted.png", sep=""), metadata = metadata, ...) + } + + if(plot.svar==TRUE){ + ## plot the prediction variance? + svarname <- paste(obj@variable, ".", "svar", sep="") + svar <- obj@predicted[svarname] + names(svar) <- "colour" + kml_layer(svar, colour = colour, colour_scale = get("colour_scale_svar", envir = plotKML.opts), raster_name = paste(svarname, "_svar.png", sep=""), plot.legend = FALSE) + } + + kml_layer(obj = locs, points_names = labs) + + ## plot the correlation graph and variogram: + if(all(!is.na(obj@validation$var1.pred)) & all(!is.na(obj@validation$observed))){ + png(filename=paste(varname, "_gstatplots.png", sep=""), width=pngwidth, height=pngheight, bg="white", pointsize=pngpointsize) + plot.SpatialPredictions(obj, plot.predictions=FALSE, vertical=TRUE) + dev.off() + + ## add the SpatialPredictions plot: + kml_screen(image.file = paste(varname, "_gstatplots.png", sep=""), position = "LL", sname = "gstatModel summary plot") + } + + ## close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + ## open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } +}) + + +# end of script; \ No newline at end of file diff --git a/pkg/R/plotKML.SpatialSamplingPattern.R b/pkg/R/plotKML.SpatialSamplingPattern.R index deedc3a..49d22fc 100644 --- a/pkg/R/plotKML.SpatialSamplingPattern.R +++ b/pkg/R/plotKML.SpatialSamplingPattern.R @@ -1,50 +1,56 @@ - -setMethod("plotKML", "SpatialSamplingPattern", function( - obj, - folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), - file.name = paste(folder.name, ".kml", sep=""), - colour, - kmz = get("kmz", envir = plotKML.opts), - open.kml = TRUE, - ... -){ - - # target variable: - if(missing(colour)){ - obj@sp.domain@data[,"colour"] <- obj@sp.domain@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@sp.domain@data[,"colour"] <- eval(colour, obj@sp.domain@data) - } else { - obj@sp.domain@data[,"colour"] <- obj@sp.domain@data[,as.character(colour)] - } - } - - # open the KML file for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # add a description for the whole folder: - kml.out <- get("kml.out", envir=plotKML.fileIO) - description_txt <- sprintf('', obj@method) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - - # plot strata and points: - kml_layer.SpatialPolygons(obj = obj@sp.domain, colour = colour) - kml_layer.SpatialPoints(obj = obj@pattern, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } -}) - +# Purpose : Generic methods to plot sampling designs +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : it is largely based on the spcosa classes; + + +setMethod("plotKML", "SpatialSamplingPattern", function( + obj, + folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), + file.name = paste(folder.name, ".kml", sep=""), + colour, + kmz = get("kmz", envir = plotKML.opts), + open.kml = TRUE, + ... +){ + + # target variable: + if(missing(colour)){ + obj@sp.domain@data[,"colour"] <- obj@sp.domain@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@sp.domain@data[,"colour"] <- eval(colour, obj@sp.domain@data) + } else { + obj@sp.domain@data[,"colour"] <- obj@sp.domain@data[,as.character(colour)] + } + } + + # open the KML file for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # add a description for the whole folder: + kml.out <- get("kml.out", envir=plotKML.fileIO) + description_txt <- sprintf('', obj@method) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + + # plot strata and points: + kml_layer.SpatialPolygons(obj = obj@sp.domain, colour = colour) + kml_layer.SpatialPoints(obj = obj@pattern, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } +}) + # end of script; \ No newline at end of file diff --git a/pkg/R/plotKML.SpatialVectorsSimulations.R b/pkg/R/plotKML.SpatialVectorsSimulations.R index d03f59a..22a6d16 100644 --- a/pkg/R/plotKML.SpatialVectorsSimulations.R +++ b/pkg/R/plotKML.SpatialVectorsSimulations.R @@ -1,85 +1,91 @@ - -## plot object: -setMethod("plotKML", "SpatialVectorsSimulations", function( - obj, - folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), - file.name = paste(folder.name, ".kml", sep=""), - colour, - grid2poly = FALSE, - obj.summary = TRUE, - plot.svar = FALSE, - kmz = get("kmz", envir = plotKML.opts), - open.kml = TRUE, - ... -){ - - # if missing colour, pick the first var on the list - if(missing(colour)){ - obj@summaries@data[,"colour"] <- obj@summaries@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@summaries@data[,"colour"] <- eval(colour, obj@summaries@data) - } else { - obj@summaries@data[,"colour"] <- obj@summaries@data[,as.character(colour)] - } - } - - # error map (this assumes that it is always the 2nd on the list): - colour.sd <- obj@summaries@data[,2] - # mask out 0 pixels - obj@summaries@data[,"colour"] <- ifelse(obj@summaries@data[,"colour"]==0, NA, obj@summaries@data[,"colour"]) - N.r <- length(obj@realizations) - - # summary properties of the RK model: - if(obj.summary==TRUE){ - sel <- obj@summaries@data[,"colour"]>0 - md <- data.frame(Names=c("N.realizations", "avg.probability", "N.pixels"), Values=c(N.r, signif(mean(obj@summaries@data[sel,"colour"], na.rm=TRUE), 3), sum(sel, na.rm=TRUE)), stringsAsFactors = FALSE) - html <- kml_description(md, asText = TRUE, cwidth = 120, twidth = 240) - } - - if(grid2poly == TRUE){ - pol <- grid2poly(obj@summaries["colour"]) - } - - kml_open(folder.name = folder.name, file.name = file.name) - - # add a description for the whole folder: - kml.out <- get("kml.out", envir=plotKML.fileIO) - description_txt <- sprintf('', html) - parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) - assign('kml.out', kml.out, envir=plotKML.fileIO) - - if(grid2poly == TRUE){ - kml_layer(obj = pol, colour = colour, ...) - } - else { - kml_layer(obj = obj@summaries, z.lim = c(0,1), colour = colour, raster_name = paste(folder.name, "_observed.png", sep=""), ...) - } - - if(plot.svar==TRUE){ - kml_layer(obj = obj@summaries, colour = colour.sd, colour_scale = get("colour_scale_svar", envir = plotKML.opts), raster_name = paste(folder.name, "_observed.sd.png", sep=""), plot.legend = FALSE) - } - - # Realizations: - for(i in 1:N.r){ - rel <- obj@realizations[[i]] - kml_layer(obj = rel, TimeSpan.begin = i, TimeSpan.end = i+1) - } - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - +# Purpose : Generic method to plot simulated equiprobable vectors in Google Earth +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Alpha +# Note : it basically requires only a single input object; + + +## plot object: +setMethod("plotKML", "SpatialVectorsSimulations", function( + obj, + folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), + file.name = paste(folder.name, ".kml", sep=""), + colour, + grid2poly = FALSE, + obj.summary = TRUE, + plot.svar = FALSE, + kmz = get("kmz", envir = plotKML.opts), + open.kml = TRUE, + ... +){ + + # if missing colour, pick the first var on the list + if(missing(colour)){ + obj@summaries@data[,"colour"] <- obj@summaries@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@summaries@data[,"colour"] <- eval(colour, obj@summaries@data) + } else { + obj@summaries@data[,"colour"] <- obj@summaries@data[,as.character(colour)] + } + } + + # error map (this assumes that it is always the 2nd on the list): + colour.sd <- obj@summaries@data[,2] + # mask out 0 pixels + obj@summaries@data[,"colour"] <- ifelse(obj@summaries@data[,"colour"]==0, NA, obj@summaries@data[,"colour"]) + N.r <- length(obj@realizations) + + # summary properties of the RK model: + if(obj.summary==TRUE){ + sel <- obj@summaries@data[,"colour"]>0 + md <- data.frame(Names=c("N.realizations", "avg.probability", "N.pixels"), Values=c(N.r, signif(mean(obj@summaries@data[sel,"colour"], na.rm=TRUE), 3), sum(sel, na.rm=TRUE)), stringsAsFactors = FALSE) + html <- kml_description(md, asText = TRUE, cwidth = 120, twidth = 240) + } + + if(grid2poly == TRUE){ + pol <- grid2poly(obj@summaries["colour"]) + } + + kml_open(folder.name = folder.name, file.name = file.name) + + # add a description for the whole folder: + kml.out <- get("kml.out", envir=plotKML.fileIO) + description_txt <- sprintf('', html) + parseXMLAndAdd(description_txt, parent=kml.out[["Document"]]) + assign('kml.out', kml.out, envir=plotKML.fileIO) + + if(grid2poly == TRUE){ + kml_layer(obj = pol, colour = colour, ...) + } + else { + kml_layer(obj = obj@summaries, z.lim = c(0,1), colour = colour, raster_name = paste(folder.name, "_observed.png", sep=""), ...) + } + + if(plot.svar==TRUE){ + kml_layer(obj = obj@summaries, colour = colour.sd, colour_scale = get("colour_scale_svar", envir = plotKML.opts), raster_name = paste(folder.name, "_observed.sd.png", sep=""), plot.legend = FALSE) + } + + # Realizations: + for(i in 1:N.r){ + rel <- obj@realizations[[i]] + kml_layer(obj = rel, TimeSpan.begin = i, TimeSpan.end = i+1) + } + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + # end of script; \ No newline at end of file diff --git a/pkg/R/plotKML.sp.R b/pkg/R/plotKML.sp.R index 0b72084..31b71c9 100644 --- a/pkg/R/plotKML.sp.R +++ b/pkg/R/plotKML.sp.R @@ -1,410 +1,416 @@ - -setMethod("plotKML", "SpatialPointsDataFrame", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), size, colour, points_names, shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - # Guess aesthetics if missing: - if(missing(size)){ - obj@data[,"size"] <- obj@data[,1] - } else { - if(is.name(size)|is.call(size)){ - obj@data[,"size"] <- eval(size, obj@data) - } else { - obj@data[,"size"] <- obj@data[,deparse(size)] - } - } - if(missing(colour)){ - obj@data[,"colour"] <- obj@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@data[,"colour"] <- eval(colour, obj@data) - } else { - obj@data[,"colour"] <- obj@data[,as.character(colour)] - } - } - if(missing(points_names)){ - if(is.numeric(obj@data[,1])){ - points_names <- signif(obj@data[,1], 3) - } else { - points_names <- paste(obj@data[,1]) - } - } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - if(is.numeric(obj@data[,"colour"])){ - kml_layer.SpatialPoints(obj, size = size, colour = colour, points_names = points_names, shape = shape, metadata = metadata, ...) - } else { - kml_layer.SpatialPoints(obj, colour = colour, points_names = points_names, shape = shape, metadata = metadata, ...) - } - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - -setMethod("plotKML", "SpatialLinesDataFrame", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - kml_layer.SpatialLines(obj, metadata = metadata, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - -setMethod("plotKML", "SpatialPolygonsDataFrame", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, plot.labpt, labels, metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - # Guess aesthetics if missing: - if(missing(labels)){ - obj@data[,"labels"] <- obj@data[,1] - } else { - if(is.name(labels)|is.call(labels)){ - obj@data[,"labels"] <- eval(labels, obj@data) - } else { - obj@data[,"labels"] <- obj@data[,deparse(labels)] - } - } - if(missing(colour)){ - obj@data[,"colour"] <- obj@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@data[,"colour"] <- eval(colour, obj@data) - } else { - obj@data[,"colour"] <- obj@data[,as.character(colour)] - } - } - if(missing(plot.labpt)){ plot.labpt <- TRUE } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - kml_layer.SpatialPolygons(obj, colour = colour, plot.labpt = plot.labpt, labels = labels, metadata = metadata, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - -## Pixels Grids Raster -.plotKML.SpatialPixels <- function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, raster_name, metadata = NULL, kmz = FALSE, open.kml = TRUE, ...){ - - # the kml_layer.Raster works only with "Spatial" class: - if(class(obj)=="RasterLayer"){ - obj <- as(obj, "SpatialGridDataFrame") - } - - # Guess aesthetics if missing: - if(missing(colour)){ - obj@data[,"colour"] <- obj@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@data[,"colour"] <- eval(colour, obj@data) - } else { - obj@data[,"colour"] <- obj@data[,as.character(colour)] - } - } - if(missing(raster_name)){ - raster_name <- paste(normalizeFilename(names(obj)[1]), ".png", sep="") - } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - kml_layer(obj, colour = colour, raster_name = raster_name, metadata = metadata, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -} - -setMethod("plotKML", "SpatialPixelsDataFrame", .plotKML.SpatialPixels) -setMethod("plotKML", "SpatialGridDataFrame", .plotKML.SpatialPixels) -setMethod("plotKML", "RasterLayer", .plotKML.SpatialPixels) - - -setMethod("plotKML", "SpatialPhotoOverlay", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), dae.name, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - x <- strsplit(obj@filename, "/")[[1]] - image.id <- x[length(x)] - if(missing(dae.name)){ dae.name <- gsub(x=image.id, "\\.", "_") } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name, ...) - - # write layer: - kml_layer.SpatialPhotoOverlay(obj, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name, files=dae.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - -setMethod("plotKML", "SoilProfileCollection", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), var.name, metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - if(missing(var.name)){ var.name <- names(obj@horizons)[!(names(obj@horizons) %in% c(obj@idcol, obj@depthcols))][1] } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - kml_layer.SoilProfileCollection(obj, var.name = var.name, balloon = TRUE, metadata = metadata, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - -## spacetime irregular vectors / spacetime full data frames... -.plotKML.ST <- function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", points_names, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - # Guess aesthetics if missing: - if(missing(colour)){ - obj@data[,"colour"] <- obj@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@data[,"colour"] <- eval(colour, obj@data) - } else { - obj@data[,"colour"] <- obj@data[,as.character(colour)] - } - } - if(missing(points_names)&class(obj@sp)=="SpatialPoints"){ - if(is.numeric(obj@data[,1])){ - points_names <- signif(obj@data[,1], 3) - } else { - points_names <- paste(obj@data[,1]) - } - } - # subset to target variable: - obj <- obj[,,"colour"] - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - if(class(obj@sp)=="SpatialPoints"){ - kml_layer(obj, shape = shape, colour = colour, points_names = points_names, ...) - } else { - kml_layer(obj, ...) - } - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -} - -setMethod("plotKML", "STIDF", .plotKML.ST) -setMethod("plotKML", "STFDF", function(obj, ...) .plotKML.ST(as(obj, "STIDF"), ...)) -setMethod("plotKML", "STSDF", function(obj, ...) .plotKML.ST(as(obj, "STIDF"), ...)) - - -## Trajectories: -setMethod("plotKML", "STTDF", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, start.icon = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - # Guess aesthetics if missing: - if(missing(colour)){ - obj@data[,"colour"] <- obj@data[,1] - message("Plotting the first variable on the list") - } else { - if(is.name(colour)|is.call(colour)){ - obj@data[,"colour"] <- eval(colour, obj@data) - } else { - obj@data[,"colour"] <- obj@data[,as.character(colour)] - } - } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - # write layer: - kml_layer.STTDF(obj, colour = colour, start.icon = start.icon, ...) - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - -## List of objects of type "sp" -setMethod("plotKML", "list", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), size = NULL, colour, points_names = "", shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", plot.labpt = TRUE, labels = "", metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ - - # check class of object: - if(any(!(sapply(obj, class)=="SpatialPointsDataFrame"|sapply(obj, class)=="SpatialLinesDataFrame"|sapply(obj, class)=="SpatialPolygonsDataFrame"|sapply(obj, class)=="SpatialPixelsDataFrame"))){ - stop("List of objects of class SpatialPoints*, SpatialLines*, SpatialPolygons*, SpatialPixels* expected") - } - - # open for writing: - kml_open(folder.name = folder.name, file.name = file.name) - - ## target variable: - for(i in 1:length(obj)){ - if(missing(colour)){ - obj[[i]]@data[,"colour"] <- obj[[i]]@data[,1] - } else { - if(is.name(colour)|is.call(colour)){ - obj[[i]]@data[,"colour"] <- eval(colour, obj[[i]]@data) - } else { - obj[[i]]@data[,"colour"] <- obj[[i]]@data[,as.character(colour)] - } - } - } - - if(all(sapply(obj, class)=="SpatialPointsDataFrame")){ - for(i in 1:length(obj)){ - - if(points_names == ""){ - if(is.numeric(obj[[i]]@data[,1])){ - points_names_i <- signif(obj[[i]]@data[,1], 3) - } else { - points_names_i <- paste(obj[[i]]@data[,1]) - } - } - - if(is.numeric(obj[[i]]@data[,"colour"])){ - kml_layer.SpatialPoints(obj[[i]], colour = colour, points_names = points_names_i, shape = shape, metadata = metadata, ...) - } else { - kml_layer.SpatialPoints(obj[[i]], colour = colour, points_names = points_names, shape = shape, metadata = metadata, ...) - } - } - } - - if(all(sapply(obj, class)=="SpatialLinesDataFrame")){ - for(i in 1:length(obj)){ - kml_layer.SpatialLines(obj[[i]], metadata = metadata, ...) - } - } - - if(all(sapply(obj, class)=="SpatialPolygonsDataFrame")){ - for(i in 1:length(obj)){ - # Guess aesthetics if missing: - if(labels == ""){ - labels_i <- obj[[i]]@data[,1] - } else { - if(is.name(labels)|is.call(labels)){ - labels_i <- eval(labels, obj[[i]]@data) - } else { - labels_i <- obj[[i]]@data[,deparse(labels)] - } - } - - kml_layer.SpatialPolygons(obj[[i]], colour = colour, plot.labpt = plot.labpt, labels = labels_i, metadata = metadata, ...) - } - } - - if(all(sapply(obj, class)=="SpatialPixelsDataFrame")){ - for(i in 1:length(obj)){ - - ## subset to the bounding box if necessary: - bbn <- round(diff(obj[[i]]@bbox[1,])/obj[[i]]@grid@cellsize[1])*round(diff(obj[[i]]@bbox[2,])/obj[[i]]@grid@cellsize[2]) - if(max(obj[[i]]@grid.index, na.rm=TRUE)>bbn){ - x <- as.data.frame(obj[[i]]) - suppressWarnings( gridded(x) <- ~x+y ) - proj4string(x) = obj[[i]]@proj4string - obj[[i]] <- x - } - - raster_name_i <- paste(names(obj[[i]])[1], "_", i, ".png", sep="") - kml_layer.SpatialPixels(obj[[i]], colour = colour, raster_name = raster_name_i, metadata = metadata, plot.legend=FALSE, ...) - } - } - - # close the file: - kml_close(file.name = file.name) - if (kmz == TRUE){ - kml_compress(file.name = file.name) - } - # open KML file in the default browser: - if(open.kml==TRUE){ - kml_View(file.name) - } else { - message(paste("Object written to:", file.name)) - } - -}) - - +# Purpose : Default methods to plot sp-type objects; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : pre-Alpha +# Note : these functions can be further customized; + + +setMethod("plotKML", "SpatialPointsDataFrame", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), size, colour, points_names, shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # Guess aesthetics if missing: + if(missing(size)){ + obj@data[,"size"] <- obj@data[,1] + } else { + if(is.name(size)|is.call(size)){ + obj@data[,"size"] <- eval(size, obj@data) + } else { + obj@data[,"size"] <- obj@data[,deparse(size)] + } + } + if(missing(colour)){ + obj@data[,"colour"] <- obj@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@data[,"colour"] <- eval(colour, obj@data) + } else { + obj@data[,"colour"] <- obj@data[,as.character(colour)] + } + } + if(missing(points_names)){ + if(is.numeric(obj@data[,1])){ + points_names <- signif(obj@data[,1], 3) + } else { + points_names <- paste(obj@data[,1]) + } + } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + if(is.numeric(obj@data[,"colour"])){ + kml_layer.SpatialPoints(obj, size = size, colour = colour, points_names = points_names, shape = shape, metadata = metadata, ...) + } else { + kml_layer.SpatialPoints(obj, colour = colour, points_names = points_names, shape = shape, metadata = metadata, ...) + } + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + +setMethod("plotKML", "SpatialLinesDataFrame", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + kml_layer.SpatialLines(obj, metadata = metadata, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + +setMethod("plotKML", "SpatialPolygonsDataFrame", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, plot.labpt, labels, metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # Guess aesthetics if missing: + if(missing(labels)){ + obj@data[,"labels"] <- obj@data[,1] + } else { + if(is.name(labels)|is.call(labels)){ + obj@data[,"labels"] <- eval(labels, obj@data) + } else { + obj@data[,"labels"] <- obj@data[,deparse(labels)] + } + } + if(missing(colour)){ + obj@data[,"colour"] <- obj@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@data[,"colour"] <- eval(colour, obj@data) + } else { + obj@data[,"colour"] <- obj@data[,as.character(colour)] + } + } + if(missing(plot.labpt)){ plot.labpt <- TRUE } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + kml_layer.SpatialPolygons(obj, colour = colour, plot.labpt = plot.labpt, labels = labels, metadata = metadata, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + +## Pixels Grids Raster +.plotKML.SpatialPixels <- function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, raster_name, metadata = NULL, kmz = FALSE, open.kml = TRUE, ...){ + + # the kml_layer.Raster works only with "Spatial" class: + if(class(obj)=="RasterLayer"){ + obj <- as(obj, "SpatialGridDataFrame") + } + + # Guess aesthetics if missing: + if(missing(colour)){ + obj@data[,"colour"] <- obj@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@data[,"colour"] <- eval(colour, obj@data) + } else { + obj@data[,"colour"] <- obj@data[,as.character(colour)] + } + } + if(missing(raster_name)){ + raster_name <- paste(normalizeFilename(names(obj)[1]), ".png", sep="") + } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + kml_layer(obj, colour = colour, raster_name = raster_name, metadata = metadata, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +} + +setMethod("plotKML", "SpatialPixelsDataFrame", .plotKML.SpatialPixels) +setMethod("plotKML", "SpatialGridDataFrame", .plotKML.SpatialPixels) +setMethod("plotKML", "RasterLayer", .plotKML.SpatialPixels) + + +setMethod("plotKML", "SpatialPhotoOverlay", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), dae.name, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + x <- strsplit(obj@filename, "/")[[1]] + image.id <- x[length(x)] + if(missing(dae.name)){ dae.name <- gsub(x=image.id, "\\.", "_") } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name, ...) + + # write layer: + kml_layer.SpatialPhotoOverlay(obj, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name, files=dae.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + +setMethod("plotKML", "SoilProfileCollection", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), var.name, metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + if(missing(var.name)){ var.name <- names(obj@horizons)[!(names(obj@horizons) %in% c(obj@idcol, obj@depthcols))][1] } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + kml_layer.SoilProfileCollection(obj, var.name = var.name, balloon = TRUE, metadata = metadata, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + +## spacetime irregular vectors / spacetime full data frames... +.plotKML.ST <- function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", points_names, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # Guess aesthetics if missing: + if(missing(colour)){ + obj@data[,"colour"] <- obj@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@data[,"colour"] <- eval(colour, obj@data) + } else { + obj@data[,"colour"] <- obj@data[,as.character(colour)] + } + } + if(missing(points_names)&class(obj@sp)=="SpatialPoints"){ + if(is.numeric(obj@data[,1])){ + points_names <- signif(obj@data[,1], 3) + } else { + points_names <- paste(obj@data[,1]) + } + } + # subset to target variable: + obj <- obj[,,"colour"] + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + if(class(obj@sp)=="SpatialPoints"){ + kml_layer(obj, shape = shape, colour = colour, points_names = points_names, ...) + } else { + kml_layer(obj, ...) + } + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +} + +setMethod("plotKML", "STIDF", .plotKML.ST) +setMethod("plotKML", "STFDF", function(obj, ...) .plotKML.ST(as(obj, "STIDF"), ...)) +setMethod("plotKML", "STSDF", function(obj, ...) .plotKML.ST(as(obj, "STIDF"), ...)) + + +## Trajectories: +setMethod("plotKML", "STTDF", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, start.icon = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # Guess aesthetics if missing: + if(missing(colour)){ + obj@data[,"colour"] <- obj@data[,1] + message("Plotting the first variable on the list") + } else { + if(is.name(colour)|is.call(colour)){ + obj@data[,"colour"] <- eval(colour, obj@data) + } else { + obj@data[,"colour"] <- obj@data[,as.character(colour)] + } + } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + # write layer: + kml_layer.STTDF(obj, colour = colour, start.icon = start.icon, ...) + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + +## List of objects of type "sp" +setMethod("plotKML", "list", function(obj, folder.name = normalizeFilename(deparse(substitute(obj, env=parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), size = NULL, colour, points_names = "", shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png", plot.labpt = TRUE, labels = "", metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, ...){ + + # check class of object: + if(any(!(sapply(obj, class)=="SpatialPointsDataFrame"|sapply(obj, class)=="SpatialLinesDataFrame"|sapply(obj, class)=="SpatialPolygonsDataFrame"|sapply(obj, class)=="SpatialPixelsDataFrame"))){ + stop("List of objects of class SpatialPoints*, SpatialLines*, SpatialPolygons*, SpatialPixels* expected") + } + + # open for writing: + kml_open(folder.name = folder.name, file.name = file.name) + + ## target variable: + for(i in 1:length(obj)){ + if(missing(colour)){ + obj[[i]]@data[,"colour"] <- obj[[i]]@data[,1] + } else { + if(is.name(colour)|is.call(colour)){ + obj[[i]]@data[,"colour"] <- eval(colour, obj[[i]]@data) + } else { + obj[[i]]@data[,"colour"] <- obj[[i]]@data[,as.character(colour)] + } + } + } + + if(all(sapply(obj, class)=="SpatialPointsDataFrame")){ + for(i in 1:length(obj)){ + + if(points_names == ""){ + if(is.numeric(obj[[i]]@data[,1])){ + points_names_i <- signif(obj[[i]]@data[,1], 3) + } else { + points_names_i <- paste(obj[[i]]@data[,1]) + } + } + + if(is.numeric(obj[[i]]@data[,"colour"])){ + kml_layer.SpatialPoints(obj[[i]], colour = colour, points_names = points_names_i, shape = shape, metadata = metadata, ...) + } else { + kml_layer.SpatialPoints(obj[[i]], colour = colour, points_names = points_names, shape = shape, metadata = metadata, ...) + } + } + } + + if(all(sapply(obj, class)=="SpatialLinesDataFrame")){ + for(i in 1:length(obj)){ + kml_layer.SpatialLines(obj[[i]], metadata = metadata, ...) + } + } + + if(all(sapply(obj, class)=="SpatialPolygonsDataFrame")){ + for(i in 1:length(obj)){ + # Guess aesthetics if missing: + if(labels == ""){ + labels_i <- obj[[i]]@data[,1] + } else { + if(is.name(labels)|is.call(labels)){ + labels_i <- eval(labels, obj[[i]]@data) + } else { + labels_i <- obj[[i]]@data[,deparse(labels)] + } + } + + kml_layer.SpatialPolygons(obj[[i]], colour = colour, plot.labpt = plot.labpt, labels = labels_i, metadata = metadata, ...) + } + } + + if(all(sapply(obj, class)=="SpatialPixelsDataFrame")){ + for(i in 1:length(obj)){ + + ## subset to the bounding box if necessary: + bbn <- round(diff(obj[[i]]@bbox[1,])/obj[[i]]@grid@cellsize[1])*round(diff(obj[[i]]@bbox[2,])/obj[[i]]@grid@cellsize[2]) + if(max(obj[[i]]@grid.index, na.rm=TRUE)>bbn){ + x <- as.data.frame(obj[[i]]) + suppressWarnings( gridded(x) <- ~x+y ) + proj4string(x) = obj[[i]]@proj4string + obj[[i]] <- x + } + + raster_name_i <- paste(names(obj[[i]])[1], "_", i, ".png", sep="") + kml_layer.SpatialPixels(obj[[i]], colour = colour, raster_name = raster_name_i, metadata = metadata, plot.legend=FALSE, ...) + } + } + + # close the file: + kml_close(file.name = file.name) + if (kmz == TRUE){ + kml_compress(file.name = file.name) + } + # open KML file in the default browser: + if(open.kml==TRUE){ + kml_View(file.name) + } else { + message(paste("Object written to:", file.name)) + } + +}) + + # end of script; \ No newline at end of file diff --git a/pkg/R/readGPX.R b/pkg/R/readGPX.R index b40f696..0af91c2 100644 --- a/pkg/R/readGPX.R +++ b/pkg/R/readGPX.R @@ -1,130 +1,134 @@ -# Note: corrections in the code by: Berry Boessenkool (berryboessenkool@hotmail.com) - -readGPX <- function( - gpx.file, - metadata = TRUE, - bounds = TRUE, - waypoints = TRUE, - tracks = TRUE, - routes = TRUE - ) - - { - opt <- options(warn=-1) - if(!file.exists(gpx.file)) stop("The file '", gpx.file, "'\n does not exist in ", getwd() ) - - if(metadata==TRUE) { metadata <- .readGPX.element(gpx.file, "name") } - if(bounds==TRUE) { bounds <- .readGPX.element(gpx.file, "bounds") } - if(waypoints==TRUE) { waypoints <- .readGPX.element(gpx.file, "wpt") } - if(tracks==TRUE) { tracks <- .readGPX.element(gpx.file, "trk") } - if(routes==TRUE) { routes <- .readGPX.element(gpx.file, "rte") } - - gpx <- list(metadata=metadata, bounds=bounds, waypoints=waypoints, tracks=tracks, routes=routes) - return(gpx) - on.exit(options(opt)) -} - -## Read various elements from a *.gpx file: - -.readGPX.element <- function(gpx.file, element) { - # element = "metadata", "wpt", "rte", "trk" - - ret <- xmlTreeParse(gpx.file, useInternalNodes = TRUE) - # top structure: - top <- xmlRoot(ret) - - # check if there is any content: - if(any(grep(element, names(top)))) { - - # tracks: - if(element=="trk"){ - ret <- NULL - nu <- which(names(top) %in% element) - for(c in seq_along(nu)){ - lst <- which(names(top[[nu[c]]]) %in% "trkseg") - nm <- names(top[[nu[c]]][[lst[1]]][[1]]) - ret[[c]] <- list(NULL) - for(i in seq_along(lst)) { - trkpt <- top[[nu[c]]][[lst[i]]] - ret[[c]][[i]] <- data.frame(NULL) - ## get columns (https://www.topografix.com/GPX/1/1/#type_wptType) - lon <- as.numeric(xmlSApply(trkpt, xmlGetAttr, "lon")) - lat <- as.numeric(xmlSApply(trkpt, xmlGetAttr, "lat")) - ret[[c]][[i]][1:length(lon),"lon"] <- lon - ret[[c]][[i]][1:length(lat),"lat"] <- lat - if(!nm[[1]]=="NULL"){ - for(j in 1:length(nm)){ - xm <- as.character(sapply(sapply(xmlChildren(trkpt), function(x) x[[nm[[j]]]]), xmlValue)) - ret[[c]][[i]][1:length(xm), nm[[j]]] <- xm - } - } - } - names(ret[[c]]) <- xmlValue(top[[nu[c]]][["name"]]) - } - } - - if(element=="wpt"){ - ret <- data.frame(NULL) - nu <- which(names(top) %in% element) - nm <- names(top[[nu[1]]]) - for(i in seq_along(nu)) { - # coordinates: - ret[i, "lon"] <- as.numeric(xmlGetAttr(top[[nu[i]]], "lon")) - ret[i, "lat"] <- as.numeric(xmlGetAttr(top[[nu[i]]], "lat")) - if(!nm[[1]]=="NULL"){ - for(j in 1:length(nm)){ - ret[i, nm[[j]]] <- xmlValue(xmlChildren(top[[nu[i]]])[[nm[[j]]]]) - } - } - } - } - - if(element=="rte"){ - ret <- NULL - nu <- which(names(top) %in% element) - for(c in seq_along(nu)){ - ret[[c]] <- data.frame(NULL) - lst <- which(names(top[[nu[c]]]) %in% "rtept") - nm <- names(top[[nu[c]]][[lst[1]]]) - for(i in seq_along(lst)) { - rtept <- top[[nu[c]]][[lst[i]]] - ret[[c]][i, "lon"] <- as.numeric(xmlGetAttr(rtept, "lon")) - ret[[c]][i, "lat"] <- as.numeric(xmlGetAttr(rtept, "lat")) - if(!nm[[1]]=="NULL"){ - for(j in c("name","cmt","desc","sym","type")){ - try(ret[[c]][i, j] <- xmlValue(rtept[[j]]), silent = TRUE) - } - } - } - names(ret)[c] <- xmlValue(top[[nu[c]]][["name"]]) - } - } - - # bounds - if(element=="bounds"){ - nu <- which(names(top) %in% element) - ret <- matrix(rep(NA, 4), nrow=2, dimnames = list(c("lat", "lon"), c("min", "max"))) - # coordinates: - ret[1,1] <- as.numeric(xmlGetAttr(top[[nu[1]]], "minlon")) - ret[1,2] <- as.numeric(xmlGetAttr(top[[nu[1]]], "maxlon")) - ret[2,1] <- as.numeric(xmlGetAttr(top[[nu[1]]], "minlat")) - ret[2,2] <- as.numeric(xmlGetAttr(top[[nu[1]]], "maxlat")) - } - - # metadata - if(element=="name"){ - lst <- c("name","desc","author","email","url","urlname","time") - nu <- which(names(top) %in% lst) - if(!nu[[1]]=="NULL"){ - ret <- data.frame(NULL) - for(i in seq_along(lst)) { - try(ret[1,lst[i]] <- xmlValue(top[[nu[[i]]]]), silent = TRUE) - } - } - } - - } - else { ret <- NULL } - - return(ret) -} +# Purpose : Read GPX files [http://www.topografix.com/gpx.asp] and convert the data to tables; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Status : working version +# Note : corrections in the code by: Berry Boessenkool (berryboessenkool@hotmail.com) + +readGPX <- function( + gpx.file, + metadata = TRUE, + bounds = TRUE, + waypoints = TRUE, + tracks = TRUE, + routes = TRUE + ) + + { + opt <- options(warn=-1) + if(!file.exists(gpx.file)) stop("The file '", gpx.file, "'\n does not exist in ", getwd() ) + + if(metadata==TRUE) { metadata <- .readGPX.element(gpx.file, "name") } + if(bounds==TRUE) { bounds <- .readGPX.element(gpx.file, "bounds") } + if(waypoints==TRUE) { waypoints <- .readGPX.element(gpx.file, "wpt") } + if(tracks==TRUE) { tracks <- .readGPX.element(gpx.file, "trk") } + if(routes==TRUE) { routes <- .readGPX.element(gpx.file, "rte") } + + gpx <- list(metadata=metadata, bounds=bounds, waypoints=waypoints, tracks=tracks, routes=routes) + return(gpx) + on.exit(options(opt)) +} + +## Read various elements from a *.gpx file: + +.readGPX.element <- function(gpx.file, element) { + # element = "metadata", "wpt", "rte", "trk" + + ret <- xmlTreeParse(gpx.file, useInternalNodes = TRUE) + # top structure: + top <- xmlRoot(ret) + + # check if there is any content: + if(any(grep(element, names(top)))) { + + # tracks: + if(element=="trk"){ + ret <- NULL + nu <- which(names(top) %in% element) + for(c in seq_along(nu)){ + lst <- which(names(top[[nu[c]]]) %in% "trkseg") + nm <- names(top[[nu[c]]][[lst[1]]][[1]]) + ret[[c]] <- list(NULL) + for(i in seq_along(lst)) { + trkpt <- top[[nu[c]]][[lst[i]]] + ret[[c]][[i]] <- data.frame(NULL) + ## get columns (http://www.topografix.com/GPX/1/1/#type_wptType) + lon <- as.numeric(xmlSApply(trkpt, xmlGetAttr, "lon")) + lat <- as.numeric(xmlSApply(trkpt, xmlGetAttr, "lat")) + ret[[c]][[i]][1:length(lon),"lon"] <- lon + ret[[c]][[i]][1:length(lat),"lat"] <- lat + if(!nm[[1]]=="NULL"){ + for(j in 1:length(nm)){ + xm <- as.character(sapply(sapply(xmlChildren(trkpt), function(x) x[[nm[[j]]]]), xmlValue)) + ret[[c]][[i]][1:length(xm), nm[[j]]] <- xm + } + } + } + names(ret[[c]]) <- xmlValue(top[[nu[c]]][["name"]]) + } + } + + if(element=="wpt"){ + ret <- data.frame(NULL) + nu <- which(names(top) %in% element) + nm <- names(top[[nu[1]]]) + for(i in seq_along(nu)) { + # coordinates: + ret[i, "lon"] <- as.numeric(xmlGetAttr(top[[nu[i]]], "lon")) + ret[i, "lat"] <- as.numeric(xmlGetAttr(top[[nu[i]]], "lat")) + if(!nm[[1]]=="NULL"){ + for(j in 1:length(nm)){ + ret[i, nm[[j]]] <- xmlValue(xmlChildren(top[[nu[i]]])[[nm[[j]]]]) + } + } + } + } + + if(element=="rte"){ + ret <- NULL + nu <- which(names(top) %in% element) + for(c in seq_along(nu)){ + ret[[c]] <- data.frame(NULL) + lst <- which(names(top[[nu[c]]]) %in% "rtept") + nm <- names(top[[nu[c]]][[lst[1]]]) + for(i in seq_along(lst)) { + rtept <- top[[nu[c]]][[lst[i]]] + ret[[c]][i, "lon"] <- as.numeric(xmlGetAttr(rtept, "lon")) + ret[[c]][i, "lat"] <- as.numeric(xmlGetAttr(rtept, "lat")) + if(!nm[[1]]=="NULL"){ + for(j in c("name","cmt","desc","sym","type")){ + try(ret[[c]][i, j] <- xmlValue(rtept[[j]]), silent = TRUE) + } + } + } + names(ret)[c] <- xmlValue(top[[nu[c]]][["name"]]) + } + } + + # bounds + if(element=="bounds"){ + nu <- which(names(top) %in% element) + ret <- matrix(rep(NA, 4), nrow=2, dimnames = list(c("lat", "lon"), c("min", "max"))) + # coordinates: + ret[1,1] <- as.numeric(xmlGetAttr(top[[nu[1]]], "minlon")) + ret[1,2] <- as.numeric(xmlGetAttr(top[[nu[1]]], "maxlon")) + ret[2,1] <- as.numeric(xmlGetAttr(top[[nu[1]]], "minlat")) + ret[2,2] <- as.numeric(xmlGetAttr(top[[nu[1]]], "maxlat")) + } + + # metadata + if(element=="name"){ + lst <- c("name","desc","author","email","url","urlname","time") + nu <- which(names(top) %in% lst) + if(!nu[[1]]=="NULL"){ + ret <- data.frame(NULL) + for(i in seq_along(lst)) { + try(ret[1,lst[i]] <- xmlValue(top[[nu[[i]]]]), silent = TRUE) + } + } + } + + } + else { ret <- NULL } + + return(ret) +} diff --git a/pkg/R/readKML.GBIFdensity.R b/pkg/R/readKML.GBIFdensity.R index 8bd77d3..4ef1ace 100644 --- a/pkg/R/readKML.GBIFdensity.R +++ b/pkg/R/readKML.GBIFdensity.R @@ -1,94 +1,99 @@ -# Note: Description of the GBIF celldensity records is available at: [http://data.gbif.org/ws/rest/density]; - -readKML.GBIFdensity <- function(kml.file, gbif.url = FALSE, silent = FALSE){ - - if(is.na(file.info(kml.file)$size)){ - stop(paste(kml.file, "does not exist in the working directory")) - } - else{ - if(file.info(kml.file)$size < 1024){ - warning("File size < 1KB... possibly an empty object") - } - } - - if(silent==FALSE){ - warning("All usage of these data must be in accordance with the GBIF Data Use Agreement - see http://www.gbif.org/DataProviders/Agreements/DUA", immediate. = TRUE) - } - - ret <- xmlTreeParse(kml.file, useInternalNodes = TRUE) - # top structure: - top <- xmlRoot(ret) - doc.name <- xmlValue(top[["Document"]][["name"]]) - # strip the latin name: - lname <- strsplit(doc.name, "GBIF Data Portal Occurrence Density Layer for species: ")[[1]][2] - # get coordinates and counts: - count.lst <- NULL - crds.lst <- NULL - desc.lst <- NULL - # TH: xpath commands e.g. xpathApply(top, "//Placemark/name", xmlValue) would not produce anything; - nf <- which(names(top[["Document"]]) %in% "Folder") - if(length(nf)>0){ - if(silent == FALSE){ - pb <- txtProgressBar(min=0, max=length(nf), style=3) - } - for(i in seq_along(nf)){ - count.lst[[i]] <- xmlValue(top[["Document"]][[nf[i]]][["Placemark"]][["name"]]) - crds.lst[[i]] <- xmlValue(top[["Document"]][[nf[i]]][["Placemark"]][["Point"]][["coordinates"]]) - if(gbif.url == TRUE){ - desc.lst[[i]] <- xmlValue(top[["Document"]][[nf[i]]][["Placemark"]][["description"]]) - } - if(silent == FALSE){ setTxtProgressBar(pb, i) } - } - if(silent == FALSE){ close(pb) } - # number of records: - nrecs <- as.numeric(sapply(count.lst, function(x){strsplit(strsplit(x, " - ")[[1]][2], "record")[[1]][1]})) - # coordinates of the cell: - lon <- as.numeric(sapply(crds.lst, function(x){strsplit(x, ",")[[1]][1]})) - lat <- as.numeric(sapply(crds.lst, function(x){strsplit(x, ",")[[1]][2]})) - # cell id and taxon concept keys: - if(gbif.url == TRUE){ - cellid <- paste(sapply(sapply(desc.lst, function(x){strsplit(x, "cellid=")[[1]][2]}), function(x){strsplit(x, "&")[[1]][1]})) - taxonconceptkey <- paste(sapply(sapply(desc.lst, function(x){strsplit(x, "taxonconceptkey=")[[1]][2]}), function(x){strsplit(x, '">')[[1]][1]})) - out <- data.frame(lon, lat, nrecs, cellid, taxonconceptkey) - } - else{ - out <- data.frame(lon, lat, nrecs) - } - ## Rasterize: - coordinates(out) <- ~lon+lat - # create an empty grid: - crs = CRS("+proj=longlat +datum=WGS84") - r.sp <- SpatialGrid(GridTopology(cellcentre.offset=c(-179.5,-89.5), cellsize=c(1,1), cells.dim=c(360,180)), proj4string = crs) - r <- raster(r.sp) - # rasterize - convert points to a raster map: - out.r <- rasterize(out, r, "nrecs", fun=mean) - names(out.r) <- lname - - if(gbif.url == TRUE){ - out2.r <- rasterize(out, r, "cellid") - out2.r@data@isfactor <- TRUE - out2.r@legend@values <- levels(as.factor(cellid)) - names(out.r) <- "cellid" - out3.r <- rasterize(out, r, "taxonconceptkey") - out3.r@data@isfactor <- TRUE - out3.r@legend@values <- levels(as.factor(taxonconceptkey)) - names(out3.r) <- "taxonconceptkey" - out.r <- brick(out.r, out2.r, out3.r) - } - - out.r@title <- paste("GBIF cell density count for:", lname) - out.r@history <- paste(kml.file) - out.r@zname <- "Last update" - out.r <- setZ(out.r, as.character(file.info(kml.file)$mtime)) - - return(out.r) - - } - else - { - warning("No nodes of type 'Folder' were found. Not a valid GBIF celldensity KML.") - return(NULL) - } -} - +# Purpose : Reads GBIF celldensity records from KML to RasterBrick; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : Description of the GBIF celldensity records is available at: [http://data.gbif.org/ws/rest/density]; + + +readKML.GBIFdensity <- function(kml.file, gbif.url = FALSE, silent = FALSE){ + + if(is.na(file.info(kml.file)$size)){ + stop(paste(kml.file, "does not exist in the working directory")) + } + else{ + if(file.info(kml.file)$size < 1024){ + warning("File size < 1KB... possibly an empty object") + } + } + + if(silent==FALSE){ + warning("All usage of these data must be in accordance with the GBIF Data Use Agreement - see http://www.gbif.org/DataProviders/Agreements/DUA", immediate. = TRUE) + } + + ret <- xmlTreeParse(kml.file, useInternalNodes = TRUE) + # top structure: + top <- xmlRoot(ret) + doc.name <- xmlValue(top[["Document"]][["name"]]) + # strip the latin name: + lname <- strsplit(doc.name, "GBIF Data Portal Occurrence Density Layer for species: ")[[1]][2] + # get coordinates and counts: + count.lst <- NULL + crds.lst <- NULL + desc.lst <- NULL + # TH: xpath commands e.g. xpathApply(top, "//Placemark/name", xmlValue) would not produce anything; + nf <- which(names(top[["Document"]]) %in% "Folder") + if(length(nf)>0){ + if(silent == FALSE){ + pb <- txtProgressBar(min=0, max=length(nf), style=3) + } + for(i in seq_along(nf)){ + count.lst[[i]] <- xmlValue(top[["Document"]][[nf[i]]][["Placemark"]][["name"]]) + crds.lst[[i]] <- xmlValue(top[["Document"]][[nf[i]]][["Placemark"]][["Point"]][["coordinates"]]) + if(gbif.url == TRUE){ + desc.lst[[i]] <- xmlValue(top[["Document"]][[nf[i]]][["Placemark"]][["description"]]) + } + if(silent == FALSE){ setTxtProgressBar(pb, i) } + } + if(silent == FALSE){ close(pb) } + # number of records: + nrecs <- as.numeric(sapply(count.lst, function(x){strsplit(strsplit(x, " - ")[[1]][2], "record")[[1]][1]})) + # coordinates of the cell: + lon <- as.numeric(sapply(crds.lst, function(x){strsplit(x, ",")[[1]][1]})) + lat <- as.numeric(sapply(crds.lst, function(x){strsplit(x, ",")[[1]][2]})) + # cell id and taxon concept keys: + if(gbif.url == TRUE){ + cellid <- paste(sapply(sapply(desc.lst, function(x){strsplit(x, "cellid=")[[1]][2]}), function(x){strsplit(x, "&")[[1]][1]})) + taxonconceptkey <- paste(sapply(sapply(desc.lst, function(x){strsplit(x, "taxonconceptkey=")[[1]][2]}), function(x){strsplit(x, '">')[[1]][1]})) + out <- data.frame(lon, lat, nrecs, cellid, taxonconceptkey) + } + else{ + out <- data.frame(lon, lat, nrecs) + } + ## Rasterize: + coordinates(out) <- ~lon+lat + # create an empty grid: + crs = CRS("+proj=longlat +datum=WGS84") + r.sp <- SpatialGrid(GridTopology(cellcentre.offset=c(-179.5,-89.5), cellsize=c(1,1), cells.dim=c(360,180)), proj4string = crs) + r <- raster(r.sp) + # rasterize - convert points to a raster map: + out.r <- rasterize(out, r, "nrecs", fun=mean) + names(out.r) <- lname + + if(gbif.url == TRUE){ + out2.r <- rasterize(out, r, "cellid") + out2.r@data@isfactor <- TRUE + out2.r@legend@values <- levels(as.factor(cellid)) + names(out.r) <- "cellid" + out3.r <- rasterize(out, r, "taxonconceptkey") + out3.r@data@isfactor <- TRUE + out3.r@legend@values <- levels(as.factor(taxonconceptkey)) + names(out3.r) <- "taxonconceptkey" + out.r <- brick(out.r, out2.r, out3.r) + } + + out.r@title <- paste("GBIF cell density count for:", lname) + out.r@history <- paste(kml.file) + out.r@zname <- "Last update" + out.r <- setZ(out.r, as.character(file.info(kml.file)$mtime)) + + return(out.r) + + } + else + { + warning("No nodes of type 'Folder' were found. Not a valid GBIF celldensity KML.") + return(NULL) + } +} + # end of script; \ No newline at end of file diff --git a/pkg/R/reproject.R b/pkg/R/reproject.R index 3e43d02..dff64f9 100644 --- a/pkg/R/reproject.R +++ b/pkg/R/reproject.R @@ -1,202 +1,209 @@ -reproject.SpatialPoints <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts), ...) { - message(paste("Reprojecting to", CRS, "...")) - res <- spTransform(x = obj, CRSobj = CRS(CRS)) - return(res) -} - - -reproject.RasterLayer <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts), program = "raster", tmp.file = TRUE, NAflag = get("NAflag", envir = plotKML.opts), show.output.on.console = FALSE, method, ...) { - - if(raster::is.factor(obj)){ - method <- "ngb" - } else { - if(missing(method)){ method <- "bilinear" } - } - - if(program=="raster"){ - message(paste("Reprojecting to", CRS, "...")) - res <- raster::projectRaster(obj, crs = CRS, method = method, progress='text') - names(res) <- names(obj) - } else { - - if(program=="GDAL"){ - gdalwarp <- get("gdalwarp", envir = plotKML.opts) - - # look for GDAL path: - if(nchar(gdalwarp)==0){ - plotKML.env(show.env = FALSE) - gdalwarp <- get("gdalwarp", envir = plotKML.opts) - } - - if(tmp.file==TRUE){ - tf <- tempfile() - } else { - tf <- normalizeFilename(deparse(substitute(obj, env = parent.frame()))) - } - - if(!nchar(gdalwarp)==0){ - if(method == "ngb") { method <- "near" } - writeRaster(obj, paste(tf, ".tif", sep=""), overwrite=TRUE, NAflag=NAflag) - # resample to WGS84 system: - message(paste("Using gdalwarp function:", gdalwarp)) - message(paste("Reprojecting to", CRS, "...")) - system(paste(gdalwarp, " ", tf, ".tif", " -t_srs \"", CRS, "\" ", tf, "_ll.tif -dstnodata \"", NAflag, "\" ", " -r ", method, sep=""), show.output.on.console = show.output.on.console) - res <- raster(paste(tf, "_ll.tif", sep=""), silent = TRUE) - names(res) <- names(obj) - } else { - stop("Could not locate GDAL. See 'plotKML.env()' for more info.") } - } - } - - return(res) -} - - -reproject.SpatialGrid <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts), tmp.file = TRUE, program = "raster", NAflag = get("NAflag", envir = plotKML.opts), show.output.on.console = FALSE, ...) { - - ## convert all character vectors to factors: - for(j in 1:ncol(obj)){ - if(is.character(obj@data[,j])){ obj@data[,j] <- as.factor(obj@data[,j]) } - } - - if(program=="raster"){ - - # if multiple layers: - if(ncol(obj) > 1) { - r <- raster::stack(obj) - res <- list(NULL) - for(j in 1:ncol(obj)){ - if(is.factor(obj@data[,j])){ - r[[j]] <- raster::as.factor(r[[j]]) - } - res[[j]] <- reproject(r[[j]], CRS = CRS) - } - res <- as(raster::stack(res), "SpatialGridDataFrame") - ## TH: time consuming but would be preferred: - # res <- as(res, "SpatialPixelsDataFrame") - names(res) <- names(obj) - } - - # single layer: - else { - r <- raster(obj) - if(is.factor(obj@data[,1])){ - r <- raster::as.factor(r) - message(paste("Reprojecting to", CRS, "...")) - res <- as(raster::projectRaster(r, crs = CRS, method = "ngb"), "SpatialGridDataFrame") - } else { - res <- as(reproject(r, CRS = CRS), "SpatialGridDataFrame") - } - - names(res) <- names(obj) - } - - # try to fix factor-type objects: - for(j in 1:ncol(obj)){ - if(is.factor(obj@data[,j])){ - # copy levels: - res@data[,j] <- as.factor(res@data[,j]) - try( levels(res@data[,j]) <- levels(obj@data[,j]), silent = TRUE ) - } - } - } - - if(program=="GDAL"){ - gdalwarp <- get("gdalwarp", envir = plotKML.opts) - # look for GDAL path if missing: - if(nchar(gdalwarp)==0){ - plotKML.env() - gdalwarp <- get("gdalwarp", envir = plotKML.opts) - } - message(paste("Using gdalwarp function:", gdalwarp)) - - if(!nchar(gdalwarp)==0){ - - for(j in 1:ncol(obj)){ - - if(tmp.file==TRUE){ - tf <- tempfile() - } - else { - tf <- paste(normalizeFilename(deparse(substitute(obj, env = parent.frame()))), names(obj)[j], sep="_") - } - - # write SPDF to a file: - if(is.factor(obj@data[,j])){ - x <- obj[j] - x@data[,1] <- as.integer(x@data[,1]) - if(max(x@data[,1], na.rm=TRUE)<254){ - writeGDAL(x, paste(tf, ".tif", sep=""), "GTiff", mvFlag = 255, type="Byte") - } else { - writeGDAL(x, paste(tf, ".tif", sep=""), "GTiff") - } - } - else { - writeGDAL(obj[j], paste(tf, ".tif", sep=""), "GTiff") - } - - message(paste("Reprojecting to", CRS, "...")) - # resample to WGS84 system: - if(is.factor(obj@data[,j])){ - system(paste(gdalwarp, ' ', tf, '.tif', ' -t_srs \"', CRS, '\" ', tf, '_ll.tif -dstnodata \"', NAflag, '\" -r near', sep=""), show.output.on.console = show.output.on.console) - } - else { - system(paste(gdalwarp, ' ', tf, '.tif', ' -t_srs \"', CRS, '\" ', tf, '_ll.tif -dstnodata \"', NAflag, '\" -r bilinear', sep=""), show.output.on.console = show.output.on.console) - } - ## read images back to R: - if(j==1){ - res <- readGDAL(paste(tf, "_ll.tif", sep=""), silent = TRUE) - names(res) <- names(obj)[j] - } - else{ - res@data[names(obj)[j]] <- readGDAL(paste(tf, "_ll.tif", sep=""), silent = TRUE)$band1 - } - - ## reformat to the original factors: - if(is.factor(obj@data[,j])){ - res@data[,j] <- as.factor(res@data[,j]) - try( levels(res@data[,j]) <- levels(obj@data[,j]) , silent = TRUE) - } - unlink(paste(tf, ".tif", sep="")) - unlink(paste(tf, "_ll.tif", sep="")) - } - } - - else { - stop("Could not locate GDAL. See 'plotKML.env()' for more info.") - } - - } - - ## TH: time consuming but preferred: - # res <- as(res, "SpatialPixelsDataFrame") - return(res) -} - - -reproject.RasterStack <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts)) { - rs <- list(NULL) - for(j in 1:nlayers(obj)){ - rs[[j]] <- reproject(obj[[j]], CRS = CRS) - } - return(stack(rs)) -} - - -reproject.RasterBrick <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts)) { - r <- stack(obj) - rs <- reproject.RasterStack(r, CRS = CRS) - return(brick(rs)) -} - -# connect all methods and classes: -setMethod("reproject", "SpatialPoints", reproject.SpatialPoints) -setMethod("reproject", "SpatialPolygons", reproject.SpatialPoints) -setMethod("reproject", "SpatialLines", reproject.SpatialPoints) -setMethod("reproject", "RasterLayer", reproject.RasterLayer) -setMethod("reproject", "SpatialGridDataFrame", reproject.SpatialGrid) -setMethod("reproject", "SpatialPixelsDataFrame", reproject.SpatialGrid) -setMethod("reproject", "RasterStack", reproject.RasterStack) -setMethod("reproject", "RasterBrick", reproject.RasterBrick) - -# end of script; +# Purpose : Automatic reprojection of vector and raster features to geographic coordinates; +# Maintainer : Pierre Roudier (pierre.roudier@landcare.nz); +# Contributions : Tomislav Hengl (tom.hengl@wur.nl); Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : tested +# Note : in the case of gridded data, bounding box and cell size are estimated by the program (raster / GDAL); + + +reproject.SpatialPoints <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts), ...) { + message(paste("Reprojecting to", CRS, "...")) + res <- spTransform(x = obj, CRSobj = CRS(CRS)) + return(res) +} + + +reproject.RasterLayer <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts), program = "raster", tmp.file = TRUE, NAflag = get("NAflag", envir = plotKML.opts), show.output.on.console = FALSE, method, ...) { + + if(raster::is.factor(obj)){ + method <- "ngb" + } else { + if(missing(method)){ method <- "bilinear" } + } + + if(program=="raster"){ + message(paste("Reprojecting to", CRS, "...")) + res <- raster::projectRaster(obj, crs = CRS, method = method, progress='text') + names(res) <- names(obj) + } else { + + if(program=="GDAL"){ + gdalwarp <- get("gdalwarp", envir = plotKML.opts) + + # look for GDAL path: + if(nchar(gdalwarp)==0){ + plotKML.env(silent = FALSE, show.env = FALSE) + gdalwarp <- get("gdalwarp", envir = plotKML.opts) + } + + if(tmp.file==TRUE){ + tf <- tempfile() + } else { + tf <- normalizeFilename(deparse(substitute(obj, env = parent.frame()))) + } + + if(!nchar(gdalwarp)==0){ + if(method == "ngb") { method <- "near" } + writeRaster(obj, paste(tf, ".tif", sep=""), overwrite=TRUE, NAflag=NAflag) + # resample to WGS84 system: + message(paste("Using gdalwarp function:", gdalwarp)) + message(paste("Reprojecting to", CRS, "...")) + system(paste(gdalwarp, " ", tf, ".tif", " -t_srs \"", CRS, "\" ", tf, "_ll.tif -dstnodata \"", NAflag, "\" ", " -r ", method, sep=""), show.output.on.console = show.output.on.console) + res <- raster(paste(tf, "_ll.tif", sep=""), silent = TRUE) + names(res) <- names(obj) + } else { + stop("Could not locate GDAL. See 'plotKML.env()' for more info.") } + } + } + + return(res) +} + + +reproject.SpatialGrid <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts), tmp.file = TRUE, program = "raster", NAflag = get("NAflag", envir = plotKML.opts), show.output.on.console = FALSE, ...) { + + ## convert all character vectors to factors: + for(j in 1:ncol(obj)){ + if(is.character(obj@data[,j])){ obj@data[,j] <- as.factor(obj@data[,j]) } + } + + if(program=="raster"){ + + # if multiple layers: + if(ncol(obj) > 1) { + r <- raster::stack(obj) + res <- list(NULL) + for(j in 1:ncol(obj)){ + if(is.factor(obj@data[,j])){ + r[[j]] <- raster::as.factor(r[[j]]) + } + res[[j]] <- reproject(r[[j]], CRS = CRS) + } + res <- as(raster::stack(res), "SpatialGridDataFrame") + ## TH: time consuming but would be preferred: + # res <- as(res, "SpatialPixelsDataFrame") + names(res) <- names(obj) + } + + # single layer: + else { + r <- raster(obj) + if(is.factor(obj@data[,1])){ + r <- raster::as.factor(r) + message(paste("Reprojecting to", CRS, "...")) + res <- as(raster::projectRaster(r, crs = CRS, method = "ngb"), "SpatialGridDataFrame") + } else { + res <- as(reproject(r, CRS = CRS), "SpatialGridDataFrame") + } + + names(res) <- names(obj) + } + + # try to fix factor-type objects: + for(j in 1:ncol(obj)){ + if(is.factor(obj@data[,j])){ + # copy levels: + res@data[,j] <- as.factor(res@data[,j]) + try( levels(res@data[,j]) <- levels(obj@data[,j]), silent = TRUE ) + } + } + } + + if(program=="GDAL"){ + gdalwarp <- get("gdalwarp", envir = plotKML.opts) + # look for GDAL path if missing: + if(nchar(gdalwarp)==0){ + plotKML.env(silent = FALSE) + gdalwarp <- get("gdalwarp", envir = plotKML.opts) + } + message(paste("Using gdalwarp function:", gdalwarp)) + + if(!nchar(gdalwarp)==0){ + + for(j in 1:ncol(obj)){ + + if(tmp.file==TRUE){ + tf <- tempfile() + } + else { + tf <- paste(normalizeFilename(deparse(substitute(obj, env = parent.frame()))), names(obj)[j], sep="_") + } + + # write SPDF to a file: + if(is.factor(obj@data[,j])){ + x <- obj[j] + x@data[,1] <- as.integer(x@data[,1]) + if(max(x@data[,1], na.rm=TRUE)<254){ + writeGDAL(x, paste(tf, ".tif", sep=""), "GTiff", mvFlag = 255, type="Byte") + } else { + writeGDAL(x, paste(tf, ".tif", sep=""), "GTiff") + } + } + else { + writeGDAL(obj[j], paste(tf, ".tif", sep=""), "GTiff") + } + + message(paste("Reprojecting to", CRS, "...")) + # resample to WGS84 system: + if(is.factor(obj@data[,j])){ + system(paste(gdalwarp, ' ', tf, '.tif', ' -t_srs \"', CRS, '\" ', tf, '_ll.tif -dstnodata \"', NAflag, '\" -r near', sep=""), show.output.on.console = show.output.on.console) + } + else { + system(paste(gdalwarp, ' ', tf, '.tif', ' -t_srs \"', CRS, '\" ', tf, '_ll.tif -dstnodata \"', NAflag, '\" -r bilinear', sep=""), show.output.on.console = show.output.on.console) + } + ## read images back to R: + if(j==1){ + res <- readGDAL(paste(tf, "_ll.tif", sep=""), silent = TRUE) + names(res) <- names(obj)[j] + } + else{ + res@data[names(obj)[j]] <- readGDAL(paste(tf, "_ll.tif", sep=""), silent = TRUE)$band1 + } + + ## reformat to the original factors: + if(is.factor(obj@data[,j])){ + res@data[,j] <- as.factor(res@data[,j]) + try( levels(res@data[,j]) <- levels(obj@data[,j]) , silent = TRUE) + } + unlink(paste(tf, ".tif", sep="")) + unlink(paste(tf, "_ll.tif", sep="")) + } + } + + else { + stop("Could not locate GDAL. See 'plotKML.env()' for more info.") + } + + } + + ## TH: time consuming but preferred: + # res <- as(res, "SpatialPixelsDataFrame") + return(res) +} + + +reproject.RasterStack <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts)) { + rs <- list(NULL) + for(j in 1:nlayers(obj)){ + rs[[j]] <- reproject(obj[[j]], CRS = CRS) + } + return(stack(rs)) +} + + +reproject.RasterBrick <- function(obj, CRS = get("ref_CRS", envir = plotKML.opts)) { + r <- stack(obj) + rs <- reproject.RasterStack(r, CRS = CRS) + return(brick(rs)) +} + +# connect all methods and classes: +setMethod("reproject", "SpatialPoints", reproject.SpatialPoints) +setMethod("reproject", "SpatialPolygons", reproject.SpatialPoints) +setMethod("reproject", "SpatialLines", reproject.SpatialPoints) +setMethod("reproject", "RasterLayer", reproject.RasterLayer) +setMethod("reproject", "SpatialGridDataFrame", reproject.SpatialGrid) +setMethod("reproject", "SpatialPixelsDataFrame", reproject.SpatialGrid) +setMethod("reproject", "RasterStack", reproject.RasterStack) +setMethod("reproject", "RasterBrick", reproject.RasterBrick) + +# end of script; diff --git a/pkg/R/spMetadata.R b/pkg/R/spMetadata.R index b353bbe..f29d335 100644 --- a/pkg/R/spMetadata.R +++ b/pkg/R/spMetadata.R @@ -1,553 +1,557 @@ -# Note: Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/], which can be converted to "ISO 19139" XML schema; and on the INSPIRE Metadata Implementing Rules [http://inspire.jrc.ec.europa.eu/documents/Metadata/MD_IR_and_ISO_20131029.pdf] - -## internal methods: -setMethod("GetNames", "SpatialMetadata", function(obj){paste(obj@field.names)}) -setMethod("GetPalette", "SpatialMetadata", function(obj){obj@palette}) - -## Generate a spMetadata class object: -.spMetadata.Spatial <- function( - obj, - xml.file, ## optional input metadata file - out.xml.file, - md.type = c("FGDC", "INSPIRE")[1], - generate.missing = TRUE, - GoogleGeocode = FALSE, - signif.digit = 3, - colour_scale, - color = NULL, - bounds, - legend_names, - icons, - validate.schema = FALSE, - ... -) -{ - - ## Check if there is a data slot: - if(!("data" %in% slotNames(obj))){ - stop("Object of class 'Spatial*DataFrame' required.") - } - - ## Use metadata file if it does exit: - if(!missing(xml.file)){ - if(file.exists(xml.file)){ - message(paste("Reading the metadata file: ", xml.file, sep="")) - ret <- xmlTreeParse(xml.file) - ml <- xmlRoot(ret) - a <- xmlTreeParse(xml.file, useInternalNodes = TRUE) - - ## Try to generate missing metadata: - if(generate.missing == TRUE){ - message("Generating missing metadata...") - ## Metadata template: - if(md.type=="INSPIRE"){ - tmpl <- xmlTreeParse(system.file("INSPIRE_ISO19139.xml", package = "plotKML"), useInternalNodes = TRUE) - } else { - tmpl <- xmlTreeParse(system.file("FGDC.xml", package="plotKML"), useInternalNodes=TRUE) - } - top <- xmlRoot(tmpl) - nx <- names(unlist(xmlToList(top))) - ## compare the actual xml file and the template: - cross <- compareXMLDocs(a=a, b=tmpl) - - ## Merge the existing Metadata file with existing template: - if(length(cross[["inB"]])>0){ - for(i in 1:length(cross[["inB"]])){ - ## position of the missing node in the target doc: - nodn <- attr(cross[["inB"]], "dimnames")[[1]][i] - x_l <- strsplit(nx[grep(nodn, nx)], "\\.")[[1]] - ## TH: 7 levels - this is not the best implementation :( -> it takes ca 3-5 seconds; - for(j in 1:length(x_l)){ - if(j==1 & !x_l[j] %in% names(ml)) { ml <- append.XMLNode(ml, xmlNode(x_l[j], "")) } - if(j==2 & !x_l[j] %in% names(ml[[x_l[1]]])) { ml[[x_l[1]]] <- append.XMLNode(ml[[x_l[1]]], xmlNode(x_l[j], "")) } - if(j==3 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]])) { ml[[x_l[1]]][[x_l[2]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]], xmlNode(x_l[j], "")) } - if(j==4 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]], xmlNode(x_l[j], "")) } - if(j==5 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]], xmlNode(x_l[j], "")) } - if(j==6 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]], xmlNode(x_l[j], "")) } - if(j==7 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]][[x_l[6]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]][[x_l[6]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]][[x_l[6]]], xmlNode(x_l[j], "")) } - } - }} - } - - if(validate.schema == TRUE){ - if(md.type=="INSPIRE"){ - message("Connecting to the INSPIRE schema...") - try(xsd <- xmlTreeParse(get("inspire_xsd", envir=plotKML.opts), isSchema=TRUE, useInternalNodes = TRUE)) - } - if(md.type=="FGDC"){ - message("Connecting to the FGDC schema...") - try(xsd <- xmlTreeParse(get("fgdc_xsd", envir=plotKML.opts), isSchema=TRUE, useInternalNodes = TRUE)) - } - ## validate if the schema is OK: - try(xsd.val <- xmlSchemaValidate(xsd, a)) - ## print the results of validation: - x <- NULL - try(x <- sapply(xsd.val$errors, function(x){x["msg"][[1]]})) - if(nzchar(x)){ - warning(paste(x), call. = FALSE) - } - } - message(paste('Finished generating missing nodes. Open file \"', out.xml.file, '\" and add missing information.', sep="")) - - } else { - warning(paste("Could not locate ", xml.file, ". See '?spMetadata' for more details.", sep=""), call.=FALSE) - } - } ## If the metadata file does not exit, use the template available in the "/inst" directory: - else { - ## Metadata template: - if(md.type=="INSPIRE"){ - ret <- xmlTreeParse(system.file("INSPIRE_ISO19139.xml", package="plotKML"), useInternalNodes = TRUE) - } - if(md.type=="FGDC"){ - ret <- xmlTreeParse(system.file("FGDC.xml", package="plotKML"), useInternalNodes = TRUE) - } - ml <- xmlRoot(ret) - - ## Load static metadata entries (if they do not exist already): - metadata.env(..., show.env = FALSE) - ## Target variable: - Target_variable <- names(obj)[1] - ## Generate a name for the output XML file: - if(missing(out.xml.file)){ - out.xml.file <- paste(normalizeFilename(deparse(substitute(obj, env=parent.frame()))), ".xml", sep="") - } - ## Measurement resolution: - Attribute_Measurement_Resolution <- get("Attribute_Measurement_Resolution", envir = metadata) - if(Attribute_Measurement_Resolution==""){ - ## Estimate the numeric resolution by using the optimal number of bins in the histogram: - if(is.numeric(obj@data[,Target_variable])){ - Attribute_Measurement_Resolution <- signif(diff(quantile(obj@data[,Target_variable], na.rm=TRUE, prob=c(.025,.975)))/(length(hist(obj@data[,Target_variable], breaks="FD", plot=FALSE)$breaks)*2), 2) - } - } - - ## The bounding box: - if(md.type=="INSPIRE"){ - west <- get("Extent_West_Longitude", envir = metadata) - east <- get("Extent_East_Longitude", envir = metadata) - south <- get("Extent_South_Latitude", envir = metadata) - north <- get("Extent_North_Latitude", envir = metadata) - } else { - west <- get("West_Bounding_Coordinate", envir = metadata) - east <- get("East_Bounding_Coordinate", envir = metadata) - south <- get("South_Bounding_Coordinate", envir = metadata) - north <- get("North_Bounding_Coordinate", envir = metadata) - } - if(any(list(west,east,south,north)=="")){ - message("Estimating the bounding box coordinates...") - obj.ll <- reproject(obj) - west <- min(coordinates(obj.ll)[,1]) - east <- max(coordinates(obj.ll)[,1]) - north <- max(coordinates(obj.ll)[,2]) - south <- min(coordinates(obj.ll)[,2]) - } - - ## Automatically update some standard nodes (INSPIRE schema): - if(md.type=="INSPIRE"){ - ## Generate UUID: - UUID <- get("UUID", envir = metadata) - if(UUID==""){ - if(requireNamespace("uuid", quietly = TRUE)){ - xmlValue(ml[["fileIdentifier"]][[1]]) <- uuid::UUIDgenerate(use.time = FALSE) - } - } - ## Date stamp: - xmlValue(ml[["dateStamp"]][["Date"]]) <- get("Date_stamp", envir = metadata) - ## RS identifier: - CI_RS_identifier <- get("CI_RS_identifier", envir = metadata) - if(CI_RS_identifier==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["identifier"]][["RS_Identifier"]][["code"]][[1]]) <- uuid::UUIDgenerate(use.time = FALSE) - } - ## Responsible party: - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["organisationName"]][[1]]) <- get("MD_Organisation_name", envir = metadata) - MD_Electronic_mail_address <- get("MD_Electronic_mail_address", envir = metadata) - if(!MD_Electronic_mail_address==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["contactInfo"]][["CI_Contact"]][["address"]][["CI_Address"]][["electronicMailAddress"]][[1]]) <- MD_Electronic_mail_address - } - MD_contact_URL <- get("MD_contact_URL", envir = metadata) - if(!MD_contact_URL==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["contactInfo"]][["CI_Contact"]][["onlineResource"]][["CI_OnlineResource"]][["linkage"]][[1]]) <- MD_contact_URL - } - ## Citation title: - CI_Citation_title <- get("CI_Citation_title", envir = metadata) - if(CI_Citation_title==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["title"]][[1]]) <- normalizeFilename(deparse(substitute(obj))) - } else { - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["title"]][[1]]) <- CI_Citation_title - } - CI_Unique_name <- get("CI_Unique_name", envir = metadata) - if(!CI_Unique_name==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["identifier"]][["RS_Identifier"]][["code"]][[1]]) <- CI_Unique_name - } - ## Abstract: - MD_Abstract <- get("MD_Abstract", envir = metadata) - if(!MD_Abstract==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["abstract"]][[1]]) <- MD_Abstract - } - ## Lineage: - DQ_Lineage_statement <- get("DQ_Lineage_statement", envir = metadata) - if(!DQ_Lineage_statement==""){ - xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["lineage"]][["LI_Lineage"]][["statement"]][[1]]) <- DQ_Lineage_statement - } - ## Use limitations: - MD_Use_limitations <- get("MD_Use_limitations", envir = metadata) - if(!MD_Use_limitations==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["resourceConstraints"]][["MD_Constraints"]][["useLimitation"]][[1]]) <- MD_Use_limitations - } - ## Scale number / resolution: - MD_Equivalent_scale <- get("MD_Equivalent_scale", envir = metadata) - xx <- which(names(ml[["identificationInfo"]][["MD_DataIdentification"]]) == "spatialResolution") ## TH: there are two nodes of the same name! - if(!MD_Equivalent_scale==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[1]]][["MD_Resolution"]][["equivalentScale"]][["MD_RepresentativeFraction"]][["denominator"]][["Integer"]]) <- MD_Equivalent_scale - } - MD_Resolution <- get("MD_Resolution", envir = metadata) - if(!MD_Resolution==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_Resolution"]][["distance"]][["Distance"]]) <- MD_Resolution - xmlAttrs(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_Resolution"]][["distance"]][["Distance"]])[[1]] <- "#m" - } - ## Coordinate system: - MD_ReferenceSystem_Identifier <- get("MD_ReferenceSystem_Identifier", envir = metadata) - if(MD_ReferenceSystem_Identifier==""){ - xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["code"]][[1]]) <- proj4string(obj) - xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["codeSpace"]][[1]]) <- "proj4" - } else { - xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["code"]][[1]]) <- MD_ReferenceSystem_Identifier - xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["codeSpace"]][[1]]) <- get("MD_ReferenceSystem_type", envir = metadata) - } - - ## Contact organization: - xmlValue(ml[["contact"]][["CI_ResponsibleParty"]][["organisationName"]][[1]]) <- get("CI_Organisation_name", envir = metadata) - xmlValue(ml[["contact"]][["CI_ResponsibleParty"]][["role"]][["CI_RoleCode"]][[1]]) <- get("CI_Role", envir = metadata) - ## Author: - CI_Electronic_mail_address <- get("CI_Electronic_mail_address", envir = metadata) - if(!CI_Electronic_mail_address==""){ - xmlValue(ml[["contact"]][["CI_ResponsibleParty"]][["contactInfo"]][["CI_Contact"]][["address"]][["CI_Address"]][["electronicMailAddress"]][[1]]) <- CI_Electronic_mail_address - } - - ## Thesaurus: - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["thesaurusName"]][["CI_Citation"]][["title"]][[1]]) <- get("MD_Thesaurus_name", envir = metadata) - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["thesaurusName"]][["CI_Citation"]][["date"]][["CI_Date"]][["date"]][["Date"]]) <- get("MD_Thesaurus_date", envir = metadata) - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["thesaurusName"]][["CI_Citation"]][["date"]][["CI_Date"]][["dateType"]][["CI_DateTypeCode"]]) <- get("MD_Thesaurus_date_type", envir = metadata) - ## Keywords: - MD_Keyword <- get("MD_Keyword", envir = metadata) - if(!all(MD_Keyword=="")){ - for(i in 1:length(MD_Keyword)){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["MD_Keywords"]][[i]][["CharacterString"]]) = MD_Keyword[i] - } - } - ## Language: - xmlValue(ml[["language"]][["LanguageCode"]]) <- get("Language_code", envir = metadata) - xmlAttrs(ml[["language"]][["LanguageCode"]])[[2]] <- get("Language_code", envir = metadata) - xmlValue(ml[["characterSet"]][["MD_CharacterSetCode"]][[1]]) <- get("MD_Character_set_code", envir = metadata) - xmlValue(ml[["hierarchyLevel"]][["MD_ScopeCode"]][[1]]) <- get("MD_scope_code", envir = metadata) - ## Citation date: - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["date"]][["CI_Date"]][["date"]][["Date"]]) <- get("CI_Citation_date", envir = metadata) - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["language"]][["LanguageCode"]]) <- get("MD_Language_code", envir = metadata) - xmlAttrs(ml[["identificationInfo"]][["MD_DataIdentification"]][["language"]][["LanguageCode"]])[[2]] <- get("MD_Language_code", envir = metadata) - ## All topic categories: - MD_Topic_category_code <- get("MD_Topic_category_code", envir = metadata) - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["topicCategory"]][["MD_TopicCategoryCode"]]) <- MD_Topic_category_code[1] - if(length(MD_Topic_category_code) > 1) { - xi <- length(MD_Topic_category_code) - 1 - xt <- as.vector(which(names(ml[["identificationInfo"]][["MD_DataIdentification"]]) == "topicCategory")[1]) - xm <- xmlSize(ml[["identificationInfo"]][["MD_DataIdentification"]]) - j <- 0 - for (i in (xt + 1):xm) { - ml[["identificationInfo"]][["MD_DataIdentification"]][xm + xi + j][[1]] <- ml[["identificationInfo"]][["MD_DataIdentification"]][i][[1]] - j <- j + 1 - } - for(i in 2:length(MD_Topic_category_code)) { - ml[["identificationInfo"]][["MD_DataIdentification"]][xt + i - 1][[1]] <- ml[["identificationInfo"]][["MD_DataIdentification"]][["topicCategory"]] - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][xt + i - 1][[1]][["MD_TopicCategoryCode"]]) <- MD_Topic_category_code[i] - } - } - ## Data quality info: - DQ_Citation_title <- get("DQ_Citation_title", envir = metadata) - if(!DQ_Citation_title==""){ - xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["report"]][["DQ_DomainConsistency"]][["result"]][["DQ_ConformanceResult"]][["specification"]][["CI_Citation"]][["title"]][[1]]) <- DQ_Citation_title - } - DQ_Citation_date <- get("DQ_Citation_date", envir = metadata) - if(!DQ_Citation_title==""){ - xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["report"]][["DQ_DomainConsistency"]][["result"]][["DQ_ConformanceResult"]][["specification"]][["CI_Citation"]][["date"]][["CI_Date"]][["date"]][["Date"]]) <- DQ_Citation_date - } - xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["report"]][["DQ_DomainConsistency"]][["result"]][["DQ_ConformanceResult"]][["specification"]][["CI_Citation"]][["date"]][["CI_Date"]][["dateType"]][["CI_DateTypeCode"]]) <- get("DQ_Citation_date_type", envir = metadata) - ## Resource locator... - CI_Online_resource_URL <- get("CI_Online_resource_URL", envir = metadata) - if(!CI_Online_resource_URL==""){ - xmlValue(ml[["distributionInfo"]][["MD_Distribution"]][["transferOptions"]][["MD_DigitalTransferOptions"]][["onLine"]][["CI_OnlineResource"]][["linkage"]][["URL"]]) <- CI_Online_resource_URL - } - if(validate.schema==TRUE){ - try.connection <- try(url(CI_Online_resource_URL, open = 'rb')) - try.error <- inherits(try.connection, "try-error") - if(try.error == T){ - warning("'CI_Online_resource_URL' points to an invalid URL.") - } - } - ## Bounding box: - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["westBoundLongitude"]][["Decimal"]]) <- west - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["eastBoundLongitude"]][["Decimal"]]) <- east - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["northBoundLatitude"]][["Decimal"]]) <- north - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["southBoundLatitude"]][["Decimal"]]) <- south - ## Dates: - Time_period_begin <- get("Time_period_begin", envir = metadata) - if(!Time_period_begin==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["temporalElement"]][["EX_TemporalExtent"]][["extent"]][["TimePeriod"]][["beginPosition"]]) <- as(Time_period_begin, "character") - } - Time_period_end <- get("Time_period_end", envir = metadata) - if(!Time_period_end==""){ - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["temporalElement"]][["EX_TemporalExtent"]][["extent"]][["TimePeriod"]][["endPosition"]]) <- as(Time_period_end, "character") - } - ## Metadata standard: - xmlValue(ml[["metadataStandardName"]][[1]]) <- get("MD_Standard_name", envir = metadata) - xmlValue(ml[["metadataStandardVersion"]][[1]]) <- get("MD_Standard_version", envir = metadata) - ## Contact: - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["role"]][["CI_RoleCode"]]) <- get("MD_Role", envir = metadata) - xmlAttrs(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["role"]][["CI_RoleCode"]])[[2]] <- get("MD_Role", envir = metadata) - ## Use constraints: - xx <- which(names(ml[["identificationInfo"]][["MD_DataIdentification"]]) == "resourceConstraints") ## TH: there are two nodes of the same name! - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_LegalConstraints"]][["accessConstraints"]][["MD_RestrictionCode"]]) <- get("MD_Access_constraints", envir = metadata) - xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_LegalConstraints"]][["otherConstraints"]][[1]]) <- get("MD_Other_restrictions", envir = metadata) - - } - - ## Automatically update some standard nodes (FGDC schema): - if(md.type=="FGDC"){ - ## Location name: - Indirect_Spatial_Reference <- get("Indirect_Spatial_Reference", envir = metadata) - if(Indirect_Spatial_Reference=="" & GoogleGeocode == TRUE){ - if(requireNamespace("rjson", quietly = TRUE)){ - googleurl <- url(paste("http://maps.googleapis.com/maps/api/geocode/json?latlng=", round(mean(obj.ll@bbox[2,]),3), ",", round(mean(obj.ll@bbox[1,]),3), "&sensor=false", sep="")) - try(Indirect_Spatial_Reference <- rjson::fromJSON(file=googleurl)[["results"]][[1]][["formatted_address"]]) - close(googleurl) - } - } - - ## Citation title: - Citation_title <- get("Citation_title", envir = metadata) - if(Citation_title==""){ - xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["title"]]) <- normalizeFilename(deparse(substitute(obj))) - } else { - xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["title"]]) <- Citation_title - } - ## Data format: - xmlValue(ml[["distinfo"]][["stdorder"]][["digform"]][["digtinfo"]][["formcont"]]) <- class(obj)[1] - ## Data citation: - xmlValue(ml[["eainfo"]][["overview"]][["eadetcit"]]) <- paste("http://CRAN.R-project.org/package=", attr(class(obj), "package"), "/", sep="") - ## Entity type: - xmlValue(ml[["eainfo"]][["detailed"]][["enttyp"]][["enttypl"]]) <- class(obj@data[, Target_variable]) - ## Range of values: - if(is.numeric(obj@data[,Target_variable])){ - xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["rdommin"]]) <- min(obj@data[,Target_variable], na.rm=TRUE) - xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["rdommax"]]) <- max(obj@data[,Target_variable], na.rm=TRUE) - } - ## Attribute label: - xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrlabl"]]) <- Target_variable - Attribute_Definition <- get("Attribute_Definition", envir = metadata) - if(!Attribute_Definition==""){ - xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdef"]]) <- Attribute_Definition - } - ## MB: geoform node: - Geospatial_Data_Presentation_Form <- get("Geospatial_Data_Presentation_Form", envir = metadata) - if(!Geospatial_Data_Presentation_Form==""){ - xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["geoform"]]) <- Geospatial_Data_Presentation_Form - } - ## MB: 'pubinfo' nodes: - Citation_Publisher <- get("Citation_Publisher", envir = metadata) - if(!Citation_Publisher==""){ - xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["pubinfo"]][["publish"]]) <- Citation_Publisher - } - Publication_Place <- get("Publication_Place", envir = metadata) - if(!Publication_Place==""){ - xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["pubinfo"]][["pubplace"]]) <- Publication_Place - } - Citation_URL <- get("Citation_URL", envir = metadata) - if(!Citation_URL==""){ - xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["onlink"]]) <- Citation_URL - } - ## MB: insert 'edition' node: - Purpose <- get("Purpose", envir = metadata) - if(!Purpose==""){ - xmlValue(ml[["idinfo"]][["descript"]][["purpose"]]) <- Purpose - } - Abstract <- get("Abstract", envir = metadata) - if(!Abstract==""){ - xmlValue(ml[["idinfo"]][["descript"]][["abstract"]]) <- Abstract - } - Supplemental_Information <- get("Supplemental_Information", envir = metadata) - if(!Supplemental_Information==""){ - xmlValue(ml[['idinfo']][['descript']]['supplinf']) <- Supplemental_Information - } - ## temporal extent: - Beginning_Date <- get("Beginning_Date", envir = metadata) - if(!Beginning_Date==""){ - xmlValue(ml[["idinfo"]][["timeperd"]][["timeinfo"]][["rngdates"]][["begdate"]]) <- Beginning_Date - } - Ending_Date <- get("Ending_Date", envir = metadata) - if(!Ending_Date==""){ - xmlValue(ml[["idinfo"]][["timeperd"]][["timeinfo"]][["rngdates"]][["enddate"]]) <- Ending_Date - } - ## keywords theme: - Theme_Keyword <- get("Theme_Keyword", envir = metadata) - if(!all(Theme_Keyword=="")){ - for(i in 1:length(Theme_Keyword)) { - if(i != length(Theme_Keyword)) { - ml[['idinfo']][['keywords']][['theme']][i+2] <- ml[['idinfo']][['keywords']][['theme']][i+1] - } - xmlValue(ml[['idinfo']][['keywords']][['theme']][i+1][['themekey']]) <- Theme_Keyword[i] - } - } - Theme_Keyword_Thesaurus <- get("Theme_Keyword_Thesaurus", envir = metadata) - if(!all(Theme_Keyword_Thesaurus=="")){ - for(i in 1:length(Theme_Keyword_Thesaurus)){ - if(i != length(Theme_Keyword_Thesaurus)) { - ml[['idinfo']][['keywords']][['place']][i+2] <- ml[['idinfo']][['keywords']][['place']][i+1] - } - xmlValue(ml[['idinfo']][['keywords']][['place']][i+1][['placekey']]) <- Theme_Keyword_Thesaurus[i] - } - } - ## Measurement resolution: - xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["attrmres"]]) <- Attribute_Measurement_Resolution - Attribute_Units_of_Measure <- get("Attribute_Units_of_Measure", envir = metadata) - if(!Attribute_Units_of_Measure==""){ - xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["attrunit"]]) <- Attribute_Units_of_Measure - } - ## Estimate object size: - xmlValue(ml[["distinfo"]][["stdorder"]][["digform"]][["digtinfo"]][["transize"]]) <- paste(signif(object.size(obj@data[, Target_variable])/1024, 4), "Kb (uncompressed)") - ## MB: insert status information (progress, update): - Status_Progress <- get("Status_Progress", envir = metadata) - if(length(Status_Progress)==1L){ - xmlValue(ml[["idinfo"]][["status"]][["progress"]]) <- Status_Progress - } - Maintenance_and_Update_Frequency <- get("Maintenance_and_Update_Frequency", envir = metadata) - if(!Maintenance_and_Update_Frequency==""){ - xmlValue(ml[["idinfo"]][["status"]][["update"]]) <- Maintenance_and_Update_Frequency - } - ## Bounding box: - xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["westbc"]]) <- west - xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["eastbc"]]) <- east - xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["northbc"]]) <- north - xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["southbc"]]) <- south - xmlValue(ml[["spref"]][["horizsys"]][["geograph"]][["geogunit"]]) <- "Decimal degrees" - ## Representation type: - Direct_Spatial_Reference_Method <- get("Direct_Spatial_Reference_Method", envir = metadata)[1] - if(!Direct_Spatial_Reference_Method==""){ - xmlValue(ml[['spdoinfo']][['direct']]) <- Direct_Spatial_Reference_Method - } - ## metadata generation time: - xmlValue(ml[["metainfo"]][["metd"]]) <- Sys.Date() - ## Spatial reference: - if(!Indirect_Spatial_Reference==""){ - xmlValue(ml[["spdoinfo"]][["indspref"]]) <- Indirect_Spatial_Reference - } - ## number of elements: - xmlValue(ml[["spdoinfo"]][["ptvctinf"]][["sdtsterm"]][["ptvctcnt"]]) <- nrow(obj@data) - ## System information: - xmlValue(ml[["idinfo"]][["native"]]) <- get("Native_Data_Set_Environment", envir = metadata) - xmlValue(ml[["idinfo"]][["ptcontac"]][["cntinfo"]][["cntorgp"]][["cntper"]]) <- get("Contact_Information_Person", envir = metadata) - Metadata_Contact_Position <- get("Metadata_Contact_Position", envir = metadata) - if(!Metadata_Contact_Position==""){ - xmlValue(ml[["metainfo"]][["metc"]][["cntinfo"]][["cntpos"]]) <- get("Metadata_Contact_Position", envir = metadata) - } - } - - } - message("Finished generating standard metadata...\nManual editing of the metadata file might be required.") - - ## attach friendly metadata names: - ny <- unlist(xmlToList(ml)) - ## convert to a table: - met <- data.frame(metadata=names(ny), value=paste(ny)) - ## add friendly names: - mdnames <- read.csv(system.file("mdnames.csv", package="plotKML")) - field_names <- merge(met, mdnames[,c("metadata","field.names")], by="metadata", all.x=TRUE, all.y=FALSE, sort=FALSE)[,"field.names"] - field_names <- field_names[!is.na(field_names)] - ## generate metadata doc: - saveXML(ml, out.xml.file) - doc = xmlInternalTreeParse(out.xml.file) - - ## color palette: - if(missing(bounds)){ - if(is.numeric(obj@data[,Target_variable])){ - bounds <- seq(range(obj@data[,Target_variable], na.rm = TRUE, finite = TRUE)[1], range(obj@data[,Target_variable], na.rm = TRUE, finite = TRUE)[2], Attribute_Measurement_Resolution/2) ## half the numeric resolution! - bounds.c <- signif((bounds[-1]+bounds[-length(bounds)])/2, signif.digit) - if(missing(legend_names)) { legend_names <- as.character(bounds.c) } - } - else { - x <- as.factor(obj@data[,Target_variable]) - bounds <- c(0, seq_along(levels(x))) - bounds.c <- bounds[-1] - if(missing(legend_names)) { legend_names <- as.character(levels(x)) } - } } - - ## generate a palette: - if(missing(colour_scale)){ - if(is.numeric(obj@data[,Target_variable])){ - colour_scale <- get("colour_scale_numeric", envir = plotKML.opts) - } - else { - colour_scale <- get("colour_scale_factor", envir = plotKML.opts) - } - } - - if(missing(icons)){ - icons <- rep("", length(legend_names)) - } - - cols <- colorRamp(colour_scale, space="rgb", interpolate = "linear") - cdata <- scales::rescale(bounds.c) - if(missing(color)){ - color <- rgb(cols(cdata)/255) - } - - ## make a spatial palette: - pal <- new("sp.palette", type=class(obj@data[,Target_variable]), bounds=bounds, color = color, names = legend_names, icons = icons) - ## make a SpatialMetadata object: - spmd <- new("SpatialMetadata", xml=doc, field.names=paste(field_names), palette=pal, sp=as(obj, "Spatial")) - return(spmd) - -} - -setMethod("spMetadata", "Spatial", .spMetadata.Spatial) - -## Raster objects: -.spMetadata.Raster <- function(obj, bounds = NULL, color = NULL, ...){ - - if(!is.null(bounds)) {bounds <- obj@legend@values} - if(!is.null(color)) {color <- obj@legend@color} - - ## convert a Raster layer to SGDF: - if(nlayers(obj) > 1){ - obj <- raster(obj, layer = 1) - } - obj <- as(obj, "SpatialGridDataFrame") - - .spMetadata.Spatial(obj, ...) -} - -setMethod("spMetadata", "RasterLayer", .spMetadata.Raster) - - -################## READ METADATA ############## - -## Read metadata from a xml.file and convert to a table: -read.metadata <- function(xml.file, delim.sign, full.names){ - - if(missing(full.names)){ - full.names = read.csv(system.file("mdnames.csv", package="plotKML")) - } - ret <- xmlTreeParse(xml.file, useInternalNodes = TRUE) - top <- xmlRoot(ret) - nx <- unlist(xmlToList(top)) ## , addAttributes=FALSE - ## convert to a table: - if(!missing(delim.sign)){ - nxn <- gsub("\\.", delim.sign, attr(nx, "names")) - } else { - nxn <- attr(nx, "names") - } - met <- data.frame(metadata = nxn, value=paste(nx), stringsAsFactors = FALSE) - ## add more friendly names: - metm <- merge(x=met, y=full.names[,c("metadata","field.names")], by="metadata", all.x=TRUE, sort=FALSE) - - return(metm[,c(1,3,2)]) -} - +# Purpose : Automated generation of (spatial) metadata +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Michael Blaschek (blaschek@geographie.uni-kiel.de) and Eloi Ribeiro (eloi.carvalhoribeiro@wur.nl); +# Dev Status : Beta +# Note : Based on the US gov sp metadata standards [http://www.fgdc.gov/metadata/csdgm/], which can be converted to "ISO 19139" XML schema; and on the INSPIRE Metadata Implementing Rules [http://inspire.jrc.ec.europa.eu/documents/Metadata/MD_IR_and_ISO_20131029.pdf] + +## internal methods: +setMethod("GetNames", "SpatialMetadata", function(obj){paste(obj@field.names)}) +setMethod("GetPalette", "SpatialMetadata", function(obj){obj@palette}) + +## Generate a spMetadata class object: +.spMetadata.Spatial <- function( + obj, + xml.file, ## optional input metadata file + out.xml.file, + md.type = c("FGDC", "INSPIRE")[1], + generate.missing = TRUE, + GoogleGeocode = FALSE, + signif.digit = 3, + colour_scale, + color = NULL, + bounds, + legend_names, + icons, + validate.schema = FALSE, + ... +) +{ + + ## Check if there is a data slot: + if(!("data" %in% slotNames(obj))){ + stop("Object of class 'Spatial*DataFrame' required.") + } + + ## Use metadata file if it does exit: + if(!missing(xml.file)){ + if(file.exists(xml.file)){ + message(paste("Reading the metadata file: ", xml.file, sep="")) + ret <- xmlTreeParse(xml.file) + ml <- xmlRoot(ret) + a <- xmlTreeParse(xml.file, useInternalNodes = TRUE) + + ## Try to generate missing metadata: + if(generate.missing == TRUE){ + message("Generating missing metadata...") + ## Metadata template: + if(md.type=="INSPIRE"){ + tmpl <- xmlTreeParse(system.file("INSPIRE_ISO19139.xml", package = "plotKML"), useInternalNodes = TRUE) + } else { + tmpl <- xmlTreeParse(system.file("FGDC.xml", package="plotKML"), useInternalNodes=TRUE) + } + top <- xmlRoot(tmpl) + nx <- names(unlist(xmlToList(top))) + ## compare the actual xml file and the template: + cross <- compareXMLDocs(a=a, b=tmpl) + + ## Merge the existing Metadata file with existing template: + if(length(cross[["inB"]])>0){ + for(i in 1:length(cross[["inB"]])){ + ## position of the missing node in the target doc: + nodn <- attr(cross[["inB"]], "dimnames")[[1]][i] + x_l <- strsplit(nx[grep(nodn, nx)], "\\.")[[1]] + ## TH: 7 levels - this is not the best implementation :( -> it takes ca 3-5 seconds; + for(j in 1:length(x_l)){ + if(j==1 & !x_l[j] %in% names(ml)) { ml <- append.XMLNode(ml, xmlNode(x_l[j], "")) } + if(j==2 & !x_l[j] %in% names(ml[[x_l[1]]])) { ml[[x_l[1]]] <- append.XMLNode(ml[[x_l[1]]], xmlNode(x_l[j], "")) } + if(j==3 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]])) { ml[[x_l[1]]][[x_l[2]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]], xmlNode(x_l[j], "")) } + if(j==4 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]], xmlNode(x_l[j], "")) } + if(j==5 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]], xmlNode(x_l[j], "")) } + if(j==6 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]], xmlNode(x_l[j], "")) } + if(j==7 & !x_l[j] %in% names(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]][[x_l[6]]])) { ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]][[x_l[6]]] <- append.XMLNode(ml[[x_l[1]]][[x_l[2]]][[x_l[3]]][[x_l[4]]][[x_l[5]]][[x_l[6]]], xmlNode(x_l[j], "")) } + } + }} + } + + if(validate.schema == TRUE){ + if(md.type=="INSPIRE"){ + message("Connecting to the INSPIRE schema...") + try(xsd <- xmlTreeParse(get("inspire_xsd", envir=plotKML.opts), isSchema=TRUE, useInternalNodes = TRUE)) + } + if(md.type=="FGDC"){ + message("Connecting to the FGDC schema...") + try(xsd <- xmlTreeParse(get("fgdc_xsd", envir=plotKML.opts), isSchema=TRUE, useInternalNodes = TRUE)) + } + ## validate if the schema is OK: + try(xsd.val <- xmlSchemaValidate(xsd, a)) + ## print the results of validation: + x <- NULL + try(x <- sapply(xsd.val$errors, function(x){x["msg"][[1]]})) + if(nzchar(x)){ + warning(paste(x), call. = FALSE) + } + } + message(paste('Finished generating missing nodes. Open file \"', out.xml.file, '\" and add missing information.', sep="")) + + } else { + warning(paste("Could not locate ", xml.file, ". See '?spMetadata' for more details.", sep=""), call.=FALSE) + } + } ## If the metadata file does not exit, use the template available in the "/inst" directory: + else { + ## Metadata template: + if(md.type=="INSPIRE"){ + ret <- xmlTreeParse(system.file("INSPIRE_ISO19139.xml", package="plotKML"), useInternalNodes = TRUE) + } + if(md.type=="FGDC"){ + ret <- xmlTreeParse(system.file("FGDC.xml", package="plotKML"), useInternalNodes = TRUE) + } + ml <- xmlRoot(ret) + + ## Load static metadata entries (if they do not exist already): + metadata.env(..., show.env = FALSE) + ## Target variable: + Target_variable <- names(obj)[1] + ## Generate a name for the output XML file: + if(missing(out.xml.file)){ + out.xml.file <- paste(normalizeFilename(deparse(substitute(obj, env=parent.frame()))), ".xml", sep="") + } + ## Measurement resolution: + Attribute_Measurement_Resolution <- get("Attribute_Measurement_Resolution", envir = metadata) + if(Attribute_Measurement_Resolution==""){ + ## Estimate the numeric resolution by using the optimal number of bins in the histogram: + if(is.numeric(obj@data[,Target_variable])){ + Attribute_Measurement_Resolution <- signif(diff(quantile(obj@data[,Target_variable], na.rm=TRUE, prob=c(.025,.975)))/(length(hist(obj@data[,Target_variable], breaks="FD", plot=FALSE)$breaks)*2), 2) + } + } + + ## The bounding box: + if(md.type=="INSPIRE"){ + west <- get("Extent_West_Longitude", envir = metadata) + east <- get("Extent_East_Longitude", envir = metadata) + south <- get("Extent_South_Latitude", envir = metadata) + north <- get("Extent_North_Latitude", envir = metadata) + } else { + west <- get("West_Bounding_Coordinate", envir = metadata) + east <- get("East_Bounding_Coordinate", envir = metadata) + south <- get("South_Bounding_Coordinate", envir = metadata) + north <- get("North_Bounding_Coordinate", envir = metadata) + } + if(any(list(west,east,south,north)=="")){ + message("Estimating the bounding box coordinates...") + obj.ll <- reproject(obj) + west <- min(coordinates(obj.ll)[,1]) + east <- max(coordinates(obj.ll)[,1]) + north <- max(coordinates(obj.ll)[,2]) + south <- min(coordinates(obj.ll)[,2]) + } + + ## Automatically update some standard nodes (INSPIRE schema): + if(md.type=="INSPIRE"){ + ## Generate UUID: + UUID <- get("UUID", envir = metadata) + if(UUID==""){ + if(requireNamespace("uuid", quietly = TRUE)){ + xmlValue(ml[["fileIdentifier"]][[1]]) <- uuid::UUIDgenerate(use.time = FALSE) + } + } + ## Date stamp: + xmlValue(ml[["dateStamp"]][["Date"]]) <- get("Date_stamp", envir = metadata) + ## RS identifier: + CI_RS_identifier <- get("CI_RS_identifier", envir = metadata) + if(CI_RS_identifier==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["identifier"]][["RS_Identifier"]][["code"]][[1]]) <- uuid::UUIDgenerate(use.time = FALSE) + } + ## Responsible party: + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["organisationName"]][[1]]) <- get("MD_Organisation_name", envir = metadata) + MD_Electronic_mail_address <- get("MD_Electronic_mail_address", envir = metadata) + if(!MD_Electronic_mail_address==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["contactInfo"]][["CI_Contact"]][["address"]][["CI_Address"]][["electronicMailAddress"]][[1]]) <- MD_Electronic_mail_address + } + MD_contact_URL <- get("MD_contact_URL", envir = metadata) + if(!MD_contact_URL==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["contactInfo"]][["CI_Contact"]][["onlineResource"]][["CI_OnlineResource"]][["linkage"]][[1]]) <- MD_contact_URL + } + ## Citation title: + CI_Citation_title <- get("CI_Citation_title", envir = metadata) + if(CI_Citation_title==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["title"]][[1]]) <- normalizeFilename(deparse(substitute(obj))) + } else { + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["title"]][[1]]) <- CI_Citation_title + } + CI_Unique_name <- get("CI_Unique_name", envir = metadata) + if(!CI_Unique_name==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["identifier"]][["RS_Identifier"]][["code"]][[1]]) <- CI_Unique_name + } + ## Abstract: + MD_Abstract <- get("MD_Abstract", envir = metadata) + if(!MD_Abstract==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["abstract"]][[1]]) <- MD_Abstract + } + ## Lineage: + DQ_Lineage_statement <- get("DQ_Lineage_statement", envir = metadata) + if(!DQ_Lineage_statement==""){ + xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["lineage"]][["LI_Lineage"]][["statement"]][[1]]) <- DQ_Lineage_statement + } + ## Use limitations: + MD_Use_limitations <- get("MD_Use_limitations", envir = metadata) + if(!MD_Use_limitations==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["resourceConstraints"]][["MD_Constraints"]][["useLimitation"]][[1]]) <- MD_Use_limitations + } + ## Scale number / resolution: + MD_Equivalent_scale <- get("MD_Equivalent_scale", envir = metadata) + xx <- which(names(ml[["identificationInfo"]][["MD_DataIdentification"]]) == "spatialResolution") ## TH: there are two nodes of the same name! + if(!MD_Equivalent_scale==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[1]]][["MD_Resolution"]][["equivalentScale"]][["MD_RepresentativeFraction"]][["denominator"]][["Integer"]]) <- MD_Equivalent_scale + } + MD_Resolution <- get("MD_Resolution", envir = metadata) + if(!MD_Resolution==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_Resolution"]][["distance"]][["Distance"]]) <- MD_Resolution + xmlAttrs(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_Resolution"]][["distance"]][["Distance"]])[[1]] <- "#m" + } + ## Coordinate system: + MD_ReferenceSystem_Identifier <- get("MD_ReferenceSystem_Identifier", envir = metadata) + if(MD_ReferenceSystem_Identifier==""){ + xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["code"]][[1]]) <- proj4string(obj) + xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["codeSpace"]][[1]]) <- "proj4" + } else { + xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["code"]][[1]]) <- MD_ReferenceSystem_Identifier + xmlValue(ml[["referenceSystemInfo"]][["MD_ReferenceSystem"]][["referenceSystemIdentifier"]][["RS_Identifier"]][["codeSpace"]][[1]]) <- get("MD_ReferenceSystem_type", envir = metadata) + } + + ## Contact organization: + xmlValue(ml[["contact"]][["CI_ResponsibleParty"]][["organisationName"]][[1]]) <- get("CI_Organisation_name", envir = metadata) + xmlValue(ml[["contact"]][["CI_ResponsibleParty"]][["role"]][["CI_RoleCode"]][[1]]) <- get("CI_Role", envir = metadata) + ## Author: + CI_Electronic_mail_address <- get("CI_Electronic_mail_address", envir = metadata) + if(!CI_Electronic_mail_address==""){ + xmlValue(ml[["contact"]][["CI_ResponsibleParty"]][["contactInfo"]][["CI_Contact"]][["address"]][["CI_Address"]][["electronicMailAddress"]][[1]]) <- CI_Electronic_mail_address + } + + ## Thesaurus: + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["thesaurusName"]][["CI_Citation"]][["title"]][[1]]) <- get("MD_Thesaurus_name", envir = metadata) + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["thesaurusName"]][["CI_Citation"]][["date"]][["CI_Date"]][["date"]][["Date"]]) <- get("MD_Thesaurus_date", envir = metadata) + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["thesaurusName"]][["CI_Citation"]][["date"]][["CI_Date"]][["dateType"]][["CI_DateTypeCode"]]) <- get("MD_Thesaurus_date_type", envir = metadata) + ## Keywords: + MD_Keyword <- get("MD_Keyword", envir = metadata) + if(!all(MD_Keyword=="")){ + for(i in 1:length(MD_Keyword)){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["descriptiveKeywords"]][["MD_Keywords"]][[i]][["CharacterString"]]) = MD_Keyword[i] + } + } + ## Language: + xmlValue(ml[["language"]][["LanguageCode"]]) <- get("Language_code", envir = metadata) + xmlAttrs(ml[["language"]][["LanguageCode"]])[[2]] <- get("Language_code", envir = metadata) + xmlValue(ml[["characterSet"]][["MD_CharacterSetCode"]][[1]]) <- get("MD_Character_set_code", envir = metadata) + xmlValue(ml[["hierarchyLevel"]][["MD_ScopeCode"]][[1]]) <- get("MD_scope_code", envir = metadata) + ## Citation date: + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["citation"]][["CI_Citation"]][["date"]][["CI_Date"]][["date"]][["Date"]]) <- get("CI_Citation_date", envir = metadata) + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["language"]][["LanguageCode"]]) <- get("MD_Language_code", envir = metadata) + xmlAttrs(ml[["identificationInfo"]][["MD_DataIdentification"]][["language"]][["LanguageCode"]])[[2]] <- get("MD_Language_code", envir = metadata) + ## All topic categories: + MD_Topic_category_code <- get("MD_Topic_category_code", envir = metadata) + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["topicCategory"]][["MD_TopicCategoryCode"]]) <- MD_Topic_category_code[1] + if(length(MD_Topic_category_code) > 1) { + xi <- length(MD_Topic_category_code) - 1 + xt <- as.vector(which(names(ml[["identificationInfo"]][["MD_DataIdentification"]]) == "topicCategory")[1]) + xm <- xmlSize(ml[["identificationInfo"]][["MD_DataIdentification"]]) + j <- 0 + for (i in (xt + 1):xm) { + ml[["identificationInfo"]][["MD_DataIdentification"]][xm + xi + j][[1]] <- ml[["identificationInfo"]][["MD_DataIdentification"]][i][[1]] + j <- j + 1 + } + for(i in 2:length(MD_Topic_category_code)) { + ml[["identificationInfo"]][["MD_DataIdentification"]][xt + i - 1][[1]] <- ml[["identificationInfo"]][["MD_DataIdentification"]][["topicCategory"]] + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][xt + i - 1][[1]][["MD_TopicCategoryCode"]]) <- MD_Topic_category_code[i] + } + } + ## Data quality info: + DQ_Citation_title <- get("DQ_Citation_title", envir = metadata) + if(!DQ_Citation_title==""){ + xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["report"]][["DQ_DomainConsistency"]][["result"]][["DQ_ConformanceResult"]][["specification"]][["CI_Citation"]][["title"]][[1]]) <- DQ_Citation_title + } + DQ_Citation_date <- get("DQ_Citation_date", envir = metadata) + if(!DQ_Citation_title==""){ + xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["report"]][["DQ_DomainConsistency"]][["result"]][["DQ_ConformanceResult"]][["specification"]][["CI_Citation"]][["date"]][["CI_Date"]][["date"]][["Date"]]) <- DQ_Citation_date + } + xmlValue(ml[["dataQualityInfo"]][["DQ_DataQuality"]][["report"]][["DQ_DomainConsistency"]][["result"]][["DQ_ConformanceResult"]][["specification"]][["CI_Citation"]][["date"]][["CI_Date"]][["dateType"]][["CI_DateTypeCode"]]) <- get("DQ_Citation_date_type", envir = metadata) + ## Resource locator... + CI_Online_resource_URL <- get("CI_Online_resource_URL", envir = metadata) + if(!CI_Online_resource_URL==""){ + xmlValue(ml[["distributionInfo"]][["MD_Distribution"]][["transferOptions"]][["MD_DigitalTransferOptions"]][["onLine"]][["CI_OnlineResource"]][["linkage"]][["URL"]]) <- CI_Online_resource_URL + } + if(validate.schema==TRUE){ + try.connection <- try(url(CI_Online_resource_URL, open = 'rb')) + try.error <- inherits(try.connection, "try-error") + if(try.error == T){ + warning("'CI_Online_resource_URL' points to an invalid URL.") + } + } + ## Bounding box: + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["westBoundLongitude"]][["Decimal"]]) <- west + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["eastBoundLongitude"]][["Decimal"]]) <- east + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["northBoundLatitude"]][["Decimal"]]) <- north + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["geographicElement"]][["EX_GeographicBoundingBox"]][["southBoundLatitude"]][["Decimal"]]) <- south + ## Dates: + Time_period_begin <- get("Time_period_begin", envir = metadata) + if(!Time_period_begin==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["temporalElement"]][["EX_TemporalExtent"]][["extent"]][["TimePeriod"]][["beginPosition"]]) <- as(Time_period_begin, "character") + } + Time_period_end <- get("Time_period_end", envir = metadata) + if(!Time_period_end==""){ + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["extent"]][["EX_Extent"]][["temporalElement"]][["EX_TemporalExtent"]][["extent"]][["TimePeriod"]][["endPosition"]]) <- as(Time_period_end, "character") + } + ## Metadata standard: + xmlValue(ml[["metadataStandardName"]][[1]]) <- get("MD_Standard_name", envir = metadata) + xmlValue(ml[["metadataStandardVersion"]][[1]]) <- get("MD_Standard_version", envir = metadata) + ## Contact: + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["role"]][["CI_RoleCode"]]) <- get("MD_Role", envir = metadata) + xmlAttrs(ml[["identificationInfo"]][["MD_DataIdentification"]][["pointOfContact"]][["CI_ResponsibleParty"]][["role"]][["CI_RoleCode"]])[[2]] <- get("MD_Role", envir = metadata) + ## Use constraints: + xx <- which(names(ml[["identificationInfo"]][["MD_DataIdentification"]]) == "resourceConstraints") ## TH: there are two nodes of the same name! + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_LegalConstraints"]][["accessConstraints"]][["MD_RestrictionCode"]]) <- get("MD_Access_constraints", envir = metadata) + xmlValue(ml[["identificationInfo"]][["MD_DataIdentification"]][[xx[2]]][["MD_LegalConstraints"]][["otherConstraints"]][[1]]) <- get("MD_Other_restrictions", envir = metadata) + + } + + ## Automatically update some standard nodes (FGDC schema): + if(md.type=="FGDC"){ + ## Location name: + Indirect_Spatial_Reference <- get("Indirect_Spatial_Reference", envir = metadata) + if(Indirect_Spatial_Reference=="" & GoogleGeocode == TRUE){ + if(requireNamespace("rjson", quietly = TRUE)){ + googleurl <- url(paste("http://maps.googleapis.com/maps/api/geocode/json?latlng=", round(mean(obj.ll@bbox[2,]),3), ",", round(mean(obj.ll@bbox[1,]),3), "&sensor=false", sep="")) + try(Indirect_Spatial_Reference <- rjson::fromJSON(file=googleurl)[["results"]][[1]][["formatted_address"]]) + close(googleurl) + } + } + + ## Citation title: + Citation_title <- get("Citation_title", envir = metadata) + if(Citation_title==""){ + xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["title"]]) <- normalizeFilename(deparse(substitute(obj))) + } else { + xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["title"]]) <- Citation_title + } + ## Data format: + xmlValue(ml[["distinfo"]][["stdorder"]][["digform"]][["digtinfo"]][["formcont"]]) <- class(obj)[1] + ## Data citation: + xmlValue(ml[["eainfo"]][["overview"]][["eadetcit"]]) <- paste("http://CRAN.R-project.org/package=", attr(class(obj), "package"), "/", sep="") + ## Entity type: + xmlValue(ml[["eainfo"]][["detailed"]][["enttyp"]][["enttypl"]]) <- class(obj@data[, Target_variable]) + ## Range of values: + if(is.numeric(obj@data[,Target_variable])){ + xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["rdommin"]]) <- min(obj@data[,Target_variable], na.rm=TRUE) + xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["rdommax"]]) <- max(obj@data[,Target_variable], na.rm=TRUE) + } + ## Attribute label: + xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrlabl"]]) <- Target_variable + Attribute_Definition <- get("Attribute_Definition", envir = metadata) + if(!Attribute_Definition==""){ + xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdef"]]) <- Attribute_Definition + } + ## MB: geoform node: + Geospatial_Data_Presentation_Form <- get("Geospatial_Data_Presentation_Form", envir = metadata) + if(!Geospatial_Data_Presentation_Form==""){ + xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["geoform"]]) <- Geospatial_Data_Presentation_Form + } + ## MB: 'pubinfo' nodes: + Citation_Publisher <- get("Citation_Publisher", envir = metadata) + if(!Citation_Publisher==""){ + xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["pubinfo"]][["publish"]]) <- Citation_Publisher + } + Publication_Place <- get("Publication_Place", envir = metadata) + if(!Publication_Place==""){ + xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["pubinfo"]][["pubplace"]]) <- Publication_Place + } + Citation_URL <- get("Citation_URL", envir = metadata) + if(!Citation_URL==""){ + xmlValue(ml[["idinfo"]][["citation"]][["citeinfo"]][["onlink"]]) <- Citation_URL + } + ## MB: insert 'edition' node: + Purpose <- get("Purpose", envir = metadata) + if(!Purpose==""){ + xmlValue(ml[["idinfo"]][["descript"]][["purpose"]]) <- Purpose + } + Abstract <- get("Abstract", envir = metadata) + if(!Abstract==""){ + xmlValue(ml[["idinfo"]][["descript"]][["abstract"]]) <- Abstract + } + Supplemental_Information <- get("Supplemental_Information", envir = metadata) + if(!Supplemental_Information==""){ + xmlValue(ml[['idinfo']][['descript']]['supplinf']) <- Supplemental_Information + } + ## temporal extent: + Beginning_Date <- get("Beginning_Date", envir = metadata) + if(!Beginning_Date==""){ + xmlValue(ml[["idinfo"]][["timeperd"]][["timeinfo"]][["rngdates"]][["begdate"]]) <- Beginning_Date + } + Ending_Date <- get("Ending_Date", envir = metadata) + if(!Ending_Date==""){ + xmlValue(ml[["idinfo"]][["timeperd"]][["timeinfo"]][["rngdates"]][["enddate"]]) <- Ending_Date + } + ## keywords theme: + Theme_Keyword <- get("Theme_Keyword", envir = metadata) + if(!all(Theme_Keyword=="")){ + for(i in 1:length(Theme_Keyword)) { + if(i != length(Theme_Keyword)) { + ml[['idinfo']][['keywords']][['theme']][i+2] <- ml[['idinfo']][['keywords']][['theme']][i+1] + } + xmlValue(ml[['idinfo']][['keywords']][['theme']][i+1][['themekey']]) <- Theme_Keyword[i] + } + } + Theme_Keyword_Thesaurus <- get("Theme_Keyword_Thesaurus", envir = metadata) + if(!all(Theme_Keyword_Thesaurus=="")){ + for(i in 1:length(Theme_Keyword_Thesaurus)){ + if(i != length(Theme_Keyword_Thesaurus)) { + ml[['idinfo']][['keywords']][['place']][i+2] <- ml[['idinfo']][['keywords']][['place']][i+1] + } + xmlValue(ml[['idinfo']][['keywords']][['place']][i+1][['placekey']]) <- Theme_Keyword_Thesaurus[i] + } + } + ## Measurement resolution: + xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["attrmres"]]) <- Attribute_Measurement_Resolution + Attribute_Units_of_Measure <- get("Attribute_Units_of_Measure", envir = metadata) + if(!Attribute_Units_of_Measure==""){ + xmlValue(ml[["eainfo"]][["detailed"]][["attr"]][["attrdomv"]][["rdom"]][["attrunit"]]) <- Attribute_Units_of_Measure + } + ## Estimate object size: + xmlValue(ml[["distinfo"]][["stdorder"]][["digform"]][["digtinfo"]][["transize"]]) <- paste(signif(object.size(obj@data[, Target_variable])/1024, 4), "Kb (uncompressed)") + ## MB: insert status information (progress, update): + Status_Progress <- get("Status_Progress", envir = metadata) + if(length(Status_Progress)==1L){ + xmlValue(ml[["idinfo"]][["status"]][["progress"]]) <- Status_Progress + } + Maintenance_and_Update_Frequency <- get("Maintenance_and_Update_Frequency", envir = metadata) + if(!Maintenance_and_Update_Frequency==""){ + xmlValue(ml[["idinfo"]][["status"]][["update"]]) <- Maintenance_and_Update_Frequency + } + ## Bounding box: + xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["westbc"]]) <- west + xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["eastbc"]]) <- east + xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["northbc"]]) <- north + xmlValue(ml[["idinfo"]][["spdom"]][["bounding"]][["southbc"]]) <- south + xmlValue(ml[["spref"]][["horizsys"]][["geograph"]][["geogunit"]]) <- "Decimal degrees" + ## Representation type: + Direct_Spatial_Reference_Method <- get("Direct_Spatial_Reference_Method", envir = metadata)[1] + if(!Direct_Spatial_Reference_Method==""){ + xmlValue(ml[['spdoinfo']][['direct']]) <- Direct_Spatial_Reference_Method + } + ## metadata generation time: + xmlValue(ml[["metainfo"]][["metd"]]) <- Sys.Date() + ## Spatial reference: + if(!Indirect_Spatial_Reference==""){ + xmlValue(ml[["spdoinfo"]][["indspref"]]) <- Indirect_Spatial_Reference + } + ## number of elements: + xmlValue(ml[["spdoinfo"]][["ptvctinf"]][["sdtsterm"]][["ptvctcnt"]]) <- nrow(obj@data) + ## System information: + xmlValue(ml[["idinfo"]][["native"]]) <- get("Native_Data_Set_Environment", envir = metadata) + xmlValue(ml[["idinfo"]][["ptcontac"]][["cntinfo"]][["cntorgp"]][["cntper"]]) <- get("Contact_Information_Person", envir = metadata) + Metadata_Contact_Position <- get("Metadata_Contact_Position", envir = metadata) + if(!Metadata_Contact_Position==""){ + xmlValue(ml[["metainfo"]][["metc"]][["cntinfo"]][["cntpos"]]) <- get("Metadata_Contact_Position", envir = metadata) + } + } + + } + message("Finished generating standard metadata...\nManual editing of the metadata file might be required.") + + ## attach friendly metadata names: + ny <- unlist(xmlToList(ml)) + ## convert to a table: + met <- data.frame(metadata=names(ny), value=paste(ny)) + ## add friendly names: + mdnames <- read.csv(system.file("mdnames.csv", package="plotKML")) + field_names <- merge(met, mdnames[,c("metadata","field.names")], by="metadata", all.x=TRUE, all.y=FALSE, sort=FALSE)[,"field.names"] + field_names <- field_names[!is.na(field_names)] + ## generate metadata doc: + saveXML(ml, out.xml.file) + doc = xmlInternalTreeParse(out.xml.file) + + ## color palette: + if(missing(bounds)){ + if(is.numeric(obj@data[,Target_variable])){ + bounds <- seq(range(obj@data[,Target_variable], na.rm = TRUE, finite = TRUE)[1], range(obj@data[,Target_variable], na.rm = TRUE, finite = TRUE)[2], Attribute_Measurement_Resolution/2) ## half the numeric resolution! + bounds.c <- signif((bounds[-1]+bounds[-length(bounds)])/2, signif.digit) + if(missing(legend_names)) { legend_names <- as.character(bounds.c) } + } + else { + x <- as.factor(obj@data[,Target_variable]) + bounds <- c(0, seq_along(levels(x))) + bounds.c <- bounds[-1] + if(missing(legend_names)) { legend_names <- as.character(levels(x)) } + } } + + ## generate a palette: + if(missing(colour_scale)){ + if(is.numeric(obj@data[,Target_variable])){ + colour_scale <- get("colour_scale_numeric", envir = plotKML.opts) + } + else { + colour_scale <- get("colour_scale_factor", envir = plotKML.opts) + } + } + + if(missing(icons)){ + icons <- rep("", length(legend_names)) + } + + cols <- colorRamp(colour_scale, space="rgb", interpolate = "linear") + cdata <- scales::rescale(bounds.c) + if(missing(color)){ + color <- rgb(cols(cdata)/255) + } + + ## make a spatial palette: + pal <- new("sp.palette", type=class(obj@data[,Target_variable]), bounds=bounds, color = color, names = legend_names, icons = icons) + ## make a SpatialMetadata object: + spmd <- new("SpatialMetadata", xml=doc, field.names=paste(field_names), palette=pal, sp=as(obj, "Spatial")) + return(spmd) + +} + +setMethod("spMetadata", "Spatial", .spMetadata.Spatial) + +## Raster objects: +.spMetadata.Raster <- function(obj, bounds = NULL, color = NULL, ...){ + + if(!is.null(bounds)) {bounds <- obj@legend@values} + if(!is.null(color)) {color <- obj@legend@color} + + ## convert a Raster layer to SGDF: + if(nlayers(obj) > 1){ + obj <- raster(obj, layer = 1) + } + obj <- as(obj, "SpatialGridDataFrame") + + .spMetadata.Spatial(obj, ...) +} + +setMethod("spMetadata", "RasterLayer", .spMetadata.Raster) + + +################## READ METADATA ############## + +## Read metadata from a xml.file and convert to a table: +read.metadata <- function(xml.file, delim.sign, full.names){ + + if(missing(full.names)){ + full.names = read.csv(system.file("mdnames.csv", package="plotKML")) + } + ret <- xmlTreeParse(xml.file, useInternalNodes = TRUE) + top <- xmlRoot(ret) + nx <- unlist(xmlToList(top)) ## , addAttributes=FALSE + ## convert to a table: + if(!missing(delim.sign)){ + nxn <- gsub("\\.", delim.sign, attr(nx, "names")) + } else { + nxn <- attr(nx, "names") + } + met <- data.frame(metadata = nxn, value=paste(nx), stringsAsFactors = FALSE) + ## add more friendly names: + metm <- merge(x=met, y=full.names[,c("metadata","field.names")], by="metadata", all.x=TRUE, sort=FALSE) + + return(metm[,c(1,3,2)]) +} + # end of script; \ No newline at end of file diff --git a/pkg/R/spPhoto.R b/pkg/R/spPhoto.R index e7222f1..aabf400 100644 --- a/pkg/R/spPhoto.R +++ b/pkg/R/spPhoto.R @@ -1,120 +1,125 @@ -# Note: Combination of the pixmap package and EXIF information [https://exiftool.org/]; - -## Generate SpatialPhotoOverlay object: -spPhoto <- function( - filename, - obj, - pixmap, - exif.info = NULL, - ImageWidth = 0, - ImageHeight = 0, - bands = rep(rep(1, ImageHeight*ImageWidth), 3), - bbox = c(0,0,3/36000*ImageWidth,3/36000*ImageHeight), - DateTime = "", - ExposureTime = "", - FocalLength = "50 mm", - Flash = "No Flash", - rotation = 0, - leftFov = -30, - rightFov = 30, - bottomFov = -30, - topFov = 30, - near = 50, # in meters; - shape = c("rectangle", "cylinder", "sphere")[1], - range = 1000, # m; - tilt = 90, - heading = 0, - roll = 0, - test.filename = TRUE - ){ - - if(test.filename==TRUE){ - if(!file.exists(filename)){ - if(requireNamespace("RCurl", quietly = TRUE)){ - z <- RCurl::getURI(filename, .opts=RCurl::curlOptions(header=TRUE, nobody=TRUE, transfertext=TRUE, failonerror=FALSE, ssl.verifypeer = FALSE)) - if(!length(x <- grep(z, pattern="404 Not Found"))==0){ - stop(paste("File", filename, "could not be located.")) - } else { - pixmap <- pixmapRGB(bands, ImageHeight, ImageWidth, bbox = bbox) - } - } else { - stop('package "RCurl" required but missing') - } - } else { - stop(paste("File", filename, "could not be located.")) - } - } - - # Local copy or in memory - if(!missing(pixmap)&missing(filename)){ - filename = "" - } - - ## if missing the coordinate system assume latlon: - if(!missing(obj)){ - if(is.na(proj4string(obj))) { proj4string(obj) <- CRS(get("ref_CRS", envir = plotKML.opts)) } - } - - ## if missing EXIF data: - if(is.null(exif.info)){ - exif.info <- as.list(data.frame(DateTime, ExposureTime, FocalLength, Flash)) - } - else{ - ## try to guess coordinates from EXIF data: - if(missing(obj)&any(names(exif.info) %in% "GPSLongitude")){ - if(any(names(exif.info) %in% "GPSAltitude")){ - x <- as.numeric(strsplit(exif.info$GPSAltitude, "/")[[1]]) - try(exif.info$GPSAltitude <- ifelse(length(x)>1, x[1]/x[2], x)) - } - else { - exif.info$GPSAltitude <- 0 - } - - obj <- data.frame(lon=as.numeric(exif.info$GPSLongitude), lat=as.numeric(exif.info$GPSLatitude), alt=as.numeric(exif.info$GPSAltitude)) - coordinates(obj) <- ~lon+lat+alt - proj4string(obj) <- CRS(get("ref_CRS", envir = plotKML.opts)) - - } - else { - stop("GPS Longitude/Latitude tags not available from the exif.info object.") - } - - ## correct the ViewVolume: - exif.info$ImageWidth <- as.numeric(exif.info$ImageWidth) - exif.info$ImageHeight <- as.numeric(exif.info$ImageHeight) - asp = exif.info$ImageWidth / exif.info$ImageHeight - leftFov = leftFov * asp - rightFov = rightFov * asp - - ## format the DateTime field: - exif.info$DateTime <- format(as.POSIXct(exif.info$DateTime, format="%Y:%m:%d %H:%M:%S", tz="GMT"), "%Y-%m-%dT%H:%M:%SZ") - - ## add missing columns: - if(!any(names(exif.info) %in% "ExposureTime")){ - exif.info$ExposureTime <- ExposureTime - } - if(!any(names(exif.info) %in% "FocalLength")){ - exif.info$FocalLength <- FocalLength - } - if(!any(names(exif.info) %in% "Flash")){ - exif.info$Flash <- Flash - } - - } - - ## Get the heading (if available): - if(any(names(exif.info) %in% "GPSImgDirection")){ - x <- as.numeric(strsplit(exif.info$GPSImgDirection, "/")[[1]]) - try(exif.info$GPSImgDirection <- ifelse(length(x)>1, x[1]/x[2], x)) - heading = exif.info$GPSImgDirection - } - - ## Photo geometry: - PhotoOverlay <- as.list(data.frame(rotation, leftFov, rightFov, bottomFov, topFov, near, shape, range, tilt, heading, roll)) - - ## make a SpatialPhotoOverlay object: - spPh <- new("SpatialPhotoOverlay", filename = filename, pixmap = pixmap, exif.info = exif.info, PhotoOverlay = PhotoOverlay, sp = obj) - return(spPh) -} - -# end of script; +# Purpose : Generation of SpatialPhotoOverlay object +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : ; +# Dev Status : Pre-Alpha +# Note : Combination of the pixmap package and EXIF information [http://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/EXIF.html]; + + +## Generate SpatialPhotoOverlay object: +spPhoto <- function( + filename, + obj, + pixmap, + exif.info = NULL, + ImageWidth = 0, + ImageHeight = 0, + bands = rep(rep(1, ImageHeight*ImageWidth), 3), + bbox = c(0,0,3/36000*ImageWidth,3/36000*ImageHeight), + DateTime = "", + ExposureTime = "", + FocalLength = "50 mm", + Flash = "No Flash", + rotation = 0, + leftFov = -30, + rightFov = 30, + bottomFov = -30, + topFov = 30, + near = 50, # in meters; + shape = c("rectangle", "cylinder", "sphere")[1], + range = 1000, # m; + tilt = 90, + heading = 0, + roll = 0, + test.filename = TRUE + ){ + + if(test.filename==TRUE){ + if(!file.exists(filename)){ + if(requireNamespace("RCurl", quietly = TRUE)){ + z <- RCurl::getURI(filename, .opts=RCurl::curlOptions(header=TRUE, nobody=TRUE, transfertext=TRUE, failonerror=FALSE, ssl.verifypeer = FALSE)) + if(!length(x <- grep(z, pattern="404 Not Found"))==0){ + stop(paste("File", filename, "could not be located.")) + } else { + pixmap <- pixmapRGB(bands, ImageHeight, ImageWidth, bbox = bbox) + } + } else { + stop('package "RCurl" required but missing') + } + } else { + stop(paste("File", filename, "could not be located.")) + } + } + + # Local copy or in memory + if(!missing(pixmap)&missing(filename)){ + filename = "" + } + + ## if missing the coordinate system assume latlon: + if(!missing(obj)){ + if(is.na(proj4string(obj))) { proj4string(obj) <- CRS(get("ref_CRS", envir = plotKML.opts)) } + } + + ## if missing EXIF data: + if(is.null(exif.info)){ + exif.info <- as.list(data.frame(DateTime, ExposureTime, FocalLength, Flash)) + } + else{ + ## try to guess coordinates from EXIF data: + if(missing(obj)&any(names(exif.info) %in% "GPSLongitude")){ + if(any(names(exif.info) %in% "GPSAltitude")){ + x <- as.numeric(strsplit(exif.info$GPSAltitude, "/")[[1]]) + try(exif.info$GPSAltitude <- ifelse(length(x)>1, x[1]/x[2], x)) + } + else { + exif.info$GPSAltitude <- 0 + } + + obj <- data.frame(lon=as.numeric(exif.info$GPSLongitude), lat=as.numeric(exif.info$GPSLatitude), alt=as.numeric(exif.info$GPSAltitude)) + coordinates(obj) <- ~lon+lat+alt + proj4string(obj) <- CRS(get("ref_CRS", envir = plotKML.opts)) + + } + else { + stop("GPS Longitude/Latitude tags not available from the exif.info object.") + } + + ## correct the ViewVolume: + exif.info$ImageWidth <- as.numeric(exif.info$ImageWidth) + exif.info$ImageHeight <- as.numeric(exif.info$ImageHeight) + asp = exif.info$ImageWidth / exif.info$ImageHeight + leftFov = leftFov * asp + rightFov = rightFov * asp + + ## format the DateTime field: + exif.info$DateTime <- format(as.POSIXct(exif.info$DateTime, format="%Y:%m:%d %H:%M:%S", tz="GMT"), "%Y-%m-%dT%H:%M:%SZ") + + ## add missing columns: + if(!any(names(exif.info) %in% "ExposureTime")){ + exif.info$ExposureTime <- ExposureTime + } + if(!any(names(exif.info) %in% "FocalLength")){ + exif.info$FocalLength <- FocalLength + } + if(!any(names(exif.info) %in% "Flash")){ + exif.info$Flash <- Flash + } + + } + + ## Get the heading (if available): + if(any(names(exif.info) %in% "GPSImgDirection")){ + x <- as.numeric(strsplit(exif.info$GPSImgDirection, "/")[[1]]) + try(exif.info$GPSImgDirection <- ifelse(length(x)>1, x[1]/x[2], x)) + heading = exif.info$GPSImgDirection + } + + ## Photo geometry: + PhotoOverlay <- as.list(data.frame(rotation, leftFov, rightFov, bottomFov, topFov, near, shape, range, tilt, heading, roll)) + + ## make a SpatialPhotoOverlay object: + spPh <- new("SpatialPhotoOverlay", filename = filename, pixmap = pixmap, exif.info = exif.info, PhotoOverlay = PhotoOverlay, sp = obj) + return(spPh) +} + +# end of script; diff --git a/pkg/R/vect2rast.R b/pkg/R/vect2rast.R index 7ce91f2..040c489 100644 --- a/pkg/R/vect2rast.R +++ b/pkg/R/vect2rast.R @@ -1,267 +1,272 @@ -# Note: The output pixel size is determined using simple cartographic principles (see [http://dx.doi.org/10.1016/j.cageo.2005.11.008]); - -## POINTS -vect2rast.SpatialPoints <- function(obj, fname = names(obj)[1], cell.size, bbox, file.name, silent = FALSE, method = c("raster", "SAGA")[1], FIELD = 0, MULTIPLE = 1, LINE_TYPE = 0, GRID_TYPE = 2, ...){ - - # add indicator value if missing data frame: - if(!any(slotNames(obj) %in% "data")){ - obj <- SpatialPointsDataFrame(obj, data=data.frame(x=rep(1, length(obj)))) - names(obj) <- "mask" - } else { - obj <- obj[fname] - } - - if(missing(bbox)) { bbox <- obj@bbox } - # make an empty raster based on extent: - if(missing(cell.size)){ - # print warning: - if(length(obj)>10000){ - warning("Automated derivation of suitable cell size can be time consuming and can lead to artifacts.", immediate. = TRUE) - } - - if(requireNamespace("spatstat.geom", quietly = TRUE)){ - x <- as(obj, "ppp") - nd <- spatstat.geom::nndist(x$x, x$y) - ndb <- boxplot(nd, plot=FALSE) - cell.size <- signif(ndb$stats[3]/2, 2) - if(cell.size==0){ stop("Estimated cell size is 0, consider removing duplicate points") } - if(silent==FALSE){message(paste("Estimated nearest neighbour distance (point pattern):", cell.size*2))} - } - } - - if(method=="raster"){ - x <- GridTopology(cellcentre.offset=bbox[,1], cellsize=c(cell.size,cell.size), cells.dim=c(round(abs(diff(bbox[1,])/cell.size), 0), ncols=round(abs(diff(bbox[2,])/cell.size), 0))) - r.sp <- SpatialGrid(x, proj4string = obj@proj4string) - r <- raster(r.sp) - # convert factors to integers: - if(is.factor(obj@data[,1])){ - obj@data[,1] <- as.integer(obj@data[,1]) - } - # rasterize - convert vector to a raster map: - obj <- obj[!is.na(obj@data[,1]),] - in.r <- rasterize(obj, r, field = names(obj)[1], ...) - res <- as(in.r, "SpatialGridDataFrame") - names(res) = names(obj)[1] - attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") - attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] - - if(!missing(file.name)){ - writeRaster(in.r, filename=file.name, overwrite=TRUE) - } - } - - else{ - if(method=="SAGA"){ # SAGA GIS 2.0.8 - - if(!rsaga.env()[["cmd"]]=="NULL"){ - - tmf <- tempfile() - tf <- set.file.extension(tmf, ".shp") - if(requireNamespace("maptools", quietly = TRUE)){ - maptools::writePointsShape(obj, tf) - } else { - writeOGR(obj, tf, tmf, driver="ESRI Shapefile") - } - - if(missing(file.name)){ - file.name <- set.file.extension(tempfile(), ".sgrd") - } - # rasterize map using SAGA GIS: - rsaga.geoprocessor("grid_gridding", 0, param=list(INPUT=tf, FIELD=FIELD, MULTIPLE=MULTIPLE, LINE_TYPE=LINE_TYPE, GRID_TYPE=0, TARGET=0, USER_XMIN=bbox[1,1]+cell.size/2, USER_XMAX=bbox[1,2]-cell.size/2, USER_YMIN=bbox[2,1]+cell.size/2, USER_YMAX=bbox[2,2]-cell.size/2, USER_SIZE=cell.size, USER_GRID=file.name, GRID_TYPE=GRID_TYPE), show.output.on.console = silent) - res <- readGDAL(set.file.extension(file.name, ".sdat"), silent = silent) - names(res) = names(obj)[1] - attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") - attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] - - } - else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } - } - else{ stop("Method not available") - } - } - - return(res) -} - -## LINES -vect2rast.SpatialLines <- function(obj, fname = names(obj)[1], cell.size, bbox, file.name, silent = FALSE, method = c("raster", "SAGA")[1], FIELD = 0, MULTIPLE = 1, LINE_TYPE = 1, GRID_TYPE = 2, ...){ - - # add indicator value if missing data frame: - if(!any(slotNames(obj) %in% "data")){ - obj <- SpatialLinesDataFrame(obj, data=data.frame(x=rep(1, length(obj)))) - names(obj) <- "mask" - } else { - obj <- obj[fname] - } - - if(missing(bbox)) { bbox <- obj@bbox } - # make an empty raster based on extent: - if(missing(cell.size)) { - # print warning: - if(length(obj)>1000){ - warning("Automated derivation of suitable cell size can be time consuming and can lead to artifacts.", immediate. = TRUE) - } - - if(requireNamespace("spatstat.linnet", quietly = TRUE)){ - x <- as(as(obj, "SpatialLines"), "lpp") - nd <- spatstat.linnet::nndist.lpp(x) # this can be time consuming! - ndb <- boxplot(nd, plot=FALSE) - cell.size <- signif(ndb$stats[3]/2, 2) - if(cell.size==0){ stop("Estimated cell size is 0, consider removing duplicate points") } - if(silent==FALSE){message(paste("Estimated nearest neighbour distance (line segments):", cell.size*2))} - } - } - - if(method=="raster"){ - x <- GridTopology(cellcentre.offset=bbox[,1], cellsize=c(cell.size,cell.size), cells.dim=c(round(abs(diff(bbox[1,])/cell.size), 0), ncols=round(abs(diff(bbox[2,])/cell.size), 0))) - r.sp <- SpatialGrid(x, proj4string = obj@proj4string) - r <- raster(r.sp) - # convert factors to integers: - if(is.factor(obj@data[,1])){ - obj@data[,1] <- as.integer(obj@data[,1]) - } - # rasterize - convert vector to a raster map: - obj <- obj[!is.na(obj@data[,1]),] - in.r <- rasterize(obj, r, field = names(obj)[1], ...) - res <- as(in.r, "SpatialGridDataFrame") - names(res) = names(obj)[1] - attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") - attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] - - if(!missing(file.name)){ - writeRaster(in.r, filename=file.name, overwrite=TRUE) - } - } - - else{ - if(method=="SAGA"){ # SAGA GIS 2.0.8 - - if(!rsaga.env()[["cmd"]]=="NULL"){ - - tmf <- tempfile() - tf <- set.file.extension(tmf, ".shp") - if(requireNamespace("maptools", quietly = TRUE)){ - maptools::writeLinesShape(obj, tf) - } else { - writeOGR(obj, tf, tmf, driver="ESRI Shapefile") - } - - if(missing(file.name)){ - file.name <- set.file.extension(tempfile(), ".sgrd") - } - # rasterize map using SAGA GIS: - rsaga.geoprocessor("grid_gridding", 0, param=list(INPUT=tf, FIELD=FIELD, MULTIPLE=MULTIPLE, LINE_TYPE=LINE_TYPE, GRID_TYPE=0, TARGET=0, USER_XMIN=bbox[1,1]+cell.size/2, USER_XMAX=bbox[1,2]-cell.size/2, USER_YMIN=bbox[2,1]+cell.size/2, USER_YMAX=bbox[2,2]-cell.size/2, USER_SIZE=cell.size, USER_GRID=file.name, GRID_TYPE=GRID_TYPE), show.output.on.console = silent) - res <- readGDAL(set.file.extension(file.name, ".sdat"), silent = silent) - names(res) = names(obj)[1] - attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") - attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] - - } - else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } - } - else{ stop("Method not available") - } - } - - return(res) -} - -## POLYGONS -vect2rast.SpatialPolygons <- function(obj, fname = names(obj)[1], cell.size, bbox, file.name, silent = FALSE, method = c("raster", "SAGA")[1], FIELD = 0, MULTIPLE = 0, LINE_TYPE = 1, GRID_TYPE = 2, ...){ - - # add indicator value if missing data frame: - if(!any(slotNames(obj) %in% "data")){ - obj <- SpatialPolygonsDataFrame(obj, data=data.frame(x=rep(1, length(obj)))) - names(obj) <- "mask" - } else { - obj <- obj[fname] - } - - if(missing(bbox)) { bbox <- obj@bbox } - # make an empty raster based on extent: - if(missing(cell.size)) { - # print warning: - if(length(obj)>1000){ - warning("Automated derivation of suitable cell size can be time consuming and can lead to artifacts.", immediate. = TRUE) - } - - if(requireNamespace("spatstat", quietly = TRUE)){ - x <- sapply(obj@polygons, slot, "area") - cell.size <- signif(sqrt(median(x))/2, 2) - if(cell.size==0){ stop("Estimated cell size is 0, consider removing duplicate points") } - if(silent==FALSE){message(paste("Estimated median polygon size:", cell.size*2))} - } - } - - if(method=="raster"){ - x <- GridTopology(cellcentre.offset=bbox[,1], cellsize=c(cell.size,cell.size), cells.dim=c(round(abs(diff(bbox[1,])/cell.size), 0), ncols=round(abs(diff(bbox[2,])/cell.size), 0))) - r.sp <- SpatialGrid(x, proj4string = obj@proj4string) - r <- raster(r.sp) - # convert factors to integers: - if(is.factor(obj@data[,1])){ - obj@data[,1] <- as.integer(obj@data[,1]) - } - # rasterize - convert vector to a raster map: - obj <- obj[!is.na(obj@data[,1]),] - in.r <- rasterize(obj, r, field = names(obj)[1], ...) - res <- as(in.r, "SpatialGridDataFrame") - names(res) = names(obj)[1] - attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") - attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] - - if(!missing(file.name)){ - writeRaster(in.r, filename=file.name, overwrite=TRUE) - } - } - - else{ - if(method=="SAGA"){ # SAGA GIS 2.0.8 - - if(!rsaga.env()[["cmd"]]=="NULL"){ - - tmf <- tempfile() - tf <- set.file.extension(tmf, ".shp") - if(requireNamespace("maptools", quietly = TRUE)){ - maptools::writePolyShape(obj, tf) - } else { - writeOGR(obj, tf, tmf, driver="ESRI Shapefile") - } - - if(missing(file.name)){ - file.name <- set.file.extension(tempfile(), ".sgrd") - } - # rasterize map using SAGA GIS: - rsaga.geoprocessor("grid_gridding", 0, param=list(INPUT=tf, FIELD=FIELD, MULTIPLE=MULTIPLE, LINE_TYPE=LINE_TYPE, GRID_TYPE=0, TARGET=0, USER_XMIN=bbox[1,1]+cell.size/2, USER_XMAX=bbox[1,2]-cell.size/2, USER_YMIN=bbox[2,1]+cell.size/2, USER_YMAX=bbox[2,2]-cell.size/2, USER_SIZE=cell.size, USER_GRID=file.name, GRID_TYPE=GRID_TYPE), show.output.on.console = silent) - res <- readGDAL(set.file.extension(file.name, ".sdat"), silent = silent) - names(res) = names(obj)[1] - attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") - attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] - attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] - - } - else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } - } - else{ stop("Method not available") - } - } - - return(res) -} - - -setMethod("vect2rast", "SpatialPoints", vect2rast.SpatialPoints) -setMethod("vect2rast", "SpatialPolygons", vect2rast.SpatialPolygons) -setMethod("vect2rast", "SpatialLines", vect2rast.SpatialLines) - -# end of script; +# Purpose : Convert a vector map to a raster and (optional) write to a file; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); Pierre Roudier (pierre.roudier@landcare.nz); +# Status : tested +# Note : The output pixel size is determined using simple cartographic principles (see [http://dx.doi.org/10.1016/j.cageo.2005.11.008]); + + +## POINTS +vect2rast.SpatialPoints <- function(obj, fname = names(obj)[1], cell.size, bbox, file.name, silent = FALSE, method = c("raster", "SAGA")[1], FIELD = 0, MULTIPLE = 1, LINE_TYPE = 0, GRID_TYPE = 2, ...){ + + # add indicator value if missing data frame: + if(!any(slotNames(obj) %in% "data")){ + obj <- SpatialPointsDataFrame(obj, data=data.frame(x=rep(1, length(obj)))) + names(obj) <- "mask" + } else { + obj <- obj[fname] + } + + if(missing(bbox)) { bbox <- obj@bbox } + # make an empty raster based on extent: + if(missing(cell.size)){ + # print warning: + if(length(obj)>10000){ + warning("Automated derivation of suitable cell size can be time consuming and can lead to artifacts.", immediate. = TRUE) + } + + if(requireNamespace("spatstat", quietly = TRUE)){ + x <- as(obj, "ppp") + nd <- spatstat::nndist(x$x, x$y) + ndb <- boxplot(nd, plot=FALSE) + cell.size <- signif(ndb$stats[3]/2, 2) + if(cell.size==0){ stop("Estimated cell size is 0, consider removing duplicate points") } + if(silent==FALSE){message(paste("Estimated nearest neighbour distance (point pattern):", cell.size*2))} + } + } + + if(method=="raster"){ + x <- GridTopology(cellcentre.offset=bbox[,1], cellsize=c(cell.size,cell.size), cells.dim=c(round(abs(diff(bbox[1,])/cell.size), 0), ncols=round(abs(diff(bbox[2,])/cell.size), 0))) + r.sp <- SpatialGrid(x, proj4string = obj@proj4string) + r <- raster(r.sp) + # convert factors to integers: + if(is.factor(obj@data[,1])){ + obj@data[,1] <- as.integer(obj@data[,1]) + } + # rasterize - convert vector to a raster map: + obj <- obj[!is.na(obj@data[,1]),] + in.r <- rasterize(obj, r, field = names(obj)[1], ...) + res <- as(in.r, "SpatialGridDataFrame") + names(res) = names(obj)[1] + attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") + attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] + + if(!missing(file.name)){ + writeRaster(in.r, filename=file.name, overwrite=TRUE) + } + } + + else{ + if(method=="SAGA"){ # SAGA GIS 2.0.8 + + if(!rsaga.env()[["cmd"]]=="NULL"){ + + tmf <- tempfile() + tf <- set.file.extension(tmf, ".shp") + if(requireNamespace("maptools", quietly = TRUE)){ + maptools::writePointsShape(obj, tf) + } else { + writeOGR(obj, tf, tmf, driver="ESRI Shapefile") + } + + if(missing(file.name)){ + file.name <- set.file.extension(tempfile(), ".sgrd") + } + # rasterize map using SAGA GIS: + rsaga.geoprocessor("grid_gridding", 0, param=list(INPUT=tf, FIELD=FIELD, MULTIPLE=MULTIPLE, LINE_TYPE=LINE_TYPE, GRID_TYPE=0, TARGET=0, USER_XMIN=bbox[1,1]+cell.size/2, USER_XMAX=bbox[1,2]-cell.size/2, USER_YMIN=bbox[2,1]+cell.size/2, USER_YMAX=bbox[2,2]-cell.size/2, USER_SIZE=cell.size, USER_GRID=file.name, GRID_TYPE=GRID_TYPE), show.output.on.console = silent) + res <- readGDAL(set.file.extension(file.name, ".sdat"), silent = silent) + names(res) = names(obj)[1] + attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") + attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] + + } + else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } + } + else{ stop("Method not available") + } + } + + return(res) +} + +## LINES +vect2rast.SpatialLines <- function(obj, fname = names(obj)[1], cell.size, bbox, file.name, silent = FALSE, method = c("raster", "SAGA")[1], FIELD = 0, MULTIPLE = 1, LINE_TYPE = 1, GRID_TYPE = 2, ...){ + + # add indicator value if missing data frame: + if(!any(slotNames(obj) %in% "data")){ + obj <- SpatialLinesDataFrame(obj, data=data.frame(x=rep(1, length(obj)))) + names(obj) <- "mask" + } else { + obj <- obj[fname] + } + + if(missing(bbox)) { bbox <- obj@bbox } + # make an empty raster based on extent: + if(missing(cell.size)) { + # print warning: + if(length(obj)>1000){ + warning("Automated derivation of suitable cell size can be time consuming and can lead to artifacts.", immediate. = TRUE) + } + + if(requireNamespace("spatstat", quietly = TRUE)){ + x <- as(as(obj, "SpatialLines"), "psp") + nd <- spatstat::nndist.psp(x) # this can be time consuming! + ndb <- boxplot(nd, plot=FALSE) + cell.size <- signif(ndb$stats[3]/2, 2) + if(cell.size==0){ stop("Estimated cell size is 0, consider removing duplicate points") } + if(silent==FALSE){message(paste("Estimated nearest neighbour distance (line segments):", cell.size*2))} + } + } + + if(method=="raster"){ + x <- GridTopology(cellcentre.offset=bbox[,1], cellsize=c(cell.size,cell.size), cells.dim=c(round(abs(diff(bbox[1,])/cell.size), 0), ncols=round(abs(diff(bbox[2,])/cell.size), 0))) + r.sp <- SpatialGrid(x, proj4string = obj@proj4string) + r <- raster(r.sp) + # convert factors to integers: + if(is.factor(obj@data[,1])){ + obj@data[,1] <- as.integer(obj@data[,1]) + } + # rasterize - convert vector to a raster map: + obj <- obj[!is.na(obj@data[,1]),] + in.r <- rasterize(obj, r, field = names(obj)[1], ...) + res <- as(in.r, "SpatialGridDataFrame") + names(res) = names(obj)[1] + attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") + attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] + + if(!missing(file.name)){ + writeRaster(in.r, filename=file.name, overwrite=TRUE) + } + } + + else{ + if(method=="SAGA"){ # SAGA GIS 2.0.8 + + if(!rsaga.env()[["cmd"]]=="NULL"){ + + tmf <- tempfile() + tf <- set.file.extension(tmf, ".shp") + if(requireNamespace("maptools", quietly = TRUE)){ + maptools::writeLinesShape(obj, tf) + } else { + writeOGR(obj, tf, tmf, driver="ESRI Shapefile") + } + + if(missing(file.name)){ + file.name <- set.file.extension(tempfile(), ".sgrd") + } + # rasterize map using SAGA GIS: + rsaga.geoprocessor("grid_gridding", 0, param=list(INPUT=tf, FIELD=FIELD, MULTIPLE=MULTIPLE, LINE_TYPE=LINE_TYPE, GRID_TYPE=0, TARGET=0, USER_XMIN=bbox[1,1]+cell.size/2, USER_XMAX=bbox[1,2]-cell.size/2, USER_YMIN=bbox[2,1]+cell.size/2, USER_YMAX=bbox[2,2]-cell.size/2, USER_SIZE=cell.size, USER_GRID=file.name, GRID_TYPE=GRID_TYPE), show.output.on.console = silent) + res <- readGDAL(set.file.extension(file.name, ".sdat"), silent = silent) + names(res) = names(obj)[1] + attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") + attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] + + } + else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } + } + else{ stop("Method not available") + } + } + + return(res) +} + +## POLYGONS +vect2rast.SpatialPolygons <- function(obj, fname = names(obj)[1], cell.size, bbox, file.name, silent = FALSE, method = c("raster", "SAGA")[1], FIELD = 0, MULTIPLE = 0, LINE_TYPE = 1, GRID_TYPE = 2, ...){ + + # add indicator value if missing data frame: + if(!any(slotNames(obj) %in% "data")){ + obj <- SpatialPolygonsDataFrame(obj, data=data.frame(x=rep(1, length(obj)))) + names(obj) <- "mask" + } else { + obj <- obj[fname] + } + + if(missing(bbox)) { bbox <- obj@bbox } + # make an empty raster based on extent: + if(missing(cell.size)) { + # print warning: + if(length(obj)>1000){ + warning("Automated derivation of suitable cell size can be time consuming and can lead to artifacts.", immediate. = TRUE) + } + + if(requireNamespace("spatstat", quietly = TRUE)){ + x <- sapply(obj@polygons, slot, "area") + cell.size <- signif(sqrt(median(x))/2, 2) + if(cell.size==0){ stop("Estimated cell size is 0, consider removing duplicate points") } + if(silent==FALSE){message(paste("Estimated median polygon size:", cell.size*2))} + } + } + + if(method=="raster"){ + x <- GridTopology(cellcentre.offset=bbox[,1], cellsize=c(cell.size,cell.size), cells.dim=c(round(abs(diff(bbox[1,])/cell.size), 0), ncols=round(abs(diff(bbox[2,])/cell.size), 0))) + r.sp <- SpatialGrid(x, proj4string = obj@proj4string) + r <- raster(r.sp) + # convert factors to integers: + if(is.factor(obj@data[,1])){ + obj@data[,1] <- as.integer(obj@data[,1]) + } + # rasterize - convert vector to a raster map: + obj <- obj[!is.na(obj@data[,1]),] + in.r <- rasterize(obj, r, field = names(obj)[1], ...) + res <- as(in.r, "SpatialGridDataFrame") + names(res) = names(obj)[1] + attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") + attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] + + if(!missing(file.name)){ + writeRaster(in.r, filename=file.name, overwrite=TRUE) + } + } + + else{ + if(method=="SAGA"){ # SAGA GIS 2.0.8 + + if(!rsaga.env()[["cmd"]]=="NULL"){ + + tmf <- tempfile() + tf <- set.file.extension(tmf, ".shp") + if(requireNamespace("maptools", quietly = TRUE)){ + maptools::writePolyShape(obj, tf) + } else { + writeOGR(obj, tf, tmf, driver="ESRI Shapefile") + } + + if(missing(file.name)){ + file.name <- set.file.extension(tempfile(), ".sgrd") + } + # rasterize map using SAGA GIS: + rsaga.geoprocessor("grid_gridding", 0, param=list(INPUT=tf, FIELD=FIELD, MULTIPLE=MULTIPLE, LINE_TYPE=LINE_TYPE, GRID_TYPE=0, TARGET=0, USER_XMIN=bbox[1,1]+cell.size/2, USER_XMAX=bbox[1,2]-cell.size/2, USER_YMIN=bbox[2,1]+cell.size/2, USER_YMAX=bbox[2,2]-cell.size/2, USER_SIZE=cell.size, USER_GRID=file.name, GRID_TYPE=GRID_TYPE), show.output.on.console = silent) + res <- readGDAL(set.file.extension(file.name, ".sdat"), silent = silent) + names(res) = names(obj)[1] + attr(res@bbox, "dimnames") = attr(obj@bbox, "dimnames") + attr(res@grid@cellcentre.offset, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cellsize, "names") <- attr(obj@bbox, "dimnames")[[1]] + attr(res@grid@cells.dim, "names") <- attr(obj@bbox, "dimnames")[[1]] + + } + else { stop("SAGA GIS path could not be located. See 'rsaga.env()' for more info.") } + } + else{ stop("Method not available") + } + } + + return(res) +} + + +setMethod("vect2rast", "SpatialPoints", vect2rast.SpatialPoints) +setMethod("vect2rast", "SpatialPolygons", vect2rast.SpatialPolygons) +setMethod("vect2rast", "SpatialLines", vect2rast.SpatialLines) + +# end of script; diff --git a/pkg/R/whitening.R b/pkg/R/whitening.R index 6961439..fe93f98 100644 --- a/pkg/R/whitening.R +++ b/pkg/R/whitening.R @@ -1,38 +1,43 @@ - -whitening <- function( - z, # target variable - zvar, # associated uncertainty - zlim = c(min(z, na.rm=TRUE), max(z, na.rm=TRUE)), - elim = c(.4,1), - global.var = var(z, na.rm=TRUE), - col.type = "RGB") # output col.type can be "RGB" or "hex" - { - - # Derive the normalized error: - er <- sqrt(zvar)/sqrt(global.var) - # Strech the values (z) to the inspection range: - tz <- (z-zlim[1])/(zlim[2]-zlim[1]) - tz <- ifelse(tz<=0, 0, ifelse(tz>1, 1, tz)) - # Derive the Hues: - f1 <- -90-tz*300 - f2 <- ifelse(f1<=-360, f1+360, f1) - H <- ifelse(f2>=0, f2, (f2+360)) - # Strech the error values (e) to the inspection range: - er <- (er-elim[1])/(elim[2]-elim[1]) - er <- ifelse(er<=0, 0, ifelse(er>1, 1, er)) - # Derive the saturation and intensity images: - S <- 1-er - V <- 0.5*(1+er) - - # Convert the HSV values to RGB and put them as R, G, B bands: - if(col.type=="hex"){ - out.cols <- hex(HSV(H, S, V)) - return(out.cols) - } - else { - out.cols <- as(HSV(H, S, V), "RGB") - return(out.cols) -} -} - -# end of script; +# Purpose : Derive whitenned color based on the uncertainty; +# Maintainer : Tomislav Hengl (tom.hengl@wur.nl); +# Contributions : Dylan Beaudette (debeaudette@ucdavis.edu); +# Status : pre-alpha +# Note : this technique requires a special 2D legend; + +whitening <- function( + z, # target variable + zvar, # associated uncertainty + zlim = c(min(z, na.rm=TRUE), max(z, na.rm=TRUE)), + elim = c(.4,1), + global.var = var(z, na.rm=TRUE), + col.type = "RGB") # output col.type can be "RGB" or "hex" + { + + # Derive the normalized error: + er <- sqrt(zvar)/sqrt(global.var) + # Strech the values (z) to the inspection range: + tz <- (z-zlim[1])/(zlim[2]-zlim[1]) + tz <- ifelse(tz<=0, 0, ifelse(tz>1, 1, tz)) + # Derive the Hues: + f1 <- -90-tz*300 + f2 <- ifelse(f1<=-360, f1+360, f1) + H <- ifelse(f2>=0, f2, (f2+360)) + # Strech the error values (e) to the inspection range: + er <- (er-elim[1])/(elim[2]-elim[1]) + er <- ifelse(er<=0, 0, ifelse(er>1, 1, er)) + # Derive the saturation and intensity images: + S <- 1-er + V <- 0.5*(1+er) + + # Convert the HSV values to RGB and put them as R, G, B bands: + if(col.type=="hex"){ + out.cols <- hex(HSV(H, S, V)) + return(out.cols) + } + else { + out.cols <- as(HSV(H, S, V), "RGB") + return(out.cols) +} +} + +# end of script; diff --git a/pkg/data/eberg_contours.rda b/pkg/data/eberg_contours.rda index 33bc168..31a99a6 100644 Binary files a/pkg/data/eberg_contours.rda and b/pkg/data/eberg_contours.rda differ diff --git a/pkg/data/eberg_zones.rda b/pkg/data/eberg_zones.rda index 60a64f6..59a5ca5 100644 Binary files a/pkg/data/eberg_zones.rda and b/pkg/data/eberg_zones.rda differ diff --git a/pkg/demo/plotKML.R b/pkg/demo/plotKML.R index 39f8bbf..a77c76a 100644 --- a/pkg/demo/plotKML.R +++ b/pkg/demo/plotKML.R @@ -1,6 +1,6 @@ -## Complete tutorial available at: [http://plotkml.r-forge.r-project.org] +## Complete tutorial available at: [http://gsif.isric.org/doku.php?id=wiki:tutorial_plotkml] -plotKML.env(kmz = FALSE) +plotKML.env(silent = FALSE, kmz = FALSE) ## -------------- SpatialPointsDataFrame --------- ## library(sp) library(rgdal) @@ -52,7 +52,7 @@ plotKML(LNCCOR6, colour_scale=pal) ## -------------- SpatialPhotoOverlay --------- ## library(RCurl) imagename = "Soil_monolith.jpg" -urlExists = url.exists("https://commons.wikimedia.org") +urlExists = url.exists("http://commons.wikimedia.org") if(urlExists){ x1 <- getWikiMedia.ImageInfo(imagename) sm <- spPhoto(filename = x1$url$url, exif.info = x1$metadata) @@ -60,26 +60,26 @@ if(urlExists){ plotKML(sm) } -# ## -------------- SoilProfileCollection --------- ## -# library(aqp) -# library(plyr) -# ## sample profile from Nigeria: -# lon = 3.90; lat = 7.50; id = "ISRIC:NG0017"; FAO1988 = "LXp" -# top = c(0, 18, 36, 65, 87, 127) -# bottom = c(18, 36, 65, 87, 127, 181) -# ORCDRC = c(18.4, 4.4, 3.6, 3.6, 3.2, 1.2) -# hue = c("7.5YR", "7.5YR", "2.5YR", "5YR", "5YR", "10YR") -# value = c(3, 4, 5, 5, 5, 7); chroma = c(2, 4, 6, 8, 4, 3) -# ## prepare a SoilProfileCollection: -# prof1 <- join(data.frame(id, top, bottom, ORCDRC, hue, value, chroma), -# data.frame(id, lon, lat, FAO1988), type='inner') -# prof1$soil_color <- with(prof1, munsell2rgb(hue, value, chroma)) -# depths(prof1) <- id ~ top + bottom -# site(prof1) <- ~ lon + lat + FAO1988 -# coordinates(prof1) <- ~ lon + lat -# proj4string(prof1) <- CRS("+proj=longlat +datum=WGS84") -# prof1 -# plotKML(prof1, var.name="ORCDRC", color.name="soil_color") +## -------------- SoilProfileCollection --------- ## +library(aqp) +library(plyr) +## sample profile from Nigeria: +lon = 3.90; lat = 7.50; id = "ISRIC:NG0017"; FAO1988 = "LXp" +top = c(0, 18, 36, 65, 87, 127) +bottom = c(18, 36, 65, 87, 127, 181) +ORCDRC = c(18.4, 4.4, 3.6, 3.6, 3.2, 1.2) +hue = c("7.5YR", "7.5YR", "2.5YR", "5YR", "5YR", "10YR") +value = c(3, 4, 5, 5, 5, 7); chroma = c(2, 4, 6, 8, 4, 3) +## prepare a SoilProfileCollection: +prof1 <- join(data.frame(id, top, bottom, ORCDRC, hue, value, chroma), + data.frame(id, lon, lat, FAO1988), type='inner') +prof1$soil_color <- with(prof1, munsell2rgb(hue, value, chroma)) +depths(prof1) <- id ~ top + bottom +site(prof1) <- ~ lon + lat + FAO1988 +coordinates(prof1) <- ~ lon + lat +proj4string(prof1) <- CRS("+proj=longlat +datum=WGS84") +prof1 +plotKML(prof1, var.name="ORCDRC", color.name="soil_color") ## -------------- STIDF --------- ## library(spacetime) @@ -148,7 +148,7 @@ plotKML(rr, z.lim=z.lim) ## -------------- STTDF --------- ## library(fossil) library(spacetime) -library(adehabitatLT) +library(adehabitat) data(gpxbtour) ## format the time column: gpxbtour$ctime <- as.POSIXct(gpxbtour$time, format="%Y-%m-%dT%H:%M:%SZ") @@ -229,34 +229,34 @@ plotKML(om.rk, colour_scale = SAGA_pal[[1]], plotKML(om.rk, colour_scale = SAGA_pal[[1]], grid2poly = TRUE) ## -------------- SpatialSamplingPattern --------- ## -#library(spcosa) -#library(sp) +library(spcosa) +library(sp) ## read a polygon map: -#shpFarmsum <- readOGR(dsn = system.file("maps", package = "spcosa"), -# layer = "farmsum") +shpFarmsum <- readOGR(dsn = system.file("maps", package = "spcosa"), + layer = "farmsum") ## stratify `Farmsum' into 50 strata -#myStratification <- stratify(shpFarmsum, nStrata = 50) +myStratification <- stratify(shpFarmsum, nStrata = 50) ## sample two sampling units per stratum -#mySamplingPattern <- spsample(myStratification, n = 2) +mySamplingPattern <- spsample(myStratification, n = 2) ## attach the correct proj4 string: -#library(RCurl) -#urlExists = url.exists("https://spatialreference.org/ref/sr-org/6781/proj4/") -#if(urlExists){ -# nl.rd <- getURL("https://spatialreference.org/ref/sr-org/6781/proj4/") -# proj4string(mySamplingPattern@sample) <- CRS(nl.rd) -# # prepare spatial domain (polygons): -# sp.domain <- as(myStratification@cells, "SpatialPolygons") -# sp.domain <- SpatialPolygonsDataFrame(sp.domain, -# data.frame(ID=as.factor(myStratification@stratumId)), match.ID = FALSE) -# proj4string(sp.domain) <- CRS(nl.rd) -# # create new object: -# mySamplingPattern.ssp <- new("SpatialSamplingPattern", -# method = class(mySamplingPattern), pattern = mySamplingPattern@sample, -# sp.domain = sp.domain) -# # the same plot now in Google Earth: -# shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" -# plotKML(mySamplingPattern.ssp, shape = shape) -#} +library(RCurl) +urlExists = url.exists("http://spatialreference.org/ref/sr-org/6781/proj4/") +if(urlExists){ + nl.rd <- getURL("http://spatialreference.org/ref/sr-org/6781/proj4/") + proj4string(mySamplingPattern@sample) <- CRS(nl.rd) + # prepare spatial domain (polygons): + sp.domain <- as(myStratification@cells, "SpatialPolygons") + sp.domain <- SpatialPolygonsDataFrame(sp.domain, + data.frame(ID=as.factor(myStratification@stratumId)), match.ID = FALSE) + proj4string(sp.domain) <- CRS(nl.rd) + # create new object: + mySamplingPattern.ssp <- new("SpatialSamplingPattern", + method = class(mySamplingPattern), pattern = mySamplingPattern@sample, + sp.domain = sp.domain) + # the same plot now in Google Earth: + shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" + plotKML(mySamplingPattern.ssp, shape = shape) +} ## -------------- RasterBrickSimulations --------- ## library(sp) diff --git a/pkg/inst/CITATION b/pkg/inst/CITATION index 3d211ee..b5ce7e8 100644 --- a/pkg/inst/CITATION +++ b/pkg/inst/CITATION @@ -11,12 +11,12 @@ citEntry(entry = "Article", volume = "63", number = "5", pages = "1--25", - url = "https://www.jstatsoft.org/v63/i05/", + url = "http://www.jstatsoft.org/v63/i05/", textVersion = paste("Tomislav Hengl, Pierre Roudier, Dylan Beaudette, Edzer Pebesma (2015).", "plotKML: Scientific Visualization of Spatio-Temporal Data.", "Journal of Statistical Software, 63(5), 1-25.", - "URL https://www.jstatsoft.org/v63/i05/.") + "URL http://www.jstatsoft.org/v63/i05/.") ) diff --git a/pkg/man/HRprec08.Rd b/pkg/man/HRprec08.Rd index a1b3680..5aab87b 100644 --- a/pkg/man/HRprec08.Rd +++ b/pkg/man/HRprec08.Rd @@ -1,43 +1,44 @@ -\name{HRprec08} -\docType{data} -\alias{HRprec08} -\title{Daily precipitation for Croatia for year 2008} -\description{The daily measurements of precipitation (rain gauges) for year 2008 kindly contributed by the \href{http://meteo.hr}{Croatian National Meteorological Service}. \code{HRprec08} contains 175,059 measurements of precipitation sums (489 stations by 365 days). -} -\usage{data(HRprec08)} -\format{ -The \code{HRprec08} data frames contain the following columns: - \describe{ - \item{\code{NAME}}{name of the meteorological station} - \item{\code{Lon}}{a numeric vector; x-coordiante / longitude in the WGS84 system} - \item{\code{Lat}}{a numeric vector; y-coordinate / latitude in the WGS84 system} - \item{\code{DATE}}{'Date' class vector} - \item{\code{PREC}}{daily cummulative precipitation in mm (precipitation from the day before)} - } -} -\author{ Tomislav Hengl and Melita Percec Tadic } -\references{ -\itemize{ -\item Testik, F.Y. and Gebremichael, M. Eds (2011) Rainfall: State of the Science. Geophysical monograph series, Vol. 191, 287 p. \doi{10.1029/GM191} -\item Zaninovic K., Gajic-Capka, M., Percec Tadic, M. et al., (2010) \href{http://klima.hr/razno.php?id=publikacije¶m=atlas}{Klimatski atlas Hrvatske / Climate atlas of Croatia 1961-1990., 1971-2000}. Zagreb, Croatian National Meteorological Service, 200 p. -\item AGGM book datasets (\url{http://spatial-analyst.net/book/HRclim2008}) -} -} -\note{ The precipitation estimates in mm (\code{HRprec08}) are collected in a bottle within the rain gauge and readings are usually manual by an observer at 7 a.m. The precipitation collected in the morning refer to the precipitation for previous 24 hours. To project coordinates we suggest using the \href{https://spatialreference.org/ref/epsg/32633/}{UTM zone 33N} system as this coordinate system was used to prepare the \href{http://spatial-analyst.net/book/HRclim2008}{gridded predictors}. -} -\seealso{ \code{\link{HRtemp08}} } -\examples{ -data(HRprec08) -library(sp) -\dontrun{# subset: -prec.2008.05.01 <- HRprec08[HRprec08$DATE=="2008-05-01",] -coordinates(prec.2008.05.01) <- ~Lon+Lat -proj4string(prec.2008.05.01) <- CRS("+proj=lonlat +datum=WGS84") -# write to KML: -shape = "http://plotkml.r-forge.r-project.org/circle.png" -data(SAGA_pal) -kml(prec.2008.05.01, size = PREC, shape = shape, colour = PREC, - colour_scale = SAGA_pal[[9]], labels = PREC) -} -} -\keyword{datasets} \ No newline at end of file +\name{HRprec08} +\docType{data} +\encoding{latin1} +\alias{HRprec08} +\title{Daily precipitation for Croatia for year 2008} +\description{The daily measurements of precipitation (rain gauges) for year 2008 kindly contributed by the \href{http://meteo.hr}{Croatian National Meteorological Service}. \code{HRprec08} contains 175,059 measurements of precipitation sums (489 stations by 365 days). +} +\usage{data(HRprec08)} +\format{ +The \code{HRprec08} data frames contain the following columns: + \describe{ + \item{\code{NAME}}{name of the meteorological station} + \item{\code{Lon}}{a numeric vector; x-coordiante / longitude in the WGS84 system} + \item{\code{Lat}}{a numeric vector; y-coordinate / latitude in the WGS84 system} + \item{\code{DATE}}{'Date' class vector} + \item{\code{PREC}}{daily cummulative precipitation in mm (precipitation from the day before)} + } +} +\author{ Tomislav Hengl and Melita Percec Tadic } +\references{ +\itemize{ +\item Testik, F.Y. and Gebremichael, M. Eds (2011) \href{http://www.agu.org/books/gm/v191/}{Rainfall: State of the Science}. Geophysical monograph series, Vol. 191, 287 p. +\item Zaninovic K., Gajic-Capka, M., Percec Tadic, M. et al., (2010) \href{http://klima.hr/razno.php?id=publikacije¶m=atlas}{Klimatski atlas Hrvatske / Climate atlas of Croatia 1961-1990., 1971-2000}. Zagreb, Croatian National Meteorological Service, 200 p. +\item AGGM book datasets (\url{http://spatial-analyst.net/book/HRclim2008}) +} +} +\note{ The precipitation estimates in mm (\code{HRprec08}) are collected in a bottle within the rain gauge and readings are usually manual by an observer at 7 a.m. The precipitation collected in the morning refer to the precipitation for previous 24 hours. To project coordinates we suggest using the \href{http://spatialreference.org/ref/epsg/32633/}{UTM zone 33N} system as this coordinate system was used to prepare the \href{http://spatial-analyst.net/book/HRclim2008}{gridded predictors}. +} +\seealso{ \code{\link{HRtemp08}} } +\examples{ +data(HRprec08) +library(sp) +\dontrun{# subset: +prec.2008.05.01 <- HRprec08[HRprec08$DATE=="2008-05-01",] +coordinates(prec.2008.05.01) <- ~Lon+Lat +proj4string(prec.2008.05.01) <- CRS("+proj=lonlat +datum=WGS84") +# write to KML: +shape = "http://plotkml.r-forge.r-project.org/circle.png" +data(SAGA_pal) +kml(prec.2008.05.01, size = PREC, shape = shape, colour = PREC, + colour_scale = SAGA_pal[[9]], labels = PREC) +} +} +\keyword{datasets} diff --git a/pkg/man/HRtemp08.Rd b/pkg/man/HRtemp08.Rd index e0f8266..0115ec3 100644 --- a/pkg/man/HRtemp08.Rd +++ b/pkg/man/HRtemp08.Rd @@ -1,138 +1,138 @@ -\name{HRtemp08} -\docType{data} -\encoding{latin1} -\alias{HRtemp08} -\title{Daily temperatures for Croatia for year 2008} -\description{The daily measurements of temperature (thermometers) for year 2008 kindly contributed by the \href{http://meteo.hr}{Croatian National Meteorological Service}. \code{HRtemp08} contains 56,608 measurements of temperature (159 stations by 365 days). -} -\usage{data(HRtemp08)} -\format{ -The \code{HRtemp08} data frames contain the following columns: - \describe{ - \item{\code{NAME}}{name of the meteorological station} - \item{\code{Lon}}{a numeric vector; x-coordiante / longitude in the WGS84 system} - \item{\code{Lat}}{a numeric vector; y-coordinate / latitude in the WGS84 system} - \item{\code{DATE}}{'Date' class vector} - \item{\code{TEMP}}{daily temperature measurements in degree C} - } -} -\author{ Tomislav Hengl, Melita Percec Tadic and Benedikt Graeler} -\references{ -\itemize{ -\item Hengl, T., Heuvelink, G.B.M., Percec Tadic, M., Pebesma, E., (2011) Spatio-temporal prediction of daily temperatures using time-series of MODIS LST images. Theoretical and Applied Climatology, 107(1-2): 265-277. \doi{10.1007/s00704-011-0464-2} -\item AGGM book datasets (\url{http://spatial-analyst.net/book/HRclim2008}) -} -} -\note{ The precision of the temperature readings in \code{HRtemp08} is tenth of degree C. On most climatological stations temperature is measured three times a day, at 7 a.m., 1 p.m. and 9 p.m. The daily mean can be calculated as a weighted average. -} -\seealso{ \code{\link{HRprec08}} } -\examples{ -data(HRtemp08) - -\dontrun{ -## examples from: http://dx.doi.org/10.1007/s00704-011-0464-2 -library(spacetime) -library(gstat) -library(sp) -sp <- SpatialPoints(HRtemp08[,c("Lon","Lat")]) -proj4string(sp) <- CRS("+proj=longlat +datum=WGS84") -HRtemp08.st <- STIDF(sp, time = HRtemp08$DATE-.5, - data = HRtemp08[,c("NAME","TEMP")], - endTime = as.POSIXct(HRtemp08$DATE+.5)) -## Country borders: -con0 <- url("http://www.gadm.org/data/rda/HRV_adm1.RData") -load(con0) -stplot(HRtemp08.st[,"2008-07-02::2008-07-03","TEMP"], - na.rm=TRUE, col.regions=SAGA_pal[[1]], - sp.layout=list("sp.polygons", gadm)) - -## Load covariates: -con <- url("http://plotkml.r-forge.r-project.org/HRgrid1km.rda") -load(con) -str(HRgrid1km) -sel.s <- c("HRdem","HRdsea","HRtwi","Lat","Lon") -## Prepare static covariates: -begin <- as.Date("2008-01-01") -endTime <- as.POSIXct(as.Date("2008-12-31")) -sp.grid <- as(HRgrid1km, "SpatialPixels") -HRgrid1km.st0 <- STFDF(sp.grid, time=begin, - data=HRgrid1km@data[,sel.s], endTime=endTime) -## Prepare dynamic covariates: -sel.d <- which(!names(HRgrid1km) \%in\% sel.s) -dates <- sapply(names(HRgrid1km)[sel.d], - function(x){strsplit(x, "LST")[[1]][2]} -) -dates <- as.Date(dates, format="\%Y_\%m_\%d") -## Sort values of MODIS LST bands: -m <- data.frame(MODIS.LST = as.vector(unlist(HRgrid1km@data[,sel.d]))) -## >10M values! -## Create an object of type STFDF: -HRgrid1km.stD <- STFDF(sp.grid, time=dates-4, data=m, - endTime=as.POSIXct(dates+4)) - -## Overlay in space and time: -HRtemp08.stxy <- spTransform(HRtemp08.st, CRS(proj4string(HRgrid1km))) -ov.s <- over(HRtemp08.stxy, HRgrid1km.st0) -ov.d <- over(HRtemp08.stxy, HRgrid1km.stD) -## Prepare the regression matrix: -regm <- do.call(cbind, list(HRtemp08.stxy@data, ov.s, ov.d)) -## Estimate cumulative days: -regm$cday <- floor(unclass(HRtemp08.stxy@endTime)/86400-.5) -str(regm) -## Plot a single station: -scatter.smooth(regm$cday[regm$NAME=="Zavian"], - regm$TEMP[regm$NAME=="Zavian"], - xlab="Cumulative days", - ylab="Mean daily temperature (\260C)", - ylim=c(-12,28), main="GL039 (Zavi\236an)", - col="grey") -## Run PCA so we can filter missing pixels in the MODIS images: -pca <- prcomp(~HRdem+HRdsea+Lat+Lon+HRtwi+MODIS.LST, - data=regm, scale.=TRUE) -selc <- c("TEMP","Lon","Lat","cday") -regm.pca <- cbind( regm[-pca$na.action, selc], - as.data.frame(pca$x)) -## Fit a spatio-temporal regression model: -theta <- min(regm.pca$cday) -lm.HRtemp08 <- lm(TEMP~PC1+PC2+PC3+PC4+PC5+PC6 - +cos((cday-theta)*pi/180), data=regm.pca) -summary(lm.HRtemp08) - -## Prediction locations -> focus on Istria: -data(LST) -gridded(LST) <- ~lon+lat -proj4string(LST) <- CRS("+proj=longlat +datum=WGS84") -LST.xy <- reproject(LST[1], proj4string(HRgrid1km)) -LST.xy <- as(LST.xy, "SpatialPixels") -## targeted dates: -t.dates <- as.Date(c("2008-02-01","2008-05-01","2008-08-01"), - format="\%Y-\%m-\%d") -LST.st <- STF(geometry(LST.xy), time=t.dates) -## get values of covariates: -ov.s.IS <- over(LST.st, HRgrid1km.st0) -ov.d.IS <- over(LST.st, HRgrid1km.stD) -LST.stdf <- STFDF(geometry(LST.xy), time=t.dates, - data=cbind(ov.s.IS, ov.d.IS)) -## predict Principal Components: -LST.pca <- as.data.frame(predict(pca, LST.stdf@data)) -LST.stdf@data[,paste0("PC",1:6)] <- LST.pca -cday.l <- as.vector(sapply( - floor(unclass(LST.stdf@endTime)/86400-.5), - rep, nrow(LST.xy@coords))) -LST.stdf@data[,"cday"] <- cday.l -stplot(LST.stdf[,,"PC1"], col.regions=SAGA_pal[[1]]) -stplot(LST.stdf[,,"PC2"], col.regions=SAGA_pal[[1]]) - -## Predict spatio-temporal regression: -LST.stdf@data[,"TEMP.reg"] <- predict(lm.HRtemp08, - newdata=LST.stdf@data) -## Plot predictions: -gadm.ll <- as(spTransform(gadm, - CRS(proj4string(HRgrid1km))), "SpatialLines") -stplot(LST.stdf[,,"TEMP.reg"], col.regions=SAGA_pal[[1]], - sp.layout=list( list("sp.lines", gadm.ll), - list("sp.points", HRtemp08.stxy, col="black", pch=19) ) - ) -} -} +\name{HRtemp08} +\docType{data} +\encoding{latin1} +\alias{HRtemp08} +\title{Daily temperatures for Croatia for year 2008} +\description{The daily measurements of temperature (thermometers) for year 2008 kindly contributed by the \href{http://meteo.hr}{Croatian National Meteorological Service}. \code{HRtemp08} contains 56,608 measurements of temperature (159 stations by 365 days). +} +\usage{data(HRtemp08)} +\format{ +The \code{HRtemp08} data frames contain the following columns: + \describe{ + \item{\code{NAME}}{name of the meteorological station} + \item{\code{Lon}}{a numeric vector; x-coordiante / longitude in the WGS84 system} + \item{\code{Lat}}{a numeric vector; y-coordinate / latitude in the WGS84 system} + \item{\code{DATE}}{'Date' class vector} + \item{\code{TEMP}}{daily temperature measurements in degree C} + } +} +\author{ Tomislav Hengl, Melita Percec Tadic and Benedikt \enc{Gräler}{Graeler}} +\references{ +\itemize{ +\item Hengl, T., Heuvelink, G.B.M., Percec Tadic, M., Pebesma, E., (2011) \href{http://dx.doi.org/10.1007/s00704-011-0464-2}{Spatio-temporal prediction of daily temperatures using time-series of MODIS LST images}. Theoretical and Applied Climatology, 107(1-2): 265-277. +\item AGGM book datasets (\url{http://spatial-analyst.net/book/HRclim2008}) +} +} +\note{ The precision of the temperature readings in \code{HRtemp08} is tenth of degree C. On most climatological stations temperature is measured three times a day, at 7 a.m., 1 p.m. and 9 p.m. The daily mean can be calculated as a weighted average. +} +\seealso{ \code{\link{HRprec08}} } +\examples{ +data(HRtemp08) + +\dontrun{ +## examples from: http://dx.doi.org/10.1007/s00704-011-0464-2 +library(spacetime) +library(gstat) +library(sp) +sp <- SpatialPoints(HRtemp08[,c("Lon","Lat")]) +proj4string(sp) <- CRS("+proj=longlat +datum=WGS84") +HRtemp08.st <- STIDF(sp, time = HRtemp08$DATE-.5, + data = HRtemp08[,c("NAME","TEMP")], + endTime = as.POSIXct(HRtemp08$DATE+.5)) +## Country borders: +con0 <- url("http://www.gadm.org/data/rda/HRV_adm1.RData") +load(con0) +stplot(HRtemp08.st[,"2008-07-02::2008-07-03","TEMP"], + na.rm=TRUE, col.regions=SAGA_pal[[1]], + sp.layout=list("sp.polygons", gadm)) + +## Load covariates: +con <- url("http://plotkml.r-forge.r-project.org/HRgrid1km.rda") +load(con) +str(HRgrid1km) +sel.s <- c("HRdem","HRdsea","HRtwi","Lat","Lon") +## Prepare static covariates: +begin <- as.Date("2008-01-01") +endTime <- as.POSIXct(as.Date("2008-12-31")) +sp.grid <- as(HRgrid1km, "SpatialPixels") +HRgrid1km.st0 <- STFDF(sp.grid, time=begin, + data=HRgrid1km@data[,sel.s], endTime=endTime) +## Prepare dynamic covariates: +sel.d <- which(!names(HRgrid1km) \%in\% sel.s) +dates <- sapply(names(HRgrid1km)[sel.d], + function(x){strsplit(x, "LST")[[1]][2]} +) +dates <- as.Date(dates, format="\%Y_\%m_\%d") +## Sort values of MODIS LST bands: +m <- data.frame(MODIS.LST = as.vector(unlist(HRgrid1km@data[,sel.d]))) +## >10M values! +## Create an object of type STFDF: +HRgrid1km.stD <- STFDF(sp.grid, time=dates-4, data=m, + endTime=as.POSIXct(dates+4)) + +## Overlay in space and time: +HRtemp08.stxy <- spTransform(HRtemp08.st, CRS(proj4string(HRgrid1km))) +ov.s <- over(HRtemp08.stxy, HRgrid1km.st0) +ov.d <- over(HRtemp08.stxy, HRgrid1km.stD) +## Prepare the regression matrix: +regm <- do.call(cbind, list(HRtemp08.stxy@data, ov.s, ov.d)) +## Estimate cumulative days: +regm$cday <- floor(unclass(HRtemp08.stxy@endTime)/86400-.5) +str(regm) +## Plot a single station: +scatter.smooth(regm$cday[regm$NAME=="Zavian"], + regm$TEMP[regm$NAME=="Zavian"], + xlab="Cumulative days", + ylab="Mean daily temperature (\260C)", + ylim=c(-12,28), main="GL039 (Zavi\236an)", + col="grey") +## Run PCA so we can filter missing pixels in the MODIS images: +pca <- prcomp(~HRdem+HRdsea+Lat+Lon+HRtwi+MODIS.LST, + data=regm, scale.=TRUE) +selc <- c("TEMP","Lon","Lat","cday") +regm.pca <- cbind( regm[-pca$na.action, selc], + as.data.frame(pca$x)) +## Fit a spatio-temporal regression model: +theta <- min(regm.pca$cday) +lm.HRtemp08 <- lm(TEMP~PC1+PC2+PC3+PC4+PC5+PC6 + +cos((cday-theta)*pi/180), data=regm.pca) +summary(lm.HRtemp08) + +## Prediction locations -> focus on Istria: +data(LST) +gridded(LST) <- ~lon+lat +proj4string(LST) <- CRS("+proj=longlat +datum=WGS84") +LST.xy <- reproject(LST[1], proj4string(HRgrid1km)) +LST.xy <- as(LST.xy, "SpatialPixels") +## targeted dates: +t.dates <- as.Date(c("2008-02-01","2008-05-01","2008-08-01"), + format="\%Y-\%m-\%d") +LST.st <- STF(geometry(LST.xy), time=t.dates) +## get values of covariates: +ov.s.IS <- over(LST.st, HRgrid1km.st0) +ov.d.IS <- over(LST.st, HRgrid1km.stD) +LST.stdf <- STFDF(geometry(LST.xy), time=t.dates, + data=cbind(ov.s.IS, ov.d.IS)) +## predict Principal Components: +LST.pca <- as.data.frame(predict(pca, LST.stdf@data)) +LST.stdf@data[,paste0("PC",1:6)] <- LST.pca +cday.l <- as.vector(sapply( + floor(unclass(LST.stdf@endTime)/86400-.5), + rep, nrow(LST.xy@coords))) +LST.stdf@data[,"cday"] <- cday.l +stplot(LST.stdf[,,"PC1"], col.regions=SAGA_pal[[1]]) +stplot(LST.stdf[,,"PC2"], col.regions=SAGA_pal[[1]]) + +## Predict spatio-temporal regression: +LST.stdf@data[,"TEMP.reg"] <- predict(lm.HRtemp08, + newdata=LST.stdf@data) +## Plot predictions: +gadm.ll <- as(spTransform(gadm, + CRS(proj4string(HRgrid1km))), "SpatialLines") +stplot(LST.stdf[,,"TEMP.reg"], col.regions=SAGA_pal[[1]], + sp.layout=list( list("sp.lines", gadm.ll), + list("sp.points", HRtemp08.stxy, col="black", pch=19) ) + ) +} +} \keyword{datasets} \ No newline at end of file diff --git a/pkg/man/LST.Rd b/pkg/man/LST.Rd index 5ee3fe3..dbf834a 100644 --- a/pkg/man/LST.Rd +++ b/pkg/man/LST.Rd @@ -1,30 +1,31 @@ -\name{LST} -\alias{LST} -\docType{data} -\encoding{latin1} -\title{Time series of MODIS LST images} -\description{\code{LST} contains a spatial sub-sample (Istra region in Croatia) of 46 time series of MODIS LST images (estimated Land Surface Temperature in degrees C) at 1 km resolution. The temporal support size of these images is 8-days.} -\usage{data(LST)} -\format{ -The \code{LST} data frame contains the following layers: - \describe{ - \item{\code{LST2008_01_01}}{8-day MODIS LST mosaick for period 2007-12-29 to 2008-01-04} - \item{\code{LST2008_01_09}}{8-day MODIS LST mosaick for period 2008-01-05 to 2008-01-13} - \item{\code{\dots}}{subsequent bands} - \item{\code{lon}}{a numeric vector; x-coordinate (m) in the WGS84 system } - \item{\code{lat}}{a numeric vector; y-coordinate (m) in the WGS84 system } - } -} -\author{ Tomislav Hengl and Melita Percec Tadic } -\references{ -\itemize{ -\item Hengl, T., Heuvelink, G.B.M., Percec Tadic, M., Pebesma, E., (2011) Spatio-temporal prediction of daily temperatures using time-series of MODIS LST images. Theoretical and Applied Climatology, 107(1-2): 265-277. \doi{10.1007/s00704-011-0464-2} -\item MODIS products (\url{https://lpdaac.usgs.gov/data/get-started-data/}) -} -} -\note{Time series of 46 day-time and night-time 8-day composite LST images (\href{https://lpdaac.usgs.gov/data/get-started-data/}{MOD11A2} product bands \code{1} and \code{5}) was obtained from the NASA's FTP server (\url{https://ladsweb.modaps.eosdis.nasa.gov/}). The original 8-day composite images were created by patching together images from a period of \enc{±}{+-}4 days, so that the proportion of clouds can be reduced to a minimum. The \code{"zvalue"} slot in the \code{"RasterBrick"} object can be used as the dateTime column expressed as:\cr - -\code{yyyy-mm-ddThh:mm:sszzzzzz}\cr - -where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents \enc{±}{+-}hh:mm in relation to UTC.} -\keyword{datasets} +\name{LST} +\alias{LST} +\docType{data} +\encoding{latin1} +\title{Time series of MODIS LST images} +\description{\code{LST} contains a spatial sub-sample (Istra region in Croatia) of 46 time series of MODIS LST images (estimated Land Surface Temperature in degrees C) at 1 km resolution. The temporal support size of these images is 8-days. +} +\usage{data(LST)} +\format{ +The \code{LST} data frame contains the following layers: + \describe{ + \item{\code{LST2008_01_01}}{8-day MODIS LST mosaick for period 2007-12-29 to 2008-01-04} + \item{\code{LST2008_01_09}}{8-day MODIS LST mosaick for period 2008-01-05 to 2008-01-13} + \item{\code{\dots}}{subsequent bands} + \item{\code{lon}}{a numeric vector; x-coordinate (m) in the WGS84 system } + \item{\code{lat}}{a numeric vector; y-coordinate (m) in the WGS84 system } + } +} +\author{ Tomislav Hengl and Melita Percec Tadic } +\references{ +\itemize{ +\item Hengl, T., Heuvelink, G.B.M., Percec Tadic, M., Pebesma, E., (2011) \href{http://dx.doi.org/10.1007/s00704-011-0464-2}{Spatio-temporal prediction of daily temperatures using time-series of MODIS LST images}. Theoretical and Applied Climatology, 107(1-2): 265-277. +\item MODIS products (\url{https://lpdaac.usgs.gov/products/modis_products_table}) +} +} +\note{Time series of 46 day-time and night-time 8-day composite LST images (\href{https://lpdaac.usgs.gov/products/modis_products_table/mod11a2}{MOD11A2} product bands \code{1} and \code{5}) was obtained from the NASA's FTP server (\url{ftp://ladsftp.nascom.nasa.gov}). The original 8-day composite images were created by patching together images from a period of \enc{±}{+-}4 days, so that the proportion of clouds can be reduced to a minimum. The \code{"zvalue"} slot in the \code{"RasterBrick"} object can be used as the dateTime column expressed as:\cr + +\code{yyyy-mm-ddThh:mm:sszzzzzz}\cr + +where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents \enc{±}{+-}hh:mm in relation to UTC.} +\keyword{datasets} diff --git a/pkg/man/SAGA_pal.Rd b/pkg/man/SAGA_pal.Rd index 9caed38..7e6f1e7 100644 --- a/pkg/man/SAGA_pal.Rd +++ b/pkg/man/SAGA_pal.Rd @@ -5,23 +5,23 @@ \alias{SAGA_pal} \alias{R_pal} \title{Colour palettes for numeric variables} -\description{\code{SAGA_pal} contains 22 colour palettes imported from SAGA GIS (Conrad, 2007). \code{R_pal} 12 standard colour palettes used in R to visualize continuous and binary variables. Each colour palette consists of 20 colours in the hexadecimal system. Use \code{display.pal} function to plot different sets of palettes.} +\description{\code{SAGA_pal} contains 22 colour palettes imported from SAGA GIS (\href{http://webdoc.sub.gwdg.de/diss/2007/conrad/conrad.pdf}{Conrad, 2007}). \code{R_pal} 12 standard colour palettes used in R to visualize continuous and binary variables. Each colour palette consists of 20 colours in the hexadecimal system. Use \code{display.pal} function to plot different sets of palettes.} \usage{ data(SAGA_pal) data(R_pal) } -\author{\href{http://www.saga-gis.org}{SAGA GIS} has been created by the SAGA GIS development team (lead by J. \enc{Böhner}{Boehner} and O. Conrad, from the Institute of Geography, University of Hamburg, Germany). The colour palettes have been exported from SAGA (as \code{".sprm"} SAGA parameter files) and ported to R. All palletes described here were prepared for R by Tomislav Hengl (\email{tom.hengl@opengeohub.org}).} +\author{\href{http://www.saga-gis.org}{SAGA GIS} has been created by the SAGA GIS development team (lead by J. \enc{B?hner}{Boehner} and O. Conrad, from the Institute of Geography, University of Hamburg, Germany). The colour palettes have been exported from SAGA (as \code{".sprm"} SAGA parameter files) and ported to R. All palletes described here were prepared for R by Tomislav Hengl (\email{tom.hengl@wur.nl}).} \references{ \itemize{ -\item Conrad, O., (2007). SAGA --- Entwurf, Funktionsumfang und Anwendung eines Systems \enc{für}{fur} Automatisierte Geowissenschaftliche Analysen. Electronic doctoral dissertation, University of \enc{Göttingen}{Goettingen}. -\item Rogowitz, B.E., Treinish, L.A., (1998, December). Data visualization: the end of the rainbow. Spectrum, IEEE, 35(12):52-59. \doi{10.1109/6.736450} -\item Borland, D. and Russell, M. T. II, (2007). Rainbow Color Map (Still) Considered Harmful. Computer Graphics and Applications, IEEE, 27(2):14-17. \doi{10.1109/MCG.2007.323435} +\item Conrad, O., (2007). \href{http://webdoc.sub.gwdg.de/diss/2007/conrad/conrad.pdf}{SAGA --- Entwurf, Funktionsumfang und Anwendung eines Systems f?r Automatisierte Geowissenschaftliche Analysen}. Electronic doctoral dissertation, University of \enc{G?ttingen}{Goettingen}. +\item Rogowitz, B.E., Treinish, L.A., (1998, December). \href{http://dx.doi.org/10.1109/6.736450}{Data visualization: the end of the rainbow}. Spectrum, IEEE, 35(12):52-59 +\item Borland, D. and Russell, M. T. II, (2007). \href{http://dx.doi.org/10.1109/MCG.2007.323435}{Rainbow Color Map (Still) Considered Harmful}. Computer Graphics and Applications, IEEE, 27(2):14-17. \item \url{https://cran.r-project.org/package=RColorBrewer} \item \url{https://cran.r-project.org/package=colorspace} } } \note{\code{rainbow_75}, \code{heat colors}, \code{terrain_colors}, \code{topo_colors}, and \code{bpy_colors} are the standard color palettes used in R to visualize numeric/continuous variables. \code{soc_pal}, \code{pH_pal}, \code{tex_pal}, \code{BS_pal} and \code{CEC_pal} palettes are suitable for visualization of soil variables (soil organic carbon, pH, soil texture fractions, Base Saturation and Cation Exchange Capacity). \code{blue_grey_red} palette is recommended for visualization of binary variables (values in the range 0-1), and \code{grey_black} is a white-to-black type color palette that contains no white color (hence it will not confuse low values with NA values in the PNG/GIF files).\cr -Possibly the most used palettes for visualization of numeric variables are \code{rev(rainbow(65)[1:48])} and \code{SAGA_pal[[1]]} (the SAGA GIS default palette). It is however worth mentioning that in the data visualization literature (and the cartography literature in particular), the rainbow (sometimes also called spectral) color ramp is generally recognized as a \emph{bad choice} for visualization of sequential/continuous variables (Rogowitz and Treinish, 1998; \doi{10.1109/6.736450}; Borland and Russell, 2007; \doi{10.1109/MCG.2007.323435}). +Possibly the most used palettes for visualization of numeric variables are \code{rev(rainbow(65)[1:48])} and \code{SAGA_pal[[1]]} (the SAGA GIS default palette). It is however worth mentioning that in the data visualization literature (and the cartography literature in particular), the rainbow (sometimes also called spectral) color ramp is generally recognized as a \emph{bad choice} for visualization of sequential/continuous variables (\href{http://dx.doi.org/10.1109/6.736450}{Rogowitz and Treinish, 1998}; \href{http://dx.doi.org/10.1109/MCG.2007.323435}{Borland and Russell, 2007}). } \seealso{\code{\link{worldgrids_pal}}, \code{RColorBrewer::display.brewer.all}} \examples{ diff --git a/pkg/man/SpatialMaxEntOutput.Rd b/pkg/man/SpatialMaxEntOutput.Rd index 1d6324f..c7ef3e6 100644 --- a/pkg/man/SpatialMaxEntOutput.Rd +++ b/pkg/man/SpatialMaxEntOutput.Rd @@ -24,7 +24,7 @@ \references{ \itemize{ \item Hijmans, R.J, Elith, J., (2012) \href{https://CRAN.R-project.org/package=dismo}{Species distribution modeling with R}. CRAN, Vignette for the dismo package, 72 p. -\item Royle, J.A., Chandler, R.B., Yackulic, C. and J. D. Nichols. (2012) Likelihood analysis of species occurrence probability from presence-only data for modelling species distributions. Methods in Ecology and Evolution. \doi{10.1111/j.2041-210X.2011.00182.x} +\item Royle, J.A., Chandler, R.B., Yackulic, C. and J. D. Nichols. (2012) \href{http://dx.doi.org/10.1111/j.2041-210X.2011.00182.x}{Likelihood analysis of species occurrence probability from presence-only data for modelling species distributions}. Methods in Ecology and Evolution. \item dismo package (\url{https://CRAN.R-project.org/package=dismo}) \item maxlike package (\url{https://CRAN.R-project.org/package=maxlike}) \item rgbif package (\url{https://CRAN.R-project.org/package=rgbif}) diff --git a/pkg/man/SpatialPhotoOverlay.Rd b/pkg/man/SpatialPhotoOverlay.Rd index 25c2172..a28dbaa 100644 --- a/pkg/man/SpatialPhotoOverlay.Rd +++ b/pkg/man/SpatialPhotoOverlay.Rd @@ -8,7 +8,7 @@ \describe{ \item{\code{filename}}{object of class "character"; URI of the filename location (typically a URL)} \item{\code{pixmap}}{object of class "pixmapRGB"; RGB bands of a bitmapped images} - \item{\code{exif.info}}{object of class "list"; \href{https://exiftool.org/}{EXIF} photo metadata} + \item{\code{exif.info}}{object of class "list"; \href{http://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/EXIF.html}{EXIF} photo metadata} \item{\code{PhotoOverlay}}{object of class "list"; list of the camera geometry parameters (KML specifications)} \item{\code{sp}}{object of class "SpatialPoints"; location of the camera} } diff --git a/pkg/man/SpatialPredictions.Rd b/pkg/man/SpatialPredictions.Rd index b573ec4..1d44863 100644 --- a/pkg/man/SpatialPredictions.Rd +++ b/pkg/man/SpatialPredictions.Rd @@ -2,7 +2,7 @@ \docType{class} \alias{SpatialPredictions-class} \alias{plot.SpatialPredictions} -\alias{plot,SpatialPredictions-method} +\alias{plot,SpatialPredictions,ANY-method} \title{A class for spatial predictions produced using \code{gstat} package} \description{A class containing input and output maps generated through the process of geostatistical mapping. Object of this class can be directly visualized in Google Earth by using the \code{\link{plotKML-method}}.} \section{Slots}{ @@ -25,12 +25,12 @@ \references{ \itemize{ \item Hengl, T. (2009) \href{http://spatial-analyst.net/book/}{A Practical Guide to Geostatistical Mapping}, 2nd Edt. University of Amsterdam, www.lulu.com, 291 p. -\item Hengl, T., Nikolic, M., MacMillan, R.A., (2012) Mapping efficiency and information content. International Journal of Applied Earth Observation and Geoinformation, special issue Spatial Statistics Conference. \doi{10.1016/j.jag.2012.02.005} +\item Hengl, T., Nikolic, M., MacMillan, R.A., (2012) \href{http://dx.doi.org/10.1016/j.jag.2012.02.005}{Mapping efficiency and information content}. International Journal of Applied Earth Observation and Geoinformation, special issue Spatial Statistics Conference. } } \note{ \code{"SpatialPredictions"} saves results of predictions for a single target variable, which can be of type numeric or factor. Multiple variables can be combined into a list. } \author{ Tomislav Hengl } -\seealso{ \code{\link{plotKML-method}}, \code{gstat::gstat-class}, \code{\link{RasterBrickSimulations-class}} +\seealso{ \code{\link{plotKML-method}}, \code{GSIF::fit.gstatModel}, \code{gstat::gstat-class}, \code{\link{RasterBrickSimulations-class}} } \keyword{classes} diff --git a/pkg/man/SpatialSamplingPattern.Rd b/pkg/man/SpatialSamplingPattern.Rd index 1bfd662..66ab6f1 100644 --- a/pkg/man/SpatialSamplingPattern.Rd +++ b/pkg/man/SpatialSamplingPattern.Rd @@ -17,6 +17,6 @@ } } \author{ Tomislav Hengl } -\seealso{ \code{\link{plotKML-method}}, \code{\link{plotKML-method}} +\seealso{ \code{\link{plotKML-method}}, \code{spcosa::spsample}, \code{\link{plotKML-method}} } \keyword{classes} diff --git a/pkg/man/baranja.Rd b/pkg/man/baranja.Rd index 125b08a..17d504c 100644 --- a/pkg/man/baranja.Rd +++ b/pkg/man/baranja.Rd @@ -1,91 +1,91 @@ -\name{baranja} -\docType{data} -\encoding{latin1} -\alias{barxyz} -\alias{bargrid} -\alias{barstr} -\title{Baranja hill case study} -\description{Baranja hill is a 4 by 4 km large study area in the Baranja region, eastern Croatia (corresponds to a size of an aerial photograph). This data set has been extensively used to describe various DEM modelling and analysis steps (see \href{http://geomorphometry.org/book}{Hengl and Reuter, 2008}; Hengl et al., 2010; \doi{10.5194/hess-14-1153-2010}). Object \code{barxyz} contains 6370 precise observations of elevations (from field survey and digitized from the stereo images); \code{bargrid} contains \emph{observed} probabilities of streams (digitized from the 1:5000 topo map); \code{barstr} contains 100 simulated stream networks (\code{"SpatialLines"}) using \code{barxyz} point data as input (see examples below).} -\usage{data(bargrid)} -\format{ -The \code{bargrid} data frame (regular grid at 30 m intervals) contains the following columns: - \describe{ - \item{\code{p.obs}}{observed probability of stream (0-1)} - \item{\code{x}}{a numeric vector; x-coordinate (m) in the MGI / Balkans zone 6 } - \item{\code{y}}{a numeric vector; y-coordinate (m) in the MGI / Balkans zone 6 } -} -} -\author{ Tomislav Hengl } -\references{ -\itemize{ -\item Hengl, T., Reuter, H.I. (eds), (2008) \href{http://geomorphometry.org/book}{Geomorphometry: Concepts, Software, Applications}. Developments in Soil Science, vol. 33, Elsevier, 772 p. -\item Hengl, T., Heuvelink, G. B. M., van Loon, E. E., (2010) On the uncertainty of stream networks derived from elevation data: the error propagation approach. Hydrology and Earth System Sciences, 14:1153-1165. \doi{10.5194/hess-14-1153-2010} -\item \url{http://geomorphometry.org/content/baranja-hill} -} -} -\note{Consider using the 30 m resolution grid (see \code{bargrid}) as the target resolution (output maps). -} -\examples{ -library(sp) -library(gstat) -## sampled elevations: -data(barxyz) -prj = "+proj=tmerc +lat_0=0 +lon_0=18 +k=0.9999 +x_0=6500000 +y_0=0 +ellps=bessel +units=m -+towgs84=550.499,164.116,475.142,5.80967,2.07902,-11.62386,0.99999445824" -coordinates(barxyz) <- ~x+y -proj4string(barxyz) <- CRS(prj) -## grids: -data(bargrid) -data(barstr) -coordinates(bargrid) <- ~x+y -gridded(bargrid) <- TRUE -proj4string(bargrid) <- barxyz@proj4string -bargrid@grid -\dontrun{## Example with simulated streams: -data(R_pal) -library(rgdal) -library(RSAGA) -pnt = list("sp.points", barxyz, col="black", pch="+") -spplot(bargrid[1], sp.layout=pnt, - col.regions = R_pal[["blue_grey_red"]]) -## Deriving stream networks using geostatistical simulations: -Z.ovgm <- vgm(psill=1831, model="Mat", range=1051, nugget=0, kappa=1.2) -sel <- runif(length(barxyz$Z))<.2 -N.sim <- 5 -## geostatistical simulations: -DEM.sim <- krige(Z~1, barxyz[sel,], bargrid, model=Z.ovgm, nmax=20, - nsim=N.sim, debug.level=-1) -## Note: this operation can be time consuming - -stream.list <- list(rep(NA, N.sim)) -## derive stream networks in SAGA GIS: -for (i in 1:N.sim) { - writeGDAL(DEM.sim[i], paste("DEM", i, ".sdat", sep=""), - drivername = "SAGA", mvFlag = -99999) - ## filter the spurious sinks: - rsaga.fill.sinks(in.dem=paste("DEM", i, ".sgrd", sep=""), - out.dem="DEMflt.sgrd", check.module.exists = FALSE) - ## extract the channel network SAGA GIS: - rsaga.geoprocessor(lib="ta_channels", module=0, - param=list(ELEVATION="DEMflt.sgrd", - CHNLNTWRK=paste("channels", i, ".sgrd", sep=""), - CHNLROUTE="channel_route.sgrd", - SHAPES="channels.shp", - INIT_GRID="DEMflt.sgrd", - DIV_CELLS=3, MINLEN=40), - check.module.exists = FALSE, - show.output.on.console=FALSE) - stream.list[[i]] <- readOGR("channels.shp", "channels", - verbose=FALSE) - proj4string(stream.list[[i]]) <- barxyz@proj4string -} -# plot all derived streams at top of each other: -streams.plot <- as.list(rep(NA, N.sim)) -for(i in 1:N.sim){ - streams.plot[[i]] <- list("sp.lines", stream.list[[i]]) -} -spplot(DEM.sim[1], col.regions=grey(seq(0.4,1,0.025)), scales=list(draw=T), -sp.layout=streams.plot) -} -} -\keyword{datasets} +\name{baranja} +\docType{data} +\encoding{latin1} +\alias{barxyz} +\alias{bargrid} +\alias{barstr} +\title{Baranja hill case study} +\description{Baranja hill is a 4 by 4 km large study area in the Baranja region, eastern Croatia (corresponds to a size of an aerial photograph). This data set has been extensively used to describe various DEM modelling and analysis steps (see \href{http://geomorphometry.org/book}{Hengl and Reuter, 2008}; \href{http://dx.doi.org/10.5194/hess-14-1153-2010}{Hengl et al., 2010}). Object \code{barxyz} contains 6370 precise observations of elevations (from field survey and digitized from the stereo images); \code{bargrid} contains \emph{observed} probabilities of streams (digitized from the 1:5000 topo map); \code{barstr} contains 100 simulated stream networks (\code{"SpatialLines"}) using \code{barxyz} point data as input (see examples below).} +\usage{data(bargrid)} +\format{ +The \code{bargrid} data frame (regular grid at 30 m intervals) contains the following columns: + \describe{ + \item{\code{p.obs}}{observed probability of stream (0-1)} + \item{\code{x}}{a numeric vector; x-coordinate (m) in the MGI / Balkans zone 6 } + \item{\code{y}}{a numeric vector; y-coordinate (m) in the MGI / Balkans zone 6 } +} +} +\author{ Tomislav Hengl } +\references{ +\itemize{ +\item Hengl, T., Reuter, H.I. (eds), (2008) \href{http://geomorphometry.org/book}{Geomorphometry: Concepts, Software, Applications}. Developments in Soil Science, vol. 33, Elsevier, 772 p. +\item Hengl, T., Heuvelink, G. B. M., van Loon, E. E., (2010) \href{http://dx.doi.org/10.5194/hess-14-1153-2010}{On the uncertainty of stream networks derived from elevation data: the error propagation approach}. Hydrology and Earth System Sciences, 14:1153-1165. +\item \url{http://geomorphometry.org/content/baranja-hill} +} +} +\note{Consider using the 30 m resolution grid (see \code{bargrid}) as the target resolution (output maps). +} +\examples{ +library(sp) +library(gstat) +## sampled elevations: +data(barxyz) +prj = "+proj=tmerc +lat_0=0 +lon_0=18 +k=0.9999 +x_0=6500000 +y_0=0 +ellps=bessel +units=m ++towgs84=550.499,164.116,475.142,5.80967,2.07902,-11.62386,0.99999445824" +coordinates(barxyz) <- ~x+y +proj4string(barxyz) <- CRS(prj) +## grids: +data(bargrid) +data(barstr) +coordinates(bargrid) <- ~x+y +gridded(bargrid) <- TRUE +proj4string(bargrid) <- barxyz@proj4string +bargrid@grid +\dontrun{## Example with simulated streams: +data(R_pal) +library(rgdal) +library(RSAGA) +pnt = list("sp.points", barxyz, col="black", pch="+") +spplot(bargrid[1], sp.layout=pnt, + col.regions = R_pal[["blue_grey_red"]]) +## Deriving stream networks using geostatistical simulations: +Z.ovgm <- vgm(psill=1831, model="Mat", range=1051, nugget=0, kappa=1.2) +sel <- runif(length(barxyz$Z))<.2 +N.sim <- 5 +## geostatistical simulations: +DEM.sim <- krige(Z~1, barxyz[sel,], bargrid, model=Z.ovgm, nmax=20, + nsim=N.sim, debug.level=-1) +## Note: this operation can be time consuming + +stream.list <- list(rep(NA, N.sim)) +## derive stream networks in SAGA GIS: +for (i in 1:N.sim) { + writeGDAL(DEM.sim[i], paste("DEM", i, ".sdat", sep=""), + drivername = "SAGA", mvFlag = -99999) + ## filter the spurious sinks: + rsaga.fill.sinks(in.dem=paste("DEM", i, ".sgrd", sep=""), + out.dem="DEMflt.sgrd", check.module.exists = FALSE) + ## extract the channel network SAGA GIS: + rsaga.geoprocessor(lib="ta_channels", module=0, + param=list(ELEVATION="DEMflt.sgrd", + CHNLNTWRK=paste("channels", i, ".sgrd", sep=""), + CHNLROUTE="channel_route.sgrd", + SHAPES="channels.shp", + INIT_GRID="DEMflt.sgrd", + DIV_CELLS=3, MINLEN=40), + check.module.exists = FALSE, + show.output.on.console=FALSE) + stream.list[[i]] <- readOGR("channels.shp", "channels", + verbose=FALSE) + proj4string(stream.list[[i]]) <- barxyz@proj4string +} +# plot all derived streams at top of each other: +streams.plot <- as.list(rep(NA, N.sim)) +for(i in 1:N.sim){ + streams.plot[[i]] <- list("sp.lines", stream.list[[i]]) +} +spplot(DEM.sim[1], col.regions=grey(seq(0.4,1,0.025)), scales=list(draw=T), +sp.layout=streams.plot) +} +} +\keyword{datasets} diff --git a/pkg/man/bigfoot.Rd b/pkg/man/bigfoot.Rd index ec3946d..0c39f13 100644 --- a/pkg/man/bigfoot.Rd +++ b/pkg/man/bigfoot.Rd @@ -1,62 +1,62 @@ -\name{bigfoot} -\docType{data} -\alias{bigfoot} -\alias{USAWgrids} -\title{Bigfoot reports (USA)} -\description{2984 observations of bigfoot (with attached dates). The field occurrence records have been obtained from the \href{http://www.bfro.net/news/google_earth.asp}{BigFoot Research Organization (BFRO) website}. The BFRO reports generally consist of a description of the event and where it occurred, plus the quality classification. Similar data set has been used by Lozier et al. (2009) to demonstrate possible miss-interpretations of the results of species distribution modeling. The maps in the \code{USAWgrids} data set represent typical gridded environmental covariates used for species distribution modeling. -} -\format{ -The \code{bigfoot} data frame contains the following columns: - \describe{ - \item{\code{Lon}}{a numeric vector; x-coordinate / longitude in the WGS84 system} - \item{\code{Lat}}{a numeric vector; y-coordinate / latitude in the WGS84 system} - \item{\code{NAME}}{name assigned by the observer (usually referent month / year)} - \item{\code{DATE}}{'POSIXct' class vector} - \item{\code{TYPE}}{confidence levels; according to the BFRO website: \emph{"Class A" reports involve clear sightings in circumstances where misinterpretation or misidentification of other animals can be ruled out with greater confidence; "Class B" and "Class C" reports are less credible}.} - } -The \code{USAWgrids} data frame (46,018 pixels; Washington, Oregon, Nevada and California state) contains the following columns: - \describe{ - \item{\code{globedem}}{a numeric vector; elevations from the ETOPO1 Global Relief Model} - \item{\code{nlights03}}{an integer vector; lights at night image for 2003 (Version 2 DMSP-OLS Nighttime Lights Time Series)} - \item{\code{sroads}}{a numeric vector; distance to main roads and railroads (National Atlas of the United States)} - \item{\code{gcarb}}{a numeric vector; Global Biomass Carbon Map (New IPCC Tier-1 Global Biomass Carbon Map for the Year 2000)} - \item{\code{dTRI}}{a numeric vector; density of pollutant releases (North American Pollutant Releases and Transfers database)} - \item{\code{twi}}{a numeric vector; Topographic Wetness Index based on the globedem} - \item{\code{states}}{an integer vector; USA states} - \item{\code{globcov}}{land cover classes based on the MERIS FR images (GlobCover Land Cover version V2.2)} - \item{\code{s1}}{a numeric vector; x-coordinates in the Albers equal-area projection system} - \item{\code{s2}}{a numeric vector; y-coordinates in the Albers equal-area projection system} -} -} -\usage{data(bigfoot)} -\author{ Tomislav Hengl } -\references{ -\itemize{ -\item Lozier, J.D., Aniello, P., Hickerson, M.J., (2009) Predicting the distribution of Sasquatch in western North America: anything goes with ecological niche modelling. Journal of Biogeography, 36(9):1623-1627. \doi{10.1111/j.1365-2699.2009.02152.x} -\item BigFoot Research Organization (\url{http://www.bfro.net}) -} -} -\note{According to the \href{https://newsfeed.time.com/2011/10/11/scientists-95-sure-bigfoot-lives-in-russian-tundra/}{Time.com}, a team of a dozen-plus experts from as far afield as Canada and Sweden have proclaimed themselves 95 percent certain of the mythical animal's existence on Kemerovo region territory some 3,000 kilometers east of Moscow (announced at the Tashtagol conference in 2011). -} -\examples{ -\dontrun{# Load the BFRO records: -library(sp) -data(bigfoot) -aea.prj <- "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 -+x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs" -library(sp) -coordinates(bigfoot) <- ~Lon+Lat -proj4string(bigfoot) <- CRS("+proj=latlon +datum=WGS84") -library(rgdal) -bigfoot.aea <- spTransform(bigfoot, CRS(aea.prj)) -# Load the covariates: -data(USAWgrids) -gridded(USAWgrids) <- ~s1+s2 -proj4string(USAWgrids) <- CRS(aea.prj) -# Visualize data: -data(SAGA_pal) -pnts <- list("sp.points", bigfoot.aea, pch="+", col="yellow") -spplot(USAWgrids[2], col.regions=rev(SAGA_pal[[3]]), sp.layout=pnts) -} -} -\keyword{datasets} +\name{bigfoot} +\docType{data} +\alias{bigfoot} +\alias{USAWgrids} +\title{Bigfoot reports (USA)} +\description{2984 observations of bigfoot (with attached dates). The field occurrence records have been obtained from the \href{http://www.bfro.net/news/google_earth.asp}{BigFoot Research Organization (BFRO) website}. The BFRO reports generally consist of a description of the event and where it occurred, plus the quality classification. Similar data set has been used by \href{http://dx.doi.org/10.1111/j.1365-2699.2009.02152.x}{Lozier et al. (2009)} to demonstrate possible miss-interpretations of the results of species distribution modeling. The maps in the \code{USAWgrids} data set represent typical gridded environmental covariates used for species distribution modeling. +} +\format{ +The \code{bigfoot} data frame contains the following columns: + \describe{ + \item{\code{Lon}}{a numeric vector; x-coordinate / longitude in the WGS84 system} + \item{\code{Lat}}{a numeric vector; y-coordinate / latitude in the WGS84 system} + \item{\code{NAME}}{name assigned by the observer (usually referent month / year)} + \item{\code{DATE}}{'POSIXct' class vector} + \item{\code{TYPE}}{confidence levels; according to the BFRO website: \emph{"Class A" reports involve clear sightings in circumstances where misinterpretation or misidentification of other animals can be ruled out with greater confidence; "Class B" and "Class C" reports are less credible}.} + } +The \code{USAWgrids} data frame (46,018 pixels; Washington, Oregon, Nevada and California state) contains the following columns: + \describe{ + \item{\code{globedem}}{a numeric vector; elevations from the ETOPO1 Global Relief Model} + \item{\code{nlights03}}{an integer vector; lights at night image for 2003 (Version 2 DMSP-OLS Nighttime Lights Time Series)} + \item{\code{sroads}}{a numeric vector; distance to main roads and railroads (National Atlas of the United States)} + \item{\code{gcarb}}{a numeric vector; Global Biomass Carbon Map (New IPCC Tier-1 Global Biomass Carbon Map for the Year 2000)} + \item{\code{dTRI}}{a numeric vector; density of pollutant releases (North American Pollutant Releases and Transfers database)} + \item{\code{twi}}{a numeric vector; Topographic Wetness Index based on the globedem} + \item{\code{states}}{an integer vector; USA states} + \item{\code{globcov}}{land cover classes based on the MERIS FR images (GlobCover Land Cover version V2.2)} + \item{\code{s1}}{a numeric vector; x-coordinates in the Albers equal-area projection system} + \item{\code{s2}}{a numeric vector; y-coordinates in the Albers equal-area projection system} +} +} +\usage{data(bigfoot)} +\author{ Tomislav Hengl } +\references{ +\itemize{ +\item Lozier, J.D., Aniello, P., Hickerson, M.J., (2009) \href{http://dx.doi.org/10.1111/j.1365-2699.2009.02152.x}{Predicting the distribution of Sasquatch in western North America: anything goes with ecological niche modelling}. Journal of Biogeography, 36(9):1623-1627. +\item BigFoot Research Organization (\url{http://www.bfro.net}) +} +} +\note{According to the \href{http://newsfeed.time.com/2011/10/11/scientists-95-sure-bigfoot-lives-in-russian-tundra}{Time.com}, a team of a dozen-plus experts from as far afield as Canada and Sweden have proclaimed themselves 95 percent certain of the mythical animal's existence on Kemerovo region territory some 3,000 kilometers east of Moscow (announced at the Tashtagol conference in 2011). +} +\examples{ +\dontrun{# Load the BFRO records: +library(sp) +data(bigfoot) +aea.prj <- "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 ++x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs" +library(sp) +coordinates(bigfoot) <- ~Lon+Lat +proj4string(bigfoot) <- CRS("+proj=latlon +datum=WGS84") +library(rgdal) +bigfoot.aea <- spTransform(bigfoot, CRS(aea.prj)) +# Load the covariates: +data(USAWgrids) +gridded(USAWgrids) <- ~s1+s2 +proj4string(USAWgrids) <- CRS(aea.prj) +# Visualize data: +data(SAGA_pal) +pnts <- list("sp.points", bigfoot.aea, pch="+", col="yellow") +spplot(USAWgrids[2], col.regions=rev(SAGA_pal[[3]]), sp.layout=pnts) +} +} +\keyword{datasets} diff --git a/pkg/man/check_projection.Rd b/pkg/man/check_projection.Rd index 4f61ac8..affdbd1 100644 --- a/pkg/man/check_projection.Rd +++ b/pkg/man/check_projection.Rd @@ -17,7 +17,7 @@ A cartographic projection is KML compatible if: (a) geographical coordinates are } \references{ \itemize{ -\item WGS84 (\url{https://spatialreference.org/ref/epsg/4326/}) +\item WGS84 (\url{http://spatialreference.org/ref/epsg/4326/}) } } \author{Pierre Roudier, Tomislav Hengl, and Dylan Beaudette} diff --git a/pkg/man/eberg.Rd b/pkg/man/eberg.Rd index f8f4447..5c34c6a 100644 --- a/pkg/man/eberg.Rd +++ b/pkg/man/eberg.Rd @@ -7,8 +7,8 @@ \alias{eberg_zones} \alias{eberg_contours} \title{Ebergotzen --- soil mapping case study} -\description{\enc{Ebergötzen}{Ebergoetzen} is 10 by 10 km study area in the vicinity of the city of \enc{Göttingen}{Goettingen} in Central Germany. This area has been extensively surveyed over the years, mainly for the purposes of developing operational digital soil mapping techniques (Gehrt and \enc{Böhner}{Boehner}, 2001), and has been used by the SAGA GIS development team to demonstrate various processing steps.\cr -\code{eberg} table contains 3670 observations (augers) of soil textures at five depths (0--10, 10--30, 30--50, 50--70, and 70--90), and field records of soil types according to the German soil classification system. \code{eberg_grid} contains gridded maps at 100 m resolution that can be used as covariates for spatial prediction of soil variables. \code{eberg_grid25} contains grids at finer resolution (25 m). \code{eberg_zones} is a polygon map showing the distribution of parent material (Silt and sand, Sandy material, Clayey derivats, Clay and loess). \code{eberg_contours} shows contour lines derived from the 25 m DEM of the area using 10 m equidistance.} +\description{\enc{Ebergötzen}{Ebergoetzen} is 10 by 10 km study area in the vicinity of the city of \enc{Göttingen}{Goettingen} in Central Germany. This area has been extensively surveyed over the years, mainly for the purposes of developing operational digital soil mapping techniques (Gehrt and \enc{Böhner}{Boehner}, 2001), and has been used by the SAGA GIS development team to demonstrate various processing steps. \cr +\code{eberg} table contains 3670 observations (augers) of soil textures at five depths (0-10, 10-30, 30-50, 50-70, and 70-90), and field records of soil types according to the German soil classification system. \code{eberg_grid} contains gridded maps at 100 m resolution that can be used as covariates for spatial prediction of soil variables. \code{eberg_grid25} contains grids at finer resolution (25 m). \code{eberg_zones} is a polygon map showing the distribution of parent material (Silt and sand, Sandy material, Clayey derivats, Clay and loess). \code{eberg_contours} shows contour lines derived from the 25 m DEM of the area using 10 m equidistance.} \usage{data(eberg)} \format{ The \code{eberg} data frame (irregular points) contains the following columns: @@ -29,8 +29,8 @@ The \code{eberg_grid} data frame (regular grid at 100 m resolution) contains the \item{\code{PRMGEO6}}{a vector containing factors, parent material classes from the geological map (mapping units)} \item{\code{DEMSRT6}}{a numeric vector; elevation values from the SRTM DEM} \item{\code{TWISRT6}}{a numeric vector; Topographic Wetness Index derived using the SAGA algorithm} - \item{\code{TIRAST6}}{a numeric vector; Thermal Infrared (TIR) reflection values from the ASTER L1 image band 14 (2010-06-05T10:26:50Z) obtained via the NASA's \href{https://glovis.usgs.gov}{GloVis browser}} - \item{\code{LNCCOR6}}{a vector containing factors; \href{https://www.eea.europa.eu/data-and-maps/data/clc-2006-raster-1}{Corine Land Cover 2006} classes} + \item{\code{TIRAST6}}{a numeric vector; Thermal Infrared (TIR) reflection values from the ASTER L1 image band 14 (2010-06-05T10:26:50Z) obtained via the NASA's \href{http://glovis.usgs.gov}{GloVis browser}} + \item{\code{LNCCOR6}}{a vector containing factors; \href{http://www.eea.europa.eu/data-and-maps/data/corine-land-cover-2006-raster-1}{Corine Land Cover 2006} classes} \item{\code{x}}{a numeric vector; x-coordinate (m) in DHDN / Gauss-Krueger zone 3 (German coordinate system)} \item{\code{y}}{a numeric vector; y-coordinate (m) in DHDN / Gauss-Krueger zone 3 (German coordinate system)} } @@ -39,22 +39,22 @@ The \code{eberg_grid25} data frame (regular grid at 25 m resolution) contains th \item{\code{DEMTOPx}}{a numeric vector; elevation values from the topographic map} \item{\code{HBTSOLx}}{a vector containing factors; main soil type according to the German soil classification system (see column "soiltype" above) estimated per crop field} \item{\code{TWITOPx}}{a numeric vector; Topographic Wetness Index derived using the SAGA algorithm } - \item{\code{NVILANx}}{a numeric vector; NDVI image derived using the Landsat image from the \href{https://ec.europa.eu/jrc/en}{Image 2000 project}} + \item{\code{NVILANx}}{a numeric vector; NDVI image derived using the Landsat image from the \href{http://image2000.jrc.ec.europa.eu/}{Image 2000 project}} \item{\code{x}}{a numeric vector; x-coordinate (m) in DHDN / Gauss-Krueger zone 3 (German coordinate system) } \item{\code{y}}{a numeric vector; y-coordinate (m) in DHDN / Gauss-Krueger zone 3 (German coordinate system) } } } -\author{The \enc{Ebergötzen}{Ebergoetzen} dataset is courtesy of Gehrt Ernst (\email{Ernst.Gehrt@niedersachsen.de}), the State Authority for Mining, Energy and Geology, Hannover, Germany and Olaf Conrad, University of Hamburg (\email{conrad@geowiss.uni-hamburg.de}). The original data set has been prepared for this exercise by Tomislav Hengl (\email{tom.hengl@opengeohub.org}).} +\author{The \enc{Ebergötzen}{Ebergoetzen} dataset is courtesy of Gehrt Ernst (\email{Ernst.Gehrt@niedersachsen.de}), the State Authority for Mining, Energy and Geology, Hannover, Germany and Olaf Conrad, University of Hamburg (\email{conrad@geowiss.uni-hamburg.de}). The original data set has been prepared for this exercise by Tomislav Hengl (\email{tom.hengl@wur.nl}).} \references{ \itemize{ -\item Ad-hoc-AG Boden, (2005) Bodenkundliche Kartieranleitung. 5th Ed, Bundesanstalt \enc{für}{fur} Geowissenschaften und Rohstoffe und Niedersaechsisches Landesamt \enc{für}{fur} Bodenforshung, Hannover, p. 423. -\item \enc{Böhner}{Boehner}, J., McCloy, K. R. and Strobl, J. (Eds), (2006) \href{http://www.saga-gis.org/}{SAGA --- Analysis and Modelling Applications}. \enc{Göttinger}{Goettinger} Geographische Abhandlungen, Heft 115. Verlag Erich Goltze GmbH, \enc{Göttingen}{Goettingen}, 117 pp. -\item Gehrt, E., \enc{Böhner}{Boehner}, J., (2001) Vom punkt zur flache --- probleme des 'upscaling' in der bodenkartierung. In: Diskussionsforum Bodenwissenschaften: Vom Bohrstock zum Bildschirm. FH, \enc{Osnabrück}{Osnabruck}, pp. 17-34. -\item Skaggs, T. H., Arya, L. M., Shouse, P. J., Mohanty, B. P., (2001) Estimating Particle-Size Distribution from Limited Soil Texture Data. Soil Science Society of America Journal 65 (4): 1038-1044. \doi{10.2136/sssaj2001.6541038x} -\item \url{http://geomorphometry.org/content/ebergotzen} +\item Ad-hoc-AG Boden, (2005) Bodenkundliche Kartieranleitung. 5th Ed, Bundesanstalt fur Geowissenschaften und Rohstoffe und \enc{Niedersächsisches}{Niedersaechsisches} Landesamt \enc{für}{fur} Bodenforshung, Hannover, p. 423. +\item \enc{Böhner}{Boehner}, J., McCloy, K. R. and Strobl, J. (Eds), (2006) \href{http://saga-gis.org/}{SAGA --- Analysis and Modelling Applications}. \enc{Göttinger}{Goettinger} Geographische Abhandlungen, Heft 115. Verlag Erich Goltze GmbH, \enc{Göttingen}{Goettingen}, 117 pp. +\item Gehrt, E., \enc{Böhner}{Boehner}, J., (2001) Vom punkt zur flache --- probleme des `upscaling' in der bodenkartierung. In: Diskussionsforum Bodenwissenschaften: Vom Bohrstock zum Bildschirm. FH, \enc{Osnabrück}{Osnabruck}, pp. 17-34. +\item Skaggs, T. H., Arya, L. M., Shouse, P. J., Mohanty, B. P., (2001) \href{https://www.soils.org/publications/sssaj/articles/65/4/1038}{Estimating Particle-Size Distribution from Limited Soil Texture Data}. Soil Science Society of America Journal 65 (4): 1038-1044. +\item \url{http://geomorphometry.org/content/ebergotzen} } } -\note{Texture by hand method can be used to determine the content of soil earth fractions only to an accuracy of \enc{±}{+-}5--10\% (Skaggs et al., 2001). A surveyor distinguishes to which of the 32 texture classes a soil samples belongs to, and then estimates the content of fractions; e.g. texture class \code{St2} has 10\% clay, 25\% silt and 65\% sand (Ad-hoc-AG Boden, 2005).} +\note{Texture by hand method can be used to determine the content of soil earth fractions only to an accuracy of \enc{±}{+-}5-10\% (\href{https://www.soils.org/publications/sssaj/articles/65/4/1038}{Skaggs et al. 2001}). A surveyor distinguishes to which of the 32 texture classes a soil samples belongs to, and then estimates the content of fractions; e.g. texture class \code{St2} has 10\% clay, 25\% silt and 65\% sand (Ad-hoc-AG Boden, 2005).} \examples{ data(eberg) data(eberg_grid) diff --git a/pkg/man/geopath.rd b/pkg/man/geopath.rd index 4337fcc..331833f 100644 --- a/pkg/man/geopath.rd +++ b/pkg/man/geopath.rd @@ -22,17 +22,17 @@ where \code{distc} is the Great Circle Distance.} \value{Bearing is expressed in degrees from north. Distance is expressed in kilometers (Great Circle Distance).} \references{ \itemize{ -\item fossil package (\url{https://CRAN.R-project.org/package=fossil}), +\item fossil package (\url{https://CRAN.R-project.org/package=fossil}) +\item Haversine formula from Math Forums (\url{http://mathforum.org/dr.math/}) } } \author{ Tomislav Hengl} \seealso{ \code{\link{kml_layer.SpatialLines}}, \code{\link{kml_layer.STTDF}}, \code{fossil::earth.bear}} \examples{ library(fossil) -ams.ny <- geopath(lon1=4.892222, lon2=-74.005973, - lat1=52.373056, lat2=40.714353, print.geo=TRUE) -kml.file = paste0(tempdir(), "/ams.ny.kml") +ams.ny <- geopath(lon1=4.892222, lon2=-74.005973, lat1=52.373056, lat2=40.714353, + print.geo=TRUE) # write to a file: -kml(ams.ny, file.name=kml.file) +kml(ams.ny) } \keyword{spatial} diff --git a/pkg/man/getCRS.Rd b/pkg/man/getCRS.Rd index 16ce398..a763e7f 100644 --- a/pkg/man/getCRS.Rd +++ b/pkg/man/getCRS.Rd @@ -14,7 +14,7 @@ \arguments{ \item{obj}{object of type \code{"Spatial"} or \code{"Raster"}} } -\details{For more details about the PROJ.4 parameters refer to the \url{https://proj4.org}.} +\details{For more details about the PROJ.4 parameters refer to the \href{http://proj4.org/parameters.html}{http://proj4.org}.} \author{ Tomislav Hengl and Pierre Roudier} \seealso{ \code{sp::CRS}, \code{raster::raster}, \code{\link{check_projection}} } diff --git a/pkg/man/getWikimedia.Rd b/pkg/man/getWikimedia.Rd index 2df5870..4d929dd 100644 --- a/pkg/man/getWikimedia.Rd +++ b/pkg/man/getWikimedia.Rd @@ -2,7 +2,7 @@ \alias{getWikiMedia.ImageInfo} \title{Gets EXIF information} \description{ -\code{getWikiMedia.ImageInfo} function fetches the EXIF (Exchangeable image file format) data via the \href{https://www.mediawiki.org/wiki/API}{Wikimedia API} for any donated image. The resulting EXIF data (named list) can then be further used to construct an object of class \code{"SpatialPhotoOverlay"}, which can be parsed to KML. +\code{getWikiMedia.ImageInfo} function fetches the EXIF (Exchangeable image file format) data via the \href{http://www.mediawiki.org/wiki/API}{Wikimedia API} for any donated image. The resulting EXIF data (named list) can then be further used to construct an object of class \code{"SpatialPhotoOverlay"}, which can be parsed to KML. } \usage{getWikiMedia.ImageInfo(imagename, APIsource = "https://commons.wikimedia.org/w/api.php", @@ -16,18 +16,19 @@ \item{details}{detailed parameters of interest} \item{testURL}{logical; species if the program should first test whether the image exist at all (recommended)} } -\details{Although this is often not visible in picture editing programs, almost any image uploaded to Wikimedia contains usefull EXIF metadata. However, it is highly recommended that you insert the some important tags in the image header yourself, by using e.g. the \href{https://exiftool.org/}{EXIF tool} (courtesy of Phil Harvey), before uploading the files to Wikimedia. The \code{getWikiMedia.ImageInfo} function assumes that all required metadata has already been entered by the user before the upload, hence no further changes in the metadata will be possible. Examples of how to embed EXIF tags into an image file are available \href{https://commons.wikimedia.org/wiki/Commons:EXIF}{here}.\cr +\details{Although this is often not visible in picture editing programs, almost any image uploaded to Wikimedia contains usefull EXIF metadata. However, it is highly recommended that you insert the some important tags in the image header yourself, by using e.g. the \href{http://www.sno.phy.queensu.ca/~phil/exiftool/}{EXIF tool} (courtesy of Phil Harvey), before uploading the files to Wikimedia. The \code{getWikiMedia.ImageInfo} function assumes that all required metadata has already been entered by the user before the upload, hence no further changes in the metadata will be possible. Examples of how to embed EXIF tags into an image file are available \href{http://commons.wikimedia.org/wiki/Commons:EXIF}{here}.\cr To geocode an uploaded image consider adding:\cr \code{{{location|lat deg|lat min|lat sec|NS|long deg|long min|long sec|EW}}} \cr tag to the file description, in which case \code{getWikiMedia.ImageInfo} will automatically look for the attached coordinates via the external links. For practical purposes and because the image properties information determined by the Wikimedia system can are more reliable, the function will rewrite some important EXIF metadata (image width and height) using the actual values determined by Wikimedia server.\cr -For a list of modules and parameters that can be used via \code{getWikiMedia.ImageInfo}, please refer to \href{https://www.mediawiki.org/wiki/API}{Wikimedia API manual}. +For a list of modules and parameters that can be used via \code{getWikiMedia.ImageInfo}, please refer to \href{http://www.mediawiki.org/wiki/API}{Wikimedia API manual}. } \references{ \itemize{ -\item Wikimedia API (\url{https://www.mediawiki.org/wiki/API}) -\item EXIF tool (\url{https://exiftool.org/}) +\item Wikimedia API (\url{http://www.mediawiki.org/wiki/API}) +\item EXIF tool (\url{http://www.sno.phy.queensu.ca/~phil/exiftool/}) +\item EXIF Tags (\url{http://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/EXIF.html}) } } \author{Tomislav Hengl } diff --git a/pkg/man/gpxbtour.Rd b/pkg/man/gpxbtour.Rd index a54f9e5..e17c42c 100644 --- a/pkg/man/gpxbtour.Rd +++ b/pkg/man/gpxbtour.Rd @@ -4,7 +4,7 @@ \alias{gpxbtour} \alias{trajectory} \title{GPS log of a bike tour} -\description{GPS log of a bike tour from Wageningen (the Netherlands) to \enc{Münster}{Muenster} (Germany). The table contains 3228 records of GPS locations, speed and elevation.} +\description{GPS log of a bike tour from Wageningen (the Netherlands) to \enc{Münster}{Muenster} (Germany). The table contains 3228 records of GPS locations, speed and elevation.} \format{ The data frame contains the following columns: \describe{ @@ -17,7 +17,7 @@ } \usage{data(gpxbtour)} \author{ Tomislav Hengl } -\note{ The log was produced using the GlobalSat GH-615 GPS watch. The original data log (trackpoints) was first saved to GPX exchange format (\url{https://www.topografix.com/gpx.asp}) and then imported to R using the XML package and formatted to a data frame. +\note{ The log was produced using the GlobalSat GH-615 GPS watch. The original data log (trackpoints) was first saved to GPX exchange format (\url{http://www.topografix.com/gpx.asp}) and then imported to R using the XML package and formatted to a data frame. } \examples{ \dontrun{## load the data: @@ -29,7 +29,7 @@ coordinates(gpxbtour) <- ~lon+lat proj4string(gpxbtour) <- CRS("+proj=longlat +datum=WGS84") ## convert to a STTDF class: library(spacetime) -library(adehabitatLT) +library(adehabitat) gpx.ltraj <- as.ltraj(coordinates(gpxbtour), gpxbtour$ctime, id = "th") gpx.st <- as(gpx.ltraj, "STTDF") ## Google maps plot: diff --git a/pkg/man/kml.tiles.Rd b/pkg/man/kml.tiles.Rd index 17d02bc..8848cce 100644 --- a/pkg/man/kml.tiles.Rd +++ b/pkg/man/kml.tiles.Rd @@ -1,49 +1,49 @@ -\name{kml.tiles} -\alias{kml.tiles} -\title{Write vector object as tiled KML} -\description{Writes vector object as tiled KML. Suitable for plotting large vectors i.e. large spatial data sets.} -\usage{ -kml.tiles(obj, folder.name, file.name, - block.x, kml.logo, cpus, home.url=".", desc=NULL, - open.kml=TRUE, return.list=FALSE, \dots) -} -\arguments{ - \item{obj}{\code{"SpatialPoints*"} or \code{"SpatialLines*"} or \code{"SpatialPolygons*"}; vector layer} - \item{folder.name}{character; KML folder name} - \item{file.name}{character; output KML file name} - \item{block.x}{numeric; size of block in decimal degrees (geographical coordinates)} - \item{kml.logo}{character; optional project logo file (PNG)} - \item{cpus}{integer; specifies number of CPUs to be used by the snowfall package to speed things up} - \item{home.url}{character; optional web-directory where the PNGs will be stored} - \item{desc}{character; optional layer description} - \item{open.kml}{logical; specifies whether to open the KML file after writing} - \item{return.list}{logical; specifies whether to return list of tiled objects} - \item{\dots}{(optional) \link{aesthetics} arguments (see \code{\link{aesthetics}})} -} -\value{Returns a list of KML files.} -\note{This operation can be time-consuming for processing very large vectors. To speed up writing of KMLs, use the snowfall package.} -\author{Tomislav Hengl } -\seealso{\code{\link{plotKML}}, \code{\link{plotKML.GDALobj}}} -\examples{ -\dontrun{ -library(sp) -library(snowfall) -library(landmap) -library(rgdal) - -data(eberg) -coordinates(eberg) <- ~X+Y -proj4string(eberg) <- CRS("+init=epsg:31467") -## plot using tiles: -shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" -tiles.p <- kml.tiles(eberg["SNDMHT_A"], block.x=0.05, - size=0.8, z.lim=c(20,50), colour=SNDMHT_A, shape=shape, - labels=SNDMHT_A, return.list=TRUE) -## Returns a list of tiles -data(eberg_contours) -tiles.l <- kml.tiles(eberg_contours, block.x=0.05, - colour=Z, z.lim=range(eberg_contours$Z), - colour_scale=SAGA_pal[[1]], return.list=TRUE) -} -} +\name{kml.tiles} +\alias{kml.tiles} +\title{Write vector object as tiled KML} +\description{Writes vector object as tiled KML. Suitable for plotting large vectors i.e. large spatial data sets.} +\usage{ +kml.tiles(obj, folder.name, file.name, + block.x, kml.logo, cpus, home.url=".", desc=NULL, + open.kml=TRUE, return.list=FALSE, \dots) +} +\arguments{ + \item{obj}{\code{"SpatialPoints*"} or \code{"SpatialLines*"} or \code{"SpatialPolygons*"}; vector layer} + \item{folder.name}{character; KML folder name} + \item{file.name}{character; output KML file name} + \item{block.x}{numeric; size of block in decimal degrees (geographical coordinates)} + \item{kml.logo}{character; optional project logo file (PNG)} + \item{cpus}{integer; specifies number of CPUs to be used by the snowfall package to speed things up} + \item{home.url}{character; optional web-directory where the PNGs will be stored} + \item{desc}{character; optional layer description} + \item{open.kml}{logical; specifies whether to open the KML file after writing} + \item{return.list}{logical; specifies whether to return list of tiled objects} + \item{\dots}{(optional) \link{aesthetics} arguments (see \code{\link{aesthetics}})} +} +\value{Returns a list of KML files.} +\note{This operation can be time-consuming for processing very large vectors. To speed up writing of KMLs, use the snowfall package.} +\author{Tomislav Hengl } +\seealso{\code{\link{plotKML}}, \code{\link{plotKML.GDALobj}}} +\examples{ +\dontrun{ +library(sp) +library(snowfall) +library(GSIF) +library(rgdal) + +data(eberg) +coordinates(eberg) <- ~X+Y +proj4string(eberg) <- CRS("+init=epsg:31467") +## plot using tiles: +shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" +tiles.p <- kml.tiles(eberg["SNDMHT_A"], block.x=0.05, + size=0.8, z.lim=c(20,50), colour=SNDMHT_A, shape=shape, + labels=SNDMHT_A, return.list=TRUE) +## Returns a list of tiles +data(eberg_contours) +tiles.l <- kml.tiles(eberg_contours, block.x=0.05, + colour=Z, z.lim=range(eberg_contours$Z), + colour_scale=SAGA_pal[[1]], return.list=TRUE) +} +} \keyword{spatial} \ No newline at end of file diff --git a/pkg/man/kml_compress.Rd b/pkg/man/kml_compress.Rd index 87423c3..ae542ba 100644 --- a/pkg/man/kml_compress.Rd +++ b/pkg/man/kml_compress.Rd @@ -14,7 +14,7 @@ kml_compress(file.name, zip = "", files = "", rm = FALSE, \dots) } \references{ \itemize{ -\item KMZ description (\url{https://developers.google.com/kml/documentation/?csw=1}) +\item KMZ description (\url{http://code.google.com/apis/kml/documentation/}) } } \author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} @@ -33,12 +33,11 @@ library(rgdal) library(raster) coordinates(eberg) <- ~X+Y proj4string(eberg) <- CRS("+init=epsg:31467") -kml.file = paste0(tempdir(), "/eberg.kml") -kml_open(kml.file) +kml_open("eberg.kml") kml_layer(eberg, colour = CLYMHT_A) -kml_close(kml.file) +kml_close("eberg.kml") # compress: -kml_compress(kml.file) +kml_compress("eberg.kml") } \keyword{utilities} diff --git a/pkg/man/kml_layer.Rd b/pkg/man/kml_layer.Rd index 2e11be3..f910f1d 100644 --- a/pkg/man/kml_layer.Rd +++ b/pkg/man/kml_layer.Rd @@ -1,85 +1,60 @@ -\name{kml_layer-methods} -\docType{methods} -\alias{kml_layer} -\alias{kml_alpha} -\alias{kml_altitude} -\alias{kml_altitude_mode} -\alias{kml_colour} -\alias{kml_shape} -\alias{kml_size} -\alias{kml_layer,RasterBrick-method} -\alias{kml_layer,RasterLayer-method} -\alias{kml_layer,RasterStack-method} -\alias{kml_layer,STIDF-method} -\alias{kml_layer,STFDF-method} -\alias{kml_layer,STSDF-method} -\alias{kml_layer,STTDF-method} -\alias{kml_layer,SoilProfileCollection-method} -\alias{kml_layer,SpatialGrid-method} -\alias{kml_layer,SpatialLines-method} -\alias{kml_layer,SpatialPhotoOverlay-method} -\alias{kml_layer,SpatialPixels-method} -\alias{kml_layer,SpatialPoints-method} -\alias{kml_layer,SpatialPolygons-method} -\alias{kml_layer,sfc_POINT-method} -\alias{kml_layer,sfc_MULTIPOINT-method} -\alias{kml_layer,sfc_LINESTRING-method} -\alias{kml_layer,sfc_MULTILINESTRING-method} -\alias{kml_layer,sfc_POLYGON-method} -\alias{kml_layer,sfc_MULTIPOLYGON-method} -\alias{kml_layer,sf-method} -\title{Write objects to a KML connection} -\description{ -Writes any \code{Spatial*} object (from the sp package), \code{sfc_*} or \code{sf} object (from the sf package), spatio-temporal object (from the \code{\link[spacetime]{ST-class}} package) or \code{Raster*} object (from the raster package) to a KML file (connection) as a separate layer. Various \emph{aesthetics}, i.e. ways to represent target variables, can be set via colour, transparency, size, width, shape arguments. Their availability depends on the class of the object to plot. -} -\usage{ -kml_layer(obj, \dots) -} -\arguments{ - \item{obj}{object inheriting from the \code{Spatial*} or the \code{Raster*} classes} - \item{\dots}{additional aesthetics arguments; see details for each \code{kml_layer} function and the \code{kml_aes} function} -} -\value{An XML object that can be further parsed to a KML file (via an open connection).} -\author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} -\seealso{ -\code{\link{kml_layer.SpatialPoints}}, \code{\link{kml_layer.Raster}}, \code{\link{kml_layer.SpatialLines}}, \code{\link{kml_layer.SpatialPolygons}}, \code{\link{kml_layer.STIDF}}, \code{\link{kml_layer.STTDF}}, \code{\link{kml_layer.SoilProfileCollection}}, \code{\link{kml-methods}}, \code{\link{kml_open}}, \code{\link{kml_close}} -} -\examples{ -library(rgdal) -data(eberg_grid) -library(sp) -library(raster) -gridded(eberg_grid) <- ~x+y -proj4string(eberg_grid) <- CRS("+init=epsg:31467") -data(SAGA_pal) -data(R_pal) -\dontrun{# Plot two layers one after the other: -kml_open("eberg_grids.kml") -kml_layer(eberg_grid, colour=DEMSRT6, colour_scale=R_pal[["terrain_colors"]]) -kml_layer(eberg_grid, colour=TWISRT6, colour_scale=SAGA_pal[[1]]) -kml_close("eberg_grids.kml") -# print the result: -library(XML) -xmlRoot(xmlTreeParse("eberg_grids.kml"))[["Document"]] -} - -# examples with sf -eberg_grid_sf <- sf::st_as_sf(eberg_grid) - -# sfc objects -\dontrun{ -kml_open("eberg_grids.kml") -kml_layer(st_geometry(eberg_grid_sf)) -kml_close("eberg_grids.kml") -} - -# sf objects -\dontrun{ -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") -} -} -\keyword{spatial} -\keyword{methods} +\name{kml_layer-methods} +\docType{methods} +\alias{kml_layer} +\alias{kml_alpha} +\alias{kml_altitude} +\alias{kml_altitude_mode} +\alias{kml_colour} +\alias{kml_shape} +\alias{kml_size} +\alias{kml_layer,RasterBrick-method} +\alias{kml_layer,RasterLayer-method} +\alias{kml_layer,RasterStack-method} +\alias{kml_layer,STIDF-method} +\alias{kml_layer,STFDF-method} +\alias{kml_layer,STSDF-method} +\alias{kml_layer,STTDF-method} +\alias{kml_layer,SoilProfileCollection-method} +\alias{kml_layer,SpatialGrid-method} +\alias{kml_layer,SpatialLines-method} +\alias{kml_layer,SpatialPhotoOverlay-method} +\alias{kml_layer,SpatialPixels-method} +\alias{kml_layer,SpatialPoints-method} +\alias{kml_layer,SpatialPolygons-method} +\title{Write objects to a KML connection} +\description{ +Writes any \code{Spatial*} object (from the sp package), spatio-temporal object (from the \code{\link[spacetime]{ST-class}} package) or \code{Raster*} object (from the raster package) to a KML file (connection) as a separate layer. Various \emph{aesthetics}, i.e. ways to represent target variables, can be set via colour, transparency, size, width, shape arguments. Their availability depends on the class of the object to plot. +} +\usage{ +kml_layer(obj, \dots) +} +\arguments{ + \item{obj}{object inheriting from the \code{Spatial*} or the \code{Raster*} classes} + \item{\dots}{additional aesthetics arguments; see details for each \code{kml_layer} function and the \code{kml_aes} function} +} +\value{An XML object that can be further parsed to a KML file (via an open connection).} +\author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} +\seealso{ +\code{\link{kml_layer.SpatialPoints}}, \code{\link{kml_layer.Raster}}, \code{\link{kml_layer.SpatialLines}}, \code{\link{kml_layer.SpatialPolygons}}, \code{\link{kml_layer.STIDF}}, \code{\link{kml_layer.STTDF}}, \code{\link{kml_layer.SoilProfileCollection}}, \code{\link{kml-methods}}, \code{\link{kml_open}}, \code{\link{kml_close}} +} +\examples{ +library(rgdal) +data(eberg_grid) +library(sp) +library(raster) +gridded(eberg_grid) <- ~x+y +proj4string(eberg_grid) <- CRS("+init=epsg:31467") +data(SAGA_pal) +data(R_pal) +\dontrun{# Plot two layers one after the other: +kml_open("eberg_grids.kml") +kml_layer(eberg_grid, colour=DEMSRT6, colour_scale=R_pal[["terrain_colors"]]) +kml_layer(eberg_grid, colour=TWISRT6, colour_scale=SAGA_pal[[1]]) +kml_close("eberg_grids.kml") +# print the result: +library(XML) +xmlRoot(xmlTreeParse("eberg_grids.kml"))[["Document"]] +} +} +\keyword{spatial} +\keyword{methods} diff --git a/pkg/man/kml_legend.bar.Rd b/pkg/man/kml_legend.bar.Rd index ee95f6f..72f20b7 100644 --- a/pkg/man/kml_legend.bar.Rd +++ b/pkg/man/kml_legend.bar.Rd @@ -4,7 +4,7 @@ \description{Produces a PNG file that can be used as a screen overlay --- legend bar for numeric and factor type variables.} \usage{ kml_legend.bar(x, width, height, pointsize = 14, legend.file, legend.pal, - z.lim = range(x, na.rm=TRUE, finite=TRUE), factor.labels, png.type) + z.lim = range(x, na.rm=TRUE, finite=TRUE), factor.labels, png.type = "cairo-png") } \arguments{ \item{x}{numeric or factor-type vector} diff --git a/pkg/man/kml_open.Rd b/pkg/man/kml_open.Rd index dd5e13d..c3a835d 100644 --- a/pkg/man/kml_open.Rd +++ b/pkg/man/kml_open.Rd @@ -1,28 +1,30 @@ -\name{kml_open} -\alias{kml_open} -\alias{kml_close} -\alias{kml_View} -\title{Open / close a KML file connection} -\description{Opens a KML file in write mode and initiates the KML header. The same file connection is further accessible by other \code{kml_*()} functions such as \code{kml_layer()} and \code{kml_close()}. \code{kml_View} tries to open the produced file using the default application.} -\usage{ -kml_open(file.name, folder.name = file.name, kml_open = TRUE, - kml_visibility = TRUE, overwrite = TRUE, use.Google_gx = FALSE, - kml_xsd = get("kml_xsd", envir = plotKML.opts), - xmlns = get("kml_url", envir = plotKML.opts), - xmlns_gx = get("kml_gx", envir = plotKML.opts)) -} -\arguments{ - \item{file.name}{KML file name} - \item{folder.name}{character string; KML folder name} - \item{kml_open}{logical; specify whether to open the folder by default} - \item{kml_visibility}{logical; specify whether to make the whole folder visible} - \item{overwrite}{logical; if TRUE, "name" will be overwritten if it exists} - \item{use.Google_gx}{logical; specify whether to use the Google's extended schema} - \item{kml_xsd}{URL of the KML scheme to be used} - \item{xmlns}{URL of the OGC KML standard} - \item{xmlns_gx}{URL of the extended standard} -} -\author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} -\details{These lower level functions can be used to create customized multi-layered KML files. See plotKML package homepage / manual for more examples.} -\seealso{ \code{\link{plotKML-method}}, \code{\link{kml_layer}}, \code{\link{kml-methods}} } -\keyword{spatial} \ No newline at end of file +\name{kml_open} +\alias{kml_open} +\alias{kml_close} +\alias{kml_View} +\title{Open / close a KML file connection} +\description{Opens a KML file in write mode and initiates the KML header. The same file connection is further accessible by other \code{kml_*()} functions such as \code{kml_layer()} and \code{kml_close()}. \code{kml_View} tries to open the produced file using the default application.} +\usage{ +kml_open(file.name, folder.name = file.name, kml_open = TRUE, + kml_visibility = TRUE, overwrite = TRUE, use.Google_gx = FALSE, + kml_xsd = get("kml_xsd", envir = plotKML.opts), + xmlns = get("kml_url", envir = plotKML.opts), + xmlns_gx = get("kml_gx", envir = plotKML.opts)) +} +\arguments{ + \item{file.name}{KML file name} + \item{folder.name}{character string; KML folder name} + \item{kml_open}{logical; specify whether to open the folder by default} + \item{kml_visibility}{logical; specify whether to make the whole folder visible} + \item{overwrite}{logical; if TRUE, "name" will be overwritten if it exists} + \item{use.Google_gx}{logical; specify whether to use the Google's extended schema} + \item{kml_xsd}{URL of the KML scheme to be used} + \item{xmlns}{URL of the OGC KML standard} + \item{xmlns_gx}{URL of the extended standard} + \item{\dots}{other arguments} +} +\author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} +\details{These lower level functions can be used to create customized multi-layered KML files. See plotKML package homepage / manual for more examples.} +\seealso{ \code{\link{plotKML-method}}, \code{\link{kml_layer}}, \code{\link{kml-methods}} } +\keyword{spatial} + diff --git a/pkg/man/kml_screen.Rd b/pkg/man/kml_screen.Rd index b051484..4a2784f 100644 --- a/pkg/man/kml_screen.Rd +++ b/pkg/man/kml_screen.Rd @@ -22,7 +22,7 @@ kml_screen(image.file, sname = "", \note{The function, by default, calculates with fractions. If you change the \code{xyunits} type, all other elements need to be expressed in the same units.} \references{ \itemize{ -\item KML Reference (\url{https://developers.google.com/kml/documentation/?csw=1}) +\item KML Reference (\url{http://code.google.com/apis/kml/documentation/}) } } \author{ Tomislav Hengl } diff --git a/pkg/man/layer.Raster.Rd b/pkg/man/layer.Raster.Rd index 46d69e9..0def859 100644 --- a/pkg/man/layer.Raster.Rd +++ b/pkg/man/layer.Raster.Rd @@ -8,7 +8,7 @@ kml_layer.Raster(obj, subfolder.name = paste(class(obj)), plot.legend = TRUE, metadata = NULL, raster_name, png.width = ncol(obj), png.height = nrow(obj), min.png.width = 800, TimeSpan.begin, TimeSpan.end, - layer.name, png.type, \dots) + layer.name, png.type = "cairo-png", \dots) } \arguments{ \item{obj}{object of class \code{"RasterLayer"}, \code{"SpatialPixelsDataFrame"} or \code{"SpatialGridDataFrame"}} @@ -25,7 +25,7 @@ kml_layer.Raster(obj, subfolder.name = paste(class(obj)), plot.legend = TRUE, \item{png.type}{character; PNG type} \item{\dots}{additional \code{\link{aesthetics}} arguments} } -\details{Google Earth does not properly handle a 24-bit PNG file which has a single transparent color (read more at \href{https://groups.google.com/d/forum/earth-help}{Google Earth Help}). To force transparency, plotKML will try to set it using the \code{-matte -transparent "\#FFFFFF"} option in the \href{https://legacy.imagemagick.org/Usage/masking/}{ImageMagick convert program} (ImageMagick needs to be installed separately and located using \code{plotKML.env()}). On some Unix run machines the \code{png.type} argument has to be set manually to avoid producing empty PNGs. +\details{Google Earth does not properly handle a 24-bit PNG file which has a single transparent color (read more at \href{http://groups.google.com/group/earth-help/}{Google Earth Help}). To force transparency, plotKML will try to set it using the \code{-matte -transparent "\#FFFFFF"} option in the \href{http://www.imagemagick.org/Usage/masking/}{ImageMagick convert program} (ImageMagick needs to be installed separately and located using \code{plotKML.env()}). On some Unix run machines the \code{png.type} argument has to be set manually to avoid producing empty PNGs. } \author{Tomislav Hengl, Pierre Roudier and Dylan Beaudette} \seealso{ \code{\link{kml-methods}}, \code{\link{kml_open}}, \code{\link{kml_layer.RasterBrick}}, \code{\link{plotKML-method}} } diff --git a/pkg/man/layer.RasterBrick.Rd b/pkg/man/layer.RasterBrick.Rd index f882491..04d6985 100644 --- a/pkg/man/layer.RasterBrick.Rd +++ b/pkg/man/layer.RasterBrick.Rd @@ -10,7 +10,7 @@ kml_layer.RasterBrick(obj, plot.legend = TRUE, dtime = "", tz = "GMT", home_url = get("home_url", envir = plotKML.opts), metadata = NULL, html.table = NULL, altitudeMode = "clampToGround", balloon = FALSE, - png.width, png.height, min.png.width = 800, png.type, \dots) + png.width, png.height, min.png.width = 800, png.type = "cairo-png", \dots) } \arguments{ \item{obj}{object of class \code{"RasterBrick"} (e.g. a time series of images)} diff --git a/pkg/man/layer.STIDF.Rd b/pkg/man/layer.STIDF.Rd index c0cda88..806c8f6 100644 --- a/pkg/man/layer.STIDF.Rd +++ b/pkg/man/layer.STIDF.Rd @@ -18,7 +18,7 @@ kml_layer.STIDF(obj, dtime, \dots) \code{yyyy-mm-ddThh:mm:sszzzzzz}\cr -where \code{T} is the separator between the date and the time, and the time zone is either \code{Z} (for UTC) or \code{zzzzzz}, which represents \enc{±}{+-}hh:mm in relation to UTC. For more info on how Time Stamps work see \url{https://developers.google.com/kml/documentation/kml_tut}. If the time is measured at block support, then:\cr +where \code{T} is the separator between the date and the time, and the time zone is either \code{Z} (for UTC) or \code{zzzzzz}, which represents \enc{?}{+-}hh:mm in relation to UTC. For more info on how Time Stamps work see \url{http://kml-samples.googlecode.com}. If the time is measured at block support, then:\cr \code{ }\cr @@ -26,11 +26,11 @@ tags will be inserted. Temporal support for any spacetime class, if not specifie } \references{ \itemize{ -\item Pebesma, E. (2012) \href{https://www.jstatsoft.org/v51/i07}{Classes and Methods for Spatio-Temporal Data in R}. Journal of Statistical Software. 51(7): 1-30. +\item Pebesma, E. (2012) \href{http://www.jstatsoft.org/v51/i07}{Classes and Methods for Spatio-Temporal Data in R}. Journal of Statistical Software. 51(7): 1-30. \item spacetime package (\url{https://CRAN.R-project.org/package=spacetime}) } } -\author{Tomislav Hengl and Benedikt Graeler} +\author{Tomislav Hengl and Benedikt \enc{Gr?ler}{Graeler}} \seealso{ \code{\link{kml_layer.STTDF}}, \code{\link{plotKML-method}} } \examples{ \dontrun{ diff --git a/pkg/man/layer.STTDF.Rd b/pkg/man/layer.STTDF.Rd index 498e658..3270ac0 100644 --- a/pkg/man/layer.STTDF.Rd +++ b/pkg/man/layer.STTDF.Rd @@ -28,7 +28,7 @@ kml_layer.STTDF(obj, id.name = names(obj@data)[which(names(obj@data)== "burst")] \item{html.table}{optional description block (html) for each GPS point (vertices)} \item{\dots}{other optional arguments} } -\details{The dateTime is defined as \code{yyyy-mm-ddThh:mm:sszzzzzz}, where \code{T} is the separator between the date and the time, and the time zone is either \code{Z} (for UTC) or \code{zzzzzz}, which represents \enc{±}{+-}hh:mm in relation to UTC. For more info on how Time Stamps work see \url{https://developers.google.com/kml/documentation/kml_tut}. If the time is measured at block support, then:\cr +\details{The dateTime is defined as \code{yyyy-mm-ddThh:mm:sszzzzzz}, where \code{T} is the separator between the date and the time, and the time zone is either \code{Z} (for UTC) or \code{zzzzzz}, which represents \enc{?}{+-}hh:mm in relation to UTC. For more info on how Time Stamps work see \url{http://kml-samples.googlecode.com}. If the time is measured at block support, then:\cr \code{ } \cr @@ -36,7 +36,7 @@ tags will be inserted. Temporal support for any spacetime class, if not specifie } \references{ \itemize{ -\item \item Pebesma, E. (2012) \href{https://www.jstatsoft.org/v51/i07}{Classes and Methods for Spatio-Temporal Data in R}. Journal of Statistical Software. 51(7): 1-30. +\item \item Pebesma, E. (2012) \href{http://www.jstatsoft.org/v51/i07}{Classes and Methods for Spatio-Temporal Data in R}. Journal of Statistical Software. 51(7): 1-30. \item spacetime package (\url{https://CRAN.R-project.org/package=spacetime}) } } diff --git a/pkg/man/layer.SpatialLines.Rd b/pkg/man/layer.SpatialLines.Rd index 4379cb7..bbf7f39 100644 --- a/pkg/man/layer.SpatialLines.Rd +++ b/pkg/man/layer.SpatialLines.Rd @@ -27,17 +27,13 @@ Use the same time values for both \code{TimeSpan.begin} and \code{TimeSpan.end} \author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} \seealso{ \code{\link{kml-methods}}, \code{\link{kml_open}}, \code{\link{kml_layer.SpatialPolygons}}, \code{\link{plotKML-method}} } \examples{ -\donttest{ library(rgdal) library(sp) data(eberg_contours) data(SAGA_pal) names(eberg_contours) # KML plot with elevations used as 'colour' argument: -kml.file = paste0(tempdir(), "/eberg_contours.kml") -kml(eberg_contours, file.name = kml.file, - colour_scale = SAGA_pal[[1]], colour = Z) -} +kml(eberg_contours, colour_scale = SAGA_pal[[1]], colour = Z, kmz = TRUE) } \keyword{spatial} diff --git a/pkg/man/layer.SpatialPhotoOverlay.Rd b/pkg/man/layer.SpatialPhotoOverlay.Rd index 3bf91aa..4642b76 100644 --- a/pkg/man/layer.SpatialPhotoOverlay.Rd +++ b/pkg/man/layer.SpatialPhotoOverlay.Rd @@ -44,7 +44,7 @@ kml_layer.SpatialPhotoOverlay(obj, method = c("PhotoOverlay", "monolith")[1], } \references{ \itemize{ -\item KML Reference (\url{https://developers.google.com/kml/documentation/kmlreference?csw=1}) +\item KML Reference (\url{http://code.google.com/apis/kml/documentation/kmlreference.html}) \item COLLADA Reference (\url{https://www.khronos.org/collada/}) } } diff --git a/pkg/man/layer.SpatialPixels.Rd b/pkg/man/layer.SpatialPixels.Rd index bf66fcc..887d938 100644 --- a/pkg/man/layer.SpatialPixels.Rd +++ b/pkg/man/layer.SpatialPixels.Rd @@ -1,49 +1,49 @@ -\name{kml_layer.SpatialPixels} -\alias{kml_layer.SpatialPixels} -\alias{SpatialPixels} -\title{Writes SpatialPixels or SpatialGrid objects to KML} -\description{Writes sp classes \code{"SpatialGrid"} or \code{"SpatialPixels"} to PNG images and makes a KML document (ground overlays). Target attributes can be specified using aesthetics arguments (e.g. \code{"colour"}).} -\usage{ -kml_layer.SpatialPixels(obj, subfolder.name = paste(class(obj)), raster_name, - plot.legend = TRUE, metadata = NULL, - png.width = gridparameters(obj)[1,"cells.dim"], - png.height = gridparameters(obj)[2,"cells.dim"], - min.png.width = 800, TimeSpan.begin, TimeSpan.end, - layer.name, png.type, \dots) -} -\arguments{ - \item{obj}{object of class \code{"RasterLayer"}, \code{"SpatialPixelsDataFrame"} or \code{"SpatialGridDataFrame"}} - \item{subfolder.name}{character; optional subfolder name} - \item{plot.legend}{logical; specify whether a map legend should be generated automatically} - \item{metadata}{(optional) specify the metadata object} - \item{raster_name}{(optional) specify the output file name (PNG)} - \item{png.width}{(optional) width of the PNG file} - \item{png.height}{(optional) height of the PNG file} - \item{min.png.width}{(optional) minimum width of the PNG file} - \item{TimeSpan.begin}{object of class \code{"POSIXct"}; (optional) begin of the sampling period} - \item{TimeSpan.end}{object of class \code{"POSIXct"}; (optional) end of the sampling period} - \item{layer.name}{character; optional layer name} - \item{png.type}{character; PNG type} - \item{\dots}{additional \code{\link{aesthetics}} arguments} -} -\details{Google Earth does not properly handle a 24-bit PNG file which has a single transparent color (read more at \href{https://groups.google.com/d/forum/earth-help}{Google Earth Help}). To force transparency, plotKML will try to set it using the \code{-matte -transparent "\#FFFFFF"} option in the \href{https://legacy.imagemagick.org/Usage/masking/}{ImageMagick convert program} (ImageMagick needs to be installed separately and located using \code{plotKML.env()}). The PNG export uses the 'cairographics', which will never use a palette and normally creates a larger 32-bit ARGB file, but then always allows transparancy. On some Unix run machines the \code{png.type} argument has to be set manually to avoid producing empty PNGs. -} -\author{Tomislav Hengl, Pierre Roudier and Dylan Beaudette} -\seealso{ \code{\link{kml-methods}}, \code{\link{kml_open}}, \code{\link{kml_layer.Raster}}, \code{\link{plotKML-method}} } -\examples{ -data(eberg_grid) -library(sp) -library(rgdal) -library(raster) -coordinates(eberg_grid) <- ~x+y -gridded(eberg_grid) <- TRUE -proj4string(eberg_grid) <- CRS("+init=epsg:31467") -data(SAGA_pal) -\dontrun{## KML plot with a single raster: -kml(eberg_grid, colour_scale = SAGA_pal[[1]], colour = TWISRT6) -## make a larger image: -kml(eberg_grid, colour_scale = SAGA_pal[[1]], colour = TWISRT6, - png.width = 600, png.height = 600) -} -} -\keyword{spatial} +\name{kml_layer.SpatialPixels} +\alias{kml_layer.SpatialPixels} +\alias{SpatialPixels} +\title{Writes SpatialPixels or SpatialGrid objects to KML} +\description{Writes sp classes \code{"SpatialGrid"} or \code{"SpatialPixels"} to PNG images and makes a KML document (ground overlays). Target attributes can be specified using aesthetics arguments (e.g. \code{"colour"}).} +\usage{ +kml_layer.SpatialPixels(obj, subfolder.name = paste(class(obj)), raster_name, + plot.legend = TRUE, metadata = NULL, + png.width = gridparameters(obj)[1,"cells.dim"], + png.height = gridparameters(obj)[2,"cells.dim"], + min.png.width = 800, TimeSpan.begin, TimeSpan.end, + layer.name, png.type = "cairo-png", \dots) +} +\arguments{ + \item{obj}{object of class \code{"RasterLayer"}, \code{"SpatialPixelsDataFrame"} or \code{"SpatialGridDataFrame"}} + \item{subfolder.name}{character; optional subfolder name} + \item{plot.legend}{logical; specify whether a map legend should be generated automatically} + \item{metadata}{(optional) specify the metadata object} + \item{raster_name}{(optional) specify the output file name (PNG)} + \item{png.width}{(optional) width of the PNG file} + \item{png.height}{(optional) height of the PNG file} + \item{min.png.width}{(optional) minimum width of the PNG file} + \item{TimeSpan.begin}{object of class \code{"POSIXct"}; (optional) begin of the sampling period} + \item{TimeSpan.end}{object of class \code{"POSIXct"}; (optional) end of the sampling period} + \item{layer.name}{character; optional layer name} + \item{png.type}{character; PNG type} + \item{\dots}{additional \code{\link{aesthetics}} arguments} +} +\details{Google Earth does not properly handle a 24-bit PNG file which has a single transparent color (read more at \href{http://groups.google.com/group/earth-help/}{Google Earth Help}). To force transparency, plotKML will try to set it using the \code{-matte -transparent "\#FFFFFF"} option in the \href{http://www.imagemagick.org/Usage/masking/}{ImageMagick convert program} (ImageMagick needs to be installed separately and located using \code{plotKML.env()}). The PNG export uses the 'cairographics', which will never use a palette and normally creates a larger 32-bit ARGB file, but then always allows transparancy. On some Unix run machines the \code{png.type} argument has to be set manually to avoid producing empty PNGs. +} +\author{Tomislav Hengl, Pierre Roudier and Dylan Beaudette} +\seealso{ \code{\link{kml-methods}}, \code{\link{kml_open}}, \code{\link{kml_layer.Raster}}, \code{\link{plotKML-method}} } +\examples{ +data(eberg_grid) +library(sp) +library(rgdal) +library(raster) +coordinates(eberg_grid) <- ~x+y +gridded(eberg_grid) <- TRUE +proj4string(eberg_grid) <- CRS("+init=epsg:31467") +data(SAGA_pal) +\dontrun{## KML plot with a single raster: +kml(eberg_grid, colour_scale = SAGA_pal[[1]], colour = TWISRT6) +## make a larger image: +kml(eberg_grid, colour_scale = SAGA_pal[[1]], colour = TWISRT6, + png.width = 600, png.height = 600) +} +} +\keyword{spatial} diff --git a/pkg/man/layer.SpatialPolygons.Rd b/pkg/man/layer.SpatialPolygons.Rd index 1feb7cf..f1e3859 100644 --- a/pkg/man/layer.SpatialPolygons.Rd +++ b/pkg/man/layer.SpatialPolygons.Rd @@ -1,51 +1,49 @@ -\name{kml_layer.SpatialPolygons} -\alias{kml_layer.SpatialPolygons} -\alias{SpatialPolygons} -\title{Writes spatial polygons to KML} -\description{Writes object of class \code{"SpatialPolygons*"} to KML with a possibility to parse attribute variables using several aesthetics arguments. } -\usage{ -kml_layer.SpatialPolygons(obj, subfolder.name = paste(class(obj)), - extrude = TRUE, tessellate = FALSE, - outline = TRUE, plot.labpt = FALSE, z.scale = 1, - LabelScale = get("LabelScale", envir = plotKML.opts), - metadata = NULL, html.table = NULL, TimeSpan.begin = "", - TimeSpan.end = "", colorMode = "normal", \dots) -} -\arguments{ - \item{obj}{object of class \code{"SpatialPolygons*"}} - \item{subfolder.name}{character; optional subfolder name} - \item{extrude}{logical; specifies whether to connect the point to the ground with a line} - \item{tessellate}{logical; specifies whether to connect the LinearRing to the ground} - \item{outline}{logical; specifies whether to outline the polygon} - \item{plot.labpt}{logical; specifies whether to add the label point (polygon centre)} - \item{z.scale}{numeric; exaggeration in vertical dimension} - \item{LabelScale}{numeric; scale factor for size of labels} - \item{metadata}{(optional) specify the metadata object} - \item{html.table}{optional description block (html) for each GPS point (vertices)} - \item{TimeSpan.begin}{(optional) beginning of the referent time period} - \item{TimeSpan.end}{(optional) end of the referent time period} - \item{colorMode}{(optional) KML color mode (normal or random)} - \item{\dots}{additional style arguments (see \code{aesthetics})} -} -\details{Label points are be default not plotted. We recommend adding the legend to attribute maps instead. Transparency can be set by using the alpha argument.\cr -\code{TimeSpan.begin} and \code{TimeSpan.end} are optional TimeStamp vectors:\cr - -\code{yyyy-mm-ddThh:mm:sszzzzzz}\cr - -Use the same time values for both \code{TimeSpan.begin} and \code{TimeSpan.end} if the measurements refer to a single moment in time. \code{TimeSpan.begin} and \code{TimeSpan.end} can be either a single value or a vector of values.} -\author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} -\seealso{ \code{\link{kml_layer.SpatialLines}}, \code{\link{kml_layer.STIDF}}, , \code{\link{plotKML-method}} } -\examples{ -library(rgdal) -library(sp) -data(eberg_zones) -names(eberg_zones) -## visualize zones using random colors: -kml.file = paste0(tempdir(), "/eberg_zones.kml") -kml(eberg_zones, file.name=kml.file, colorMode = "random") -## with labels: -kml.file2 = paste0(tempdir(), "/eberg_zones2.kml") -kml(eberg_zones, file.name=kml.file2, colour = ZONES, - plot.labpt = TRUE, labels = ZONES, kmz = TRUE, balloon=TRUE) -} -\keyword{spatial} +\name{kml_layer.SpatialPolygons} +\alias{kml_layer.SpatialPolygons} +\alias{SpatialPolygons} +\title{Writes spatial polygons to KML} +\description{Writes object of class \code{"SpatialPolygons*"} to KML with a possibility to parse attribute variables using several aesthetics arguments. } +\usage{ +kml_layer.SpatialPolygons(obj, subfolder.name = paste(class(obj)), + extrude = TRUE, tessellate = FALSE, + outline = TRUE, plot.labpt = FALSE, z.scale = 1, + LabelScale = get("LabelScale", envir = plotKML.opts), + metadata = NULL, html.table = NULL, TimeSpan.begin = "", + TimeSpan.end = "", colorMode = "normal", \dots) +} +\arguments{ + \item{obj}{object of class \code{"SpatialPolygons*"}} + \item{subfolder.name}{character; optional subfolder name} + \item{extrude}{logical; specifies whether to connect the point to the ground with a line} + \item{tessellate}{logical; specifies whether to connect the LinearRing to the ground} + \item{outline}{logical; specifies whether to outline the polygon} + \item{plot.labpt}{logical; specifies whether to add the label point (polygon centre)} + \item{z.scale}{numeric; exaggeration in vertical dimension} + \item{LabelScale}{numeric; scale factor for size of labels} + \item{metadata}{(optional) specify the metadata object} + \item{html.table}{optional description block (html) for each GPS point (vertices)} + \item{TimeSpan.begin}{(optional) beginning of the referent time period} + \item{TimeSpan.end}{(optional) end of the referent time period} + \item{colorMode}{(optional) KML color mode (normal or random)} + \item{\dots}{additional style arguments (see \code{aesthetics})} +} +\details{Label points are be default not plotted. We recommend adding the legend to attribute maps instead. Transparency can be set by using the alpha argument.\cr +\code{TimeSpan.begin} and \code{TimeSpan.end} are optional TimeStamp vectors:\cr + +\code{yyyy-mm-ddThh:mm:sszzzzzz}\cr + +Use the same time values for both \code{TimeSpan.begin} and \code{TimeSpan.end} if the measurements refer to a single moment in time. \code{TimeSpan.begin} and \code{TimeSpan.end} can be either a single value or a vector of values.} +\author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} +\seealso{ \code{\link{kml_layer.SpatialLines}}, \code{\link{kml_layer.STIDF}}, , \code{\link{plotKML-method}} } +\examples{ +library(rgdal) +library(sp) +data(eberg_zones) +names(eberg_zones) +## visualize zones using random colors: +kml(eberg_zones, colorMode = "random") +## with labels: +kml(eberg_zones, colour = ZONES, plot.labpt = TRUE, + labels = ZONES, kmz = TRUE, balloon=TRUE) +} +\keyword{spatial} diff --git a/pkg/man/legend.whitening.Rd b/pkg/man/legend.whitening.Rd index 9691f53..0a6e3ba 100644 --- a/pkg/man/legend.whitening.Rd +++ b/pkg/man/legend.whitening.Rd @@ -6,7 +6,7 @@ kml_legend.whitening(legend.res = 0.01, width = 120, height = 300, pointsize = 14, x.lim, e.lim, leg.asp = 0.3 * width/height, legend.file = "whitening_legend.png", - matte = FALSE, png.type) + matte = FALSE, png.type = "cairo-png") } \arguments{ \item{legend.res}{numeric; resolution on a 0-1 scale} @@ -24,7 +24,7 @@ kml_legend.whitening(legend.res = 0.01, width = 120, height = 300, pointsize = 1 \note{Google Earth does not properly handle a 24-bit PNG file which has a single transparent color. In order to force transparency in the output PNG, the function with try using ImageMagick convert function. ImageMagick needs to be installed separately and located using \code{plotKML.env()}.} \references{ \itemize{ -\item Hengl, T., Heuvelink, G.M.B., Stein, A., (2004) A generic framework for spatial prediction of soil variables based on regression-kriging. Geoderma 122 (1-2): 75-93. \doi{10.1016/j.geoderma.2003.08.018} +\item Hengl, T., Heuvelink, G.M.B., Stein, A., (2004) \href{http://dx.doi.org/10.1016/j.geoderma.2003.08.018}{A generic framework for spatial prediction of soil variables based on regression-kriging}. Geoderma 122 (1-2): 75-93. \item Hengl, T., (2003) \href{http://www.geocomputation.org/2003/Papers/Hengl_Paper.pdf}{Visualisation of uncertainty using the HSI colour model: computations with colours}. 7th International Conference on GeoComputation (CD-ROM), p. 8. } } diff --git a/pkg/man/metadata2SLD.Rd b/pkg/man/metadata2SLD.Rd index 0677b92..2679143 100644 --- a/pkg/man/metadata2SLD.Rd +++ b/pkg/man/metadata2SLD.Rd @@ -5,7 +5,7 @@ \alias{metadata2SLD.Spatial} \alias{metadata2SLD,SpatialMetadata-method} \title{Methods to create a Styled Layer Description (\bold{SLD}) file} -\description{Creates a \href{https://docs.geoserver.org/stable/en/user/styling/}{Styled Layer Description} (\bold{SLD}) file, that can be attached to a spatial layer contributed to GeoServer. It writes the \code{"sp.pallete"} object (legend entries, titles and colors) to an external file.} +\description{Creates a \href{http://docs.geoserver.org/stable/en/user/styling/}{Styled Layer Description} (\bold{SLD}) file, that can be attached to a spatial layer contributed to GeoServer. It writes the \code{"sp.pallete"} object (legend entries, titles and colors) to an external file.} \usage{ \S4method{metadata2SLD}{SpatialMetadata}(obj, \dots) } diff --git a/pkg/man/metadata2SLD.SpatialPixels.Rd b/pkg/man/metadata2SLD.SpatialPixels.Rd index 8cebb00..f0247a2 100644 --- a/pkg/man/metadata2SLD.SpatialPixels.Rd +++ b/pkg/man/metadata2SLD.SpatialPixels.Rd @@ -1,7 +1,7 @@ \name{metadata2SLD.SpatialPixels} \alias{metadata2SLD.SpatialPixels} \title{Writes a Styled Layer Description (\bold{SLD}) file} -\description{Writes a \href{https://docs.geoserver.org/stable/en/user/styling/}{Styled Layer Description} (\bold{SLD}) file, that can be attached to a spatial layer contributed to GeoServer. } +\description{Writes a \href{http://docs.geoserver.org/stable/en/user/styling/}{Styled Layer Description} (\bold{SLD}) file, that can be attached to a spatial layer contributed to GeoServer. } \usage{ metadata2SLD.SpatialPixels(obj, Format_Information_Content = xmlValue(obj@xml[["//formcont"]]), @@ -17,7 +17,7 @@ metadata2SLD.SpatialPixels(obj, \item{obj.name}{character; name of the layer} \item{sld.file}{character; name of the output file} \item{Citation_title}{character; title of the layer} - \item{ColorMap_type}{character; type of the colorMap see \url{https://docs.geoserver.org}} + \item{ColorMap_type}{character; type of the colorMap see \url{http://docs.geoserver.org}} \item{opacity}{logical; specifies the opacity} \item{brw.trg}{character; color scheme according to www.colorbrewer2.org; default to 'Greys'} \item{target.var}{character; target variable used to calculate the class-intervals} diff --git a/pkg/man/normalizeFilename.Rd b/pkg/man/normalizeFilename.Rd index b01ac8c..af0213c 100644 --- a/pkg/man/normalizeFilename.Rd +++ b/pkg/man/normalizeFilename.Rd @@ -12,7 +12,7 @@ normalizeFilename(x, form = c("default", "8.3")[1], \item{fix.encoding}{logical; specifies whether to fix the encoding} \item{sub.sign}{substitution symbol} } -\details{This function removes all reserved characters: (less than), (greater than), (colon), (double quote), (forward slash), (backslash), (vertical bar or pipe), (question mark), (asterisk), and empty spaces, from the file name. This is important when writing a list of objects to an external file (e.g. KML) as it prevents from creating erroneous file names.} +\details{This function removes all \href{http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx}{reserved characters}: (less than), (greater than), (colon), (double quote), (forward slash), (backslash), (vertical bar or pipe), (question mark), (asterisk), and empty spaces, from the file name. This is important when writing a list of objects to an external file (e.g. KML) as it prevents from creating erroneous file names.} \author{Tomislav Hengl} \seealso{\code{utils::shortPathName}, \code{RSAGA:set.file.extension}} \examples{ diff --git a/pkg/man/plotKML-package.Rd b/pkg/man/plotKML-package.Rd index ef42314..3d8fd96 100644 --- a/pkg/man/plotKML-package.Rd +++ b/pkg/man/plotKML-package.Rd @@ -14,14 +14,14 @@ LazyLoad: \tab yes\cr } } \author{ -Tomislav Hengl (\email{tom.hengl@opengeohub.org}), Pierre Roudier (\email{pierre.roudier@landcare.nz}), Dylan Beaudette (\email{debeaudette@ucdavis.edu}), Edzer Pebesma (\email{edzer.pebesma@uni-muenster.de}) +Tomislav Hengl (\email{tom.hengl@wur.nl}), Pierre Roudier (\email{pierre.roudier@landcare.nz}), Dylan Beaudette (\email{debeaudette@ucdavis.edu}), Edzer Pebesma (\email{edzer.pebesma@uni-muenster.de}) } \references{ \itemize{ -\item KML documentation (\url{https://developers.google.com/kml/documentation/?csw=1}) +\item KML documentation (\url{http://code.google.com/apis/kml/documentation/}) \item \strong{Google Earth Outreach} project (\url{http://earth.google.com/outreach/tutorials.html}) -\item Hengl, T., Roudier, P., Beaudette, D. and Pebesma, E. (2015) \href{https://www.jstatsoft.org/v63/i05/}{plotKML: Scientific Visualization of Spatio-Temporal Data}. Journal of Statistical Software, 63(5): 1--25. +\item Hengl, T., Roudier, P., Beaudette, D. and Pebesma, E. (2015) \href{http://www.jstatsoft.org/v63/i05/}{plotKML: Scientific Visualization of Spatio-Temporal Data}. Journal of Statistical Software, 63(5): 1--25. } } -\note{This package has been developed as a part of the Global Soil Information Facilities project, which is run jointly by the ISRIC Institute and collaborators. ISRIC is a non-profit organization with a mandate to serve the international community as custodian of global soil information and to increase awareness and understanding of the role of soils in major global issues.} +\note{This package has been developed as a part of the \href{http://gsif.isric.org/}{\strong{Global Soil Information Facilities}} project, which is run jointly by the ISRIC Institute and collaborators. ISRIC is a non-profit organization with a mandate to serve the international community as custodian of global soil information and to increase awareness and understanding of the role of soils in major global issues.} \keyword{spatial} \ No newline at end of file diff --git a/pkg/man/plotKML.GDALobj.Rd b/pkg/man/plotKML.GDALobj.Rd index ae6e849..f4fae22 100644 --- a/pkg/man/plotKML.GDALobj.Rd +++ b/pkg/man/plotKML.GDALobj.Rd @@ -1,53 +1,53 @@ -\name{plotKML.GDALobj} -\alias{plotKML.GDALobj} -\title{Write tiled objects to KML} -\description{Write tiled objects to KML. Suitable for plotting large rasters i.e. large spatial data sets.} -\usage{ -plotKML.GDALobj(obj, file.name, block.x, tiles=NULL, - tiles.sel=NULL, altitude=0, altitudeMode="relativeToGround", colour_scale, - z.lim=NULL, breaks.lst=NULL, kml.logo, overwrite=TRUE, cpus, - home.url=".", desc=NULL, open.kml=TRUE, CRS=attr(obj, "projection"), - plot.legend=TRUE) -} -\arguments{ - \item{obj}{\code{"GDALobj"} object i.e. a pointer to a spatial layer} - \item{file.name}{character; output KML file name} - \item{block.x}{numeric; size of block in meters or corresponding mapping units} - \item{tiles}{data.frame; tiling definition generated using \code{landmap::tile}} - \item{tiles.sel}{integer; selection of tiles to be plotted} - \item{altitude}{numeric; altitude of the ground overlay} - \item{altitudeMode}{character; either \code{"absolute"}, \code{"relativeToGround"} or \code{"clampToGround"}} - \item{colour_scale}{character; color palette} - \item{z.lim}{numeric; upper lower boundaries} - \item{breaks.lst}{numeric; optional break lines (must be of size \code{length(colour_scale)+1)}} - \item{kml.logo}{character; optional project logo file (PNG)} - \item{overwrite}{logical; specifies whether to overwrite PNGs if available} - \item{cpus}{integer; specifies number of CPUs to be used by the snowfall package to speed things up} - \item{home.url}{character; optional web-directory where the PNGs will be stored} - \item{desc}{character; optional layer description} - \item{open.kml}{logical; specifies whether to open the KML file after writing} - \item{CRS}{character; projection string (if missing)} - \item{plot.legend}{logical; indicate whether to plot summary legend} -} -\value{Returns a list of KML files.} -\note{This operation can be time-consuming for processing very large rasters e.g. more than 10,000 by 10,000 pixels. To speed up writing of KMLs, use the snowfall package.} -\author{Tomislav Hengl } -\seealso{\code{\link{plotKML}}, \code{\link{kml.tiles}}} -\examples{ -\dontrun{ -library(sp) -library(snowfall) -library(landmap) -library(rgdal) -fn = system.file("pictures/SP27GTIF.TIF", - package = "rgdal") -obj <- GDALinfo(fn) -tiles <- getSpatialTiles(obj, block.x=5000, - return.SpatialPolygons = FALSE) -## plot using tiles: -plotKML.GDALobj(obj, tiles=tiles, z.lim=c(0,185)) -## Even better ideas is to first reproject -## the large grid using 'gdalUtils::gdalwarp', then tile... -} -} +\name{plotKML.GDALobj} +\alias{plotKML.GDALobj} +\title{Write tiled objects to KML} +\description{Write tiled objects to KML. Suitable for plotting large rasters i.e. large spatial data sets.} +\usage{ +plotKML.GDALobj(obj, file.name, block.x, tiles=NULL, + tiles.sel=NULL, altitude=0, altitudeMode="relativeToGround", colour_scale, + z.lim=NULL, breaks.lst=NULL, kml.logo, overwrite=TRUE, cpus, + home.url=".", desc=NULL, open.kml=TRUE, CRS=attr(obj, "projection"), + plot.legend=TRUE) +} +\arguments{ + \item{obj}{\code{"GDALobj"} object i.e. a pointer to a spatial layer} + \item{file.name}{character; output KML file name} + \item{block.x}{numeric; size of block in meters or corresponding mapping units} + \item{tiles}{data.frame; tiling definition generated using \code{GSIF::tile}} + \item{tiles.sel}{integer; selection of tiles to be plotted} + \item{altitude}{numeric; altitude of the ground overlay} + \item{altitudeMode}{character; either \code{"absolute"}, \code{"relativeToGround"} or \code{"clampToGround"}} + \item{colour_scale}{character; color palette} + \item{z.lim}{numeric; upper lower boundaries} + \item{breaks.lst}{numeric; optional break lines (must be of size \code{length(colour_scale)+1)}} + \item{kml.logo}{character; optional project logo file (PNG)} + \item{overwrite}{logical; specifies whether to overwrite PNGs if available} + \item{cpus}{integer; specifies number of CPUs to be used by the snowfall package to speed things up} + \item{home.url}{character; optional web-directory where the PNGs will be stored} + \item{desc}{character; optional layer description} + \item{open.kml}{logical; specifies whether to open the KML file after writing} + \item{CRS}{character; projection string (if missing)} + \item{plot.legend}{logical; indicate whether to plot summary legend} +} +\value{Returns a list of KML files.} +\note{This operation can be time-consuming for processing very large rasters e.g. more than 10,000 by 10,000 pixels. To speed up writing of KMLs, use the snowfall package.} +\author{Tomislav Hengl } +\seealso{\code{\link{plotKML}}, \code{\link{kml.tiles}}} +\examples{ +\dontrun{ +library(sp) +library(snowfall) +library(GSIF) +library(rgdal) +fn = system.file("pictures/SP27GTIF.TIF", + package = "rgdal") +obj <- GDALinfo(fn) +tiles <- getSpatialTiles(obj, block.x=5000, + return.SpatialPolygons = FALSE) +## plot using tiles: +plotKML.GDALobj(obj, tiles=tiles, z.lim=c(0,185)) +## Even better ideas is to first reproject +## the large grid using 'gdalUtils::gdalwarp', then tile... +} +} \keyword{spatial} \ No newline at end of file diff --git a/pkg/man/plotKML.Rd b/pkg/man/plotKML.Rd index eec401c..e5ce6dd 100644 --- a/pkg/man/plotKML.Rd +++ b/pkg/man/plotKML.Rd @@ -21,15 +21,9 @@ \alias{plotKML,RasterBrickTimeSeries-method} \alias{plotKML,SpatialSamplingPattern-method} \alias{plotKML,list-method} -\alias{plotKML,sf-method} -\alias{plotKML,stars-method} \title{Methods for plotting results of spatial analysis in Google Earth} \description{The method writes inputs and outputs of spatial analysis (a list of point, gridded and/or polygon data usually) to KML and opens the KML file in Google Earth (or any other default package used to view KML/KMZ files).} \usage{ -\S4method{plotKML}{sf}(obj, - folder.name = normalizeFilename(deparse(substitute(obj, env = parent.frame()))), - file.name = paste(folder.name, ".kml", sep=""), - metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, \dots) \S4method{plotKML}{SpatialPointsDataFrame}(obj, folder.name = normalizeFilename(deparse(substitute(obj, env = parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), @@ -101,7 +95,7 @@ \S4method{plotKML}{SpatialPredictions}(obj, folder.name = normalizeFilename(deparse(substitute(obj, env = parent.frame()))), file.name = paste(folder.name, ".kml", sep=""), colour, - grid2poly = FALSE, obj.summary = FALSE, plot.svar = FALSE, + grid2poly = FALSE, obj.summary = TRUE, plot.svar = FALSE, pngwidth = 210, pngheight = 580, pngpointsize = 14, metadata = NULL, kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, \dots) \S4method{plotKML}{SpatialSamplingPattern}(obj, @@ -122,7 +116,7 @@ kmz = get("kmz", envir = plotKML.opts), open.kml = TRUE, \dots) } \arguments{ - \item{obj}{input object of specific class; either some \href{https://cran.r-project.org/package=sf}{sf}, or \href{https://cran.r-project.org/package=sp}{sp}, or \href{https://cran.r-project.org/package=raster}{raster} or \href{https://cran.r-project.org/package=spacetime}{spacetime} package class object, or plotKML composite objects containing both inputs and outputs of analysis} + \item{obj}{input object of specific class; either some \href{https://cran.r-project.org/package=sp}{sp}, or \href{https://cran.r-project.org/package=raster}{raster} or \href{https://cran.r-project.org/package=spacetime}{spacetime} package class object, or plotKML composite objects containing both inputs and outputs of analysis} \item{folder.name}{character; folder name in the KML file} \item{file.name}{character; output KML file name} \item{size}{for point objects for plotting (see \link{aesthetics})} @@ -154,14 +148,13 @@ \details{This is a generic function to plot various spatial and spatio-temporal R objects that contain both inputs and outputs of spatial analysis. The resulting plots (referred to as \emph{`views'}) are expected to be cartographically complete as they should contain legends, and data and model descriptions. In principle, \code{plotKML} works with both simple spatial objects, and complex objects such as \code{"SpatialPredictions"}, \code{"SpatialVectorsSimulations"}, \code{"RasterBrickSimulations"}, \code{"RasterBrickTimeSeries"}, \code{"SpatialMaxEntOutput"} and similar. To further customize visualizations consider combining the lower level functions \code{\link{kml_open}}, \code{\link{kml_close}}, \code{\link{kml_compress}}, \code{\link{kml_screen}} into your own \code{plotKML()} method. All ST-classes are coerced to the STIDF format and hence use the plotKML method for STIDFs. -The \code{sf} objects are processed according to the class of the geometry column. The aestethics are defined in the same way as for their {sp} counterparts. } -\note{To prepare a list of objects of class \code{"SpatialPointsDataFrame"}, \code{"SpatialLinesDataFrame"}, \code{"SpatialPolygonsDataFrame"}, or \code{"SpatialPixelsDataFrame"} consider using the \code{landmap::tile} function. Writting large spatial objects via plotKML can be time consuming. Please refer to the package manual for more information. +\note{To prepare a list of objects of class \code{"SpatialPointsDataFrame"}, \code{"SpatialLinesDataFrame"}, \code{"SpatialPolygonsDataFrame"}, or \code{"SpatialPixelsDataFrame"} consider using the \code{GSIF::tile} function. Writting large spatial objects via plotKML can be time consuming. Please refer to the package manual for more information. } \seealso{ \code{\link{SpatialPredictions-class}}, \code{\link{SpatialVectorsSimulations-class}}, \code{\link{RasterBrickSimulations-class}}, \code{\link{RasterBrickTimeSeries-class}}, \code{\link{SpatialMaxEntOutput-class}}, \code{\link{SpatialSamplingPattern-class}} } \examples{ -plotKML.env(kmz = FALSE) +plotKML.env(silent = FALSE, kmz = FALSE) ## -------------- SpatialPointsDataFrame --------- ## library(sp) library(rgdal) @@ -176,23 +169,13 @@ plotKML(eberg["CLYMHT_A"], colour_scale=rep("#FFFF00", 2), points_names="") } ## plot points with a legend: shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" -kml.file = paste0(tempdir(), "/eberg_CLYMHT_A.kml") -leg.file = paste0(dirname(kml.file), "/kml_legend.png") -kml_open(kml.file) +kml_open("eberg_CLYMHT_A.kml") kml_layer(eberg["CLYMHT_A"], colour=CLYMHT_A, z.lim=c(20,60), - colour_scale=SAGA_pal[[1]], shape=shape, points_names="") -kml_legend.bar(x=eberg$CLYMHT_A, - legend.file=leg.file, - legend.pal=SAGA_pal[[1]], z.lim=c(20,60)) -kml_screen(image.file=leg.file) -kml_close(kml.file) - -## ----- sf objects with sfc_POINT geometry ----- ## -eberg_sf <- sf::st_as_sf(eberg) -\dontrun{ -plotKML(eberg_sf["CLYMHT_A"]) -plotKML(eberg_sf["CLYMHT_A"], colour_scale = rep("#FFFF00", 2), points_names = "") -} + colour_scale=SAGA_pal[[1]], shape=shape, points_names="") +kml_legend.bar(x=eberg$CLYMHT_A, legend.file="kml_legend.png", + legend.pal=SAGA_pal[[1]], z.lim=c(20,60)) +kml_screen(image.file="kml_legend.png") +kml_close("eberg_CLYMHT_A.kml") ## -------------- SpatialLinesDataFrame --------- ## data(eberg_contours) @@ -202,13 +185,6 @@ plotKML(eberg_contours) plotKML(eberg_contours, colour=Z, altitude=Z) } -## ---- sf objects with sfc_LINESTRING geometry ---- ## -eberg_contours_sf <- sf::st_as_sf(eberg_contours) -\dontrun{ -plotKML(eberg_contours_sf) -plotKML(eberg_contours_sf, colour = Z, altitude = Z) -} - ## -------------- SpatialPolygonsDataFrame --------- ## data(eberg_zones) \dontrun{ @@ -218,13 +194,6 @@ zmin = 230 plotKML(eberg_zones["ZONES"], altitude=zmin+runif(length(eberg_zones))*500) } -## ------ sf objects with sfc_POLYGON geometry ------ ## -eberg_zones_sf <- sf::st_as_sf(eberg_zones) -\dontrun{ -plotKML(eberg_zones_sf["ZONES"]) -plotKML(eberg_zones_sf["ZONES"], altitude = zmin + runif(length(eberg_zones)) * 500) -} - ## -------------- SpatialPixelsDataFrame --------- ## library(rgdal) library(raster) @@ -252,7 +221,7 @@ plotKML(LNCCOR6, colour_scale=pal) \dontrun{ library(RCurl) imagename = "Soil_monolith.jpg" -urlExists = url.exists("https://commons.wikimedia.org") +urlExists = url.exists("http://commons.wikimedia.org") if(urlExists){ x1 <- getWikiMedia.ImageInfo(imagename) sm <- spPhoto(filename = x1$url$url, exif.info = x1$metadata) @@ -318,7 +287,6 @@ plotKML(fmd_ST, colour_scale=SAGA_pal[[1]]) ## -------------- STFDF --------- ## -\dontrun{ ## results of krigeST: library(gstat) library(sp) @@ -344,9 +312,10 @@ DE_pred <- STF(sp=as(DE_gridded,"SpatialPoints"), time=rr@time) DE_kriged <- krigeST(PM10~1, data=rr, newdata=DE_pred, modelList=sumMetricVgm) gridded(DE_kriged@sp) <- TRUE -#stplot(DE_kriged) +stplot(DE_kriged) ## plot in Google Earth: z.lim = range(DE_kriged@data, na.rm=TRUE) +\dontrun{ plotKML(DE_kriged, z.lim=z.lim) ## add observations points: plotKML(rr, z.lim=z.lim) @@ -356,7 +325,7 @@ plotKML(rr, z.lim=z.lim) \dontrun{ library(fossil) library(spacetime) -library(adehabitatLT) +library(adehabitat) data(gpxbtour) ## format the time column: gpxbtour$ctime <- as.POSIXct(gpxbtour$time, format="\%Y-\%m-\%dT\%H:\%M:\%SZ") @@ -422,7 +391,7 @@ data(meuse.grid) gridded(meuse.grid) <- ~x+y proj4string(meuse.grid) <- CRS("+init=epsg:28992") \dontrun{## fit a model: -library(landmap) +library(GSIF) omm <- fit.gstatModel(observations = meuse, formulaString = om~dist, family = gaussian(log), covariates = meuse.grid) ## produce SpatialPredictions: @@ -433,6 +402,38 @@ plotKML(om.rk, colour_scale = SAGA_pal[[1]]) plotKML(om.rk, colour_scale = SAGA_pal[[1]], grid2poly = TRUE) } +## -------------- SpatialSamplingPattern --------- ## +\dontrun{ +library(spcosa) +library(sp) +## read a polygon map: +shpFarmsum <- readOGR(dsn = system.file("maps", package = "spcosa"), + layer = "farmsum") +## stratify `Farmsum' into 50 strata +myStratification <- stratify(shpFarmsum, nStrata = 50) +## sample two sampling units per stratum +mySamplingPattern <- spsample(myStratification, n = 2) +## attach the correct proj4 string: +library(RCurl) +urlExists = url.exists("http://spatialreference.org/ref/sr-org/6781/proj4/") +if(urlExists){ + nl.rd <- getURL("http://spatialreference.org/ref/sr-org/6781/proj4/") + proj4string(mySamplingPattern@sample) <- CRS(nl.rd) + # prepare spatial domain (polygons): + sp.domain <- as(myStratification@cells, "SpatialPolygons") + sp.domain <- SpatialPolygonsDataFrame(sp.domain, + data.frame(ID=as.factor(myStratification@stratumId)), match.ID = FALSE) + proj4string(sp.domain) <- CRS(nl.rd) + # create new object: + mySamplingPattern.ssp <- new("SpatialSamplingPattern", + method = class(mySamplingPattern), pattern = mySamplingPattern@sample, + sp.domain = sp.domain) + # the same plot now in Google Earth: + shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" + plotKML(mySamplingPattern.ssp, shape = shape) +} +} + ## -------------- RasterBrickSimulations --------- ## \dontrun{ library(sp) @@ -507,7 +508,7 @@ library(spatstat) bigfoot.aea <- as.ppp(spTransform(bigfoot, CRS(aea.prj))) ## Load the covariates: sel.grids <- c("globedem","nlights03","sdroads","gcarb","twi","globcov") -library(landmap) +library(GSIF) library(dismo) ## run MaxEnt analysis: jar <- paste(system.file(package="dismo"), "/java/maxent.jar", sep='') diff --git a/pkg/man/plotKML.env.Rd b/pkg/man/plotKML.env.Rd index a442029..200d478 100644 --- a/pkg/man/plotKML.env.Rd +++ b/pkg/man/plotKML.env.Rd @@ -14,7 +14,7 @@ \item{colour_scale_numeric}{default colour scheme for numeric variables} \item{colour_scale_factor}{default colour scheme for factor variables} \item{colour_scale_svar}{default colour scheme for model error (e.g. mapping error)} - \item{ref_CRS}{the referent CRS \href{https://spatialreference.org/ref/epsg/4326/}{proj4string} (\code{"+proj=longlat +datum=WGS84"})} + \item{ref_CRS}{the referent CRS \href{http://spatialreference.org/ref/epsg/4326/}{proj4string} (\code{"+proj=longlat +datum=WGS84"})} \item{NAflag}{the default missing value flag (usually \code{"-99999"})} \item{icon}{the default icon URL} \item{LabelScale}{the default scale factor for labels} @@ -41,10 +41,10 @@ The external software tools are not required by default and most of operations i } \references{ \itemize{ -\item ImageMagick (\url{https://imagemagick.org}) -\item GDAL (\url{https://gdal.org}) +\item ImageMagick (\url{http://imagemagick.org}) +\item GDAL (\url{http://gdal.org}) \item SAGA GIS (\url{http://www.saga-gis.org}) -\item Python (\url{https://www.python.org}) +\item Python (\url{http://python.org}) } } \author{Tomislav Hengl, Dylan Beaudette} @@ -52,7 +52,7 @@ The external software tools are not required by default and most of operations i \code{library(plotKML); plotKML.env(..., show.env = FALSE)}\cr in your \code{"/etc/Rprofile.site"}. } -\section{Warning}{Under Linux OS you need to install GDAL binaries by using e.g.:\cr +\section{Warning}{Under Linux OS you need to install GDAL binaries by using:\cr \code{sudo apt-get install gdal-bin} } \examples{ diff --git a/pkg/man/readGPX.Rd b/pkg/man/readGPX.Rd index 227d79b..88ead0a 100644 --- a/pkg/man/readGPX.Rd +++ b/pkg/man/readGPX.Rd @@ -1,32 +1,32 @@ -\name{readGPX} -\alias{readGPX} -\title{Import GPX (GPS track) files} -\description{Reads various elements from a \code{*.gpx} file --- metadata, waypoints, tracks and routes --- and converts them to dataframes.} -\usage{readGPX(gpx.file, metadata = TRUE, bounds = TRUE, - waypoints = TRUE, tracks = TRUE, routes = TRUE) -} -\arguments{ - \item{gpx.file}{location of the gpx.file} - \item{metadata}{logical; species whether the metadata should be imported} - \item{bounds}{logical; species whether the bounding box coordinates should be imported} - \item{waypoints}{logical; species whether all waypoints should be imported} - \item{tracks}{logical; species whether all tracks should be imported} - \item{routes}{logical; species whether all routes should be imported} -} -\details{\bold{Waypoint} is a point of interest, or named feature on a map. \bold{Track} is an ordered list of points describing a path. \bold{Route} is an ordered list of waypoints representing a series of turn points leading to a destination. -} -\references{ -\itemize{ -\item GPX data format (\url{https://www.topografix.com/gpx.asp}) -\item XML tutorial (\url{https://github.com/omegahat/XML}) -} -} -\author{Tomislav Hengl } -\seealso{\code{rgdal::readOGR}, \code{\link{kml_layer.STTDF}}} -\examples{ -\dontrun{# read GPX file from web: -fells_loop <- readGPX("https://www.topografix.com/fells_loop.gpx") -str(fells_loop) -} -} +\name{readGPX} +\alias{readGPX} +\title{Import GPX (GPS track) files} +\description{Reads various elements from a \code{*.gpx} file --- metadata, waypoints, tracks and routes --- and converts them to dataframes.} +\usage{readGPX(gpx.file, metadata = TRUE, bounds = TRUE, + waypoints = TRUE, tracks = TRUE, routes = TRUE) +} +\arguments{ + \item{gpx.file}{location of the gpx.file} + \item{metadata}{logical; species whether the metadata should be imported} + \item{bounds}{logical; species whether the bounding box coordinates should be imported} + \item{waypoints}{logical; species whether all waypoints should be imported} + \item{tracks}{logical; species whether all tracks should be imported} + \item{routes}{logical; species whether all routes should be imported} +} +\details{\bold{Waypoint} is a point of interest, or named feature on a map. \bold{Track} is an ordered list of points describing a path. \bold{Route} is an ordered list of waypoints representing a series of turn points leading to a destination. +} +\references{ +\itemize{ +\item GPX data format (\url{http://www.topografix.com/gpx.asp}) +\item XML tutorial (\url{https://github.com/omegahat/XML}) +} +} +\author{Tomislav Hengl } +\seealso{\code{rgdal::readOGR}, \code{\link{kml_layer.STTDF}}} +\examples{ +\dontrun{# read GPX file from web: +fells_loop <- readGPX("http://www.topografix.com/fells_loop.gpx") +str(fells_loop) +} +} \keyword{spatial} \ No newline at end of file diff --git a/pkg/man/readKML.GBIFdensity.Rd b/pkg/man/readKML.GBIFdensity.Rd index eb0d1b0..bc36465 100644 --- a/pkg/man/readKML.GBIFdensity.Rd +++ b/pkg/man/readKML.GBIFdensity.Rd @@ -1,47 +1,47 @@ -\name{readKML.GBIFdensity} -\alias{readKML.GBIFdensity} -\title{Imports GBIF cell density records} -\description{Read GBIF cell (1--degree) density record counts and converts them to a \code{"raster"} object.} -\usage{readKML.GBIFdensity(kml.file, gbif.url = FALSE, silent = FALSE) -} -\arguments{ - \item{kml.file}{GBIF cell density file (local file or URL)} - \item{gbif.url}{logical; species whether the cellid and taxon content information should be also imported (usually not used)} - \item{silent}{logical; species whether the progress bar should be printed} -} -\details{This document contains data shared through the GBIF Network --- see \url{https://www.gbif.org/occurrence} for more information. GBIF records are constantly updated and every map derived refers to a certain date indicated in the \code{@zname} \emph{Last update} slot.\cr -All usage of these data must be in accordance with the GBIF Data Use Agreement: \url{https://www.gbif.org/terms}.} -\references{ -\itemize{ -\item GBIF cell density description (\url{https://www.gbif.org/occurrence}) -} -} -\author{Tomislav Hengl } -\seealso{\code{\link{readGPX}}} -\examples{ -\dontrun{# reading taxon density maps: -kml.file <- "taxon-celldensity-2294100.kml" -# download.file(paste("http://data.gbif.org/occurrences/taxon/celldensity/", kml.file, sep=""), -# destfile=paste(getwd(), kml.file, sep="")) -# this will not run (you must first accept the data usage agreeent); -# instead, obtain the kml file via a web browser, and save it to the working directory: -r <- readKML.GBIFdensity(kml.file) -class(r) -summary(r) -image(r) -# add world borders: -library(maps) -country.m = map('world', plot=FALSE, fill=TRUE) -IDs <- sapply(strsplit(country.m$names, ":"), function(x) x[1]) -library(maptools) -country <- as(map2SpatialPolygons(country.m, IDs=IDs), "SpatialLines") -lines(country) -# to import a list of files, use e.g.: -kml.list <- list(kml.file) -r.lst <- lapply(kml.list, readKML.GBIFdensity, silent = TRUE) -# mask out missing layers (empty KML files): -mask <- !sapply(r.lst, is.null) -r.lst <- brick(r.lst[mask]) -} -} -\keyword{spatial} +\name{readKML.GBIFdensity} +\alias{readKML.GBIFdensity} +\title{Imports GBIF cell density records} +\description{Read GBIF cell (1--degree) density record counts and converts them to a \code{"raster"} object.} +\usage{readKML.GBIFdensity(kml.file, gbif.url = FALSE, silent = FALSE) +} +\arguments{ + \item{kml.file}{GBIF cell density file (local file or URL)} + \item{gbif.url}{logical; species whether the cellid and taxon content information should be also imported (usually not used)} + \item{silent}{logical; species whether the progress bar should be printed} +} +\details{This document contains data shared through the GBIF Network --- see \url{http://www.gbif.org/occurrence} for more information. GBIF records are constantly updated and every map derived refers to a certain date indicated in the \code{@zname} \emph{Last update} slot.\cr +All usage of these data must be in accordance with the GBIF Data Use Agreement: \url{http://www.gbif.org/disclaimer/datause}.} +\references{ +\itemize{ +\item GBIF cell density description (\url{http://www.gbif.org/occurrence}) +} +} +\author{Tomislav Hengl } +\seealso{\code{\link{readGPX}}} +\examples{ +\dontrun{# reading taxon density maps: +kml.file <- "taxon-celldensity-2294100.kml" +# download.file(paste("http://data.gbif.org/occurrences/taxon/celldensity/", kml.file, sep=""), +# destfile=paste(getwd(), kml.file, sep="")) +# this will not run (you must first accept the data usage agreeent); +# instead, obtain the kml file via a web browser, and save it to the working directory: +r <- readKML.GBIFdensity(kml.file) +class(r) +summary(r) +image(r) +# add world borders: +library(maps) +country.m = map('world', plot=FALSE, fill=TRUE) +IDs <- sapply(strsplit(country.m$names, ":"), function(x) x[1]) +library(maptools) +country <- as(map2SpatialPolygons(country.m, IDs=IDs), "SpatialLines") +lines(country) +# to import a list of files, use e.g.: +kml.list <- list(kml.file) +r.lst <- lapply(kml.list, readKML.GBIFdensity, silent = TRUE) +# mask out missing layers (empty KML files): +mask <- !sapply(r.lst, is.null) +r.lst <- brick(r.lst[mask]) +} +} +\keyword{spatial} diff --git a/pkg/man/reproject.Rd b/pkg/man/reproject.Rd index 01e0acd..5054114 100644 --- a/pkg/man/reproject.Rd +++ b/pkg/man/reproject.Rd @@ -16,7 +16,7 @@ \alias{reproject,RasterLayer-method} \alias{reproject,RasterBrick-method} \title{Methods to reproject maps to a referent coordinate system (WGS84)} -\description{This wrapper function reprojects any vector or raster spatial data to some referent coordinate system (by default: geographic coordinates on the \href{https://spatialreference.org/ref/epsg/4326/}{World Geodetic System of 1984 / WGS84} datum).} +\description{This wrapper function reprojects any vector or raster spatial data to some referent coordinate system (by default: geographic coordinates on the \href{http://spatialreference.org/ref/epsg/4326/}{World Geodetic System of 1984 / WGS84} datum).} \usage{ \S4method{reproject}{SpatialPoints}(obj, CRS, \dots) \S4method{reproject}{SpatialPolygons}(obj, CRS, \dots) @@ -41,12 +41,12 @@ \item{\dots}{arguments evaluated in the context of function \code{projectRaster} from the raster package} } \details{ -In the case of raster and/or gridded maps, by selecting \code{program = "GDAL"} \code{gdalwarp} functionality will be initiated (otherwise it tries to reproject via the package raster). This requires that \href{https://gdal.org}{GDAL} are installed and located from R via \code{paths()}. +In the case of raster and/or gridded maps, by selecting \code{program = "GDAL"} \code{gdalwarp} functionality will be initiated (otherwise it tries to reproject via the package raster). This requires that \href{http://gdal.org}{GDAL} are installed and located from R via \code{paths()}. } \references{ \itemize{ \item Raster package (\url{https://CRAN.R-project.org/package=raster}) -\item GDAL (\url{https://gdal.org}) +\item GDAL (\url{http://GDAL.org}) } } \author{Pierre Roudier, Tomislav Hengl and Dylan Beaudette} diff --git a/pkg/man/spMetadata.Rd b/pkg/man/spMetadata.Rd index 3ae5613..d93778d 100644 --- a/pkg/man/spMetadata.Rd +++ b/pkg/man/spMetadata.Rd @@ -38,11 +38,11 @@ The \code{read.metadata} function reads the formatted metadata (\code{.xml}), pr \item{\dots}{additional arguments to be passed e.g. via the \code{metadata.env()}} } \details{ -\code{spMetadata} tries to locate a metadata file in the working directory (it looks for a metadata file with the same name as the object name). If no \code{.xml} file exists, it will load the template xml file available in the system folder (e.g. \code{system.file("FGDC.xml", package="plotKML")} or \code{system.file("INSPIRE_ISO19139.xml", package="plotKML")}). The \code{FGDC.xml}/\code{INSPIRE_ISO19139.xml} files contain typical metadata entries with description and examples. For practical purposes, one metadata object in plotKML can be associated with only one variable i.e. one column in the \code{"data"} slot (the first column by default). To prepare a metadata xml file following the FGDC standard, consider using e.g. the \href{http://geology.usgs.gov/tools/metadata/tools/doc/tkme.html}{Tkme} software: Another editor for formal metadata, by Peter N. Schweitzer (U.S. Geological Survey). Before commiting the metadata file, try also running a \href{https://mrdata.usgs.gov/validation/}{validation test}. Before committing the metadata file following the INSPIRE standard, try running the \href{http://inspire.ec.europa.eu/validator/about/}{INSPIRE Geoportal Metadata Validator}.\cr +\code{spMetadata} tries to locate a metadata file in the working directory (it looks for a metadata file with the same name as the object name). If no \code{.xml} file exists, it will load the template xml file available in the system folder (e.g. \code{system.file("FGDC.xml", package="plotKML")} or \code{system.file("INSPIRE_ISO19139.xml", package="plotKML")}). The \code{FGDC.xml}/\code{INSPIRE_ISO19139.xml} files contain typical metadata entries with description and examples. For practical purposes, one metadata object in plotKML can be associated with only one variable i.e. one column in the \code{"data"} slot (the first column by default). To prepare a metadata xml file following the FGDC standard, consider using e.g. the \href{http://geology.usgs.gov/tools/metadata/tools/doc/tkme.html}{Tkme} software: Another editor for formal metadata, by Peter N. Schweitzer (U.S. Geological Survey). Before commiting the metadata file, try also running a \href{https://mrdata.usgs.gov/validation/}{validation test}. Before committing the metadata file following the INSPIRE standard, try running the \href{http://inspire-geoportal.ec.europa.eu/validator2/}{INSPIRE Geoportal Metadata Validator}.\cr \code{spMetadata} tries to automatically generate the most usefull information, so that a user can easily find out about the input data and procedures followed to generate the visualization (KML). Typical metadata entries include e.g. (FGDC): \itemize{ \item \code{metadata[["idinfo"]][["native"]]} --- Session info e.g.: Produced using R version 2.12.2 (2011-02-25) running on Windows 7 x64. -\item \code{metadata[["spdoinfo"]][["indspref"]]} --- Indirect spatial reference estimated using the \href{https://developers.google.com/maps/documentation}{Google Maps API Web Services}. +\item \code{metadata[["spdoinfo"]][["indspref"]]} --- Indirect spatial reference estimated using the \href{http://code.google.com/apis/maps/documentation/webservices/}{Google Maps API Web Services}. \item \code{metadata[["idinfo"]][["spdom"]][["bounding"]]} --- Bounding box in the WGS84 geographical coordinates estimated by reprojecting the original bounding box. } and for INSPIRE metadata: diff --git a/pkg/man/spPhoto.Rd b/pkg/man/spPhoto.Rd index d3100e8..7db79e1 100644 --- a/pkg/man/spPhoto.Rd +++ b/pkg/man/spPhoto.Rd @@ -3,7 +3,7 @@ \alias{SpatialPhotoOverlay} \title{Generate an object of class \code{"SpatialPhotoOverlay"}} \description{ -\code{spPhoto} function can be used to wrap pixel map (\code{pixmapRGB}), \href{https://en.wikipedia.org/wiki/Exchangeable_image_file_format}{EXIF} (Exchangeable Image File format) data, spatial location information (standing point), and \code{PhotoOverlay} (geometry) parameters to create an object of class \code{"SpatialPhotoOverlay"}. This object can then be parsed to KML and visualized using Google Earth. +\code{spPhoto} function can be used to wrap pixel map (\code{pixmapRGB}), \href{http://en.wikipedia.org/wiki/Exchangeable_image_file_format}{EXIF} (Exchangeable Image File format) data, spatial location information (standing point), and \code{PhotoOverlay} (geometry) parameters to create an object of class \code{"SpatialPhotoOverlay"}. This object can then be parsed to KML and visualized using Google Earth. } \usage{spPhoto(filename, obj, pixmap, exif.info = NULL, ImageWidth = 0, ImageHeight = 0, bands = rep(rep(1, ImageHeight*ImageWidth), 3), @@ -18,7 +18,7 @@ \item{filename}{file name with extension (ideally an URL)} \item{obj}{object of class "SpatialPoints" (requires a single point object)} \item{pixmap}{object of class "pixmapRGB" (see package pixmap)} - \item{exif.info}{named list containing all available \href{https://exiftool.org/}{EXIF} metadata} + \item{exif.info}{named list containing all available \href{http://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/EXIF.html}{EXIF} metadata} \item{ImageWidth}{(optional) image width in pixels} \item{ImageHeight}{(optional) image height in pixels} \item{bands}{(optional) RGB bands as vectors (see \code{pixmap::pixmapRGB})} @@ -47,7 +47,7 @@ \item{PhotoOverlay}{list of the camera geometry parameters (KML specifications)} \item{sp}{location of the camera (\code{"SpatialPoints"} class)} } -\details{The most effective way to import a field photograph to \code{SpatialPhotoOverlay} for parsing to KML is to: (\strong{a}) use the \href{https://exiftool.org/}{EXIF tool} (courtesy of Phil Harvey) to add any important tags in the image file, (\strong{b}) once you've added all important tags, you can upload your image either to a local installation of Mediawiki or to a public portal such as the \href{https://commons.wikimedia.org/wiki/Special:UploadWizard}{Wikimedia Commons}, (\strong{c}) enter the missing information if necessary and add an image description. Once the image is on the server, you only need to record its unique name and then read all metadata from the Wikimedia server following the examples below.\cr +\details{The most effective way to import a field photograph to \code{SpatialPhotoOverlay} for parsing to KML is to: (\strong{a}) use the \href{http://www.sno.phy.queensu.ca/~phil/exiftool/}{EXIF tool} (courtesy of Phil Harvey) to add any important tags in the image file, (\strong{b}) once you've added all important tags, you can upload your image either to a local installation of Mediawiki or to a public portal such as the \href{http://commons.wikimedia.org/wiki/Special:UploadWizard}{Wikimedia Commons}, (\strong{c}) enter the missing information if necessary and add an image description. Once the image is on the server, you only need to record its unique name and then read all metadata from the Wikimedia server following the examples below.\cr You can also consider importing images to R by using the \code{pixmap} package, and reading the technical information via e.g. the \href{https://cran.r-project.org/package=exif}{\code{exif}} package. If the image is taken using a GPS enabled camera, by getting the EXIF metadata you can generate the complete \code{SpatialPhotoOverlay} object with minimum user interaction. Otherwise, you need to at least specify: creation date, file name, and location of the focal point of the camera (e.g. by creating \code{"SpatialPoints"} object). } \note{The \code{spPhoto} function will try to automatically fix the aspect ratio of the \code{ViewVolume} settings (\code{leftFov}, \code{rightFov}, \code{bottomFov}, \code{topFov}), and based on the original aspect ratio as specified in the EXIF data. This might not work for all images, in which case you will have to manually adjust those parameters.\cr @@ -55,8 +55,8 @@ Dimension of \code{3/36000*ImageWidth} in decimal degrees is about 10 m in natur } \references{ \itemize{ -\item EXIF tool (\url{https://exiftool.org/}) -\item Wikimedia API (\url{https://www.mediawiki.org/wiki/API}) +\item EXIF tool (\url{http://www.sno.phy.queensu.ca/~phil/exiftool/}) +\item Wikimedia API (\url{http://www.mediawiki.org/wiki/API}) } } \author{Tomislav Hengl} diff --git a/pkg/man/vect2rast.Rd b/pkg/man/vect2rast.Rd index 860d966..bd8a921 100644 --- a/pkg/man/vect2rast.Rd +++ b/pkg/man/vect2rast.Rd @@ -36,17 +36,17 @@ } \value{Returns an object of type \code{"SpatialGridDataFrame"}.} \details{ -This function basically extends the \code{\link{rasterize}} function available in the raster package. The advantage of \code{vect2rast}, however, is that it requires no input from the user's side i.e. it automatically determines the grid cell size and the bounding box based on the properties of the input data set. The grid cell size is estimated based on the density/size of features in the map (\code{nndist} function in \href{https://spatstat.org}{spatstat} package): (a) in the case of \code{"SpatialPoints"} cell size is determined as half the mean distance between the nearest points; (b) in the case of \code{"SpatialLines"} half cell size is determined as half the mean distance between the lines; (c) in the case of polygon data cell size is determined as half the median size (area) of polygons of interest. For more details see Hengl (2006); \doi{10.1016/j.cageo.2005.11.008}. To process larger vector maps consider using \code{method="SAGA"}. +This function basically extends the \code{\link{rasterize}} function available in the raster package. The advantage of \code{vect2rast}, however, is that it requires no input from the user's side i.e. it automatically determines the grid cell size and the bounding box based on the properties of the input data set. The grid cell size is estimated based on the density/size of features in the map (\code{nndist} function in \href{http://www.spatstat.org}{spatstat} package): (a) in the case of \code{"SpatialPoints"} cell size is determined as half the mean distance between the nearest points; (b) in the case of \code{"SpatialLines"} half cell size is determined as half the mean distance between the lines; (c) in the case of polygon data cell size is determined as half the median size (area) of polygons of interest. For more details see \href{http://dx.doi.org/10.1016/j.cageo.2005.11.008}{Hengl (2006)}. To process larger vector maps consider using \code{method="SAGA"}. } \references{ \itemize{ -\item Hengl T., (2006) Finding the right pixel size. Computers and Geosciences, 32(9): 1283-1298. \doi{10.1016/j.cageo.2005.11.008} +\item Hengl T., (2006) \href{http://dx.doi.org/10.1016/j.cageo.2005.11.008}{Finding the right pixel size}. Computers and Geosciences, 32(9): 1283-1298. \item Raster package (\url{https://CRAN.R-project.org/package=raster}) -\item SpatStat package (\url{https://spatstat.org}) +\item SpatStat package (\url{http://www.spatstat.org}) } } \author{Tomislav Hengl } -\seealso{ \code{\link{vect2rast.SpatialPoints}}, \code{raster::rasterize}} +\seealso{ \code{\link{vect2rast.SpatialPoints}}, \code{raster::rasterize}, \code{spatstat::nndist}} \examples{ \dontrun{ data(eberg) diff --git a/pkg/man/whitening.Rd b/pkg/man/whitening.Rd index 1455515..adf2436 100644 --- a/pkg/man/whitening.Rd +++ b/pkg/man/whitening.Rd @@ -16,11 +16,11 @@ whitening(z, zvar, zlim = c(min(z, na.rm=TRUE), max(z, na.rm=TRUE)), } \details{The HSI is a psychologically appealing color model for visualization of uncertainty: hue is used to visualize values and \emph{whitening} (\emph{paleness} or \emph{leaching} percentage) is used to visualize the uncertainty, or in other words the map is incomplete in the areas of high uncertainty. Unlike standard legends for continuous variables, this legend has two axis --- one for value range and one for uncertainty range (see also \code{\link{kml_legend.whitening}}).\cr The standard range for \code{elim} is 0.4 and 1.0 (maximum). This assumes that a satisfactory prediction is when the model explains more than 85\% of the total variation (normalized error = 40\%). Otherwise, if the value of the normalized error get above 80\%, the model accounts for less than 50\% of variability.\cr -Whitening is of special interest for visualization of the prediction errors in geostatistics. Formulas to derive the whitening color are explained in Hengl et al. (2004). } +Whitening is of special interest for visualization of the prediction errors in geostatistics. Formulas to derive the whitening color are explained in \href{http://dx.doi.org/10.1016/j.geoderma.2003.08.018}{Hengl et al. (2004)}. } \references{ \itemize{ -\item Hengl, T., Heuvelink, G.M.B., Stein, A., (2004) A generic framework for spatial prediction of soil variables based on regression-kriging. Geoderma 122 (1-2): 75-93. \doi{10.1016/j.geoderma.2003.08.018} -\item Hue-Saturation-Intensity color model (\url{https://en.wikipedia.org/wiki/HSL_and_HSV}) +\item Hengl, T., Heuvelink, G.M.B., Stein, A., (2004) \href{http://dx.doi.org/10.1016/j.geoderma.2003.08.018}{A generic framework for spatial prediction of soil variables based on regression-kriging}. Geoderma 122 (1-2): 75-93. +\item Hue-Saturation-Intensity color model (\url{http://en.wikipedia.org/wiki/HSL_and_HSV}) } } \author{ Tomislav Hengl and Pierre Roudier } diff --git a/pkg/man/worldgrids_pal.Rd b/pkg/man/worldgrids_pal.Rd index 62f75ec..06fdb9a 100644 --- a/pkg/man/worldgrids_pal.Rd +++ b/pkg/man/worldgrids_pal.Rd @@ -11,7 +11,7 @@ A number of color palettes used to visualize various environmental categorical / \describe{ \item{\code{anthroms}}{Color palette used for the global map of anthroms (Ellis and Ramankutty, 2008).} \item{\code{bodemfgr}}{A simplified color palette for soil types.} - \item{\code{corine2k}}{Color palette used in the Corine 2000 project for land cover classes (\enc{Büttner}{Buttner}, et al., 2002).} + \item{\code{corine2k}}{Color palette used in the Corine 2000 project for land cover classes (\enc{Büttner}{Buttner}, et al., 2002).} \item{\code{glc2000}}{Color palette used for the Global Land Cover 2000 mapping project (Global Land Cover 2000).} \item{\code{globcov}}{Color palette used for the ENVISAT-based Global Land Cover map at resolution of 300 m (GlobCover Land Cover version V2.2).} \item{\code{gtkaart}}{Color palette used for the Ground water levels map of the Netherlands (Gaast et al. 2005).} @@ -28,7 +28,7 @@ data(worldgrids_pal) \references{ \itemize{ \item Bicheron, P. et al. (2008) GLOBCOVER: Products Description and Validation Report. MEDIAS France, Toulouse, 47 p. -\item \enc{Büttner}{Buttner}, G. et al. (2002) Corine Land Cover update 2000, Technical guidelines. EEA (European Environment Agency), Kopenhagen. +\item \enc{Büttner}{Buttner}, G. et al. (2002) Corine Land Cover update 2000, Technical guidelines. EEA (European Environment Agency), Kopenhagen. \item Ellis, E.C., Ramankutty, N. (2008) Putting people in the map: anthropogenic biomes of the world. Frontiers in Ecology and the Environment, Vol. 6, No. 8, pp. 439-447. \item Fritz, S. et al. (2003) Harmonisation, mosaicing and production of the Global Land Cover 2000 database. JRC report EUR 20849 EN, Luxembourg, 41 p. \item Gaast, J.W.J. van der, H.R.J. Vroon en M. Pleijter, (2006) De grondwaterdynamiek in het waterschap Regge en Dinkel. Wageningen, Alterra-rapport 1335. diff --git a/pkg/vignettes/jss1079.R b/pkg/vignettes/jss1079.R index e7b9bab..97fdda3 100644 --- a/pkg/vignettes/jss1079.R +++ b/pkg/vignettes/jss1079.R @@ -1,147 +1,148 @@ -### R code from vignette source 'jss1079.Rnw' - -################################################### -### code chunk number 1: jss1079.Rnw:69-73 -################################################### -if(!require(gstat)){install.packages("gstat"); library(gstat)} -if(!require(raster)){install.packages("raster"); library(raster)} -if(!require(plotKML)){install.packages("plotKML"); library(plotKML)} -if(!require(GSIF)){install.packages("GSIF"); library(GSIF)} - - -################################################### -### code chunk number 2: jss1079.Rnw:76-77 -################################################### -options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) - - -################################################### -### code chunk number 3: jss1079.Rnw:83-86 -################################################### -rm(list=ls()) -plotKML.version <- sessionInfo()[["otherPkgs"]][["plotKML"]][["Version"]] -plotKML.env(show.env = FALSE) - - -################################################### -### code chunk number 4: jss1079.Rnw:185-192 -################################################### -library("sp") -lat = 37.423156 -lon = -122.084917 -name = "Google headquarters" -pnt = data.frame(name, lat, lon) -coordinates(pnt) <- ~lon+lat -proj4string(pnt) <- CRS("+proj=longlat +datum=WGS84") - - -################################################### -### code chunk number 5: jss1079.Rnw:213-223 -################################################### -library("XML") -pnt.kml <- newXMLNode("kml") -h2 <- newXMLNode("Document", parent = pnt.kml) -h3 <- newXMLNode("name", "Google headquarters", parent = h2) -h4 <- newXMLNode("Folder", parent=pnt.kml[["Document"]]) -txtc <- sprintf(' - %.5f,%.5f,%.0f', - coordinates(pnt)[,1], coordinates(pnt)[,2], rep(0, length(pnt))) -parseXMLAndAdd(txtc, parent = h4) -pnt.kml - - -################################################### -### code chunk number 6: jss1079.Rnw:255-260 -################################################### -library("plotKML") -data("eberg") -eberg <- eberg[runif(nrow(eberg))<.2,] -coordinates(eberg) <- ~X+Y -proj4string(eberg) <- CRS("+init=epsg:31467") - - -################################################### -### code chunk number 7: jss1079.Rnw:265-266 -################################################### -eberg.ll <- reproject(eberg) - - -################################################### -### code chunk number 8: jss1079.Rnw:271-272 -################################################### -kml(eberg.ll["CLYMHT_A"], colour=CLYMHT_A) - - -################################################### -### code chunk number 9: jss1079.Rnw:289-291 -################################################### -spplot(eberg.ll["CLYMHT_A"], edge.col="black", - alpha=0.8, cex=seq(.3,3,length=5)) - - -################################################### -### code chunk number 10: jss1079.Rnw:326-329 -################################################### -shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" -kml(eberg.ll, shape = shape, colour = CLYMHT_A, labels = SNDMHT_A, - altitude = SNDMHT_A*10, extrude = TRUE) - - -################################################### -### code chunk number 11: jss1079.Rnw:366-370 -################################################### -data("eberg_grid") -coordinates(eberg_grid) <- ~x+y -gridded(eberg_grid) <- TRUE -proj4string(eberg_grid) <- CRS("+init=epsg:31467") - - -################################################### -### code chunk number 12: jss1079.Rnw:375-379 -################################################### -kml_open("eberg.kml") -kml_layer(eberg_grid, colour=TWISRT6) -kml_layer(eberg.ll[1,], colour=CLYMHT_A) -kml_close("eberg.kml") - - -################################################### -### code chunk number 13: jss1079.Rnw:418-420 -################################################### -library("sp") -demo(meuse, echo=FALSE) - - -################################################### -### code chunk number 14: jss1079.Rnw:425-429 -################################################### -library("GSIF") -omm <- fit.gstatModel(meuse, om~dist+ffreq, meuse.grid, - family = gaussian(log)) -om.rk <- predict(omm, meuse.grid) - - -################################################### -### code chunk number 15: jss1079.Rnw:475-489 -################################################### -data("fmd") -fmd0 <- data.frame(fmd) -coordinates(fmd0) <- c("X", "Y") -proj4string(fmd0) <- CRS("+init=epsg:27700") -fmd_sp <- as(fmd0, "SpatialPoints") -dates <- as.Date("2001-02-18")+fmd0$ReportedDay -library("spacetime") -fmd_ST <- STIDF(fmd_sp, dates, data.frame(ReportedDay=fmd0$ReportedDay)) -data("northcumbria") -ln <- Line(northcumbria) -NC <- SpatialLines(list(Lines(list(ln), ID="NC"))) -proj4string(NC) <- CRS("+init=epsg:27700") -stplot(fmd_ST, sp.layout=list("sp.lines", NC), col.regions=SAGA_pal[[1]]) - - -################################################### -### code chunk number 16: jss1079.Rnw:496-497 -################################################### -kml(fmd_ST, colour=ReportedDay, colour_scale=SAGA_pal[[1]]) - - +### R code from vignette source 'jss1079.Rnw' +### Encoding: ISO8859-1 + +################################################### +### code chunk number 1: jss1079.Rnw:69-73 +################################################### +if(!require(gstat)){install.packages("gstat"); library(gstat)} +if(!require(raster)){install.packages("raster"); library(raster)} +if(!require(plotKML)){install.packages("plotKML"); library(plotKML)} +if(!require(GSIF)){install.packages("GSIF"); library(GSIF)} + + +################################################### +### code chunk number 2: jss1079.Rnw:76-77 +################################################### +options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) + + +################################################### +### code chunk number 3: jss1079.Rnw:83-86 +################################################### +rm(list=ls()) +plotKML.version <- sessionInfo()[["otherPkgs"]][["plotKML"]][["Version"]] +plotKML.env(show.env = FALSE) + + +################################################### +### code chunk number 4: jss1079.Rnw:185-192 +################################################### +library("sp") +lat = 37.423156 +lon = -122.084917 +name = "Google headquarters" +pnt = data.frame(name, lat, lon) +coordinates(pnt) <- ~lon+lat +proj4string(pnt) <- CRS("+proj=longlat +datum=WGS84") + + +################################################### +### code chunk number 5: jss1079.Rnw:213-223 +################################################### +library("XML") +pnt.kml <- newXMLNode("kml") +h2 <- newXMLNode("Document", parent = pnt.kml) +h3 <- newXMLNode("name", "Google headquarters", parent = h2) +h4 <- newXMLNode("Folder", parent=pnt.kml[["Document"]]) +txtc <- sprintf(' + %.5f,%.5f,%.0f', + coordinates(pnt)[,1], coordinates(pnt)[,2], rep(0, length(pnt))) +parseXMLAndAdd(txtc, parent = h4) +pnt.kml + + +################################################### +### code chunk number 6: jss1079.Rnw:255-260 +################################################### +library("plotKML") +data("eberg") +eberg <- eberg[runif(nrow(eberg))<.2,] +coordinates(eberg) <- ~X+Y +proj4string(eberg) <- CRS("+init=epsg:31467") + + +################################################### +### code chunk number 7: jss1079.Rnw:265-266 +################################################### +eberg.ll <- reproject(eberg) + + +################################################### +### code chunk number 8: jss1079.Rnw:271-272 +################################################### +kml(eberg.ll["CLYMHT_A"], colour=CLYMHT_A) + + +################################################### +### code chunk number 9: jss1079.Rnw:289-291 +################################################### +spplot(eberg.ll["CLYMHT_A"], edge.col="black", + alpha=0.8, cex=seq(.3,3,length=5)) + + +################################################### +### code chunk number 10: jss1079.Rnw:326-329 +################################################### +shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" +kml(eberg.ll, shape = shape, colour = CLYMHT_A, labels = SNDMHT_A, + altitude = SNDMHT_A*10, extrude = TRUE) + + +################################################### +### code chunk number 11: jss1079.Rnw:366-370 +################################################### +data("eberg_grid") +coordinates(eberg_grid) <- ~x+y +gridded(eberg_grid) <- TRUE +proj4string(eberg_grid) <- CRS("+init=epsg:31467") + + +################################################### +### code chunk number 12: jss1079.Rnw:375-379 +################################################### +kml_open("eberg.kml") +kml_layer(eberg_grid, colour=TWISRT6) +kml_layer(eberg.ll[1,], colour=CLYMHT_A) +kml_close("eberg.kml") + + +################################################### +### code chunk number 13: jss1079.Rnw:418-420 +################################################### +library("sp") +demo(meuse, echo=FALSE) + + +################################################### +### code chunk number 14: jss1079.Rnw:425-429 +################################################### +library("GSIF") +omm <- fit.gstatModel(meuse, om~dist+ffreq, meuse.grid, + family = gaussian(log)) +om.rk <- predict(omm, meuse.grid) + + +################################################### +### code chunk number 15: jss1079.Rnw:475-489 +################################################### +data("fmd") +fmd0 <- data.frame(fmd) +coordinates(fmd0) <- c("X", "Y") +proj4string(fmd0) <- CRS("+init=epsg:27700") +fmd_sp <- as(fmd0, "SpatialPoints") +dates <- as.Date("2001-02-18")+fmd0$ReportedDay +library("spacetime") +fmd_ST <- STIDF(fmd_sp, dates, data.frame(ReportedDay=fmd0$ReportedDay)) +data("northcumbria") +ln <- Line(northcumbria) +NC <- SpatialLines(list(Lines(list(ln), ID="NC"))) +proj4string(NC) <- CRS("+init=epsg:27700") +stplot(fmd_ST, sp.layout=list("sp.lines", NC), col.regions=SAGA_pal[[1]]) + + +################################################### +### code chunk number 16: jss1079.Rnw:496-497 +################################################### +kml(fmd_ST, colour=ReportedDay, colour_scale=SAGA_pal[[1]]) + + diff --git a/pkg/vignettes/jss1079.Rnw b/pkg/vignettes/jss1079.Rnw index 39fb210..7586f59 100644 --- a/pkg/vignettes/jss1079.Rnw +++ b/pkg/vignettes/jss1079.Rnw @@ -34,26 +34,23 @@ %% in the following format: \Address{ T. Hengl \\ - OpenGeoHub foundation \\ - Roghorst 206, 6708 KT Wageningen, the Netherlands \\ - Tel.: +31- 317-427537\\ - E-mail: \email{tom.hengl@opengeohub.org}\\ + ISRIC --- World Soil Information \\ + P.O. Box 353, 6700 AJ Wageningen, the Netherlands \\ + Tel.: +31- 317-484199\\ + E-mail: \email{tom.hengl@wur.nl}\\ } %% for those who use Sweave please include the following line (with % symbols): %% need no \usepackage{Sweave.sty} -\usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage{amssymb} \usepackage{verbatim} \usepackage{xcolor,graphicx} \usepackage{booktabs} \usepackage{latexsym} -\usepackage{array,tabularx,rotating} %Table format packages +\usepackage{array,tabularx,multirow,rotating} %Table format packages \usepackage{hyperref} -\usepackage{multirow} -\usepackage{textcomp} \hypersetup{colorlinks=true, linkcolor=black, citecolor=black, urlcolor=black, bookmarksnumbered=true, bookmarksopen=true, pdfview=FitH, pdfstartview=FitH, @@ -66,14 +63,14 @@ \begin{document} %\VignetteIndexEntry{ plotKML: Scientific Visualization of Spatio-temporal Data } -%% jss options, see https://www.jstatsoft.org/style +%% jss options, see http://www.jstatsoft.org/style %% make sure all packages are there already, if not go and get them <>= if(!require(gstat)){install.packages("gstat"); library(gstat)} if(!require(raster)){install.packages("raster"); library(raster)} if(!require(plotKML)){install.packages("plotKML"); library(plotKML)} -if(!require(landmap)){install.packages("landmap"); library(landmap)} +if(!require(GSIF)){install.packages("GSIF"); library(GSIF)} @ <>= @@ -104,7 +101,7 @@ Keyhole Markup Language (KML) is an XML language focused on geographic visualiza Although \proglang{R} is primarily known as a statistical computing environment \citep{RTeam2005R}, it is of increasing interest to the field of geoinformatics and applied spatial data analysis due to its extensibility and the growing diversity of spatial and spatio-temporal data structures \citep{pebesma2005classes,Pebesma2010Ifgi,Bivand2013Springer}. Geo-visualization functions in \proglang{R}, on the other hand, are limited because \proglang{R} was not originally designed for interactive exploration of spatial data or as a GIS platform. Although there are many packages in \proglang{R} already that allow interactive visualization, overlay and animated display of geographical phenomena (via packages \href{http://www.ggobi.org/rggobi/}{\pkg{RGGOBI}} and \pkg{iPlots}; for a review refer to \citep{CookSwayne2007} and/or \citep{theus2009interactive}), \proglang{R} has its limitations for interactively exploring geographical data. \par -There is considerable potential for building connectivity between the sophisticated spatial analysis possible in \proglang{R} and the geo-visualization capacities afforded by Google Earth. However, the export of spatial data from \proglang{R} to KML is not trivial. KML files can be produced using the using GDAL (Geospatial Data Abstraction Library) KML driver, but so far only limited functionality is supported. As the driver description page indicates: \emph{``At this time, only vector layers are handled by the KML driver$\ldots$ limited support is available for fills, line color and other styling attributes.''}\footnote{\url{https://gdal.org/ogr/drv_kml.html}}\par +There is considerable potential for building connectivity between the sophisticated spatial analysis possible in \proglang{R} and the geo-visualization capacities afforded by Google Earth. However, the export of spatial data from \proglang{R} to KML is not trivial. KML files can be produced using the using GDAL (Geospatial Data Abstraction Library) KML driver, but so far only limited functionality is supported. As the driver description page indicates: \emph{``At this time, only vector layers are handled by the KML driver$\ldots$ limited support is available for fills, line color and other styling attributes.''}\footnote{\url{http://www.gdal.org/ogr/drv_kml.html}}\par Within the \proglang{R} community, other packages produced specifically to allow creation of KML files include: \pkg{rgdal} \citep{rgdal} and \pkg{raster} \citep{raster}, while truly specialized KML writing packages include \pkg{R2G2} \citep{Arigo2012} and \pkg{RKML}\footnote{\url{http://www.omegahat.org/RKML/}}. Our objective with the \pkg{plotKML} package was to provide a simple interface to generate KML files with a small number of arguments, and allow users to directly plot spatio-temporal data classes, available in \proglang{R} via the \pkg{sp} \citep{pebesma2005classes}, \pkg{spacetime} \citep{spacetime}, \pkg{aqp} \citep{aqp} and \pkg{raster} \citep{raster} packages, in a virtual globe type of browser. \par @@ -115,7 +112,7 @@ This article describes the main functionality and the design of the \pkg{plotKML \subsection{Scientific visualization of geographic phenomena} -The purpose of scientific visualization is to \emph{``graphically illustrate scientific data to enable scientists to understand, illustrate, and glean insight from their data.''}\footnote{\url{https://en.wikipedia.org/wiki/Scientific_visualization}} According to \citet{Friendly2001}, scientific visualization can be primarily connected with visualization of 3D data \emph{``where the emphasis is on realistic renderings of volumes, surfaces, illumination sources, and so forth, perhaps with a dynamic (time) component.''} In that context, the main purpose of \pkg{plotKML} package is to enable interactive scientific visualization of geographic phenomena i.e.\@ scientific geovisualization \citep{dykes2005exploring}.\par +The purpose of scientific visualization is to \emph{``graphically illustrate scientific data to enable scientists to understand, illustrate, and glean insight from their data.''}\footnote{\url{http://en.wikipedia.org/wiki/Scientific_visualization}} According to \citet{Friendly2001}, scientific visualization can be primarily connected with visualization of 3D data \emph{``where the emphasis is on realistic renderings of volumes, surfaces, illumination sources, and so forth, perhaps with a dynamic (time) component.''} In that context, the main purpose of \pkg{plotKML} package is to enable interactive scientific visualization of geographic phenomena i.e.\@ scientific geovisualization \citep{dykes2005exploring}.\par Interactive geovisualization, i.e.\@ dynamic user-controlled visualization of geographical phenomena, can be today closely connected with 3D computer environments referred to as the \emph{`Virtual globe'}, \emph{`Virtual Earth'} or \emph{`Digital Earth'} \citep{gore1998digital,bleisch2011evaluating}. At the beginning of 21st century, the most known virtual globes are \citep{bleisch2011evaluating}: @@ -423,19 +420,16 @@ library("sp") demo(meuse, echo=FALSE) @ -Via the \pkg{landmap} package \citep{landmap} we can automate the model fitting and prediction: +Via the \pkg{GSIF} package we can automate the model fitting and prediction: -\begin{CodeChunk} -\begin{CodeInput} -R> library("landmap") -R> sl = c("regr.ranger", "regr.nnet", "regr.glm") -R > omm <- train.spLearner(meuse["om"], covariates=meuse.grid[,c("dist","ffreq")], -+ lambda=0, parallel=FALSE, SL.library=sl) -R> pred <- predict(omm) -\end{CodeInput} -\end{CodeChunk} +<<>>= +library("GSIF") +omm <- fit.gstatModel(meuse, om~dist+ffreq, meuse.grid, + family = gaussian(log)) +om.rk <- predict(omm, meuse.grid) +@ -\noindent here the generic function \verb"train.spLearner" from the \pkg{landmap} package tries to fit a spatial prediction model following the input samples (\verb"meuse") and gridded maps (\verb"meuse.grid"). The output (object of class \verb'"SpatialPredictions"') can be plotted in Google Earth by running: +\noindent here the generic function \verb"fit.gstatModel" from the \pkg{GSIF} package \citep{GSIF} tries to fit a linear regression-kriging model following the input samples (\verb"meuse") and gridded maps (\verb"meuse.grid"). The output (object of class \verb'"SpatialPredictions"') can be plotted in Google Earth by running: \begin{CodeChunk} \begin{CodeInput} @@ -452,7 +446,7 @@ Closing om.rk.kml \end{CodeOutput} \end{CodeChunk} -\noindent which shows most of elements of geostatistical mapping of interest: sampling locations, resulting spatial predictions, but also success of regression model fitting. Note also that wrapping model fitting and export to KML allows full automation of the mapping process, so that such processes could also be run on a server \citep{pebesma2011intamap}.\par +\noindent which shows most of elements of geostatistical mapping of interest: sampling locations, resulting spatial predictions, but also success of regression model fitting, variogram fitting and cross-validation. Note also that wrapping model fitting and export to KML allows full automation of the mapping process, so that the process can be run on a server \citep{pebesma2011intamap}.\par \subsection{Visualization of spatio-temporal classes}\label{sec:spacetime_example} diff --git a/pkg/vignettes/jss1079.bib b/pkg/vignettes/jss1079.bib index 811e5f6..5f234e9 100644 --- a/pkg/vignettes/jss1079.bib +++ b/pkg/vignettes/jss1079.bib @@ -1,430 +1,430 @@ - -@PHDTHESIS{Conrad2007PhD, - author = {Conrad, O.}, - title = {{SAGA --- Entwurf, Funktionsumfang und Anwendung eines Systems f\"{u}r - Automatisierte Geowissenschaftliche Analysen}}, - school = {University of G\"{o}ttingen}, - year = {2007}, - address = {G\"{o}ttingen} -} - -@BOOK{Bivand2013Springer, - title = {Applied Spatial Data Analysis with \proglang{R}}, - publisher = {Springer-Verlag}, - year = {2013}, - author = {Bivand, R. and Pebesma, E. and Rubio, V.}, - pages = {402}, - edition = {2nd}, - series = {Use R Series}, - address = {Heidelberg} -} - -@article{Grothendieck:2008:JSSOBK:v25b02, - author = "Garothendieck Gabor", - title = {lattice: Multivariate Data Visualization with \proglang{R}}, - journal = "Journal of Statistical Software, Book Reviews", - volume = "25", - number = "2", - pages = "1--3", - day = "8", - month = "5", - year = "2008", - CODEN = "JSSOBK", - ISSN = "1548-7660", - bibdate = "2008-05-08", - URL = "https://www.jstatsoft.org/v25/b02", - accepted = "2008-05-08", - acknowledgement = "", - keywords = "", - submitted = "2008-05-08", -} - -@article{diggle2005point, - title={Point process methodology for on-line spatio-temporal disease surveillance}, - author={Diggle, Peter and Rowlingson, Barry and Su, Ting-li}, - journal={Environmetrics}, - volume={16}, - number={5}, - pages={423--434}, - year={2005}, - publisher={Wiley Online Library} -} - -@article{elmqvist2007occlusion, - title={{Occlusion Management in Immersive and Desktop 3D Virtual Environments: Theory and Evaluation}}, - author={Elmqvist, Niklas and Tudoreanu, Mihail Eduard}, - journal={International Journal of Virtual Reality}, - volume={6}, - number={2}, - pages={21--32}, - year={2007} -} - -@article{gore1998digital, - title={The digital earth: understanding our planet in the 21st century}, - author={Gore, Al}, - journal={Australian surveyor}, - volume={43}, - number={2}, - pages={89--91}, - year={1998}, - publisher={Taylor \& Francis} -} - -@book{dykes2005exploring, - title={{Exploring Geovisualization}}, - author={Dykes, J. and MacEachren, A.M. and Kraak, J.}, - isbn={9780080531472}, - series={International Cartographic Association}, - year={2005}, - publisher={Elsevier Science} -} - -@PHDTHESIS{bleisch2011evaluating, - title={{Evaluating the Appropriateness of Visually Combining Quantitative Data Representations with 3D Desktop Virtual Environments Using Mixed Methods}}, - author={Bleisch, S.}, - year={2011}, - type={PhD thesis}, - pages={207}, - school={City University London} -} - -@misc{Friendly2001, - AUTHOR = {Friendly, M. and Denis, D. J.}, - TITLE = {Milestones in the history of thematic cartography, statistical graphics, and data visualization}, - JOURNAL = {Milestones Project}, - YEAR = {2001}, - type = {project page}, - month = {December}, - url = {http://www.datavis.ca/milestones/} -} - -@ARTICLE{Goodchild2008, - author = {Goodchild, Michael F.}, - title = {{Commentary: whither VGI?}}, - journal = {GeoJournal}, - year = {2008}, - volume = {72}, - pages = {239-244}, - number = {3-4}, - doi = {10.1007/s10708-008-9190-4}, - issn = {0343-2521}, - publisher = {Springer Netherlands} -} - -@article{fritz2012geo, - title={{Geo-Wiki: An online platform for improving global land cover}}, - author={Fritz, Steffen and McCallum, Ian and Schill, Christian and Perger, Christoph and See, Linda and Schepaschenko, Dmitry and van der Velde, Marijn and Kraxner, Florian and Obersteiner, Michael}, - journal={Environmental Modelling \& Software}, - volume={31}, - pages={110--123}, - year={2012}, - publisher={Elsevier} -} - -@TECHREPORT{OGCKML2008, - AUTHOR = {Wilson, Tim}, - TITLE = {{OGC KML}}, - INSTITUTION = {Open Geospatial Consortium Inc.}, - YEAR = {2008}, - type = {OGC Standard}, - number = {OGC 07-147r2}, -} - -@book{wernecke2009kml, - title={{The KML handbook: geographic visualization for the Web}}, - author={Wernecke, J.}, - isbn={9780321525598}, - lccn={2008033499}, - year={2009}, - publisher={Addison-Wesley} -} - -@article{Butler2006, -author = "Butler, Declan", -title = {{Virtual globes: The web-wide world}}, -journal = "Nature", -volume = "439", -pages = "776-778", -year = "2006" -} - -@ARTICLE{Patterson2007, - author = {Patterson, Todd C.}, - title = {{Google Earth as a (Not Just) Geography Education Tool}}, - journal = {Journal of Geography}, - year = {2007}, - volume = {106}, - pages = {145-152}, - number = {4} -} - -@BOOK{McGavra2009DPC, - title = {{Technology Watch Report: Preserving Geospatial Data}}, - publisher = {Digital Preservation Coalition}, - year = {2009}, - author = {McGavra, G. and Morris, S. and Jan\'{e}e, G.}, - pages = {34}, - series = {DPC Technology Watch Series Report 09-01}, - address = {York, UK} -} - -@ARTICLE{Craglia2008IJSDIR, - author = {Craglia, M. and Goodchild, M.F. and Annoni, A. and Camara, G. and Gould, M. and Kuhn, W. and Mark, D. and Masser, I. and - Maguire, D. and Liang, S. and Parsons, E.}, - title = {{Next-Generation Digital Earth: A position paper from the Vespucci Initiative for the Advancement of Geographic Information - Science}}, - journal = {International Journal of Spatial Data Infrastructures Research}, - year = {2008}, - volume = {3}, - pages = {146--167}, - number = {6} -} - -@article{Pebesma2010Ifgi, - AUTHOR = {Pebesma, E.}, - TITLE = {\pkg{spacetime}: Spatio-Temporal Data in \proglang{R}}, - JOURNAL = {Journal of Statistical Software}, - YEAR = {2012}, - VOLUME = {51}, - ISSUE = {7}, - PAGES = {1-30}, -} - -@Manual{aqp, - title = {\pkg{aqp}: Algorithms for Quantitative Pedology}, - author = {Beaudette, Dylan and Roudier, Pierre}, - year = {2012}, - note = {\proglang{R}~package version~1.4}, - url = {http://CRAN.R-project.org/package=aqp}, -} - -@Manual{XML, - title = {\pkg{XML}: Tools for parsing and generating XML within \proglang{R} and \proglang{S}-PLUS}, - author = {Lang, Duncan Temple}, - year = {2013}, - note = {\proglang{R}~package version~3.98-1.1}, - url = {http://CRAN.R-project.org/package=XML}, -} - -@Manual{sp, - title = {\pkg{sp}: classes and methods for spatial data}, - author = {Pebesma, Edzer and Bivand, Roger}, - year = {2012}, - note = {\proglang{R}~package version~1.0-5}, - url = {http://CRAN.R-project.org/package=sp}, -} - -@ARTICLE{Pebesma2004CG, - author = {Pebesma, Edzer J.}, - title = {{Multivariable geostatistics in \proglang{S}: the \pkg{gstat} package}}, - journal = {Computers \& Geosciences}, - year = {2004}, - volume = {30}, - pages = {683-691}, - number = {7} -} - -@article{pebesma2005classes, - title={Classes and methods for spatial data in \proglang{R}}, - author={Pebesma, Edzer J and Bivand, Roger S}, - journal={\proglang{R} news}, - volume={5}, - number={2}, - pages={9--13}, - year={2005} -} - -@Manual{raster, - title = {\pkg{raster}: Geographic data analysis and modeling}, - author = {Hijmans, Robert J. and {van Etten}, Jacob}, - year = {2012}, - note = {\proglang{R}~package version~2.0-41}, - url = {http://CRAN.R-project.org/package=raster}, -} - -@Manual{rgdal, - title = {\pkg{rgdal}: Bindings for the Geospatial Data Abstraction Library}, - author = {Keitt, Timothy H. and Bivand, Roger and Pebesma, Edzer and Rowlingson, Barry}, - year = {2013}, - note = {\proglang{R}~package version~0.8-3}, - url = {http://CRAN.R-project.org/package=rgdal}, -} - -@Manual{lattice, - title = {\pkg{lattice}: Lattice Graphics}, - author = {Sarkar, Deepayan}, - year = {2013}, - note = {\proglang{R}~package version~0.20-13}, - url = {http://CRAN.R-project.org/package=lattice}, -} - -@Manual{spacetime, - title = {\pkg{spacetime}: classes and methods for spatio-temporal data}, - author = {Pebesma, Edzer}, - year = {2012}, - note = {\proglang{R}~package version~1.0-3}, - url = {http://CRAN.R-project.org/package=spacetime}, -} - -@Manual{landmap, - title = {\pkg{landmap}: Automated Spatial Prediction using Ensemble Machine Learning}, - author = {Hengl, Tomislav}, - year = {2021}, - note = {\proglang{R}~package version~0.8-0}, - url = {http://CRAN.R-project.org/package=landmap}, -} - -@Manual{stpp, - title = {\pkg{stpp}: Space-Time Point Pattern simulation, visualisation and analysis}, - author = {Gabriel, Edith and Diggle, Peter J. and Rowlingson, Barry}, - year = {2013}, - note = {\proglang{R}~package version~1.0-3}, - url = {http://CRAN.R-project.org/package=stpp}, -} - -@BOOK{Bivand2008Springer, - title = {Applied Spatial Data Analysis with \proglang{R}}, - publisher = {Springer-Verlag}, - year = {2008}, - author = {Bivand, R. and Pebesma, E. and Rubio, V.}, - pages = {400}, - series = {Use R Series}, - address = {Heidelberg} -} - -@misc{Sightseer2011, - AUTHOR = {McClendon, Brian}, - TITLE = {Google Earth downloaded more than one billion times}, - JOURNAL = {Google LatLong Blogspot}, - YEAR = {2011}, - type = {Blog}, - month = {October}, - url = {http://google-latlong.blogspot.com} -} - -@misc{Buettel2012, - AUTHOR = {Eddelbuettel, Dirk}, - TITLE = {{Counting CRAN Package Depends, Imports and Linking To}}, - JOURNAL = {Dirk Eddelbuettel's Blog}, - YEAR = {2012}, - type = {Blog}, - month = {August 16th}, - url = {http://dirk.eddelbuettel.com} -} - -@book{CookSwayne2007, - author = {Dianne Cook and Deborah F. Swayne}, - title = {{Interactive and Dynamic Graphics for Data Analysis}}, - publisher = {Springer-Verlag}, - year = 2007, - address = {New York}, - isbn = {978-0-387-71761-6} -} - -@book{theus2009interactive, - title={Interactive graphics for data analysis: principles and examples}, - author={Theus, M. and Urbanek, S.}, - isbn={9781584885948}, - lccn={2008038130}, - series={Series in computer science and data analysis}, - year={2009}, - publisher={CRC Press} -} - -@ARTICLE{Erwig1999GeoInformatica, - author = {Erwig, Martin and G\"{u}ting, Ralf Hartmut and Schneider, Markus and - Vazirgiannis, Michalis}, - title = {{Spatio-Temporal Data Types: An Approach to Modeling and Querying - Moving Objects in Databases}}, - journal = {GeoInformatica}, - year = {1999}, - volume = {3}, - pages = {269-296}, - issue = {3}, - keyword = {Earth and Environmental Science}, - publisher = {Springer Netherlands} -} - -@ARTICLE{galton2004fields, - author = {Galton, A.}, - title = {Fields and objects in space, time, and space-time}, - journal = {Spatial cognition and computation}, - year = {2004}, - volume = {4}, - pages = {39--68}, - number = {1}, - publisher = {Taylor \& Francis} -} - -@BOOK{RTeam2005R, - title = {\proglang{R}: A language and environment for statistical computing}, - publisher = {\proglang{R} Foundation for Statistical Computing}, - year = {2013}, - author = {\proglang{R} Development Core Team}}, - pages = {1731}, - address = {Vienna, Austria}, - isbn = {3900051070}, - url = {http://www.R-project.org/} -} - -@article{pebesma2011intamap, - title={{INTAMAP: the design and implementation of an interoperable automated interpolation web service}}, - author={Pebesma, Edzer and Cornford, Dan and Dubois, Gregoire and Heuvelink, Gerard and Hristopulos, Dionisis and Pilz, J{\"u}rgen and St{\"o}hlker, Ulrich and Morin, Gary and Sk{\o}ien, Jon O}, - journal={Computers \& Geosciences}, - volume={37}, - number={3}, - pages={343--352}, - year={2011}, - publisher={Elsevier} -} - -@ARTICLE{Hengl2011TAC, - author = {Hengl, Tomislav and Heuvelink, Gerard and Per\v{c}ec Tadi\'{c}, Melita and Pebesma, Edzer}, - title = {Spatio-temporal prediction of daily temperatures using time-series - of {MODIS} {LST} images}, - journal = {Theoretical and Applied Climatology}, - year = {2012}, - volume = {107}, - pages = {265-277}, - issue = {1}, - publisher = {Springer Wien} -} - -@article{DePaor2011GGM, - author = {{De Paor}, Declan G. and Whitmeyer, Steven J.}, - title = {{Geological and geophysical modeling on virtual globes using KML, COLLADA, and Javascript}}, - journal = {Computers \& Geosciences}, - issue_date = {January, 2011}, - volume = {37}, - number = {1}, - month = jan, - year = {2011}, - pages = {100--110}, - numpages = {11}, - acmid = {1924844}, - publisher = {Pergamon Press, Inc.}, - address = {Tarrytown, NY, USA} -} - -@ARTICLE{Arigo2012, - author = {Arrigo, Nils and Albert, Loren P. and Mickelson, Pascal G. and Barker, - Michael S.}, - title = {{Quantitative visualization of biological data in Google Earth using - \pkg{R2G2}, an \proglang{R} CRAN package}}, - journal = {Molecular Ecology Resources}, - year = {2012}, - volume = {12}, - pages = {1177--1179}, - number = {6} -} - -@article{Blenkinsop2012CG, -title = {{Visualizing structural geology: From Excel to Google Earth}}, -journal = "Computers \& Geosciences", -volume = "45", -number = "0", -pages = "52--56", -year = "2012", -author = "Blenkinsop, T.G." -} + +@PHDTHESIS{Conrad2007PhD, + author = {Conrad, O.}, + title = {{SAGA --- Entwurf, Funktionsumfang und Anwendung eines Systems f\"{u}r + Automatisierte Geowissenschaftliche Analysen}}, + school = {University of G\"{o}ttingen}, + year = {2007}, + address = {G\"{o}ttingen} +} + +@BOOK{Bivand2013Springer, + title = {Applied Spatial Data Analysis with \proglang{R}}, + publisher = {Springer-Verlag}, + year = {2013}, + author = {Bivand, R. and Pebesma, E. and Rubio, V.}, + pages = {402}, + edition = {2nd}, + series = {Use R Series}, + address = {Heidelberg} +} + +@article{Grothendieck:2008:JSSOBK:v25b02, + author = "Gabor Grothendieck", + title = {lattice: Multivariate Data Visualization with \proglang{R}}, + journal = "Journal of Statistical Software, Book Reviews", + volume = "25", + number = "2", + pages = "1--3", + day = "8", + month = "5", + year = "2008", + CODEN = "JSSOBK", + ISSN = "1548-7660", + bibdate = "2008-05-08", + URL = "http://www.jstatsoft.org/v25/b02", + accepted = "2008-05-08", + acknowledgement = "", + keywords = "", + submitted = "2008-05-08", +} + +@article{diggle2005point, + title={Point process methodology for on-line spatio-temporal disease surveillance}, + author={Diggle, Peter and Rowlingson, Barry and Su, Ting-li}, + journal={Environmetrics}, + volume={16}, + number={5}, + pages={423--434}, + year={2005}, + publisher={Wiley Online Library} +} + +@article{elmqvist2007occlusion, + title={{Occlusion Management in Immersive and Desktop 3D Virtual Environments: Theory and Evaluation}}, + author={Elmqvist, Niklas and Tudoreanu, Mihail Eduard}, + journal={International Journal of Virtual Reality}, + volume={6}, + number={2}, + pages={21--32}, + year={2007} +} + +@article{gore1998digital, + title={The digital earth: understanding our planet in the 21st century}, + author={Gore, Al}, + journal={Australian surveyor}, + volume={43}, + number={2}, + pages={89--91}, + year={1998}, + publisher={Taylor \& Francis} +} + +@book{dykes2005exploring, + title={{Exploring Geovisualization}}, + author={Dykes, J. and MacEachren, A.M. and Kraak, J.}, + isbn={9780080531472}, + series={International Cartographic Association}, + year={2005}, + publisher={Elsevier Science} +} + +@PHDTHESIS{bleisch2011evaluating, + title={{Evaluating the Appropriateness of Visually Combining Quantitative Data Representations with 3D Desktop Virtual Environments Using Mixed Methods}}, + author={Bleisch, S.}, + year={2011}, + type={PhD thesis}, + pages={207}, + school={City University London} +} + +@misc{Friendly2001, + AUTHOR = {Friendly, M. and Denis, D. J.}, + TITLE = {Milestones in the history of thematic cartography, statistical graphics, and data visualization}, + JOURNAL = {Milestones Project}, + YEAR = {2001}, + type = {project page}, + month = {December}, + url = {http://www.datavis.ca/milestones/} +} + +@ARTICLE{Goodchild2008, + author = {Goodchild, Michael F.}, + title = {{Commentary: whither VGI?}}, + journal = {GeoJournal}, + year = {2008}, + volume = {72}, + pages = {239-244}, + number = {3-4}, + doi = {10.1007/s10708-008-9190-4}, + issn = {0343-2521}, + publisher = {Springer Netherlands} +} + +@article{fritz2012geo, + title={{Geo-Wiki: An online platform for improving global land cover}}, + author={Fritz, Steffen and McCallum, Ian and Schill, Christian and Perger, Christoph and See, Linda and Schepaschenko, Dmitry and van der Velde, Marijn and Kraxner, Florian and Obersteiner, Michael}, + journal={Environmental Modelling \& Software}, + volume={31}, + pages={110--123}, + year={2012}, + publisher={Elsevier} +} + +@TECHREPORT{OGCKML2008, + AUTHOR = {Wilson, Tim}, + TITLE = {{OGC KML}}, + INSTITUTION = {Open Geospatial Consortium Inc.}, + YEAR = {2008}, + type = {OGC Standard}, + number = {OGC 07-147r2}, +} + +@book{wernecke2009kml, + title={{The KML handbook: geographic visualization for the Web}}, + author={Wernecke, J.}, + isbn={9780321525598}, + lccn={2008033499}, + year={2009}, + publisher={Addison-Wesley} +} + +@article{Butler2006, +author = "Butler, Declan", +title = {{Virtual globes: The web-wide world}}, +journal = "Nature", +volume = "439", +pages = "776-778", +year = "2006" +} + +@ARTICLE{Patterson2007, + author = {Patterson, Todd C.}, + title = {{Google Earth as a (Not Just) Geography Education Tool}}, + journal = {Journal of Geography}, + year = {2007}, + volume = {106}, + pages = {145-152}, + number = {4} +} + +@BOOK{McGavra2009DPC, + title = {{Technology Watch Report: Preserving Geospatial Data}}, + publisher = {Digital Preservation Coalition}, + year = {2009}, + author = {McGavra, G. and Morris, S. and Jan\'{e}e, G.}, + pages = {34}, + series = {DPC Technology Watch Series Report 09-01}, + address = {York, UK} +} + +@ARTICLE{Craglia2008IJSDIR, + author = {Craglia, M. and Goodchild, M.F. and Annoni, A. and Camara, G. and Gould, M. and Kuhn, W. and Mark, D. and Masser, I. and + Maguire, D. and Liang, S. and Parsons, E.}, + title = {{Next-Generation Digital Earth: A position paper from the Vespucci Initiative for the Advancement of Geographic Information + Science}}, + journal = {International Journal of Spatial Data Infrastructures Research}, + year = {2008}, + volume = {3}, + pages = {146--167}, + number = {6} +} + +@article{Pebesma2010Ifgi, + AUTHOR = {Pebesma, E.}, + TITLE = {\pkg{spacetime}: Spatio-Temporal Data in \proglang{R}}, + JOURNAL = {Journal of Statistical Software}, + YEAR = {2012}, + VOLUME = {51}, + ISSUE = {7}, + PAGES = {1-30}, +} + +@Manual{aqp, + title = {\pkg{aqp}: Algorithms for Quantitative Pedology}, + author = {Beaudette, Dylan and Roudier, Pierre}, + year = {2012}, + note = {\proglang{R}~package version~1.4}, + url = {http://CRAN.R-project.org/package=aqp}, +} + +@Manual{XML, + title = {\pkg{XML}: Tools for parsing and generating XML within \proglang{R} and \proglang{S}-PLUS}, + author = {Lang, Duncan Temple}, + year = {2013}, + note = {\proglang{R}~package version~3.98-1.1}, + url = {http://CRAN.R-project.org/package=XML}, +} + +@Manual{sp, + title = {\pkg{sp}: classes and methods for spatial data}, + author = {Pebesma, Edzer and Bivand, Roger}, + year = {2012}, + note = {\proglang{R}~package version~1.0-5}, + url = {http://CRAN.R-project.org/package=sp}, +} + +@ARTICLE{Pebesma2004CG, + author = {Pebesma, Edzer J.}, + title = {{Multivariable geostatistics in \proglang{S}: the \pkg{gstat} package}}, + journal = {Computers \& Geosciences}, + year = {2004}, + volume = {30}, + pages = {683-691}, + number = {7} +} + +@article{pebesma2005classes, + title={Classes and methods for spatial data in \proglang{R}}, + author={Pebesma, Edzer J and Bivand, Roger S}, + journal={\proglang{R} news}, + volume={5}, + number={2}, + pages={9--13}, + year={2005} +} + +@Manual{raster, + title = {\pkg{raster}: Geographic data analysis and modeling}, + author = {Hijmans, Robert J. and {van Etten}, Jacob}, + year = {2012}, + note = {\proglang{R}~package version~2.0-41}, + url = {http://CRAN.R-project.org/package=raster}, +} + +@Manual{rgdal, + title = {\pkg{rgdal}: Bindings for the Geospatial Data Abstraction Library}, + author = {Keitt, Timothy H. and Bivand, Roger and Pebesma, Edzer and Rowlingson, Barry}, + year = {2013}, + note = {\proglang{R}~package version~0.8-3}, + url = {http://CRAN.R-project.org/package=rgdal}, +} + +@Manual{lattice, + title = {\pkg{lattice}: Lattice Graphics}, + author = {Sarkar, Deepayan}, + year = {2013}, + note = {\proglang{R}~package version~0.20-13}, + url = {http://CRAN.R-project.org/package=lattice}, +} + +@Manual{spacetime, + title = {\pkg{spacetime}: classes and methods for spatio-temporal data}, + author = {Pebesma, Edzer}, + year = {2012}, + note = {\proglang{R}~package version~1.0-3}, + url = {http://CRAN.R-project.org/package=spacetime}, +} + +@Manual{GSIF, + title = {\pkg{GSIF}: Global Soil Information Facilities --- tools (standards and functions) and sample datasets for global soil mapping}, + author = {Hengl, Tomislav}, + year = {2013}, + note = {\proglang{R}~package version~0.3-6}, + url = {http://CRAN.R-project.org/package=GSIF}, +} + +@Manual{stpp, + title = {\pkg{stpp}: Space-Time Point Pattern simulation, visualisation and analysis}, + author = {Gabriel, Edith and Diggle, Peter J. and Rowlingson, Barry}, + year = {2013}, + note = {\proglang{R}~package version~1.0-3}, + url = {http://CRAN.R-project.org/package=stpp}, +} + +@BOOK{Bivand2008Springer, + title = {Applied Spatial Data Analysis with \proglang{R}}, + publisher = {Springer-Verlag}, + year = {2008}, + author = {Bivand, R. and Pebesma, E. and Rubio, V.}, + pages = {400}, + series = {Use R Series}, + address = {Heidelberg} +} + +@misc{Sightseer2011, + AUTHOR = {McClendon, Brian}, + TITLE = {Google Earth downloaded more than one billion times}, + JOURNAL = {Google LatLong Blogspot}, + YEAR = {2011}, + type = {Blog}, + month = {October}, + url = {http://google-latlong.blogspot.com} +} + +@misc{Buettel2012, + AUTHOR = {Eddelbuettel, Dirk}, + TITLE = {{Counting CRAN Package Depends, Imports and Linking To}}, + JOURNAL = {Dirk Eddelbuettel's Blog}, + YEAR = {2012}, + type = {Blog}, + month = {August 16th}, + url = {http://dirk.eddelbuettel.com} +} + +@book{CookSwayne2007, + author = {Dianne Cook and Deborah F. Swayne}, + title = {{Interactive and Dynamic Graphics for Data Analysis}}, + publisher = {Springer-Verlag}, + year = 2007, + address = {New York}, + isbn = {978-0-387-71761-6} +} + +@book{theus2009interactive, + title={Interactive graphics for data analysis: principles and examples}, + author={Theus, M. and Urbanek, S.}, + isbn={9781584885948}, + lccn={2008038130}, + series={Series in computer science and data analysis}, + year={2009}, + publisher={CRC Press} +} + +@ARTICLE{Erwig1999GeoInformatica, + author = {Erwig, Martin and G\"{u}ting, Ralf Hartmut and Schneider, Markus and + Vazirgiannis, Michalis}, + title = {{Spatio-Temporal Data Types: An Approach to Modeling and Querying + Moving Objects in Databases}}, + journal = {GeoInformatica}, + year = {1999}, + volume = {3}, + pages = {269-296}, + issue = {3}, + keyword = {Earth and Environmental Science}, + publisher = {Springer Netherlands} +} + +@ARTICLE{galton2004fields, + author = {Galton, A.}, + title = {Fields and objects in space, time, and space-time}, + journal = {Spatial cognition and computation}, + year = {2004}, + volume = {4}, + pages = {39--68}, + number = {1}, + publisher = {Taylor \& Francis} +} + +@BOOK{RTeam2005R, + title = {\proglang{R}: A language and environment for statistical computing}, + publisher = {\proglang{R} Foundation for Statistical Computing}, + year = {2013}, + author = {\proglang{R} Development Core Team}}, + pages = {1731}, + address = {Vienna, Austria}, + isbn = {3900051070}, + url = {http://www.R-project.org/} +} + +@article{pebesma2011intamap, + title={{INTAMAP: the design and implementation of an interoperable automated interpolation web service}}, + author={Pebesma, Edzer and Cornford, Dan and Dubois, Gregoire and Heuvelink, Gerard and Hristopulos, Dionisis and Pilz, J{\"u}rgen and St{\"o}hlker, Ulrich and Morin, Gary and Sk{\o}ien, Jon O}, + journal={Computers \& Geosciences}, + volume={37}, + number={3}, + pages={343--352}, + year={2011}, + publisher={Elsevier} +} + +@ARTICLE{Hengl2011TAC, + author = {Hengl, Tomislav and Heuvelink, Gerard and Per\v{c}ec Tadi\'{c}, Melita and Pebesma, Edzer}, + title = {Spatio-temporal prediction of daily temperatures using time-series + of {MODIS} {LST} images}, + journal = {Theoretical and Applied Climatology}, + year = {2012}, + volume = {107}, + pages = {265-277}, + issue = {1}, + publisher = {Springer Wien} +} + +@article{DePaor2011GGM, + author = {{De Paor}, Declan G. and Whitmeyer, Steven J.}, + title = {{Geological and geophysical modeling on virtual globes using KML, COLLADA, and Javascript}}, + journal = {Computers \& Geosciences}, + issue_date = {January, 2011}, + volume = {37}, + number = {1}, + month = jan, + year = {2011}, + pages = {100--110}, + numpages = {11}, + acmid = {1924844}, + publisher = {Pergamon Press, Inc.}, + address = {Tarrytown, NY, USA} +} + +@ARTICLE{Arigo2012, + author = {Arrigo, Nils and Albert, Loren P. and Mickelson, Pascal G. and Barker, + Michael S.}, + title = {{Quantitative visualization of biological data in Google Earth using + \pkg{R2G2}, an \proglang{R} CRAN package}}, + journal = {Molecular Ecology Resources}, + year = {2012}, + volume = {12}, + pages = {1177--1179}, + number = {6} +} + +@article{Blenkinsop2012CG, +title = {{Visualizing structural geology: From Excel to Google Earth}}, +journal = "Computers \& Geosciences", +volume = "45", +number = "0", +pages = "52--56", +year = "2012", +author = "Blenkinsop, T.G." +} diff --git a/plotkml.Rproj b/plotkml.Rproj deleted file mode 100644 index da894ea..0000000 --- a/plotkml.Rproj +++ /dev/null @@ -1,20 +0,0 @@ -Version: 1.0 - -RestoreWorkspace: No -SaveWorkspace: Ask -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 2 -Encoding: UTF-8 - -RnwWeave: Sweave -LaTeX: pdfLaTeX - -BuildType: Package -PackageUseDevtools: Yes -PackagePath: pkg -PackageInstallArgs: --no-multiarch --with-keep.source -PackageBuildArgs: --no-build-vignettes -PackageCheckArgs: --as-cran diff --git a/www/HRprec08.html b/www/HRprec08.html index 902d417..d5f226e 100644 --- a/www/HRprec08.html +++ b/www/HRprec08.html @@ -88,5 +88,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/HRtemp08.html b/www/HRtemp08.html index c9ae0ec..b88b92e 100644 --- a/www/HRtemp08.html +++ b/www/HRtemp08.html @@ -180,5 +180,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/ISRIC_logo.jpg b/www/ISRIC_logo.jpg new file mode 100644 index 0000000..4a4e432 Binary files /dev/null and b/www/ISRIC_logo.jpg differ diff --git a/www/LST.html b/www/LST.html index 92c21a1..ebb8aa5 100644 --- a/www/LST.html +++ b/www/LST.html @@ -40,11 +40,11 @@

Format

Note

-

Time series of 46 day-time and night-time 8-day composite LST images (MOD11A2 product bands 1 and 5) was obtained from the NASA's FTP server (https://ladsweb.modaps.eosdis.nasa.gov/). The original 8-day composite images were created by patching together images from a period of ?4 days, so that the proportion of clouds can be reduced to a minimum. The "zvalue" slot in the "RasterBrick" object can be used as the dateTime column expressed as:
+

Time series of 46 day-time and night-time 8-day composite LST images (MOD11A2 product bands 1 and 5) was obtained from the NASA's FTP server (ftp://ladsftp.nascom.nasa.gov). The original 8-day composite images were created by patching together images from a period of ±4 days, so that the proportion of clouds can be reduced to a minimum. The "zvalue" slot in the "RasterBrick" object can be used as the dateTime column expressed as:

yyyy-mm-ddThh:mm:sszzzzzz

-

where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents ?hh:mm in relation to UTC.

+

where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents ±hh:mm in relation to UTC.

Author(s)

@@ -64,5 +64,5 @@

References

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/RasterBrickSimulations.html b/www/RasterBrickSimulations.html index 08e3e03..2ea6507 100644 --- a/www/RasterBrickSimulations.html +++ b/www/RasterBrickSimulations.html @@ -80,5 +80,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/RasterBrickTimeSeries.html b/www/RasterBrickTimeSeries.html index 2696891..c53775d 100644 --- a/www/RasterBrickTimeSeries.html +++ b/www/RasterBrickTimeSeries.html @@ -50,5 +50,5 @@

See Also

RasterBrickSimulations-class, plotKML-method

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SAGA_pal.html b/www/SAGA_pal.html index 73d63dc..c3739b1 100644 --- a/www/SAGA_pal.html +++ b/www/SAGA_pal.html @@ -74,5 +74,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SpatialMaxEntOutput.html b/www/SpatialMaxEntOutput.html index de87fc8..ace8f56 100644 --- a/www/SpatialMaxEntOutput.html +++ b/www/SpatialMaxEntOutput.html @@ -82,5 +82,5 @@

See Also

plotKML-method, dismo::maxent, maxlike::maxlike, rgbif::taxonsearch

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SpatialMetadata.html b/www/SpatialMetadata.html index fac0795..22fb965 100644 --- a/www/SpatialMetadata.html +++ b/www/SpatialMetadata.html @@ -72,5 +72,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SpatialPhotoOverlay.html b/www/SpatialPhotoOverlay.html index 7aa6a37..581525c 100644 --- a/www/SpatialPhotoOverlay.html +++ b/www/SpatialPhotoOverlay.html @@ -56,5 +56,5 @@

See Also

plotKML-method, spPhoto

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SpatialPredictions.html b/www/SpatialPredictions.html index a22de6e..efcdcfd 100644 --- a/www/SpatialPredictions.html +++ b/www/SpatialPredictions.html @@ -75,5 +75,5 @@

See Also

plotKML-method, GSIF::fit.gstatModel, gstat::gstat-class, RasterBrickSimulations-class

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SpatialSamplingPattern.html b/www/SpatialSamplingPattern.html index c56544f..124af7f 100644 --- a/www/SpatialSamplingPattern.html +++ b/www/SpatialSamplingPattern.html @@ -46,5 +46,5 @@

See Also

plotKML-method, spcosa::spsample, plotKML-method

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/SpatialVectorsSimulations.html b/www/SpatialVectorsSimulations.html index 250b00d..10ea1b1 100644 --- a/www/SpatialVectorsSimulations.html +++ b/www/SpatialVectorsSimulations.html @@ -70,5 +70,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/aesthetics.html b/www/aesthetics.html index 8f20ee5..bdec641 100644 --- a/www/aesthetics.html +++ b/www/aesthetics.html @@ -47,5 +47,5 @@

See Also

kml-methods

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/baranja.html b/www/baranja.html index c1b2b79..36b21e9 100644 --- a/www/baranja.html +++ b/www/baranja.html @@ -127,5 +127,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/bigfoot.html b/www/bigfoot.html index f7c1bca..8dd2669 100644 --- a/www/bigfoot.html +++ b/www/bigfoot.html @@ -113,5 +113,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/check_projection.html b/www/check_projection.html index ad0fcdb..75667e4 100644 --- a/www/check_projection.html +++ b/www/check_projection.html @@ -84,5 +84,5 @@

Examples

# ... now ready for export -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/col2kml.html b/www/col2kml.html index 295dccb..5005fe0 100644 --- a/www/col2kml.html +++ b/www/col2kml.html @@ -53,5 +53,5 @@

Examples

kml2hex(x) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/count.GridTopology.html b/www/count.GridTopology.html index e8aa135..98d5b18 100644 --- a/www/count.GridTopology.html +++ b/www/count.GridTopology.html @@ -47,5 +47,5 @@

See Also

SpatialVectorsSimulations-class, vect2rast

-
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/display.pal.html b/www/display.pal.html index b043551..1e20598 100644 --- a/www/display.pal.html +++ b/www/display.pal.html @@ -78,5 +78,5 @@

Examples

## End(Not run) -
[Package plotKML version 0.5-9 Index]
+
[Package plotKML version 0.5-8 Index]
diff --git a/www/doc/jss1079.R b/www/doc/jss1079.R deleted file mode 100644 index 6d3a9d9..0000000 --- a/www/doc/jss1079.R +++ /dev/null @@ -1,148 +0,0 @@ -### R code from vignette source 'jss1079.Rnw' -### Encoding: UTF-8 - -################################################### -### code chunk number 1: jss1079.Rnw:72-76 -################################################### -if(!require(gstat)){install.packages("gstat"); library(gstat)} -if(!require(raster)){install.packages("raster"); library(raster)} -if(!require(plotKML)){install.packages("plotKML"); library(plotKML)} -if(!require(GSIF)){install.packages("GSIF"); library(GSIF)} - - -################################################### -### code chunk number 2: jss1079.Rnw:79-80 -################################################### -options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) - - -################################################### -### code chunk number 3: jss1079.Rnw:86-89 -################################################### -rm(list=ls()) -plotKML.version <- sessionInfo()[["otherPkgs"]][["plotKML"]][["Version"]] -plotKML.env(show.env = FALSE) - - -################################################### -### code chunk number 4: jss1079.Rnw:188-195 -################################################### -library("sp") -lat = 37.423156 -lon = -122.084917 -name = "Google headquarters" -pnt = data.frame(name, lat, lon) -coordinates(pnt) <- ~lon+lat -proj4string(pnt) <- CRS("+proj=longlat +datum=WGS84") - - -################################################### -### code chunk number 5: jss1079.Rnw:216-226 -################################################### -library("XML") -pnt.kml <- newXMLNode("kml") -h2 <- newXMLNode("Document", parent = pnt.kml) -h3 <- newXMLNode("name", "Google headquarters", parent = h2) -h4 <- newXMLNode("Folder", parent=pnt.kml[["Document"]]) -txtc <- sprintf(' - %.5f,%.5f,%.0f', - coordinates(pnt)[,1], coordinates(pnt)[,2], rep(0, length(pnt))) -parseXMLAndAdd(txtc, parent = h4) -pnt.kml - - -################################################### -### code chunk number 6: jss1079.Rnw:258-263 -################################################### -library("plotKML") -data("eberg") -eberg <- eberg[runif(nrow(eberg))<.2,] -coordinates(eberg) <- ~X+Y -proj4string(eberg) <- CRS("+init=epsg:31467") - - -################################################### -### code chunk number 7: jss1079.Rnw:268-269 -################################################### -eberg.ll <- reproject(eberg) - - -################################################### -### code chunk number 8: jss1079.Rnw:274-275 -################################################### -kml(eberg.ll["CLYMHT_A"], colour=CLYMHT_A) - - -################################################### -### code chunk number 9: jss1079.Rnw:292-294 -################################################### -spplot(eberg.ll["CLYMHT_A"], edge.col="black", - alpha=0.8, cex=seq(.3,3,length=5)) - - -################################################### -### code chunk number 10: jss1079.Rnw:329-332 -################################################### -shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" -kml(eberg.ll, shape = shape, colour = CLYMHT_A, labels = SNDMHT_A, - altitude = SNDMHT_A*10, extrude = TRUE) - - -################################################### -### code chunk number 11: jss1079.Rnw:369-373 -################################################### -data("eberg_grid") -coordinates(eberg_grid) <- ~x+y -gridded(eberg_grid) <- TRUE -proj4string(eberg_grid) <- CRS("+init=epsg:31467") - - -################################################### -### code chunk number 12: jss1079.Rnw:378-382 -################################################### -kml_open("eberg.kml") -kml_layer(eberg_grid, colour=TWISRT6) -kml_layer(eberg.ll[1,], colour=CLYMHT_A) -kml_close("eberg.kml") - - -################################################### -### code chunk number 13: jss1079.Rnw:421-423 -################################################### -library("sp") -demo(meuse, echo=FALSE) - - -################################################### -### code chunk number 14: jss1079.Rnw:428-432 -################################################### -library("GSIF") -omm <- fit.gstatModel(meuse, om~dist+ffreq, meuse.grid, - family = gaussian(log)) -om.rk <- predict(omm, meuse.grid) - - -################################################### -### code chunk number 15: jss1079.Rnw:478-491 -################################################### -data("fmd") -fmd0 <- data.frame(fmd) -coordinates(fmd0) <- c("X", "Y") -proj4string(fmd0) <- CRS("+init=epsg:27700") -fmd_sp <- as(fmd0, "SpatialPoints") -dates <- as.Date("2001-02-18")+fmd0$ReportedDay -library("spacetime") -fmd_ST <- STIDF(fmd_sp, dates, data.frame(ReportedDay=fmd0$ReportedDay)) -data("northcumbria") -ln <- Line(northcumbria) -NC <- SpatialLines(list(Lines(list(ln), ID="NC"))) -proj4string(NC) <- CRS("+init=epsg:27700") -stplot(fmd_ST, sp.layout=list("sp.lines", NC), col.regions=SAGA_pal[[1]]) - - -################################################### -### code chunk number 16: jss1079.Rnw:498-499 -################################################### -kml(fmd_ST, colour=ReportedDay, colour_scale=SAGA_pal[[1]]) - - diff --git a/www/doc/jss1079.Rnw b/www/doc/jss1079.Rnw deleted file mode 100644 index 007c335..0000000 --- a/www/doc/jss1079.Rnw +++ /dev/null @@ -1,687 +0,0 @@ -%% If you want to use the JSS style for a non-JSS paper (or a modification of a JSS -%% paper, e.g., in a vignette), you can set the option nojss in the \documentclass statement -\documentclass[article,shortnames]{jss} - -\author{Tomislav Hengl\\ISRIC --- World Soil Information\\the Netherlands \And - Pierre Roudier\\Landcare Research\\New Zealand \AND - Dylan Beaudette\\USDA-NRCS, Soil Science Division\\USA \And - Edzer Pebesma\\Institute for Geoinformatics\\University of M\"{u}nster, Germany -} -\title{\pkg{plotKML}: Scientific Visualization of Spatio-Temporal Data} - -%% for pretty printing and a nice hypersummary also set: -\Plainauthor{Tomislav Hengl, Pierre Roudier, Dylan Beaudette, Edzer Pebesma} %% comma-separated -\Plaintitle{plotKML: Scientific Visualization of Spatio-temporal Data} %% without formatting -\Shorttitle{\pkg{plotKML}: visualization of spatio-temporal data} %% a short title (if necessary) - -%% an abstract and keywords -\Abstract{ - \pkg{plotKML} is an \proglang{R} package that provides methods for writing the most common \proglang{R} spatial classes into KML files. It builds up on the existing XML parsing functionality (\pkg{XML} package), and provides similar plotting functionality as the \pkg{lattice} package. Its main objective is to provide a simple interface to generate KML files with a small number of arguments, and allows users to visually explore spatio-temporal data available in \proglang{R}: points, polygons, gridded maps, trajectory-type data, vertical profiles, ground photographs, time series vector objects or raster images, along with the results of spatial analysis such as geostatistical mapping, spatial simulations of vector and gridded objects, optimized sampling designs, species distribution models and similar. A generic \code{plotKML()} function automatically determines the parsing order and visualizes data directly from \proglang{R}; lower level functions can be combined to allow for new user-created visualization templates. In comparison to other KML writing packages, \pkg{plotKML} seems to be more object oriented, it links more closely to the existing \proglang{R} classes for spatio-temporal data (\pkg{sp}, \pkg{spacetime} and \pkg{raster} packages) than the alternatives, and provides users with the possibility to create their own templates. -} -\Keywords{space-time objects, scientific visualization, \proglang{R}, KML, geostatistics} -\Plainkeywords{space-time objects, scientific visualization, R, KML, geostatistics} %% without formatting - -%% publication information -%% NOTE: Typically, this can be left commented and will be filled out by the technical editor -\Volume{63} -\Issue{5} -\Month{February} -\Year{2015} -\Submitdate{2013-01-22} -\Acceptdate{2014-07-08} - -%% The address of (at least) one author should be given -%% in the following format: -\Address{ - T. Hengl \\ - OpenGeoHub foundation \\ - Roghorst 206, 6708 KT Wageningen, the Netherlands \\ - Tel.: +31- 317-427537\\ - E-mail: \email{tom.hengl@opengeohub.org}\\ -} - -%% for those who use Sweave please include the following line (with % symbols): -%% need no \usepackage{Sweave.sty} - -\usepackage[T1]{fontenc} -\usepackage[utf8]{inputenc} -\usepackage{amssymb} -\usepackage{verbatim} -\usepackage{xcolor,graphicx} -\usepackage{booktabs} -\usepackage{latexsym} -\usepackage{array,tabularx,rotating} %Table format packages -\usepackage{hyperref} -\usepackage{multirow} -\usepackage{textcomp} -\hypersetup{colorlinks=true, linkcolor=black, citecolor=black, - urlcolor=black, bookmarksnumbered=true, - bookmarksopen=true, pdfview=FitH, pdfstartview=FitH, - pdftitle={plotKML: scientific visualization of spatio-temporal data}, - pdfauthor={Hengl T., Roudier P., D. Beaudette and E. Pebesma},} - -%% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Note that you should use the \pkg{}, \proglang{} and \code{} commands. - -\begin{document} - -%\VignetteIndexEntry{ plotKML: Scientific Visualization of Spatio-temporal Data } -%% jss options, see http://www.jstatsoft.org/style - -%% make sure all packages are there already, if not go and get them -<>= -if(!require(gstat)){install.packages("gstat"); library(gstat)} -if(!require(raster)){install.packages("raster"); library(raster)} -if(!require(plotKML)){install.packages("plotKML"); library(plotKML)} -if(!require(GSIF)){install.packages("GSIF"); library(GSIF)} -@ - -<>= -options(prompt = "R> ", continue = "+ ", width = 70, useFancyQuotes = FALSE) -@ - -%% R options and initialisation -%% options(prompt="> ", continue="+ ", digits=3, width=70, show.signif.stars=T) -%% par(mfrow=c(1,1)) -<>= -rm(list=ls()) -plotKML.version <- sessionInfo()[["otherPkgs"]][["plotKML"]][["Version"]] -plotKML.env(show.env = FALSE) -@ - -%\begin{pagewiselinenumbers} - -\section{Introduction}\label{intro} - -Keyhole Markup Language (KML) is an XML language focused on geographic visualization, including annotation of maps and images \citep{OGCKML2008,wernecke2009kml}. It is the standard adopted by Google and now used by Google Earth{\texttrademark} as its primary exchange format. There is a growing interest in using Google Earth to visualize spatio-temporal data produced in the \proglang{R} environment for statistical computing. We believe that the main reasons responsible for this growth are: - -\begin{enumerate} - \item Google Earth is one of the most wide-spread geographical data browsers available with $>$1 billion downloads as of October 2011\footnote{\url{http://www.google.com/earth/connect/newsletter/oct11.html}}. It is a largely intuitive software, easily accessible to people without any professional GIS training, and most importantly, a framework which can be used to increase a project reach to the general public \citep{Butler2006,Patterson2007,Goodchild2008}. - \item According to \citet{McGavra2009DPC}, KML is one of the leading Open Geospatial Consortium (OGC) XML encoding standards. - \item Google Earth provides access to high-resolution remote sensing data (Ikonos, GeoEye and Cnes/Spot images, administrative vector data, SRTM DEM and similar), which allows users to qualitatively interpret the analysis results by matching the produced outputs with background imagery \citep{Craglia2008IJSDIR,fritz2012geo}. - \item As KML provides a diversity of visualization options, it is one of the more attractive platforms for scientific visualization of geographical phenomena --- it can enable scientists to detect patterns in their data not visible in other software, but it can also help engaging a wider public into scientific research and decision making \citep{Butler2006}. \citet{Goodchild2008} refers to this as the \emph{`citizen science'}. -\end{enumerate} - -Although \proglang{R} is primarily known as a statistical computing environment \citep{RTeam2005R}, it is of increasing interest to the field of geoinformatics and applied spatial data analysis due to its extensibility and the growing diversity of spatial and spatio-temporal data structures \citep{pebesma2005classes,Pebesma2010Ifgi,Bivand2013Springer}. Geo-visualization functions in \proglang{R}, on the other hand, are limited because \proglang{R} was not originally designed for interactive exploration of spatial data or as a GIS platform. Although there are many packages in \proglang{R} already that allow interactive visualization, overlay and animated display of geographical phenomena (via packages \href{http://www.ggobi.org/rggobi/}{\pkg{RGGOBI}} and \pkg{iPlots}; for a review refer to \citep{CookSwayne2007} and/or \citep{theus2009interactive}), \proglang{R} has its limitations for interactively exploring geographical data. \par - -There is considerable potential for building connectivity between the sophisticated spatial analysis possible in \proglang{R} and the geo-visualization capacities afforded by Google Earth. However, the export of spatial data from \proglang{R} to KML is not trivial. KML files can be produced using the using GDAL (Geospatial Data Abstraction Library) KML driver, but so far only limited functionality is supported. As the driver description page indicates: \emph{``At this time, only vector layers are handled by the KML driver$\ldots$ limited support is available for fills, line color and other styling attributes.''}\footnote{\url{http://www.gdal.org/ogr/drv_kml.html}}\par - -Within the \proglang{R} community, other packages produced specifically to allow creation of KML files include: \pkg{rgdal} \citep{rgdal} and \pkg{raster} \citep{raster}, while truly specialized KML writing packages include \pkg{R2G2} \citep{Arigo2012} and \pkg{RKML}\footnote{\url{http://www.omegahat.org/RKML/}}. Our objective with the \pkg{plotKML} package was to provide a simple interface to generate KML files with a small number of arguments, and allow users to directly plot spatio-temporal data classes, available in \proglang{R} via the \pkg{sp} \citep{pebesma2005classes}, \pkg{spacetime} \citep{spacetime}, \pkg{aqp} \citep{aqp} and \pkg{raster} \citep{raster} packages, in a virtual globe type of browser. \par - -This article describes the main functionality and the design of the \pkg{plotKML} package and provides a number of examples of how to produce some common KML visualization templates. Some limitations of the package in comparison with other alternative KML writing software and possibilities to improve the package are given in the discussion section. More detailed tutorials including YouTube videos can be found via the package homepage\footnote{\url{http://plotkml.r-forge.r-project.org/}}. \par - - -\section{Basic concepts} - -\subsection{Scientific visualization of geographic phenomena} - -The purpose of scientific visualization is to \emph{``graphically illustrate scientific data to enable scientists to understand, illustrate, and glean insight from their data.''}\footnote{\url{http://en.wikipedia.org/wiki/Scientific_visualization}} According to \citet{Friendly2001}, scientific visualization can be primarily connected with visualization of 3D data \emph{``where the emphasis is on realistic renderings of volumes, surfaces, illumination sources, and so forth, perhaps with a dynamic (time) component.''} In that context, the main purpose of \pkg{plotKML} package is to enable interactive scientific visualization of geographic phenomena i.e.\@ scientific geovisualization \citep{dykes2005exploring}.\par - -Interactive geovisualization, i.e.\@ dynamic user-controlled visualization of geographical phenomena, can be today closely connected with 3D computer environments referred to as the \emph{`Virtual globe'}, \emph{`Virtual Earth'} or \emph{`Digital Earth'} \citep{gore1998digital,bleisch2011evaluating}. At the beginning of 21st century, the most known virtual globes are \citep{bleisch2011evaluating}: - -\begin{itemize} - \item Google Earth - \item Microsoft Bing Maps 3D - \item AutoDesk LandXplorer - \item NASA World Wind - \item ESRI's ArcGlobe - \item Leica's Virtual Explorer -\end{itemize} - -Open source alternatives to Google Earth and Microsoft Bing Maps 3D are: (KDE) Marble\footnote{\url{http://marble.kde.org/}}, OSSIM Planet\footnote{\url{http://trac.osgeo.org/ossim/}}, and Cesium\footnote{\url{http://cesium.agi.com}}.\par - -According to \citet{elmqvist2007occlusion}, there are two main reasons for creating 3D virtual globes: - -\begin{enumerate}\renewcommand{\labelenumi}{(\alph{enumi})} - \item replicate or simulate the real world, - \item use 3D as canvas for abstract information. -\end{enumerate} - -The \pkg{plotKML} package offers both. As we will show later, it allows Google Earth to be used not only for visualization of maps, but also as a canvas for 3D or 3D+T visualization of any such data created and analyzed in \proglang{R} (see further Figures~\ref{Fig:eberg_two_aesthetics} and \ref{Fig:RasterBrickTimeSeries}). \par - -Although one can argue whether virtual globes should be used more broadly for decision making and land management, two significant developments can not be disputed: (1) ubiquitous access to free high resolution satellite imagery through Google Earth, Yahoo and Bing has revolutionized applications of GIS for both commercial and non-commercial projects, and (2) anyone is today invited to make, edit, mash-up and share geodata \citep{fritz2012geo}.\par - -\subsection{Space-time continuum}\label{sec:stcontinuum} - -Everything we measure on Earth can be linked to some space-time \emph{`location'}: - -\begin{enumerate} - \item \emph{geographic location} (longitude and latitude) - \item \emph{height above the ground surface} (altitude) - \item \emph{time of measurement} (year, month, day, hour, minute, second) - \item \emph{spatio-temporal support} (size of the blocks of material associated with measurements; time interval or duration of measurement). -\end{enumerate} - -\begin{figure*}[!htb] -\begin{center} -\includegraphics[width=\textwidth]{Fig_space_time_cube.png} \caption{Space-time cube visualized in \proglang{R}: (a) cloud plot showing location of meteorological stations in Croatia (data set from \citet{Hengl2011TAC}), (b) illustration of spatial and temporal support in the space-time cube.} -\label{Fig:space_time_cube} -\end{center} -\end{figure*} - -By attaching spatio-temporal reference to measurements we can dynamically visualize them, but also run spatio-temporal data analysis \citep{Bivand2008Springer,Pebesma2010Ifgi}. Many analysts already find it useful to be able to visualize all input and derived maps or results of spatial analysis in a Virtual Earth type of environment such as Google Earth \citep{Patterson2007}. In addition, creating a realistic visualization of observed dynamic phenomena can improve the spatial analysis process, in part, because it can help us make more thoroughly considered interpretations of analysis results \citep{Craglia2008IJSDIR}. \par - -Figure~\ref{Fig:space_time_cube} for example shows how spatio-temporal data can be visualized in a 2D+T space-time cube. The same data-set is further shown in Figure~\ref{Fig:RasterBrickTimeSeries} visualized in Google Earth.\par - -\subsection{Spatial and spatio-temporal objects} - -For \citet{Erwig1999GeoInformatica} spatio-temporal data sets and corresponding data\-bases represent two major groups of features: (1) \emph{moving or dynamic objects} (discrete or vector geometries), and (2) \emph{regions or fields} (continuous). Objects and fields can be further based on \emph{regular} or \emph{irregular} sampling systems and representation models. Many features can be modeled and represented both using discrete (vector) and continuous (raster) GIS models. For example, objects such as a population of animals can be modeled and represented as discrete objects (trajectories or points), but also as densities (\emph{regions}) or polygons representing home ranges. Likewise, earthquakes are in their essence \emph{regions} (of sudden and violent shaking of the ground), but are often represented as points. This is just to illustrate the complexity of choosing the right model for representing such dynamic features. For an introduction to the complexity of spatial and spatio-temporal objects and fields refer also to \citet{galton2004fields}. \par - -\citet[pp.28--55]{Bivand2008Springer} and \citet{Pebesma2010Ifgi} implemented classes for spatial and spatio-temporal data in \proglang{R} via the \pkg{sp} and \pkg{spacetime} packages. These classes are also highly extendable and are already widely used inside the \proglang{R} spatial data analysis community. The \pkg{sp} package \citep{pebesma2005classes} is currently one of the top 10 packages with highest number of dependencies on CRAN\footnote{See blog by Dirk Eddelb\"{u}ttel published at \url{http://dirk.eddelbuettel.com} on Thursday, 16th August 2012.}, and has been used as the main starting point for building visualization functionality in \pkg{plotKML}. \par - -\begin{table*}[!htb]\label{Fig:spacetime_objects_types} -\begin{center} -\includegraphics[width=\textwidth]{Fig_spacetime_objects_types.pdf} -\vspace{6pt} -\caption{Types of spatio-temporal objects (points and regions) based on the number of dimensions (2D, 3D, 2D+T and 3D+T) and support type and corresponding \proglang{R} classes. \texttt{STFDF} stands for a class for spatio-temporal data with full space-time grid, \texttt{STIDF} stands for a class for unstructured spatio-temporal or irregular data, and \texttt{STTDF} stands for a class for spatio-temporal trajectory data \citep{Pebesma2010Ifgi}. $\star$ --- classes not yet available in \proglang{R}.} -\end{center} -\end{table*} - -A schematic overview of 2D, 3D, 2D+T and 3D+T combinations of spatio-temporal object types is given in Table~\ref{Fig:spacetime_objects_types}. Note that not all space-time combinations of 2D/3D+T objects are yet implemented in \proglang{R}, and some are implemented but are still rather experimental. For example, voxels can be constructed by adding the third dimension to object of class \verb"SpatialPixels", but methods for such type of data are still limited.\par - -Although KML can probably accommodate all spatio-temporal objects listed in Table~\ref{Fig:spacetime_objects_types}, visualization of densely sampled 3D+T objects, e.g.\@ millions of voxels, is probably still not recommended in KML. For example, by making COLLADA (COLLAborative Design Activity; an open standard XML schema) 3D objects one can potentially generate any type of 3D spatio-temporal object, but this is then highly complex and requires good knowledge of COLLADA and KML. \par - -\subsection[Spatial data structures in R and KML]{Spatial data structures in \proglang{R} and KML} - -Consider for example the Google headquarters in Mountain View, CA. The point location can be prepared in \proglang{R} as object of class \verb"SpatialPoints*", as implemented in the \pkg{sp} package, which takes few steps: - -<<>>= -library("sp") -lat = 37.423156 -lon = -122.084917 -name = "Google headquarters" -pnt = data.frame(name, lat, lon) -coordinates(pnt) <- ~lon+lat -proj4string(pnt) <- CRS("+proj=longlat +datum=WGS84") -@ - -\begin{CodeChunk} -\begin{CodeInput} -R> pnt -\end{CodeInput} -\begin{CodeOutput} -class : SpatialPointsDataFrame -features : 1 -extent : -122.0849, -122.0849, 37.42316, 37.42316 -coord. ref. : +proj=longlat +datum=WGS84 -variables : 1 -names : name -min values : Google headquarters -max values : Google headquarters -\end{CodeOutput} -\end{CodeChunk} - -The same object in KML can be generated by using the \pkg{XML} package \citep{XML}: - -<<>>= -library("XML") -pnt.kml <- newXMLNode("kml") -h2 <- newXMLNode("Document", parent = pnt.kml) -h3 <- newXMLNode("name", "Google headquarters", parent = h2) -h4 <- newXMLNode("Folder", parent=pnt.kml[["Document"]]) -txtc <- sprintf(' - %.5f,%.5f,%.0f', - coordinates(pnt)[,1], coordinates(pnt)[,2], rep(0, length(pnt))) -parseXMLAndAdd(txtc, parent = h4) -pnt.kml -@ - -\noindent where \verb"newXMLNode" creates nodes in an XML object, \verb"sprintf" is the wrapper for the fast \textsf{C} function that returns a character vector, and \verb"saveXML" writes the object to a file (this function is does most of the work in the \pkg{plotKML} package). An XML object is basically a hierarchically structured object with nodes of different type. The rules to build and extend such objects are defined via the specific XML scheme, in this case the OGC KML 2.2 scheme \citep{OGCKML2008}.\par - -Note that, although both \proglang{R} objects and KML (XML) files are human readable and have similar hierarchical structure, they have some systematic differences. First, KML accepts only geographical coordinates in WGS84 system, which must include altitude i.e.\@ only 3D georeference is acceptable, while in \proglang{R} any \textsf{proj4} supported projection can be used and the georeference can be 2D or 3D. Secondly, KML is by default used to display objects (\emph{``placemarks''}) on Earth's surface, while the \pkg{sp} package does not restrict considering the bounding box and relative position based on land surface. To understand all rules and validity checks of the KML format refer to \citet{wernecke2009kml}, and for an introduction to the \pkg{sp} class objects refer to \citet{Bivand2013Springer}.\par - -\section{Implementation and code examples} - -\subsection{Basic principles and main use}\label{sec:installation} - -The purpose of \pkg{plotKML} is to write standard spatio-temporal objects --- spatial and space-time points, lines, polygons and grids, trajectories, georeferenced photographs and similar --- from \proglang{R} to KML/KMZ files in such a way that they correspond, as much as possible, to standard cartographic plots or standard scientific visualizations. The main philosophy of \pkg{plotKML} is thus: \par - -\begin{enumerate} - \item \emph{Create a spatio-temporal object of some class}, - \item \emph{Transform coordinates to a coordinate reference system compatible with a virtual globe (geographical coordinates in WGS84; altitude in meters; time in the UTC system)}, - \item \emph{Visualize it using the plotKML function}. -\end{enumerate} - -We refer to complete scientific visualization templates in \pkg{plotKML} as \emph{`views'}. Views are generated using a combination of low level KML writing functions, which basically coerce the spatio-temporal objects in \proglang{R} to the KML schema.\par - -Visualization-specific generic settings such as icons, color and size of icons (icon styles), labels etc.\@ are referred to as \emph{`aesthetics'} in \pkg{plotKML}. These can be set by changing function arguments within each \verb'"kml_layer"' function. Views and their components have been designed to be cartographically \emph{`complete'}, meaning that: - -\begin{itemize} - \item All spatio-temporal objects are automatically converted to the WGS84 geographical coordinates. Hence the projection system needs to be specified for each input spatial layer. - \item Legends for all aesthetics are provided using screen overlays or at least labels are attached to individual plotting objects. - \item Missing values (NA), extrapolation areas and/or masked pixels are automatically removed or made transparent. - \item Each spatial layer carries some minimum metadata that can be entered via the description tag. This way the distributed KML files can be used as official representations of registered data sets. -\end{itemize} - -The following example shows how to produce a bubble type plot using the \pkg{plotKML} package (plot shown in Figure~\ref{Fig:bubble_plot}). We start by loading the Eberg\"{o}tzen soil mapping data set (available via the \pkg{plotKML} package): - -<<>>= -library("plotKML") -data("eberg") -eberg <- eberg[runif(nrow(eberg))<.2,] -coordinates(eberg) <- ~X+Y -proj4string(eberg) <- CRS("+init=epsg:31467") -@ - -Next, we can reproject this object to the WGS84 coordinate system: - -<<>>= -eberg.ll <- reproject(eberg) -@ - -\noindent so that it can be plotted in Google Earth by using: - -<>= -kml(eberg.ll["CLYMHT_A"], colour=CLYMHT_A) -@ - -\begin{CodeChunk} -\begin{CodeInput} -R> plotKML(eberg.ll["CLYMHT_A"]) -\end{CodeInput} -\begin{CodeOutput} -Plotting the first variable on the list -KML file opened for writing... -Parsing to KML... -Closing eberg.ll__CLYMHT_A__.kml -\end{CodeOutput} -\end{CodeChunk} - -\noindent and which largely mimics the existing plotting functionality available for spatial data in \proglang{R}, e.g.\@ the \verb"spplot" functionality from the \pkg{sp} package: - -<<>>= -spplot(eberg.ll["CLYMHT_A"], edge.col="black", - alpha=0.8, cex=seq(.3,3,length=5)) -@ - -Note that the generic \verb"reproject" function available in the \pkg{plotKML} package will try to reproject any \pkg{sp} class objects to the referent WGS84 system, also within the \verb"plotKML()" function: - -\begin{CodeChunk} -\begin{CodeInput} -R> plotKML(eberg["CLYMHT_A"]) -\end{CodeInput} -\begin{CodeOutput} -Plotting the first variable on the list -KML file opened for writing... -Reprojecting to +proj=longlat +datum=WGS84 ... -Parsing to KML... -Closing eberg__CLYMHT_A__.kml -\end{CodeOutput} -\end{CodeChunk} - -This means that both \verb"plotKML(eberg)" and \verb"plotKML(eberg.ll)" would work with the same object. It is recommended, however, that the users pre-transform spatial objects into the WGS84 geographic coordinate system as this step can be time consuming when working with large data sets.\par - -\begin{figure*}[!htb] \begin{center} - \includegraphics[width=\textwidth]{Fig_bubble_plot.jpg} -\caption{Bubble-type plots in \proglang{R} and the same plot produced using the \pkg{plotKML} shown in Google Earth.} \label{Fig:bubble_plot} -\end{center} -\end{figure*} - -\begin{figure*}[!htb] -\begin{center} - \includegraphics[width=.8\textwidth]{Fig_eberg_two_aesthetics.jpg} -\caption{Multivariate visualization using three aesthetics parameters (in the case above: color, labels and elevation). The plot shows changes in sand content in the soil for the Eberg\"{o}tzen case study.} \label{Fig:eberg_two_aesthetics} -\end{center} -\end{figure*} - -By combining multiple aesthetics, \pkg{plotKML} can be used also to visualize multivariate data (Figure~\ref{Fig:eberg_two_aesthetics}). For example, to visualize two variables at the same time we would run: - -<<>>= -shape = "http://maps.google.com/mapfiles/kml/pal2/icon18.png" -kml(eberg.ll, shape = shape, colour = CLYMHT_A, labels = SNDMHT_A, - altitude = SNDMHT_A*10, extrude = TRUE) -@ - -\noindent which would use colors to visualize the clay content, and labels and altitude to represent the sand content. Possibility of multivariate visualization makes \pkg{plotKML} comparable to the \pkg{lattice} package for \proglang{R} \citep{Grothendieck:2008:JSSOBK:v25b02}.\par - - -\subsection{KML building utilities}\label{sec:kml_functions} - -Aside from the generic \verb'plotKML()' method, the package also contains a number of dedicated methods and functions, which can be referred to as the KML building utilities. The basic KML building utilities are (Figure~\ref{Fig:plotKML_utilities}): - -\begin{itemize} - \item \verb'kml_open()' --- opens a KML file in write mode, manages the KML specific URL, and the name of the KML file. It also writes the header of the KML file. - \item \verb'kml_close()' --- closes the KML file. - \item \verb'kml_layer()' --- writes any \pkg{sp} object into a KML layer (\verb'' tag). - \item \verb'kml_screenoverlay()' --- puts a PNG file on the Google Earth screen; usually a legend attached to the map or a logo image. - \item \verb'kml_compress()' --- compresses a KML file to a KMZ file. - \item \verb'kml_legend()' --- generates a legend depending on the type of spatio-temporal object. -\end{itemize} - -\begin{figure*}[!htb] -\begin{center} - \includegraphics[width=.95\textwidth]{Fig_plotKML_utilities.pdf} -\caption{Overview of the KML building utilities available in the \pkg{plotKML} package.} \label{Fig:plotKML_utilities} -\end{center} -\end{figure*} - -These utilities actually provide an advanced mode for KML creation, and allow the user to create multi-layers KML with specific legends. This means that a single KML file can be created that contains all layers of interest (e.g.\@ grids and points), associated legends and explanations of how were the maps derived.\par - -\begin{figure*}[!htb] -\begin{center} - \includegraphics[width=.8\textwidth]{Fig_layerRaster_legend.jpg} -\caption{Example of a multi-layer KML file produced using \pkg{plotKML}: Topographic Wetness Index derived in \textsf{SAGA GIS} (raster image with legend) and contour lines overlaid. This visualization template has been largely inspired by the \textsf{SAGA GIS} software \citep{Conrad2007PhD}.} \label{Fig:layerRaster_legend} -\end{center} -\end{figure*} - -The following example demonstrates how several layers can be put together in the same KML file. We start by loading some gridded layers: - -<>= -data("eberg_grid") -coordinates(eberg_grid) <- ~x+y -gridded(eberg_grid) <- TRUE -proj4string(eberg_grid) <- CRS("+init=epsg:31467") -@ - -To write a gridded layer with a point layer on the top we can run: - -<<>>= -kml_open("eberg.kml") -kml_layer(eberg_grid, colour=TWISRT6) -kml_layer(eberg.ll[1,], colour=CLYMHT_A) -kml_close("eberg.kml") -@ - -The resulting plot is shown in Figure~\ref{Fig:layerRaster_legend}. \par - - -\subsection{plotKML specific classes} - -In addition to the existing classes already available in \proglang{R}, we have constructed several new \pkg{plotKML} classes to provide even richer visualization possibilities: - -\begin{itemize} - \item \verb'"SpatialMetadata"' --- \emph{a class to store and exchange spatial metadata}. - \item \verb'"SpatialPhoto"' --- \emph{a class to store spatial location, image (photograph) and its geometric properties}. - \item \verb'"SpatialPredictions"' --- \emph{a class to store results of geostatistical mapping}. - \item \verb'"SpatialVectorsSimulations"' --- \emph{a class to store list of equiprobable simulations of point, line and polygon features}. - \item \verb'"RasterBrickSimulations"' --- \emph{a class to store a list of equiprobable realizations of the same feature}. - \item \verb'"RasterBrickTimeSeries"' --- \emph{a class to store a time series of grids representing the same feature}. -\end{itemize} - -Most of the classes listed above extend the basic \pkg{sp} and \pkg{raster} based classes by attaching the inputs and outputs of the spatial analysis. For example, the \verb'"SpatialPredictions"' class contains both the input sampled values, the results of model fitting (regression and the variogram model), predictions and the results of cross validation. By plotting such object via the \verb"plotKML-method", one can prepare complete scientific visualization for Google Earth (see Figure~\ref{Fig:SpatialPredictions_meuse}).\par - -\begin{figure*}[!htb] -\begin{center} -\includegraphics[width=\textwidth]{Fig_SpatialPredictions_meuse.jpg} -\caption{Scientific visualization of the results of geostatistical mapping (percent organic matter in top-soil) in Google Earth{\texttrademark}: a combination of visualization of gridded map with a legend and map showing the sampling locations and fitted regression and variogram models.} \label{Fig:SpatialPredictions_meuse} -\end{center} -\end{figure*} - -The process of getting from input data (\proglang{R}) to a map in Google Earth is now straightforward and requires only four steps: - -\begin{enumerate}\renewcommand{\labelenumi}{(\textit{\arabic{enumi}})} - \item \emph{load/format the data}, - \item \emph{fit the geostatistical model}, - \item \emph{make predictions}, - \item \emph{visualize maps}, -\end{enumerate} - -Consider for example the Meuse data set commonly used for geostatistical exercises \citep{Pebesma2004CG}: - -<<>>= -library("sp") -demo(meuse, echo=FALSE) -@ - -Via the \pkg{GSIF} package we can automate the model fitting and prediction: - -<<>>= -library("GSIF") -omm <- fit.gstatModel(meuse, om~dist+ffreq, meuse.grid, - family = gaussian(log)) -om.rk <- predict(omm, meuse.grid) -@ - -\noindent here the generic function \verb"fit.gstatModel" from the \pkg{GSIF} package \citep{GSIF} tries to fit a linear regression-kriging model following the input samples (\verb"meuse") and gridded maps (\verb"meuse.grid"). The output (object of class \verb'"SpatialPredictions"') can be plotted in Google Earth by running: - -\begin{CodeChunk} -\begin{CodeInput} -R> plotKML(om.rk) -\end{CodeInput} -\begin{CodeOutput} -KML file opened for writing... -Reprojecting to +proj=longlat +datum=WGS84 ... -Writing to KML... -Reprojecting to +proj=longlat +datum=WGS84 ... -Parsing to KML... -Loading required package: gstat -Closing om.rk.kml -\end{CodeOutput} -\end{CodeChunk} - -\noindent which shows most of elements of geostatistical mapping of interest: sampling locations, resulting spatial predictions, but also success of regression model fitting, variogram fitting and cross-validation. Note also that wrapping model fitting and export to KML allows full automation of the mapping process, so that the process can be run on a server \citep{pebesma2011intamap}.\par - -\subsection{Visualization of spatio-temporal classes}\label{sec:spacetime_example} - -From 2012, there are several implementations of spatio-temporal classes in \proglang{R}. \citet{Pebesma2010Ifgi} shows how purely spatial classes can be extended to space-time classes (via the \pkg{spacetime} \citep{spacetime} package): spatio-temporal full data frame (STFDF), sparse spatio-temporal data frame (STSDF), spatio-temporal irregular data frames (STIDF). \pkg{plotKML} works with most of the space-time classes implemented in \proglang{R}, especially the ones extending the \pkg{sp} classes, but the package should also work with the \pkg{raster} package class objects.\par - -\begin{figure*}[!htb] -\begin{center} -\includegraphics[width=.8\textwidth]{Fig_fmd_stplot.pdf} -\caption{Spatio-temporal plot of point pattern in time: foot-and-mouth epidemic data from north Cumbria (UK) \citep{diggle2005point}.} -\label{Fig:fmd_stplot} -\end{center} -\end{figure*} - -\begin{figure*}[!hp] -\begin{center} -\includegraphics[width=.85\textwidth]{Fig_fmd_google_earth_1.jpg}\\ -\includegraphics[width=.85\textwidth]{Fig_fmd_google_earth_2.jpg}\\ -\includegraphics[width=.85\textwidth]{Fig_fmd_google_earth_3.jpg} -\caption{Visualization of the food-and-mouth epidemic data from north Cumbria (UK) in Google Earth (compare with Figure~\ref{Fig:fmd_stplot}). Note that Google Earth allows users to slide through an event, but also to set the temporal support (width in the slide bar).} -\label{Fig:fmd_google_earth} -\end{center} -\end{figure*} - -Consider for example the foot-and-mouth epidemic data from north Cumbria (UK) \citep{diggle2005point}. This is a spatio-temporal point pattern represented with a matrix containing ($x,y,t$) coordinates of the 648 observations. To visualize this data in \proglang{R} (\pkg{spacetime} package) we would run: - -<<>>= -data("fmd") -fmd0 <- data.frame(fmd) -coordinates(fmd0) <- c("X", "Y") -proj4string(fmd0) <- CRS("+init=epsg:27700") -fmd_sp <- as(fmd0, "SpatialPoints") -dates <- as.Date("2001-02-18")+fmd0$ReportedDay -library("spacetime") -fmd_ST <- STIDF(fmd_sp, dates, data.frame(ReportedDay=fmd0$ReportedDay)) -data("northcumbria") -ln <- Line(northcumbria) -NC <- SpatialLines(list(Lines(list(ln), ID="NC"))) -proj4string(NC) <- CRS("+init=epsg:27700") -stplot(fmd_ST, sp.layout=list("sp.lines", NC), col.regions=SAGA_pal[[1]]) -@ - -\noindent which produces a plot shown in Figure~\ref{Fig:fmd_stplot}.\par - -To plot this data in Google Earth we can do (Figure~\ref{Fig:fmd_google_earth}): - -<>= -kml(fmd_ST, colour=ReportedDay, colour_scale=SAGA_pal[[1]]) -@ - -\begin{CodeChunk} -\begin{CodeInput} -R> plotKML(fmd_ST, colour_scale=SAGA_pal[[1]]) -\end{CodeInput} -\begin{CodeOutput} -Plotting the first variable on the list -KML file opened for writing... -Reprojecting to +proj=longlat +datum=WGS84 ... -Parsing to KML... -Closing fmd_ST.kml -\end{CodeOutput} -\end{CodeChunk} - -Some advantages of getting this data to Google Earth, as compared to using the \verb"stplot()" function (Figure~\ref{Fig:fmd_stplot}), are: - -\begin{enumerate} - \item We can animate spread of disease by moving the time slider. - \item We can observe the event with different temporal support size. - \item We can zoom in into the specific points and locate the actual farm. - \item We can try to analyze whether the spread of disease has anything to do with the proximity to roads, type of land cover etc. - \item We do not necessarily need to prepare any administrative data for the study area as these are already available in Google Earth. -\end{enumerate} - - -\subsection{Visualization of time series of rasters}\label{sec:rasterTimeSeries} - -\pkg{plotKML} can also be used to visualize raster stacks i.e.\@ time series of rasters. Raster stacks or raster bricks \citep{raster} can be different type of remote sensing data or predicted or modelled values. The plot shown in Figure~\ref{Fig:RasterBrickTimeSeries} is based on generic functions for plotting of \verb'"RasterBrickTimeSeries"' class data. It shows a time series of MODIS Land Surface Temperature images for a small area in Istria. We start by building an spatio-temporal object from table data: - -\begin{CodeChunk} -\begin{CodeInput} -R> data("LST") -R> gridded(LST) <- ~lon+lat -R> proj4string(LST) <- CRS("+proj=utm +zone=33 +datum=WGS84 +units=m") -\end{CodeInput} -\end{CodeChunk} - -\begin{figure*}[!htb] -\begin{center} -\includegraphics[width=.8\textwidth]{Fig_RasterBrickTimeSeries.jpg} -\caption{Example of a time series of MODIS images (\texttt{RasterBrickTimeSeries} class) plotted in Google Earth. The values of MODIS Land Surface Temperature at ground stations can be interactively explored by clicking at the points of interest. This way both changes in 2D+T and T can be visually explored.} -\label{Fig:RasterBrickTimeSeries} -\end{center} -\end{figure*} - -Next, format dates: - -\begin{CodeChunk} -\begin{CodeInput} -R> dates <- sapply(strsplit(names(LST), "LST"), function(x){x[[2]]}) -R> datesf <- format(as.Date(dates, "%Y_%m_%d"), "%Y-%m-%dT%H:%M:%SZ") -\end{CodeInput} -\end{CodeChunk} - -\noindent we subtract and add $\pm$4 days to derive begin and end period: - -\begin{CodeChunk} -\begin{CodeInput} -R> TimeSpan.begin = as.POSIXct(unclass(as.POSIXct(datesf))-4*24*60*60, -+ origin="1970-01-01") -R> TimeSpan.end = as.POSIXct(unclass(as.POSIXct(datesf))+4*24*60*60, -+ origin="1970-01-01") -R> LST_ll <- reproject(LST) -\end{CodeInput} -\begin{CodeOutput} -Reprojecting to +proj=longlat +datum=WGS84 ... -Reprojecting to +proj=longlat +datum=WGS84 ... -... -\end{CodeOutput} -\end{CodeChunk} - -Next, we can select three climatic stations in the area (to allow for visualization of time-series data) and prepare an object of class \verb'"RasterBrickTimeSeries"': - -\begin{CodeChunk} -\begin{CodeInput} -R> st.names <- c("Pazin", "Crni Lug - NP Risnjak", "Cres") -R> pnts <- HRtemp08[which(HRtemp08$NAME==st.names[1])[1],] -R> pnts <- rbind(pnts, HRtemp08[which(HRtemp08$NAME==st.names[2])[1],]) -R> pnts <- rbind(pnts, HRtemp08[which(HRtemp08$NAME==st.names[3])[1],]) -R> coordinates(pnts) <- ~Lon + Lat -R> proj4string(pnts) <- CRS("+proj=longlat +datum=WGS84") -R> LST_ll <- brick(LST_ll) -R> LST_ll@title = "Time series of MODIS Land Surface Temperature" -R> LST.ts <- new("RasterBrickTimeSeries", variable = "LST", sampled = pnts, -+ rasters = LST_ll, TimeSpan.begin = TimeSpan.begin[1:5], -+ TimeSpan.end = TimeSpan.end[1:5]) -\end{CodeInput} -\end{CodeChunk} - -\noindent so that we can plot the MODIS images in Google Earth by running: - -\begin{CodeChunk} -\begin{CodeInput} -R> plotKML(LST.ts, colour_scale=SAGA_pal[[1]]) -\end{CodeInput} -\begin{CodeOutput} -KML file opened for writing... -Parsing to KML... -Writing to KML... -Closing LST.ts.kml -\end{CodeOutput} -\end{CodeChunk} - -The resulting plot allows us to explore the changes in values both in space (by using the slide bar in Google Earth) and time (by browsing the individual time-series plots). Again, temporal support can be controlled by the width of the time slider. Setting up a wider temporal support Google Earth will interpolate the displayed colors automatically and display patterns that we would otherwise not be able to see. \par - -\subsection[plotKML in comparison to other KML writing software]{\pkg{plotKML} in comparison to other KML writing software} - -Table~\ref{Tbl:comparison} list some common KML writing software and provides our quick assessment of their functionality. In comparison to other KML writing packages in \proglang{R} and \proglang{python} (e.g.\@ \pkg{R2G2} and \pkg{pyKML}), we see the potential of \pkg{plotKML} primarily within its ambition to provide a larger family of lower-level and wrapper functions that allow both fast generation of complete plots, and customization of KML plots by binding several lower level functions (Table~\ref{Tbl:comparison}). \par - -\begin{table*}[!hp]\label{Tbl:comparison} -\begin{center} -{\footnotesize % \setlength{\extrarowheight}{6pt} -\begin{tabular}{m{.4\textwidth}ccccccccccc} -\toprule -\emph{Aspect} & -{\begin{turn}{90}\textsf{GDAL/OGR}\end{turn}}& -{\begin{turn}{90}\textsf{SAGA GIS}\end{turn}} & -{\begin{turn}{90}\textsf{GRASS GIS}\end{turn}} & -{\begin{turn}{90}\textsf{Autodesk}\end{turn}} & -{\begin{turn}{90}\textsf{Geomedia}\end{turn}} & -{\begin{turn}{90}\textsf{ArcGIS}\end{turn}} & -{\begin{turn}{90}\textsf{Mapping Toolbox}\end{turn}} & -{\begin{turn}{90}\pkg{pyKML}\end{turn}} & -{\begin{turn}{90}\pkg{R2G2}\end{turn}} & -{\begin{turn}{90}\pkg{plotKML}\end{turn}} \\ -\toprule -\raggedright{Programming language} & {\begin{turn}{90}\proglang{C++} / \proglang{Python}\end{turn}} & {\begin{turn}{90}\proglang{C++} / \proglang{Python}\end{turn}} & {\begin{turn}{90}\proglang{C++} / \proglang{Python} $\ldots$ \end{turn}} & {\begin{turn}{90}$-$\end{turn}} & {\begin{turn}{90}\proglang{SQL} $\ldots$\end{turn}} & {\begin{turn}{90}\proglang{AML} / \proglang{Python} $\ldots$ \end{turn}} & {\begin{turn}{90}\textsf{MatLab}\end{turn}} & {\begin{turn}{90}\proglang{Python}\end{turn}} & {\begin{turn}{90}\proglang{R}\end{turn}} & {\begin{turn}{90}\proglang{R}\end{turn}} \\ -\midrule -\raggedright{Open Source software} & $\checkmark$ & $\checkmark$ & $\checkmark$ & $-$ & $-$ & $-$ & $-$ & $\checkmark$ & $\checkmark$ & $\checkmark$ \\ -\midrule -\raggedright{Writes vector data (points, lines, polygons)} & $\star$ & $-$ & $\star$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\star$ & $\star$ & $\bigstar$ \\ -\midrule -\raggedright{Writes rasters (single raster layer, raster stacks)} & $-$ & $\star$ & $\star$ & $-$ & $-$ & $\bigstar$ & $\star$ & $\star$ & $-$ & $\bigstar$ \\ -\midrule -\raggedright{Writes spatio-temporal data (spatio-temporal classes)} & $-$ & $-$ & $-$ & $-$ & $-$ & $\star$ & $\star$ & $-$ & $-$ & $\bigstar$ \\ -\midrule -\raggedright{Can efficiently handle large data (Gigapixel images and large vectors)} & $\bigstar$ & $\star$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\star$ & $\star$ \\ -\midrule -\raggedright{Allows creation of visualization templates (KML writing utilities)} & $\star$ & $-$ & $\star$ & $-$ & $-$ & $\star$ & $\star$ & $\bigstar$ & $\star$ & $\bigstar$ \\ -\midrule -\raggedright{Allows styling (icons size and colors, line width, transparency etc.)} & $-$ & $-$ & $-$ & $-$ & $-$ & $\star$ & $\bigstar$ & $\star$ & $\star$ & $\bigstar$ \\ -\midrule -\raggedright{Supports visualization of scientific data (statistical plots and charts)} & $-$ & $-$ & $-$ & $-$ & $-$ & $\star$ & $\bigstar$ & $\star$ & $-$ & $\bigstar$ \\ -\midrule -\raggedright{Coding efficiency (ease of writing the spatial objects to KML files)} & $\bigstar$ & $-$ & $\bigstar$ & $-$ & $\star$ & $\bigstar$ & $\bigstar$ & $\star$ & $\bigstar$ & $\bigstar$ \\ -\midrule -\raggedright{Provides user-friendly GUI} & $-$ & $\bigstar$ & $\star$ & $\bigstar$ & $\bigstar$ & $\bigstar$ & $\star$ & $-$ & $-$ & $-$ \\ -\bottomrule -\end{tabular}} -\vspace{6pt} -\caption{A matrix comparison of some KML writing software. $\bigstar$ --- full capability, $\star$ --- possible but with limitations, $-$ --- not possible in this package. Functionality subjectively approximated by the authors (subject to discussion).} -\end{center} -\end{table*} - -Although spatial objects in \proglang{R} can be converted to KML formats using a range of different approaches, the \pkg{plotKML} package tries to simplify the process considerably. It has a potential particularly for visualising time series of spatial layers and outputs of spatial analysis (as shown in sections~\ref{sec:spacetime_example} and \ref{sec:rasterTimeSeries}), which is a task that is always rather challenging.\par - -A possible limitation of using \pkg{plotKML} will be visualization of large data sets, which is at the moment not recommended. Instead of attempting direct export of large GIS layers into a single KML file, we advice the user to consider some of the following strategies to optimize export and visualization of large data sets: - -\begin{enumerate} - \item Tile large study areas into regular blocks. - \item Consider increasing the grid cell size in the raster images and/or remove redundant nodes in the vector layers by various thinning procedures. - \item Consider putting the data into a database and then generate KML in chunks. -\end{enumerate} - - -\section{Discussion} - -We have described the design of the \proglang{R} package \pkg{plotKML} in comparison to the other existing packages and software for visualization of similar data. The \verb"plotKML()" method is suggested as a straightforward approach to get the results of spatial analysis quickly from \proglang{R} to Google Earth, but this of course does not alleviate the need for a comprehensive understanding of (geo)statistical analysis and spatial data object structures.\par - -Indirectly, \pkg{plotKML} promotes KML as a standard to use for scientific visualization of spatio-temporal data. Can this be justified? We think that there are several attractive features of using KML schema for scientific visualization. First of all, KML often goes beyond what we typically use within a desktop GIS. KML files can contain both spatial, textual and multimedia information, hence anyone can virtually explore geographical data as standing about the Earth's surface, but then also read all required information about how was the data produced and where to find more information via the embedded HTML content \citep{wernecke2009kml}. Second, as indicated in the introduction already, KML is the format used by Google Earth, and this is likely to remain the most popular geographical browser in the years to come. We believe that packages that connect statistical and geographical programming environments with Google Earth type of browsers are also critical for engaging the wider public in project outcomes. Both researchers and applied users like to see patterns in data clearly and they like to explore data in user-friendly Virtual Earth type of environment. It is also worth mentioning that, Elsevier\footnote{\url{http://www.elsevier.com/googlemaps}} now encourages authors to attach to attach KML files to their article submission. This option is now available for over 80 of their journals in earth sciences, life sciences, and social sciences, so it is in a way already a standard for scientific visualization. \par - -But there are still much room for improvements. As we have demonstrated, both \proglang{R} and KML/Google Earth are fairly flexible and can be used to represent spatial objects and features in 4D (geographical coordinates, altitude, time), nevertheless, both are not ideal for specific tasks. For example, KML is not (yet) suitable to represent complex geological structures, although some authors (e.g.\@ \citet{DePaor2011GGM} and \citet{Blenkinsop2012CG}) have suggested ways around the problem. \par - -We foresee that the future of our package will be in linking our scripts with Java scripts and/or PHP scripts i.e.\@ implementing the functionality that subsets and tiles data from large databases on the fly. We also hope to constantly update and expand the number of supported classes in \pkg{plotKML} (especially following the matrix in Table~\ref{Fig:spacetime_objects_types}) and then add more and more functionality for visualizing distributed data via network links and web mapping services.\par - - -\section*{Acknowledgments} - -This package has been developed as a part of the Global Soil Information Facilities initiative --- tools for collating and serving global soil data developed jointly by the ISRIC --- World Soil Information institute and collaborators. ISRIC is a non-profit organization with a mandate to serve the international community as custodian of global soil information and to increase awareness and understanding of the role of soils in major global issues.\par - -The authors would like to thank the two anonymous reviewers for their suggestions and \proglang{R} code chunks that were largely incorporated in this article.\par - -\bibliography{jss1079} - -%\end{pagewiselinenumbers} - -\end{document} diff --git a/www/doc/jss1079.pdf b/www/doc/jss1079.pdf deleted file mode 100644 index 53dcdde..0000000 Binary files a/www/doc/jss1079.pdf and /dev/null differ diff --git a/www/eberg.html b/www/eberg.html index 12e87cb..dbcc425 100644 --- a/www/eberg.html +++ b/www/eberg.html @@ -9,7 +9,7 @@

Ebergotzen — soil mapping case study

Description

-

Ebergötzen is 10 by 10 km study area in the vicinity of the city of Göttingen in Central Germany. This area has been extensively surveyed over the years, mainly for the purposes of developing operational digital soil mapping techniques (Gehrt and Böhner, 2001), and has been used by the SAGA GIS development team to demonstrate various processing steps.
+

Ebergötzen is 10 by 10 km study area in the vicinity of the city of Göttingen in Central Germany. This area has been extensively surveyed over the years, mainly for the purposes of developing operational digital soil mapping techniques (Gehrt and Böhner, 2001), and has been used by the SAGA GIS development team to demonstrate various processing steps.
eberg table contains 3670 observations (augers) of soil textures at five depths (0-10, 10-30, 30-50, 50-70, and 70-90), and field records of soil types according to the German soil classification system. eberg_grid contains gridded maps at 100 m resolution that can be used as covariates for spatial prediction of soil variables. eberg_grid25 contains grids at finer resolution (25 m). eberg_zones is a polygon map showing the distribution of parent material (Silt and sand, Sandy material, Clayey derivats, Clay and loess). eberg_contours shows contour lines derived from the 25 m DEM of the area using 10 m equidistance.

@@ -76,7 +76,7 @@

Format

TWITOPx

a numeric vector; Topographic Wetness Index derived using the SAGA algorithm

-
NVILANx

a numeric vector; NDVI image derived using the Landsat image from the Image 2000 project

+
NVILANx

a numeric vector; NDVI image derived using the Landsat image from the Image 2000 project

x

a numeric vector; x-coordinate (m) in DHDN / Gauss-Krueger zone 3 (German coordinate system)

@@ -88,25 +88,25 @@

Format

Note

-

Texture by hand method can be used to determine the content of soil earth fractions only to an accuracy of ±5-10% (Skaggs et al. 2001). A surveyor distinguishes to which of the 32 texture classes a soil samples belongs to, and then estimates the content of fractions; e.g. texture class St2 has 10% clay, 25% silt and 65% sand (Ad-hoc-AG Boden, 2005).

+

Texture by hand method can be used to determine the content of soil earth fractions only to an accuracy of ±5-10% (Skaggs et al. 2001). A surveyor distinguishes to which of the 32 texture classes a soil samples belongs to, and then estimates the content of fractions; e.g. texture class St2 has 10% clay, 25% silt and 65% sand (Ad-hoc-AG Boden, 2005).

Author(s)

-

The Ebergötzen dataset is courtesy of Gehrt Ernst (Ernst.Gehrt@niedersachsen.de), the State Authority for Mining, Energy and Geology, Hannover, Germany and Olaf Conrad, University of Hamburg (conrad@geowiss.uni-hamburg.de). The original data set has been prepared for this exercise by Tomislav Hengl (tom.hengl@opengeohub.org).

+

The Ebergötzen dataset is courtesy of Gehrt Ernst (Ernst.Gehrt@niedersachsen.de), the State Authority for Mining, Energy and Geology, Hannover, Germany and Olaf Conrad, University of Hamburg (conrad@geowiss.uni-hamburg.de). The original data set has been prepared for this exercise by Tomislav Hengl (tom.hengl@wur.nl).

References

    -

  • Ad-hoc-AG Boden, (2005) Bodenkundliche Kartieranleitung. 5th Ed, Bundesanstalt fur Geowissenschaften und Rohstoffe und Niedersächsisches Landesamt für Bodenforshung, Hannover, p. 423. +

  • Ad-hoc-AG Boden, (2005) Bodenkundliche Kartieranleitung. 5th Ed, Bundesanstalt fur Geowissenschaften und Rohstoffe und Niedersächsisches Landesamt für Bodenforshung, Hannover, p. 423.

    • -

  • Böhner, J., McCloy, K. R. and Strobl, J. (Eds), (2006) SAGA — Analysis and Modelling Applications. Göttinger Geographische Abhandlungen, Heft 115. Verlag Erich Goltze GmbH, Göttingen, 117 pp. +

  • Böhner, J., McCloy, K. R. and Strobl, J. (Eds), (2006) SAGA — Analysis and Modelling Applications. Göttinger Geographische Abhandlungen, Heft 115. Verlag Erich Goltze GmbH, Göttingen, 117 pp.

    • -

  • Gehrt, E., Böhner, J., (2001) Vom punkt zur flache — probleme des ‘upscaling’ in der bodenkartierung. In: Diskussionsforum Bodenwissenschaften: Vom Bohrstock zum Bildschirm. FH, Osnabrück, pp. 17-34. +

  • Gehrt, E., Böhner, J., (2001) Vom punkt zur flache — probleme des ‘upscaling’ in der bodenkartierung. In: Diskussionsforum Bodenwissenschaften: Vom Bohrstock zum Bildschirm. FH, Osnabrück, pp. 17-34.

  • Skaggs, T. H., Arya, L. M., Shouse, P. J., Mohanty, B. P., (2001) Estimating Particle-Size Distribution from Limited Soil Texture Data. Soil Science Society of America Journal 65 (4): 1038-1044. @@ -140,5 +140,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/edgeroi_overview.jpeg b/www/edgeroi_overview.jpeg deleted file mode 100755 index fe15a91..0000000 Binary files a/www/edgeroi_overview.jpeg and /dev/null differ diff --git a/www/fig_2_profiles_ocs_edgeroi.png b/www/fig_2_profiles_ocs_edgeroi.png deleted file mode 100755 index 88ec4e2..0000000 Binary files a/www/fig_2_profiles_ocs_edgeroi.png and /dev/null differ diff --git a/www/fig_2_profiles_ocs_organic.png b/www/fig_2_profiles_ocs_organic.png deleted file mode 100755 index 6e1d133..0000000 Binary files a/www/fig_2_profiles_ocs_organic.png and /dev/null differ diff --git a/www/fig_afnutrients_final_maps_macro.png b/www/fig_afnutrients_final_maps_macro.png deleted file mode 100755 index 1bd9e43..0000000 Binary files a/www/fig_afnutrients_final_maps_macro.png and /dev/null differ diff --git a/www/fig_afnutrients_final_maps_micro.png b/www/fig_afnutrients_final_maps_micro.png deleted file mode 100755 index 8378bb3..0000000 Binary files a/www/fig_afnutrients_final_maps_micro.png and /dev/null differ diff --git a/www/fig_africa_comparison_20km_1km.png b/www/fig_africa_comparison_20km_1km.png deleted file mode 100755 index 559650a..0000000 Binary files a/www/fig_africa_comparison_20km_1km.png and /dev/null differ diff --git a/www/fig_air_quality_data_stfsd_plotkml.jpg b/www/fig_air_quality_data_stfsd_plotkml.jpg deleted file mode 100755 index 2d6e5cb..0000000 Binary files a/www/fig_air_quality_data_stfsd_plotkml.jpg and /dev/null differ diff --git a/www/fig_bubble_plot.jpg b/www/fig_bubble_plot.jpg deleted file mode 100755 index cc5c493..0000000 Binary files a/www/fig_bubble_plot.jpg and /dev/null differ diff --git a/www/fig_dem_poly.jpg b/www/fig_dem_poly.jpg deleted file mode 100755 index 808fc13..0000000 Binary files a/www/fig_dem_poly.jpg and /dev/null differ diff --git a/www/fig_derivation_socs_scheme.png b/www/fig_derivation_socs_scheme.png deleted file mode 100755 index 6c41314..0000000 Binary files a/www/fig_derivation_socs_scheme.png and /dev/null differ diff --git a/www/fig_eberg_3d_soil_profile.jpg b/www/fig_eberg_3d_soil_profile.jpg deleted file mode 100755 index 7d324b1..0000000 Binary files a/www/fig_eberg_3d_soil_profile.jpg and /dev/null differ diff --git a/www/fig_eberg_comparison_25_100_m.png b/www/fig_eberg_comparison_25_100_m.png deleted file mode 100755 index 9c3de3c..0000000 Binary files a/www/fig_eberg_comparison_25_100_m.png and /dev/null differ diff --git a/www/fig_eberg_crs_test.png b/www/fig_eberg_crs_test.png deleted file mode 100755 index 1d9b2f1..0000000 Binary files a/www/fig_eberg_crs_test.png and /dev/null differ diff --git a/www/fig_eberg_hist_sndmht.png b/www/fig_eberg_hist_sndmht.png deleted file mode 100755 index b89cd19..0000000 Binary files a/www/fig_eberg_hist_sndmht.png and /dev/null differ diff --git a/www/fig_eberg_lines.jpg b/www/fig_eberg_lines.jpg deleted file mode 100755 index 5ef1a67..0000000 Binary files a/www/fig_eberg_lines.jpg and /dev/null differ diff --git a/www/fig_eberg_maxent_test.png b/www/fig_eberg_maxent_test.png deleted file mode 100755 index 82e4ba4..0000000 Binary files a/www/fig_eberg_maxent_test.png and /dev/null differ diff --git a/www/fig_eberg_merge_25_100_m.png b/www/fig_eberg_merge_25_100_m.png deleted file mode 100755 index a2b9210..0000000 Binary files a/www/fig_eberg_merge_25_100_m.png and /dev/null differ diff --git a/www/fig_eberg_polygons.jpg b/www/fig_eberg_polygons.jpg deleted file mode 100755 index e822e7f..0000000 Binary files a/www/fig_eberg_polygons.jpg and /dev/null differ diff --git a/www/fig_eberg_sims_cross_section.png b/www/fig_eberg_sims_cross_section.png deleted file mode 100755 index e09f431..0000000 Binary files a/www/fig_eberg_sims_cross_section.png and /dev/null differ diff --git a/www/fig_eberg_soiltypes_spfkm.png b/www/fig_eberg_soiltypes_spfkm.png deleted file mode 100755 index 38461a1..0000000 Binary files a/www/fig_eberg_soiltypes_spfkm.png and /dev/null differ diff --git a/www/fig_eberg_spatialmemberships.png b/www/fig_eberg_spatialmemberships.png deleted file mode 100755 index c24a47d..0000000 Binary files a/www/fig_eberg_spatialmemberships.png and /dev/null differ diff --git a/www/fig_eberg_spcs1_4.png b/www/fig_eberg_spcs1_4.png deleted file mode 100755 index 64412fb..0000000 Binary files a/www/fig_eberg_spcs1_4.png and /dev/null differ diff --git a/www/fig_eberg_spcs2_4.png b/www/fig_eberg_spcs2_4.png deleted file mode 100755 index ac46aa5..0000000 Binary files a/www/fig_eberg_spcs2_4.png and /dev/null differ diff --git a/www/fig_eberg_two_aesthetics.jpg b/www/fig_eberg_two_aesthetics.jpg deleted file mode 100755 index e5c7f7f..0000000 Binary files a/www/fig_eberg_two_aesthetics.jpg and /dev/null differ diff --git a/www/fig_future_mobile_phone.jpg b/www/fig_future_mobile_phone.jpg deleted file mode 100755 index 38653a1..0000000 Binary files a/www/fig_future_mobile_phone.jpg and /dev/null differ diff --git a/www/fig_ghana_overview_map.png b/www/fig_ghana_overview_map.png deleted file mode 100755 index 778e40a..0000000 Binary files a/www/fig_ghana_overview_map.png and /dev/null differ diff --git a/www/fig_ghana_soil_organic_carbon_stock.png b/www/fig_ghana_soil_organic_carbon_stock.png deleted file mode 100755 index 8cf0e3a..0000000 Binary files a/www/fig_ghana_soil_organic_carbon_stock.png and /dev/null differ diff --git a/www/fig_gpxtour.jpg b/www/fig_gpxtour.jpg deleted file mode 100755 index 4ffc39f..0000000 Binary files a/www/fig_gpxtour.jpg and /dev/null differ diff --git a/www/fig_gsif_predicted_layers.jpg b/www/fig_gsif_predicted_layers.jpg deleted file mode 100755 index 8754883..0000000 Binary files a/www/fig_gsif_predicted_layers.jpg and /dev/null differ diff --git a/www/fig_la_libertad_research_center_socs.jpg b/www/fig_la_libertad_research_center_socs.jpg deleted file mode 100755 index b43b9a4..0000000 Binary files a/www/fig_la_libertad_research_center_socs.jpg and /dev/null differ diff --git a/www/fig_latinhypercube_sample_eberg.jpg b/www/fig_latinhypercube_sample_eberg.jpg deleted file mode 100755 index b1b0460..0000000 Binary files a/www/fig_latinhypercube_sample_eberg.jpg and /dev/null differ diff --git a/www/fig_layerraster_legend.jpg b/www/fig_layerraster_legend.jpg deleted file mode 100755 index 4de864c..0000000 Binary files a/www/fig_layerraster_legend.jpg and /dev/null differ diff --git a/www/fig_metadata_googleearth.jpg b/www/fig_metadata_googleearth.jpg deleted file mode 100755 index 4ce8df1..0000000 Binary files a/www/fig_metadata_googleearth.jpg and /dev/null differ diff --git a/www/fig_monolith.jpg b/www/fig_monolith.jpg deleted file mode 100755 index c0f1358..0000000 Binary files a/www/fig_monolith.jpg and /dev/null differ diff --git a/www/fig_multiscale_vs_multisource.png b/www/fig_multiscale_vs_multisource.png deleted file mode 100755 index af5b29a..0000000 Binary files a/www/fig_multiscale_vs_multisource.png and /dev/null differ diff --git a/www/fig_open_land_info_scheme.png b/www/fig_open_land_info_scheme.png deleted file mode 100755 index 3319954..0000000 Binary files a/www/fig_open_land_info_scheme.png and /dev/null differ diff --git a/www/fig_orc_sd1_ghana_plot.png b/www/fig_orc_sd1_ghana_plot.png deleted file mode 100755 index 9fd4992..0000000 Binary files a/www/fig_orc_sd1_ghana_plot.png and /dev/null differ diff --git a/www/fig_orc_sd1_ghana_plot_ge.jpg b/www/fig_orc_sd1_ghana_plot_ge.jpg deleted file mode 100755 index d9bb896..0000000 Binary files a/www/fig_orc_sd1_ghana_plot_ge.jpg and /dev/null differ diff --git a/www/fig_photo_overlay.jpg b/www/fig_photo_overlay.jpg deleted file mode 100755 index 48c4d1c..0000000 Binary files a/www/fig_photo_overlay.jpg and /dev/null differ diff --git a/www/fig_pnt1_plot_orc_soildepth.png b/www/fig_pnt1_plot_orc_soildepth.png deleted file mode 100755 index 4b10507..0000000 Binary files a/www/fig_pnt1_plot_orc_soildepth.png and /dev/null differ diff --git a/www/fig_predicted_africa_orcdrc_6_depths.png b/www/fig_predicted_africa_orcdrc_6_depths.png deleted file mode 100755 index 5078920..0000000 Binary files a/www/fig_predicted_africa_orcdrc_6_depths.png and /dev/null differ diff --git a/www/fig_predicted_africa_soilvars.png b/www/fig_predicted_africa_soilvars.png deleted file mode 100755 index 73d003f..0000000 Binary files a/www/fig_predicted_africa_soilvars.png and /dev/null differ diff --git a/www/fig_rasterbricksimulations.jpg b/www/fig_rasterbricksimulations.jpg deleted file mode 100755 index d174083..0000000 Binary files a/www/fig_rasterbricksimulations.jpg and /dev/null differ diff --git a/www/fig_rasterbricktimeseries.jpg b/www/fig_rasterbricktimeseries.jpg deleted file mode 100755 index 033923e..0000000 Binary files a/www/fig_rasterbricktimeseries.jpg and /dev/null differ diff --git a/www/fig_rf_organic_carbon_stock_edgeroi.png b/www/fig_rf_organic_carbon_stock_edgeroi.png deleted file mode 100755 index c797fc3..0000000 Binary files a/www/fig_rf_organic_carbon_stock_edgeroi.png and /dev/null differ diff --git a/www/fig_simulations_streams.jpg b/www/fig_simulations_streams.jpg deleted file mode 100755 index 414802e..0000000 Binary files a/www/fig_simulations_streams.jpg and /dev/null differ diff --git a/www/fig_soil_colors_afspdb.png b/www/fig_soil_colors_afspdb.png deleted file mode 100755 index e0a12b7..0000000 Binary files a/www/fig_soil_colors_afspdb.png and /dev/null differ diff --git a/www/fig_soil_texture_triangle_afspdb_observed.png b/www/fig_soil_texture_triangle_afspdb_observed.png deleted file mode 100755 index 761c6a5..0000000 Binary files a/www/fig_soil_texture_triangle_afspdb_observed.png and /dev/null differ diff --git a/www/fig_soil_texture_triangle_usda.png b/www/fig_soil_texture_triangle_usda.png deleted file mode 100755 index 22f8a57..0000000 Binary files a/www/fig_soil_texture_triangle_usda.png and /dev/null differ diff --git a/www/fig_soilprofilecollection_block.jpg b/www/fig_soilprofilecollection_block.jpg deleted file mode 100755 index 38b4e80..0000000 Binary files a/www/fig_soilprofilecollection_block.jpg and /dev/null differ diff --git a/www/fig_soilprofilecollection_hist.jpg b/www/fig_soilprofilecollection_hist.jpg deleted file mode 100755 index edd5aa3..0000000 Binary files a/www/fig_soilprofilecollection_hist.jpg and /dev/null differ diff --git a/www/fig_spacetime_hrtemp08.jpg b/www/fig_spacetime_hrtemp08.jpg deleted file mode 100755 index 6e20d77..0000000 Binary files a/www/fig_spacetime_hrtemp08.jpg and /dev/null differ diff --git a/www/fig_spatialmaxentoutput.jpg b/www/fig_spatialmaxentoutput.jpg deleted file mode 100755 index 56e971b..0000000 Binary files a/www/fig_spatialmaxentoutput.jpg and /dev/null differ diff --git a/www/fig_spatialpredictions_meuse.jpg b/www/fig_spatialpredictions_meuse.jpg deleted file mode 100755 index 4939d21..0000000 Binary files a/www/fig_spatialpredictions_meuse.jpg and /dev/null differ diff --git a/www/fig_spatialsamplingpattern.jpg b/www/fig_spatialsamplingpattern.jpg deleted file mode 100755 index e948742..0000000 Binary files a/www/fig_spatialsamplingpattern.jpg and /dev/null differ diff --git a/www/fig_stidf_polygons.jpg b/www/fig_stidf_polygons.jpg deleted file mode 100755 index a131337..0000000 Binary files a/www/fig_stidf_polygons.jpg and /dev/null differ diff --git a/www/fig_suborders_ghana.png b/www/fig_suborders_ghana.png deleted file mode 100755 index 20267bf..0000000 Binary files a/www/fig_suborders_ghana.png and /dev/null differ diff --git a/www/fig_tiling_usagrids.png b/www/fig_tiling_usagrids.png deleted file mode 100755 index 14768bf..0000000 Binary files a/www/fig_tiling_usagrids.png and /dev/null differ diff --git a/www/fig_time_series_rasters_lst.jpg b/www/fig_time_series_rasters_lst.jpg deleted file mode 100755 index adb4a8a..0000000 Binary files a/www/fig_time_series_rasters_lst.jpg and /dev/null differ diff --git a/www/fmd.html b/www/fmd.html index 7f14701..1b5c17d 100644 --- a/www/fmd.html +++ b/www/fmd.html @@ -39,5 +39,5 @@

    See Also

    northcumbria for boundaries of the county of north Cumbria.

    -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/ge_preview.jpg b/www/ge_preview.jpg deleted file mode 100755 index d3025aa..0000000 Binary files a/www/ge_preview.jpg and /dev/null differ diff --git a/www/geopath.html b/www/geopath.html index 14df001..ed3c719 100644 --- a/www/geopath.html +++ b/www/geopath.html @@ -100,5 +100,5 @@

    Examples

    kml(ams.ny) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/getCRS.html b/www/getCRS.html index 959804a..5eb0e05 100644 --- a/www/getCRS.html +++ b/www/getCRS.html @@ -34,7 +34,7 @@

    Arguments

    Details

    -

    For more details about the PROJ.4 parameters refer to the https://proj4.org/usage/projections.html.

    +

    For more details about the PROJ.4 parameters refer to the http://proj4.org.

    Author(s)

    @@ -64,5 +64,5 @@

    Examples

    getCRS(r.ll) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/getWikimedia.html b/www/getWikimedia.html index 5de8b5b..0b4144f 100644 --- a/www/getWikimedia.html +++ b/www/getWikimedia.html @@ -99,5 +99,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/geul_plotkml_view.jpg b/www/geul_plotkml_view.jpg deleted file mode 100755 index 041977e..0000000 Binary files a/www/geul_plotkml_view.jpg and /dev/null differ diff --git a/www/gpxbtour.html b/www/gpxbtour.html index 056d615..d4afb0b 100644 --- a/www/gpxbtour.html +++ b/www/gpxbtour.html @@ -9,7 +9,7 @@

    GPS log of a bike tour

    Description

    -

    GPS log of a bike tour from Wageningen (the Netherlands) to M?nster (Germany). The table contains 3228 records of GPS locations, speed and elevation.

    +

    GPS log of a bike tour from Wageningen (the Netherlands) to Münster (Germany). The table contains 3228 records of GPS locations, speed and elevation.

    Usage

    @@ -60,7 +60,7 @@

    Examples

    proj4string(gpxbtour) <- CRS("+proj=longlat +datum=WGS84") ## convert to a STTDF class: library(spacetime) -library(adehabitatLT) +library(adehabitat) gpx.ltraj <- as.ltraj(coordinates(gpxbtour), gpxbtour$ctime, id = "th") gpx.st <- as(gpx.ltraj, "STTDF") ## Google maps plot: @@ -73,5 +73,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/grid2poly.html b/www/grid2poly.html index 81f5cff..6868823 100644 --- a/www/grid2poly.html +++ b/www/grid2poly.html @@ -99,5 +99,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/index.php b/www/index.php index 0cf2324..b6d2e2b 100644 --- a/www/index.php +++ b/www/index.php @@ -67,10 +67,10 @@

    Visualization of spatial and spatio-temporal objects in Google Earth

    -

    Contact: Tomislav Hengl,

    +

    Contact: Tomislav Hengl,

    Contributions by: Pierre Roudier, Dylan Beaudette & Edzer Pebesma

    -

    This package has been developed as a part of the Global Soil Information Facilities, which are developed jointly by the ISRIC Institute and collaborators.

    -

    The plotKML project summary page you can find here. See the complete list of functions and a list of additional settings. To submit a software bug, use the official package tracker. The fastest way to learn how plotKML works is to follow this tutorial. There is also a paper in the JSS on plotKML package functionality.

    +

    This package has been developed as a part of the Global Soil Information Facilities, which are developed jointly by the ISRIC Institute and collaborators. ISRIC is a non-profit organization with a mandate to serve the international community as custodian of global soil information and to increase awareness and understanding of the role of soils in major global issues.

    +

    The plotKML project summary page you can find here. See the complete list of functions and a list of additional settings. To submit a software bug, use the official package tracker. The fastest way to learn how plotKML works is to follow this tutorial. There is also a paper in the JSS on plotKML package functionality.

    To submit a bug or future request please use the package tracker. The package is continuously updated and it is expected to become fully operational by early 2013.

    Installation:

    Get the stable release from CRAN.

    @@ -80,7 +80,6 @@

    News:

      -
    • January 2019: maintainer e-mail updated;
    • August 2014: GEOSTAT summer school video recordings available on-line;
    • July 2013: plotKML video tutorial now available on a youtube channel;
    • May 28 2013: plotKML tutorials run on the GEOSTAT Quebec City 2013;
      • @@ -89,7 +88,7 @@ spatial and spatio-temporal data);
    • Nove 26, 2012: plotKML version 03 sent to CRAN (package now 90% complete / but with still some bugs);
    • Sept 10-12, 2012: R development workshop at IfGI Muenster (sign-up to join this workshop);
      • -
    • Aug 2012: added a plotKML tutorial;
      • +
    • Aug 2012: added a plotKML tutorial;
    • Jun 20, 2012: the package has been published via CRAN;
    • May 2012: fixed some bugs with writing PNG (kml_layer.Raster);
    • Feb 2012: the package is at the moment in the pre-alpha version; 10% missing functionality and validity checking required;
      • @@ -106,22 +105,22 @@ - @@ -129,23 +128,23 @@

      Soil monolith in Google Earth.png

      +
      @@ -153,23 +152,23 @@
      -

      DEM poly in Google Earth

      +

      DEM poly in Google Earth

      grid2poly GE_icon
      -

      TWI layerRaster in Google Earth

      +

      TWI layerRaster in Google Earth

      Raster GE_icon
      @@ -177,23 +176,23 @@
      -

      GPX bicycle Wageningen Muenster

      +

      GPX bicycle Wageningen Muenster

      STTDF GE_icon
      @@ -202,11 +201,11 @@
      - +
      OpenGeoHub logo
      ISRIC logo

      Last update: - January 04, 2019 -| contact: tom.hengl@opengeohub.org | OpenGeoHub foundation

      + November 29, 2014 +| contact: tom.hengl@wur.nl | ISRIC - World Soil Information Institute

      diff --git a/www/kml.html b/www/kml.html index 6c3d5a2..353d6b6 100644 --- a/www/kml.html +++ b/www/kml.html @@ -98,5 +98,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml.tiles.html b/www/kml.tiles.html index 233fdaa..7e45b7a 100644 --- a/www/kml.tiles.html +++ b/www/kml.tiles.html @@ -117,5 +117,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_compress.html b/www/kml_compress.html index b681269..89d104a 100644 --- a/www/kml_compress.html +++ b/www/kml_compress.html @@ -92,5 +92,5 @@

      Examples

      kml_compress("eberg.kml") -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_description.html b/www/kml_description.html index 98469d9..f5fe343 100644 --- a/www/kml_description.html +++ b/www/kml_description.html @@ -69,5 +69,5 @@

      See Also

      kml-methods

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_layer.html b/www/kml_layer.html index 3b12d35..2ee679a 100644 --- a/www/kml_layer.html +++ b/www/kml_layer.html @@ -73,5 +73,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_legend.bar.html b/www/kml_legend.bar.html index e1e2c0c..aa9f014 100644 --- a/www/kml_legend.bar.html +++ b/www/kml_legend.bar.html @@ -76,5 +76,5 @@

      See Also

      grDevices::png, kml-methods, kml_layer

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_metadata.html b/www/kml_metadata.html index a323849..229e1ab 100644 --- a/www/kml_metadata.html +++ b/www/kml_metadata.html @@ -97,5 +97,5 @@

      See Also

      spMetadata

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_open.html b/www/kml_open.html index 90d4b86..832697c 100644 --- a/www/kml_open.html +++ b/www/kml_open.html @@ -83,5 +83,5 @@

      See Also

      plotKML-method, kml_layer, kml-methods

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/kml_screen.html b/www/kml_screen.html index 598b139..9d5adb3 100644 --- a/www/kml_screen.html +++ b/www/kml_screen.html @@ -108,5 +108,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.Raster.html b/www/layer.Raster.html index 6dd670c..0503b24 100644 --- a/www/layer.Raster.html +++ b/www/layer.Raster.html @@ -19,7 +19,7 @@

      Usage

      metadata = NULL, raster_name, png.width = ncol(obj), png.height = nrow(obj), min.png.width = 800, TimeSpan.begin, TimeSpan.end, - layer.name, png.type, ...) + layer.name, png.type = "cairo-png", ...) @@ -114,5 +114,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.RasterBrick.html b/www/layer.RasterBrick.html index ec54568..d9396bf 100644 --- a/www/layer.RasterBrick.html +++ b/www/layer.RasterBrick.html @@ -21,7 +21,7 @@

      Usage

      home_url = get("home_url", envir = plotKML.opts), metadata = NULL, html.table = NULL, altitudeMode = "clampToGround", balloon = FALSE, - png.width, png.height, min.png.width = 800, png.type, ...) + png.width, png.height, min.png.width = 800, png.type = "cairo-png", ...) @@ -110,5 +110,5 @@

      See Also

      kml-methods, kml_open, kml_layer.Raster, plotKML-method

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.STIDF.html b/www/layer.STIDF.html index 3a0c392..e18159f 100644 --- a/www/layer.STIDF.html +++ b/www/layer.STIDF.html @@ -44,7 +44,7 @@

      Details

      yyyy-mm-ddThh:mm:sszzzzzz

      -

      where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents ±hh:mm in relation to UTC. For more info on how Time Stamps work see https://developers.google.com/kml/documentation/kml_tut. If the time is measured at block support, then:
      +

      where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents ?hh:mm in relation to UTC. For more info on how Time Stamps work see http://kml-samples.googlecode.com. If the time is measured at block support, then:

      <TimeStamp><begin> </begin><end> </end></TimeStamp>

      @@ -54,7 +54,7 @@

      Details

      Author(s)

      -

      Tomislav Hengl and Benedikt Gräler

      +

      Tomislav Hengl and Benedikt Gr?ler

      References

      @@ -116,5 +116,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.STTDF.html b/www/layer.STTDF.html index 25030f6..bdaa3fd 100644 --- a/www/layer.STTDF.html +++ b/www/layer.STTDF.html @@ -79,7 +79,7 @@

      Arguments

      Details

      -

      The dateTime is defined as yyyy-mm-ddThh:mm:sszzzzzz, where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents ±hh:mm in relation to UTC. For more info on how Time Stamps work see https://developers.google.com/kml/documentation/kml_tut. If the time is measured at block support, then:
      +

      The dateTime is defined as yyyy-mm-ddThh:mm:sszzzzzz, where T is the separator between the date and the time, and the time zone is either Z (for UTC) or zzzzzz, which represents ?hh:mm in relation to UTC. For more info on how Time Stamps work see http://kml-samples.googlecode.com. If the time is measured at block support, then:

      <TimeStamp><begin> </begin><end> </end></TimeStamp>

      @@ -110,5 +110,5 @@

      See Also

      readGPX, plotKML-method

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.SoilProfileCollection.html b/www/layer.SoilProfileCollection.html index ef3791a..55d8f1a 100644 --- a/www/layer.SoilProfileCollection.html +++ b/www/layer.SoilProfileCollection.html @@ -218,5 +218,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.SpatialLines.html b/www/layer.SpatialLines.html index 96d5e9b..f69a72d 100644 --- a/www/layer.SpatialLines.html +++ b/www/layer.SpatialLines.html @@ -94,5 +94,5 @@

      Examples

      kml(eberg_contours, colour_scale = SAGA_pal[[1]], colour = Z, kmz = TRUE) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.SpatialPhotoOverlay.html b/www/layer.SpatialPhotoOverlay.html index 53c05ba..f032a2c 100644 --- a/www/layer.SpatialPhotoOverlay.html +++ b/www/layer.SpatialPhotoOverlay.html @@ -174,5 +174,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.SpatialPixels.html b/www/layer.SpatialPixels.html index a49b2de..86adf1b 100644 --- a/www/layer.SpatialPixels.html +++ b/www/layer.SpatialPixels.html @@ -20,7 +20,7 @@

      Usage

      png.width = gridparameters(obj)[1,"cells.dim"], png.height = gridparameters(obj)[2,"cells.dim"], min.png.width = 800, TimeSpan.begin, TimeSpan.end, - layer.name, png.type, ...) + layer.name, png.type = "cairo-png", ...) @@ -118,5 +118,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.SpatialPoints.html b/www/layer.SpatialPoints.html index ba6e7d7..4524482 100644 --- a/www/layer.SpatialPoints.html +++ b/www/layer.SpatialPoints.html @@ -133,5 +133,5 @@

      Examples

      p1 -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/layer.SpatialPolygons.html b/www/layer.SpatialPolygons.html index be35aeb..ea05ce4 100644 --- a/www/layer.SpatialPolygons.html +++ b/www/layer.SpatialPolygons.html @@ -120,5 +120,5 @@

      Examples

      labels = ZONES, kmz = TRUE, balloon=TRUE) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/legend.whitening.html b/www/legend.whitening.html index 3141295..f2127bc 100644 --- a/www/legend.whitening.html +++ b/www/legend.whitening.html @@ -111,5 +111,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/makeCOLLADA.html b/www/makeCOLLADA.html index ac703cf..ec6e230 100644 --- a/www/makeCOLLADA.html +++ b/www/makeCOLLADA.html @@ -100,5 +100,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/metadata2SLD.SpatialPixels.html b/www/metadata2SLD.SpatialPixels.html index 13273a0..42e5dc9 100644 --- a/www/metadata2SLD.SpatialPixels.html +++ b/www/metadata2SLD.SpatialPixels.html @@ -100,5 +100,5 @@

      Examples

      ## End(Not run) -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/metadata2SLD.html b/www/metadata2SLD.html index 72fa5af..2f5cf3a 100644 --- a/www/metadata2SLD.html +++ b/www/metadata2SLD.html @@ -49,5 +49,5 @@

      See Also

      metadata2SLD.SpatialPixels, spMetadata

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/normalizeFilename.html b/www/normalizeFilename.html index e18f74c..9ec00c4 100644 --- a/www/normalizeFilename.html +++ b/www/normalizeFilename.html @@ -64,5 +64,5 @@

      Examples

      normalizeFilename("name .txt") -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/northcumbria.html b/www/northcumbria.html index 5de0fb0..03a7cc4 100644 --- a/www/northcumbria.html +++ b/www/northcumbria.html @@ -33,5 +33,5 @@

      See Also

      fmd for the space-time pattern of food-and-mouth disease in this county in 2001.

      -
      [Package plotKML version 0.5-9 Index]
      +
      [Package plotKML version 0.5-8 Index]
      diff --git a/www/photo_overlay.png b/www/photo_overlay.png deleted file mode 100755 index 506bd8e..0000000 Binary files a/www/photo_overlay.png and /dev/null differ diff --git a/www/plotKML-package.html b/www/plotKML-package.html index 069da53..6d4b287 100644 --- a/www/plotKML-package.html +++ b/www/plotKML-package.html @@ -52,7 +52,7 @@

      Note

      Author(s)

      -

      Tomislav Hengl (tom.hengl@opengeohub.org), Pierre Roudier (pierre.roudier@landcare.nz), Dylan Beaudette (debeaudette@ucdavis.edu), Edzer Pebesma (edzer.pebesma@uni-muenster.de) +

      Tomislav Hengl (tom.hengl@wur.nl), Pierre Roudier (pierre.roudier@landcare.nz), Dylan Beaudette (debeaudette@ucdavis.edu), Edzer Pebesma (edzer.pebesma@uni-muenster.de)

      @@ -71,5 +71,5 @@

      References

    -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/plotKML.GDALobj.html b/www/plotKML.GDALobj.html index 541ffd1..68df56c 100644 --- a/www/plotKML.GDALobj.html +++ b/www/plotKML.GDALobj.html @@ -142,5 +142,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/plotKML.env.html b/www/plotKML.env.html index bdb94fe..d7942c5 100644 --- a/www/plotKML.env.html +++ b/www/plotKML.env.html @@ -188,5 +188,5 @@

    Examples

    get("home_url", envir = plotKML.opts) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/plotKML.html b/www/plotKML.html index 0588b46..c99e545 100644 --- a/www/plotKML.html +++ b/www/plotKML.html @@ -449,7 +449,7 @@

    Examples

    ## Not run: library(fossil) library(spacetime) -library(adehabitatLT) +library(adehabitat) data(gpxbtour) ## format the time column: gpxbtour$ctime <- as.POSIXct(gpxbtour$time, format="%Y-%m-%dT%H:%M:%SZ") @@ -653,5 +653,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/plotKML_0.5-8.tar.gz b/www/plotKML_0.5-8.tar.gz deleted file mode 100644 index 5f3a395..0000000 Binary files a/www/plotKML_0.5-8.tar.gz and /dev/null differ diff --git a/www/plotKML_0.5-9.tar.gz b/www/plotKML_0.5-9.tar.gz deleted file mode 100644 index 9927af9..0000000 Binary files a/www/plotKML_0.5-9.tar.gz and /dev/null differ diff --git a/www/plotKML_0.6-0.tar.gz b/www/plotKML_0.6-0.tar.gz deleted file mode 100644 index faa5e84..0000000 Binary files a/www/plotKML_0.6-0.tar.gz and /dev/null differ diff --git a/www/plot_factorvar.png b/www/plot_factorvar.png deleted file mode 100755 index a96e4a3..0000000 Binary files a/www/plot_factorvar.png and /dev/null differ diff --git a/www/plot_geostat_mapping.png b/www/plot_geostat_mapping.png deleted file mode 100755 index dc9df7d..0000000 Binary files a/www/plot_geostat_mapping.png and /dev/null differ diff --git a/www/plot_lst.png b/www/plot_lst.png deleted file mode 100755 index 39866c6..0000000 Binary files a/www/plot_lst.png and /dev/null differ diff --git a/www/plot_ltraj.png b/www/plot_ltraj.png deleted file mode 100755 index 75fe214..0000000 Binary files a/www/plot_ltraj.png and /dev/null differ diff --git a/www/plot_metadata.png b/www/plot_metadata.png deleted file mode 100755 index 29a4b88..0000000 Binary files a/www/plot_metadata.png and /dev/null differ diff --git a/www/plot_pixels.png b/www/plot_pixels.png deleted file mode 100755 index c3ff2e3..0000000 Binary files a/www/plot_pixels.png and /dev/null differ diff --git a/www/plot_rasterbricksimulations.png b/www/plot_rasterbricksimulations.png deleted file mode 100755 index 4cd7bfa..0000000 Binary files a/www/plot_rasterbricksimulations.png and /dev/null differ diff --git a/www/plot_sampling_pattern.png b/www/plot_sampling_pattern.png deleted file mode 100755 index 1ebcbf1..0000000 Binary files a/www/plot_sampling_pattern.png and /dev/null differ diff --git a/www/plot_spatialmaxentoutput.png b/www/plot_spatialmaxentoutput.png deleted file mode 100755 index db45c41..0000000 Binary files a/www/plot_spatialmaxentoutput.png and /dev/null differ diff --git a/www/plot_spatialvectorssimulations.png b/www/plot_spatialvectorssimulations.png deleted file mode 100755 index 1b2cbf3..0000000 Binary files a/www/plot_spatialvectorssimulations.png and /dev/null differ diff --git a/www/plot_stidf.png b/www/plot_stidf.png deleted file mode 100755 index 516a360..0000000 Binary files a/www/plot_stidf.png and /dev/null differ diff --git a/www/plots/species_omission.png b/www/plots/species_omission.png new file mode 100644 index 0000000..1308f64 Binary files /dev/null and b/www/plots/species_omission.png differ diff --git a/www/plots/species_roc.png b/www/plots/species_roc.png new file mode 100644 index 0000000..da892c1 Binary files /dev/null and b/www/plots/species_roc.png differ diff --git a/www/polygon_altitude_plot_1_.png b/www/polygon_altitude_plot_1_.png deleted file mode 100755 index 6b0cda7..0000000 Binary files a/www/polygon_altitude_plot_1_.png and /dev/null differ diff --git a/www/readGPX.html b/www/readGPX.html index 53154d4..de2e602 100644 --- a/www/readGPX.html +++ b/www/readGPX.html @@ -88,5 +88,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/readKML.GBIFdensity.html b/www/readKML.GBIFdensity.html index 00a2c1b..4408a2a 100644 --- a/www/readKML.GBIFdensity.html +++ b/www/readKML.GBIFdensity.html @@ -39,7 +39,7 @@

    Arguments

    Details

    This document contains data shared through the GBIF Network — see http://www.gbif.org/occurrence for more information. GBIF records are constantly updated and every map derived refers to a certain date indicated in the @zname Last update slot.
    -All usage of these data must be in accordance with the GBIF Data Use Agreement: https://www.gbif.org/terms.

    +All usage of these data must be in accordance with the GBIF Data Use Agreement: http://www.gbif.org/disclaimer/datause.

    Author(s)

    @@ -92,5 +92,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/reproject.html b/www/reproject.html index 8427d6e..b7fe198 100644 --- a/www/reproject.html +++ b/www/reproject.html @@ -134,5 +134,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/sp.palette.html b/www/sp.palette.html index e09f6c6..713bb23 100644 --- a/www/sp.palette.html +++ b/www/sp.palette.html @@ -44,5 +44,5 @@

    See Also

    spMetadata, metadata2SLD-methods

    -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/spMetadata.html b/www/spMetadata.html index 180d02c..afd0408 100644 --- a/www/spMetadata.html +++ b/www/spMetadata.html @@ -100,7 +100,7 @@

    Details

  • metadata[["idinfo"]][["native"]] — Session info e.g.: Produced using R version 2.12.2 (2011-02-25) running on Windows 7 x64.

    • -

  • metadata[["spdoinfo"]][["indspref"]] — Indirect spatial reference estimated using the Google Maps API Web Services. +

  • metadata[["spdoinfo"]][["indspref"]] — Indirect spatial reference estimated using the Google Maps API Web Services.

  • metadata[["idinfo"]][["spdom"]][["bounding"]] — Bounding box in the WGS84 geographical coordinates estimated by reprojecting the original bounding box. @@ -207,5 +207,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/spPhoto.html b/www/spPhoto.html index cfcf1b9..aa7e2a9 100644 --- a/www/spPhoto.html +++ b/www/spPhoto.html @@ -214,5 +214,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/vect2rast.SpatialPoints.html b/www/vect2rast.SpatialPoints.html index fa74334..91e5e7d 100644 --- a/www/vect2rast.SpatialPoints.html +++ b/www/vect2rast.SpatialPoints.html @@ -106,5 +106,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/vect2rast.html b/www/vect2rast.html index bd0bc68..01bef25 100644 --- a/www/vect2rast.html +++ b/www/vect2rast.html @@ -143,5 +143,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/whitening.html b/www/whitening.html index b9f01e1..3ece2a0 100644 --- a/www/whitening.html +++ b/www/whitening.html @@ -90,5 +90,5 @@

    Examples

    # error exceeds global.var -> totally white; -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]
    diff --git a/www/worldgrids_pal.html b/www/worldgrids_pal.html index fdedfbc..6d352d0 100644 --- a/www/worldgrids_pal.html +++ b/www/worldgrids_pal.html @@ -105,5 +105,5 @@

    Examples

    ## End(Not run) -
    [Package plotKML version 0.5-9 Index]
    +
    [Package plotKML version 0.5-8 Index]