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)
Related
How can I remove the crossing line while using the buffer code below. I tried to create buffers round some point locations and to have a union but ended up getting a crossline.
please see the codes below
train_data
library(raster)
library(dismo)
library(sf)
bioc1 <- getData('worldclim', var='bio', res=5) #
bio1 <- bioc1[[1]]
plot(bio1)
train <- read.csv("forexample_training.csv") # the points locations to be buffered
head(train)
train.sf <- sf::st_as_sf(train, coords=c("longitude", "latitude"), crs=raster::crs(bio1))
plot(train.sf, add=TRUE)
eckertIV <- "+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"
train.sf <- sf::st_transform(train.sf, crs = eckertIV)
train.buf <- sf::st_buffer(train.sf, dist = 500000) %>%
sf::st_union() %>%
sf::st_sf() %>%
sf::st_transform(crs = raster::crs(bio1))
plot(bio1, main = names(bio1))
train.sf <- sf::st_as_sf(train, coords=c("longitude", "latitude"), crs=raster::crs(bio1))
plot(train.sf, add=TRUE)
# To add sf objects to a plot, use add = TRUE
plot(train.buf, border = "red", lwd = 3, add = TRUE)
Is it possible to display a projected raster on a projected basemap in R/leaflet? The addRasterImage() functions says that the projection needs to be in EPSG:3857. Can this not be changed by setting project = false? I am able to display projected vector data on a projected basemap, but not raster ...
My attempt:
library(leaflet)
library(raster)
library(sf)
# Find location in northern Canada
ca_df <- data.frame(long = -114.3717401, lat = 62.4525548, name="Yellowknife", stringsAsFactors = F )
ca_pt <- st_as_sf(ca_df,coords = c("long", "lat"), crs = 4326)
# Project to Alaska Polar Stereographic
ca_pt_5936 <- as_Spatial(st_transform(ca_pt, 5936))#coords
# Create raster around point
r_5936 <- raster(
matrix(round(runif(100)), ncol = 10),
xmn = ca_pt_5936[[1]] - 50000, xmx = ca_pt_5936[[1]] + 50000,
ymn = ca_pt_5936[[2]] - 50000, ymx = ca_pt_5936[[2]] + 50000,
crs = "EPSG:5936"
)
# Project raster to Web Mercator (needed to get the extent in lat/long)
r_3857 <- projectRaster(r_5936, crs="EPSG:3857", method = "ngb")
# Prep for leaflet: https://github.com/rstudio/leaflet/issues/550
tile_url <- 'https://services.arcgisonline.com/arcgis/rest/services/Polar/Arctic_Ocean_Base/MapServer/tile/{z}/{y}/{x}.png'
origin <- c(-2.8567784109255e+07, 3.2567784109255e+07)
resolutions <- c(
238810.813354,119405.406677, 59702.7033384999, 29851.3516692501,14925.675834625,
7462.83791731252,3731.41895865639, 1865.70947932806,932.854739664032,
466.427369832148, 233.213684916074, 116.60684245803701, 58.30342122888621,
29.151710614575396, 14.5758553072877, 7.28792765351156, 3.64396382688807,
1.82198191331174, 0.910990956788164, 0.45549547826179, 0.227747739130895,
0.113873869697739, 0.05693693484887, 0.028468467424435)
epsg5936 <- leafletCRS(
crsClass = 'L.Proj.CRS',
code = 'EPSG:5936',
proj4def = '+proj=stere +lat_0=90 +lat_ts=90 +lon_0=-150 +k=0.994 +x_0=2000000 +y_0=2000000 +datum=WGS84 +units=m +no_defs',
origin = origin,
resolutions = resolutions
)
# Map
leaflet(r_3857,
options= leafletOptions(
crs=epsg5936)) %>%
addTiles(urlTemplate = tile_url,
attribution = "Esri, DeLorme, GEBCO, NOAA NGDC, and other contributors",
options = tileOptions(minZoom = 0, maxZoom = 4)) %>%
addRasterImage(r_5936, project = F)
The output doesn't display the raster.
So I have the following script trying to prepare the data to do modelling on them later on using "biomod2" package. It tries to overlay species (xlm) presence points on environmental layers (bio1, bio7).
library(biomod2)
library(raster)
data <- structure(list(longitude = c(-122.84,-119.418,-78.6569,-78.1834, -89.3985), latitude = c(45.28,36.7783,37.4316,-1.8312, 32.3547)), .Names = c("X_WGS84",
"Y_WGS84"), class = "data.frame", row.names = c(NA, -5L))
data$xlm<-1
spdf <- SpatialPointsDataFrame(coords = xy, data = data,
proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
myRespName <- 'xlm'
myResp <- as.numeric(data[,myRespName])
myRespXY <- data[,c('X_WGS84','Y_WGS84')]
myExpl = stack( system.file( "external/bioclim/current/bio3.grd", package="biomod2"),
system.file( "external/bioclim/current/bio4.grd", package="biomod2"))
myBiomodData <- BIOMOD_FormatingData(resp.var = myResp,expl.var = myExpl,resp.xy = myRespXY,resp.name = myRespName)
plot(myBiomodData)
It works in this case, however, the issue is when I want to replace "bio4.grd" and "bio3.grd" layers in the package with my own data, it doesn't work. I have tried it as follow. First i thought it might be "asci" file format but even by converting them to "grd" still I don't get the points overlayed on layers stacked. It does overlay only one point in Southern USA (around Louisiana, Mississippi) though.
library(biomod2)
library(raster)
data <- structure(list(longitude = c(-122.84,-119.418,-78.6569,-78.1834, -89.3985), latitude = c(45.28,36.7783,37.4316,-1.8312, 32.3547)), .Names = c("X_WGS84",
"Y_WGS84"), class = "data.frame", row.names = c(NA, -5L))
data$xylella<-1
spdf <- SpatialPointsDataFrame(coords = xy, data = data,
proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
myRespName <- 'xylella'
myResp <- as.numeric(data[,myRespName])
myRespXY <- data[,c('X_WGS84','Y_WGS84')]
bio2<-raster("C:\\Data\\BioClim_V2_MaxEnt\\wc2.0_bio_10m_02.asc")
crs(bio2) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeRaster(bio2, "C:\\Data\\BioClim_V2_MaxEnt\\bio2", overwrite=TRUE)
bio7<-raster("C:\\Data\\BioClim_V2_MaxEnt\\wc2.0_bio_10m_07.asc")
crs(bio7) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeRaster(bio7, "C:\\Data\\BioClim_V2_MaxEnt\\bio7", overwrite=TRUE)
myExpl = stack (bio2,bio7)
myBiomodData <- BIOMOD_FormatingData(resp.var = myResp,expl.var = myExpl,resp.xy = myRespXY,resp.name = myRespName)
plot(myBiomodData)
Any help highly appreciated. Many thanks.
I would like to reproduce the last example from the marmap vignette: 'marmap-DataAnalysis' for a pacific region. The example shows the orthographic projection of the world centered at lon = 50. Here is the example:
library(marmap)
library(raster)
# Get data for the whole world. Careful: ca. 21 Mo!
world <- getNOAA.bathy(-180, 180, -90, 90, res = 15, keep = TRUE)
# Switch to raster
world.ras <- marmap::as.raster(world)
# Set the projection and project
my.proj <- "+proj=ortho +lat_0=0 +lon_0=50 +x_0=0 +y_0=0"
world.ras.proj <- projectRaster(world.ras,crs = my.proj)
# Switch back to a bathy object
world.proj <- as.bathy(world.ras.proj)
# Set colors for oceans and land masses
blues <- c("lightsteelblue4", "lightsteelblue3",
"lightsteelblue2", "lightsteelblue1")
greys <- c(grey(0.6), grey(0.93), grey(0.99))
# And plot!
plot(world.proj, image = TRUE, land = TRUE, lwd = 0.05,
bpal = list(c(0, max(world.proj, na.rm = T), greys),
c(min(world.proj, na.rm = T), 0, blues)),
axes = FALSE, xlab = "", ylab = "")
plot(world.proj, n = 1, lwd = 0.4, add = TRUE)
However, I would like to change the central to a pacific meridian, e.g. lon = 155.5. I tried this by changing the projection parameters to,
my.proj <- "+proj=ortho +lat_0=20 +lon_0=155.5 +x_0=0 +y_0=0"
but then,
world.ras.proj <- projectRaster(world.ras,crs = my.proj)
results in:
Error in if (nr != x#nrows | nc != x#ncols) { :
missing value where TRUE/FALSE needed
In addition: Warning messages:
1: In rgdal::rawTransform(projfrom, projto, nrow(xy), xy[, 1], xy[, :
259 projected point(s) not finite
2: In rgdal::rawTransform(projection(raster), crs, nrow(xy), xy[, 1], :
4 projected point(s) not finite
How can could I plot the 'bathymetric world' in a pacific region?
I have simplified your question (always good, and for me the data download did not work). In essence:
library(raster); library(rgdal)
prj1 <- "+proj=ortho +lat_0=0 +lon_0=0 +x_0=0 +y_0=0"
prj2 <- "+proj=ortho +lat_0=20 +lon_0=155.5 +x_0=0 +y_0=0"
r <- raster()
r <- init(r, 'col')
# works
x1 <- projectRaster(r, crs = prj1)
# fails
x2 <- projectRaster(r, crs = prj2)
This is a bug. I have fixed it in raster version 2.6-2 (under development, should be available next week or so)
This can be solved in marmap with the current/previous version of the raster package. You have to use the antimeridian=TRUE argument of the getNOAA.bathy() function and some trickery to allow the computations of the projection by the raster package.
The first trick is to download data with lon1 = lon2 = 0 since the antimeridian downloads 2 distinct datasets: from the antimeridian to lon1 and from lon2 to the antimeridian. Setting lon1 and lon2 equal to 0 downloads the whole world.
Then, you have to manually switch back to values of longitudes between -180 and 180 (and not 0 to 360 as produced by the animeridian argument of getNOAA.bathy()), hence the rownames(world2) <- ... line.
Finally, you have to apply the same -180 correction to specify the projection.
Here is the code:
library(marmap)
library(raster)
# Get data for the whole world. Careful: ca. 21 Mo!
world2 <- getNOAA.bathy(0, 0, -90, 90, res = 15, keep = TRUE, antimeridian=TRUE)
rownames(world2) <- as.numeric(rownames(world2))-180
# Switch to raster
world.ras <- marmap::as.raster(world2)
# Set the projection and project
my.proj <- "+proj=ortho +lat_0=20 +lon_0=155-180 +x_0=0 +y_0=0"
world.ras.proj <- projectRaster(world.ras,crs = my.proj)
# Switch back to a bathy object
world.proj <- as.bathy(world.ras.proj)
# Set colors for oceans and land masses
blues <- c("lightsteelblue4", "lightsteelblue3",
"lightsteelblue2", "lightsteelblue1")
greys <- c(grey(0.6), grey(0.93), grey(0.99))
# And plot!
plot(world.proj, image = TRUE, land = TRUE, lwd = 0.05,
bpal = list(c(0, max(world.proj, na.rm = T), greys),
c(min(world.proj, na.rm = T), 0, blues)),
axes = FALSE, xlab = "", ylab = "")
plot(world.proj, n = 1, lwd = 0.4, add = TRUE)
And here is the result:
The new version of raster (2.6-7) solves the problem of projecting across the date-line. However, due to rounding errors when downloading bathymetric data from NOAA servers, some missing cells may appear in plots. Here is an example with the code you posted in your original question:
And here is the summary() of the data:
summary(world)
# Bathymetric data of class 'bathy', with 1440 rows and 720 columns
# Latitudinal range: -89.88 to 89.88 (89.88 S to 89.88 N)
# Longitudinal range: -179.88 to 179.88 (179.88 W to 179.88 E)
# Cell size: 15 minute(s)
# Depth statistics:
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# -10635 -4286 -2455 -1892 214 6798
#
# First 5 columns and rows of the bathymetric matrix:
# -89.875 -89.625 -89.375 -89.125 -88.875
# -179.875 2746 2836 2893 2959 3016
# -179.625 2746 2835 2892 2958 3015
# -179.375 2746 2835 2891 2957 3014
# -179.125 2746 2834 2890 2956 3013
# -178.875 2746 2834 2889 2955 3012
Hence, the solution using antimeridian=TRUE detailed above should be best.
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)))