Create PNG using writeGDAL without georeference (.aux.xml) - r

When creating a PNG file using writeGDAL, a georeferencing file is created (.aux.xml) along with the PNG file. Is there a way to prevent this from happening?
The following code creates the files as explained above.
library(raster)
library(rgdal)
r <- raster(xmn=742273.5, xmx=742702.5, ymn=6812515.5, ymx=6812995.5, ncols=144, nrows=161)
r <- setValues(r, 1:ncell(r))
rSpdf <- as(r, 'SpatialPixelsDataFrame')
rSpdf$colors <- as.numeric(cut(rSpdf$layer, breaks = 10))
writeGDAL(rSpdf[, 'colors'], 'test.png', drivername = 'PNG', type = 'Byte', mvFlag = 0, colorTables = list(colorRampPalette(c('black', 'white'))(11)))

By setting rgdal::setCPLConfigOption("GDAL_PAM_ENABLED", "FALSE") the .aux.xml file is not created.
Thank you Val for pointing me to the post.
library(raster)
library(rgdal)
rgdal::setCPLConfigOption("GDAL_PAM_ENABLED", "FALSE")
r <- raster(xmn=742273.5, xmx=742702.5, ymn=6812515.5, ymx=6812995.5, ncols=144, nrows=161)
r <- setValues(r, 1:ncell(r))
rSpdf <- as(r, 'SpatialPixelsDataFrame')
rSpdf$colors <- as.numeric(cut(rSpdf$layer, breaks = 10))
writeGDAL(rSpdf[, 'colors'], 'test.png', drivername = 'PNG', type = 'Byte', mvFlag = 0, colorTables = list(colorRampPalette(c('black', 'white'))(11)))

Related

Query WorldClim using R to obtain data set of Earth's terrestrial surface only?

WorldClim can be queried from R by:
library(geodata)
df <- worldclim_global(var="bio",res = 2.5, path ="")
df will necessarily include all of Earth's land and ocean surface. Is there an efficient way to separate the two? I'd like to sample from land alone - so removing areas covered by large lakes/rivers and glaciers will need to happen as well. It is imperative that the land's surface be the global extent.
I have determined a solution for isolating the spatial extent of planet Earth that is not under the ocean, lakes, or glaciers. The following script will generate that extent for you - though some modification may be required.
For this code to be useful, you will need to download spatial data from NaturalEarth: https://www.naturalearthdata.com/downloads/10m-physical-vectors/. At the website, search for these files and download them to your computer in your working directory for your project. The files: ne_10m_land.shp, dd_land.rda,ne_10m_glaciated_areas.shp, and dd_lake.rda.
What is generated by this code can be used to extract information in a raster falling within the spatial extent created and then that data saved in a different raster (or some other format). There are several good examples for how to do that here in stackoverflow.
###
# Keeping tidy
# rm(list=ls(all=T))
# gc()
# .rs.restartR()
# rm(list=ls(all=T))
# gc()
library(spatialEco)
library(sf)
library(ggOceanMaps)
library(rgeos)
library(scattermore)
library(maptools)
library(rgdal)
library(sp)
library(plyr)
library(dplyr)
library(raster)
library(rgdal)
library(geodata)
library(exactextractr)
# where data is stored
NEDPath <- outPath <- "" # I used data from Natural Earth:
#https://www.naturalearthdata.com/downloads/10m-physical-vectors/
#you'll need the following files from there for this code to work:
#ne_10m_land.shp, dd_land.rda,ne_10m_glaciated_areas.shp, and
#dd_lake.rda
#
# # call in the world's terrestrial surface
continental <- st_read(file.path(NEDPath,
"ne_10m_land/ne_10m_land.shp"))
islands <- st_read(file.path(NEDPath, "ne_10m_minor_islands/ne_10m_minor_islands.shp"))
world <- rbind(continental,islands)
dd_land <- clip_shapefile(world, c(-180, 180, -90, 90))
save(dd_land, file = paste(outPath, "ggOceanMapsData/dd_land.rda", sep = "/"), compress = "xz")
# call in glacier coverage
glaciers <- st_read(file.path(NEDPath, "ne_10m_glaciated_areas/ne_10m_glaciated_areas.shp"))
glaciers <- as_Spatial(glaciers)
glaciers <- gBuffer(glaciers, byid = TRUE, width = 0)
dd_glacier <- clip_shapefile(glaciers, c(-180, 180, -90, 90))
dd_glacier <- gBuffer(dd_glacier, byid = FALSE, width = 0.1)
dd_glacier <- gBuffer(dd_glacier, byid = FALSE, width = -0.1)
save(dd_glacier, file = paste(outPath, "ggOceanMapsData/dd_glacier.rda", sep = "/"), compress = "xz")
# call in lakes
lake <- st_read(file.path(NEDPath, "ne_10m_lakes/ne_10m_lakes.shp"))
lake <- as_Spatial(lake)
lake <- gBuffer(lake, byid = TRUE, width = 0)
dd_lake <- clip_shapefile(lake, c(-180, 180, -90, 90))
dd_lake <- gBuffer(dd_lake, byid = FALSE, width = 0.1)
dd_lake <- gBuffer(dd_lake, byid = FALSE, width = -0.1)
save(dd_lake, file = paste(outPath, "ggOceanMapsData/dd_lake.rda", sep = "/"), compress = "xz")
# isolating extent of world's surface not covered by ice or water
terrestrial <- gDifference(dd_land, dd_lake)
terrestrial_ice_free <- gDifference(terrestrial, dd_glacier)
save(terrestrial_ice_free, file = paste(outPath, "ggOceanMapsData/landsurface.rda", sep = "/"), compress = "xz")
# call the files if saved already, if saved, you can comment out the all the code above until where the working directory is defined - this will save you a lot of time...
load(file = paste(outPath, "ggOceanMapsData/dd_land.rda", sep = "/"))
load(file = paste(outPath, "ggOceanMapsData/dd_glacier.rda", sep = "/"))
load(file = paste(outPath, "ggOceanMapsData/dd_lake.rda", sep = "/"))
load(file = paste(outPath, "ggOceanMapsData/landsurface.rda", sep = "/"))
# for convenience
land<-terrestrial_ice_free

How to open binary files in r

Can anyone help me how to open little endian and big endian binary files in r. or any code in r to covert binary files in to geotiff.
library(ggplot2)
library(viridis)
library(viridisLite)
library(digest)
library(raster)
file("D:/dddd/binary/CMORPH+MWCOMB_DAILY-025DEG_20170301", "rb")
ls(zz)
ls()
column.names=readBin(zz, character(), n=10)
column.names
varnames = readBin(zz, character(), n=4)
varnames
datavals = readBin(zz, integer(), size = 4, n = 600, endian = "little")
readvals = datavals[1:200]
writevals = datavals[201:400]
mathvals = datavals[401:600]
rdata = cbind(readvals, writevals, mathvals)
colnames(rdata) = varnames

How to optimize this R script to use the minimum CPU and Memory possible

I built this R script that generate a map and a background tiles, the problem is, I need to run it on PowerBI service, which has a very constrained resources (Ram and CPU), I attached a reproducible example
This example works fine in PowerBI service, but when I tried it with my real data only the raster or the map works, but when I do both, I get you exceed the resource available, and as it is not documented, I don't know if the issue is CPU or RAM.
what's the best way to profile this code and check which section to change
please notice the dataset is a raster saved as ASCII, using saveRDS, it is done outside PowerBI and loaded as a csv file, as PowerBI does not read binary data
# Input load. Please do not change, the dataset is generated by PowerBI, I change it only to have a reproducible example #
`dataset` = read.csv('https://raw.githubusercontent.com/djouallah/loadRobjectPBI/master/powerbidf.csv', check.names = FALSE, encoding = "UTF-8", blank.lines.skip = FALSE);
# Original Script. Please update your script content here and once completed copy below section back to the original editing window #
library(sf)
library(dplyr)
library(tmap)
library(tidyr)
tempdf <- dataset %>%
filter(!is.na(Value))%>%
dplyr::select(Index,Value)%>%
arrange(Index)%>%
mutate(Value = strsplit(as.character(Value), "#")) %>%
unnest(Value)%>%
dplyr::select(Value)
write.table(tempdf, file="test3.rds",row.names = FALSE,quote = FALSE, col.names=FALSE)
rm(tempdf)
background <- readRDS('test3.rds', refhook = NULL)
dataset <- dataset[c("x","y","color","status","labels")]
dataset$color <- as.character(dataset$color)
dataset$labels <- as.character(dataset$labels)
map <- st_as_sf(dataset,coords = c("x", "y"), crs = 4326)
chartlegend <- dataset %>%
dplyr::select(status,color)%>%
distinct(status, color)%>%
arrange(status)
rm(dataset)
tm_shape(background)+
tm_rgb() +
rm(background)+
tm_shape(map) +
tm_symbols(col = "color", size = 0.04,shape=19)+
tm_shape(filter(map, !is.na(labels))) +
tm_text(text="labels",col="white")+
rm(map)+
tm_add_legend(type='fill',labels=chartlegend$status, col=chartlegend$color)+
tm_layout(frame = FALSE,bg.color = "transparent",legend.width=2)+
tm_legend(position=c("left", "top"),text.size = 1.3)+
rm(chartlegend)
changing the code to use base R only did help a bit
# Input load. Please do not change #
`dataset` = read.csv('https://raw.githubusercontent.com/djouallah/loadRobjectPBI/master/powerbidf.csv', check.names = FALSE, encoding = "UTF-8", blank.lines.skip = FALSE);
# Original Script. Please update your script content here and once completed copy below section back to the original editing window #
library(sf)
library(tmap)
tempdf <- dataset[dataset$Value!="",]
tempdf <- tempdf[c("Index","Value")]
tempdf <- tempdf[order(tempdf$Index),]
tempdf <- stack(setNames(strsplit(as.character(tempdf$Value),'#'), tempdf$Index))
tempdf <- tempdf["values"]
write.table(tempdf, file="test3.rds",row.names = FALSE,quote = FALSE, col.names=FALSE)
rm(tempdf)
background <- readRDS('test3.rds', refhook = NULL)
dataset <- dataset[c("x","y","color","status","labels")]
dataset$color <- as.character(dataset$color)
map <- st_as_sf(dataset,coords = c("x", "y"), crs = 4326)
chartlegend <- unique(dataset[c("status","color")])
rm(dataset)
tm_shape(background)+
tm_rgb() +
rm(background)+
tm_shape(map) +
tm_symbols(col = "color", size = 0.04,shape=19)+
tm_text(text="labels",col="white")+
rm(map)+
tm_add_legend(type='fill',labels=chartlegend$status, col=chartlegend$color)+
tm_layout(frame = FALSE,outer.margins = c(0.005, 0.6, 0.06, 0.005),bg.color = "transparent",legend.width=2)+
tm_legend(position=c("right", "top"),text.size = 1.3)+
rm(chartlegend)

How to remove padding added to a PNG image created with writeGDAL

I am using writeGDAL to export raster data in PNG format to use as an image overlay on Google Maps. The image therefore needs to have the correct aspect ratio and must fit the raster extent exactly.
When I export the UTM-projected raster the result is as expected but after I project to the LatLong system the generated PNG has padding right round the raster area.
What do I need to do to get rid of this padding?
Below is sample code which creates 2 images that demonstrate the problem.
library(raster)
library(rgdal)
r <- raster(xmn=742273.5, xmx=742702.5, ymn=6812515.5, ymx=6812995.5, ncols=144, nrows=161)
r <- setValues(r, 1:ncell(r))
projection(r) <- CRS('+proj=utm +zone=35 +south +datum=WGS84 +units=m +no_defs')
pr <- projectRaster(r, crs='+proj=longlat +datum=WGS84 +no_defs')
#Coerce to SpatialPixelsDataFrame and prepare for writeGDAL
rSpdf <- as(r, 'SpatialPixelsDataFrame')
prSpdf <- as(pr, 'SpatialPixelsDataFrame')
rSpdf$colors <- as.numeric(cut(rSpdf$layer, breaks = 255))
prSpdf$colors <- as.numeric(cut(prSpdf$layer, breaks = 255))
colorTable <- list(colorRampPalette(c('red', 'yellow', 'green4'))(256))
#Export in PNG format using writeGDAL
writeGDAL(rSpdf[, 'colors'], 'utm.png', drivername = 'PNG', type = 'Byte', mvFlag = 0, colorTables = colorTable)
writeGDAL(prSpdf[, 'colors'], 'geo.png', drivername = 'PNG', type = 'Byte', mvFlag = 0, colorTables = colorTable)
#Optionally, the rasters can be exported to view in a spatial package (eg SAGA-GIS)
#writeRaster(r, filename='utm.tif', format="GTiff", overwrite=TRUE)
#writeRaster(pr, filename='geo.tif', format="GTiff", overwrite=TRUE)
By converting the projected raster to points and then coercing the points to a SpatialPixelsDataFrame (instead of coercing the raster) the padding is removed.
library(raster)
library(rgdal)
r <- raster(xmn=742273.5, xmx=742702.5, ymn=6812515.5, ymx=6812995.5, ncols=144, nrows=161)
r <- setValues(r, 1:ncell(r))
projection(r) <- CRS('+proj=utm +zone=35 +south +datum=WGS84 +units=m +no_defs')
pr <- projectRaster(r, crs='+proj=longlat +datum=WGS84 +no_defs')
points <- rasterToPoints(pr, spatial = TRUE)
prSpdf <- as(points, 'SpatialPixelsDataFrame')
prSpdf$colors <- as.numeric(cut(prSpdf$layer, breaks = 10))
colorTable <- list(colorRampPalette(c('red', 'yellow', 'green4'))(11))
writeGDAL(prSpdf[, 'colors'], 'geo.png', drivername = 'PNG', type = 'Byte', mvFlag = 0, colorTables = colorTable)

R plotly crashing on linux machines with no X11

I'm ploting together a plotly heatmap along with ggplot2 dendrograms I processed a bit (incompatible with heatmaply), on a linux machine without X11 and running into an error:
Here's the code:
library(ggplot2)
library(plotly)
library(dendextend)
#dendogram data
set.seed(1)
my.mat <- matrix(rnorm(10*100),nrow=100,ncol=10,dimnames = list(paste("g",1:100,sep=""),paste("s",1:10,sep="")))
my.hover.mat <- matrix(paste(paste(rownames(my.mat),paste("description",1:100,sep=" "),sep=":"),colnames(my.mat),signif(my.mat,3),sep="'</br>'"),nrow=100,ncol=10)
x <- as.matrix(scale(my.mat))
dd.col <- as.dendrogram(hclust(dist(x)))
dd.row <- as.dendrogram(hclust(dist(t(x))))
#cut dd.col
dd.col <- cut(dd.col,h=6)$upper
ggdend.col <- as.ggdend(dd.col)
leaf.heights <- dplyr::filter(ggdend.col$nodes,!is.na(leaf))$height
leaf.seqments.idx <- which(ggdend.col$segments$yend %in% leaf.heights)
ggdend.col$segments$yend[leaf.seqments.idx] <- max(ggdend.col$segments$yend[leaf.seqments.idx])
ggdend.col$segments$col[leaf.seqments.idx] <- "black"
ggdend.col$labels$label <- 1:nrow(ggdend.col$labels)
ggdend.col$labels$y <- max(ggdend.col$segments$yend[leaf.seqments.idx])
ggdend.col$labels$x <- ggdend.col$segments$x[leaf.seqments.idx]
ggdend.col$labels$col <- "black"
ggdend.col$segments$lwd <- 0.5
ggdend.row <- dendro_data(dd.row)
ggdend.row$labels$label <- ""
ggdend.row$labels$col <- "black"
ggdend.row$segments$lwd <- 0.5
#ggplot dendrograms
py <- ggplot()+geom_segment(data=ggdend.col$segments,aes(x=x,y=y,xend=xend,yend=yend))+coord_flip()+annotate("text",size=4,hjust=1,x=ggdend.col$label$x,y=ggdend.col$label$y,label=ggdend.col$label$label,colour=ggdend.col$label$col)+labs(x="",y="")+
theme_minimal()+theme(axis.text=element_blank(),axis.ticks=element_blank(),panel.grid=element_blank())
px <- ggplot()+geom_segment(data=ggdend.row$segments,aes(x=x,y=y,xend=xend,yend=yend))+annotate("text",size=4,hjust=1,x=ggdend.row$label$x,y=ggdend.row$label$y,label=ggdend.row$label$label,colour=ggdend.row$label$col)+labs(x="",y="")+
labs(x="",y="")+theme_minimal()+theme(axis.text=element_blank(),axis.ticks=element_blank(),panel.grid=element_blank())
# heatmap
col.ord <- order.dendrogram(dd.col)
row.ord <- order.dendrogram(dd.row)
my.mat <- my.mat[col.ord,row.ord]
my.hover.mat <- my.hover.mat[col.ord,row.ord]
heatmap.plotly <- plot_ly() %>% add_heatmap(z=~my.mat,x=factor(colnames(my.mat),lev=colnames(my.mat)),y=factor(rownames(my.mat),lev=rownames(my.mat)),hoverinfo='text',text=my.hover.mat)
# plotting it all together
eaxis <- list(showticklabels = FALSE,showgrid = FALSE,zeroline = FALSE)
p_empty <- plot_ly(filename="r-docs/dendrogram") %>% layout(margin = list(l = 200),xaxis = eaxis,yaxis = eaxis)
all.together <- plotly::subplot(px, p_empty, heatmap.plotly, py, nrows = 2, margin = 0.01)
which gives:
On a linux machine with no X11, however, the conversion of a ggplot2 object to a plotly object, that takes place in the plotly::subplot command, crashes with this error message:
Error in .External2(C_X11, paste("png::", filename, sep = ""), g$width, :
unable to start device PNG
[1]: https://i.stack.imgur.com/UhKg7.png
The same error is obtained if I try to convert the dendrogram ggplot objects: px and py, to plotly objects:
> plotly_build(py)
Error in .External2(C_X11, paste("png::", filename, sep = ""), g$width, :
unable to start device PNG
So that is not a solution to my problem.
So my questions are:
Is there a workaround to the X11 problem? I won't be able to install X11 on my machine so that one is not a possible solution.
Perhaps there's a way to generate a plotly dendrogram, either directly or from a dendrogram or ggdend objects - i.e. without having to convert a ggplot2 to a plotly object.

Resources