55# Note : Implemented for parallel processing. SuperOverlay file (https://developers.google.com/kml/documentation/kml_21tutorial?csw=1#superoverlays);
66
77
8- 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 ){
8+ 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 ){
99
1010 if (! class(obj )== " GDALobj"
1111 stop(" Object of class \" GDALobj\" required."
@@ -20,6 +20,9 @@ plotKML.GDALobj <- function(obj, file.name, block.x, tiles=NULL, tiles.sel=NULL,
2020 if (! is.null(breaks.lst )& length(breaks.lst )< 15 ){
2121 stop(" 'breaks.lst' must contain at least 15 elements"
2222 }
23+ if (is.na(CRS )){
24+ stop(" 'projection' missing or 'NA'"
25+ }
2326
2427 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"
2528 GDALobj.file <- attr(obj , " file"
@@ -38,14 +41,14 @@ plotKML.GDALobj <- function(obj, file.name, block.x, tiles=NULL, tiles.sel=NULL,
3841 if (requireNamespace(" parallel" quietly = TRUE )& requireNamespace(" snowfall" quietly = TRUE )){
3942 if (missing(cpus )){ cpus <- parallel :: detectCores(all.tests = FALSE , logical = FALSE ) }
4043 snowfall :: sfInit(parallel = TRUE , cpus = cpus )
41- snowfall :: sfExport(" GDALobj.file" " tiles" " tiles.sel" " breaks.lst" " altitude" " altitudeMode" " colour_scale" " z.lim" " overwrite"
44+ snowfall :: sfExport(" GDALobj.file" " tiles" " tiles.sel" " breaks.lst" " altitude" " altitudeMode" " colour_scale" " z.lim" " overwrite" , " CRS "
4245 snowfall :: sfLibrary(package = " rgdal" character.only = TRUE )
4346 snowfall :: sfLibrary(package = " sp" character.only = TRUE )
4447 snowfall :: sfLibrary(package = " plotKML" character.only = TRUE )
4548 snowfall :: sfLibrary(package = " XML" character.only = TRUE )
4649 snowfall :: sfLibrary(package = " RSAGA" character.only = TRUE )
4750 snowfall :: sfLibrary(package = " raster" character.only = TRUE )
48- 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 )
51+ 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 )
4952 snowfall :: sfStop()
5053 lst <- do.call(rbind , lst )
5154 } else {
@@ -87,15 +90,17 @@ plotKML.GDALobj <- function(obj, file.name, block.x, tiles=NULL, tiles.sel=NULL,
8790 </NetworkLink>' , unlist(lst [[" kml.tile" lst [[" north" lst [[" south" lst [[" east" lst [[" west" home.url , unlist(lst [[" kml.tile" sep = " /"
8891 parseXMLAndAdd(network_txt , parent = kml.out [[" Document"
8992 assign(' kml.out' kml.out , envir = plotKML.fileIO )
90- # # add logo and a legend:
91- kml.legend <- paste0(strsplit(file.name , " .kml" 1 ]][1 ], " _legend.png"
92- if (is.null(breaks.lst )){
93- kml_legend.bar(x = signif(seq(z.lim [1 ], z.lim [2 ], length.out = 25 ), 3 ), legend.file = kml.legend , legend.pal = colour_scale )
94- } else {
95- breaks.s <- seq(1 , length(breaks.lst ), length.out = 15 )
96- kml_legend.bar(x = as.factor(signif(breaks.lst [breaks.s ], 2 )), legend.file = kml.legend , legend.pal = colour_scale [breaks.s ])
93+ # # add legend and/or logo:
94+ if (plot.legend == TRUE ){
95+ kml.legend <- paste0(strsplit(file.name , " .kml" 1 ]][1 ], " _legend.png"
96+ if (is.null(breaks.lst )){
97+ kml_legend.bar(x = signif(seq(z.lim [1 ], z.lim [2 ], length.out = 25 ), 3 ), legend.file = kml.legend , legend.pal = colour_scale )
98+ } else {
99+ breaks.s <- seq(1 , length(breaks.lst ), length.out = 15 )
100+ kml_legend.bar(x = as.factor(signif(breaks.lst [breaks.s ], 2 )), legend.file = kml.legend , legend.pal = colour_scale [breaks.s ])
101+ }
102+ kml_screen(image.file = kml.legend , position = " UL" sname = " legend"
97103 }
98- kml_screen(image.file = kml.legend , position = " UL" sname = " legend"
99104 if (! missing(kml.logo )){ kml_screen(image.file = kml.logo , position = " UR" sname = " logo"
100105 kml_close(file.name )
101106 if (open.kml == TRUE ){
@@ -106,11 +111,12 @@ plotKML.GDALobj <- function(obj, file.name, block.x, tiles=NULL, tiles.sel=NULL,
106111}
107112
108113# # auxiliary function:
109- .kml_SpatialGrid_tile <- function (i , GDALobj.file , colour , tiles , breaks.lst , colour_scale , altitude , altitudeMode , z.lim , N.min = 4 , overwrite ){
114+ .kml_SpatialGrid_tile <- function (i , GDALobj.file , colour , tiles , breaks.lst , colour_scale , altitude , altitudeMode , z.lim , N.min = 4 , overwrite , CRS ){
110115 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"
111116 kml.tile <- set.file.extension(paste0(strsplit(basename(GDALobj.file ), " \\ ." 1 ]][1 ], " _T" i ), " .kml"
112117 raster_name = set.file.extension(paste0(strsplit(basename(GDALobj.file ), " \\ ." 1 ]][1 ], " _T" i ), " .png"
113118 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 )
119+ proj4string(r ) = CRS
114120 if (sum(! is.na(r @ data [,1 ]))> N.min ){
115121 prj.check <- check_projection(r , control = TRUE )
116122 if (! prj.check ) { suppressMessages( r <- reproject(r ) ) }
0 commit comments