projectRaster results in different output when projecting with its own crs - r

For a function I want to reproject a raster input - itself the output after using crop and mask - using a user set CRS. I thought that projecting with the existing crs would do nothing and simply return the input raster. To my surprise this was not the case. Below a reproducible example
Create dummy raster:
library(raster)
# Download country polygin, in this case Malawi
mwi <- raster::getData("GADM", country = "MWI", level = 0)
# Create dummy raster
grid <- raster::raster() # 1 degree raster
grid <- raster::disaggregate(grid, fact = 12) # 5 arcmin
grid <- raster::crop(grid, mwi)
values(grid) <- rep(1, ncell(grid)) # Set a value
# The input raster with dimensions 94,39,3666
grid <- raster::mask(grid, mwi)
plot(grid)
grid
# Reproject the raster using its own crs. I use ngb as it is a categorical variable.
# This raster has dimensions 102, 47, 4794 so it seems a lot of white space (NA) is added.
own_crs <- crs(grid)
grid_reproj <- raster::projectRaster(grid, crs = own_crs, method = "ngb")
plot(grid_reproj)
grid_reproj
# To remove the white space I use trim
# This results in a waster with dimensions 93, 39, 3627
grid_trim <- raster::trim(grid_reproj)
plot(grid_trim)
grid_trim
# I also decided to compare the maps visually with mapview
library(mapview)
# There seems to be a trim function in mapview which I set to FALSE
# Also use the browser for easy viewing
options(viewer = NULL)
mapviewOptions(trim = FALSE)
mapviewGetOption("trim")
mapview(grid, col.regions = "green", legend = F) +
mapview(grid_reproj, col.regions = "red", legend = F) +
mapview(grid_trim, col.regions = "blue", legend = F)
Comparing the maps I observe two things:
(1) grid and grid_trim are nearly identical apart from a single grid cell
on top. Perhaps this is due to rounding,
(2) grid_reproj has a much larger dimensions and different extent. It also
seems as if the map is slightly shifted in comparison to the other maps. This
is corrected by trim, so I assume that these are in fact NA cells and the difference might be
related how mapview displays the maps.
Hence, my main question is, what is happening when rasterProject projects with
the same extent? And why does the result differ, even after trim?

To project raster data the right way you must supply another Raster* object, and not a only crs.
If you supply a crs, a new extent is computed, a bit larger than what is expected to be needed to avoid loosing data. Of course in this odd case where the crs is actually the same it would make sense to return the input unchanged.

Related

ggmap - merging two satellite ggmaps into 1 ggmap

I am trying to map data onto higher resolution Google satellite imagery. I could use a lower resolution image (e.g. zoom 13 and limit the scales - as suggested here - ggmap extended zoom or boundaries) however, the resultant image is not clear enough for my purpose. So basically I would like to be able to combine 2 14 zoom into 1 ggmap:
library(ggmap)
library(gridExtra)
g1 <- get_googlemap(center = c(-83.986927, 33.955656), maptype="satellite", zoom=14)
g2 <- get_googlemap(center = c(-83.938079, 33.955656), maptype="satellite", zoom=14)
gmap1 <- ggmap(g1)
gmap2 <- ggmap(g2)
grid.arrange(gmap1, gmap2, ncol =2)
but have 1 ggmap object that combined gmap1 and gmap2.
You can (and probably should) convert to raster objects. You should really use them independently from then on, like tiles, since their pixels don't seem to be on the same grid basis so mosaicing them might not be perfect. You can bodge this by adjusting the tolerance.
The objects from get_googlemap are matrices with colour values in hex ("#FF000" etc) and some attributes defining the extent. The following code converts that object to a three-band RGB raster, with the right extent and CRS:
library(raster)
ggmap2raster <- function(g){
rgb = col2rgb(g)
bands = apply(rgb, 1, function(band){
raster(t(matrix(band,ncol=ncol(g), nrow=nrow(g))))
})
s = stack(bands)
bb = attr(g, "bb")
extent(s) = extent(bb$ll.lon,bb$ur.lon, bb$ll.lat, bb$ur.lat)
crs(s) <- "+init=epsg:4326"
s
}
To merge a bunch of them, this code uses mosaic, but because the layers don't seem to line up quite right (possibly because the data are really in web mercator rather than WGS84) you need to up the tolerance and hope:
mergegg <- function(glist){
m = function(...){
mosaic(...,tolerance=0.5, fun=min)
}
do.call(m,
lapply(glist, function(g){
ggmap2raster(g)
})
)
}
> r = mergegg(list(g1, g2))
> plotRGB(r)
I suspect the tolerance problem may disappear if I convert the corner coords back to Web Mercator. But that's too much bother for a Friday morning. ggmap and its handling of coordinate systems is not something I want to get into right now. You could try binding the two g1 and g2 matrix objects together but you probably would have to do the reverse transform first and to be honest given the restrictions on using Google satellite images (you have read the license conditions?) I suspect its a bad thing.
To visualise raster objects, use the tmap package instead of ggmap.

Overlaying world map on a image plot in R

I am trying to plot a global map using latitude, longitude and grid data in R. For this I am using image and image.plot functions. Additionally I need to overlay global coastline for land area. However I am not sure how to place the map exactly over my image of gridded data. Map is appearing bit shifted to the left in the console and that part is not visible either. See sample code below with random grid data.
remove(list=ls())
library(fields)
library(maps)
grid_lon<-c(0.5:1:359.5)
grid_lat<-c(-89.5:89.5)
temp1<-matrix(data = rexp(200, rate = 10), nrow = 360, ncol = 180)#random matrix
zlim=c(0,0.25)
par(oma=c( 3,0,0,0))# c(bottom, left, top, right)#plot margins
image(grid_lon,grid_lat,temp1,axes=FALSE,xlab='',ylab='')
map("world", fill=TRUE, col="white", bg="white", ylim=c(-90, 90),add=TRUE)
title(main ='Main title')
image.plot(zlim=zlim,legend.only=TRUE,horizontal=TRUE,legend.mar=0.4,legend.shrink=0.4,legend.width=0.4,nlevel=64,axis.args = list(cex.axis =1,at=zlim, labels=zlim,mgp=c(1, 0, 0),tck=0),smallplot=c(.25,.72, 0,.030),
legend.args=list( text=expression(textstyle(atop('anomaly',
paste('(meters)')),cex.main=1.2)),cex=1.2, side=1, line=1.6)
)#end image.plot
box()
In general, when working with maps it is preferable to use spatial objects, for which a projection method can be defined. The coherence with the map is then better guaranteed. Since you are working with a filled grid, an obvious choice is to use a raster from package raster. Your code would then become:
require (raster)
require (maps)
temp1<-matrix(data = rexp(180*360, rate = 10), nrow = 360, ncol = 180) #random matrix
r<-raster(temp1,xmn=-179.5,xmx=179.5,ymn=-89.5,ymx=89.5,crs="+proj=longlat +datum=WGS84")
plot(r)
map("world",add=T,fill=TRUE, col="white", bg="white")
EDIT
This code does not take into account that the data comes as a 360*180 matrix, while it is desirable to plot (map) a 180*360 matrix. Transposing is risky because it may result in an upside-down image. In order to be sure that the right coordinates are associated with the right values, we can explicitly associate them, and afterwards transform into a spatial object. The for-loop doing this is in the code below is slow, maybe it can be made more efficient, but it does the job.
require (raster)
require (maps)
# basic data, as in code given
grid_lon<-seq(0.5,359.5,1)
grid_lat<-seq(-89.5,89.5,1)
temp1<-matrix(data = rexp(200, rate = 10), nrow = 360, ncol = 180)#random matrix
# transform into data frame, where coords are associated to values
tt<-data.frame(lon=rep(NA,64800),lat=rep(NA,64800),z=rep(NA,64800))
ct<-0
for (i in 1:360){
for (j in 1:180){
ct<-ct+1
tt$lon[ct]<-grid_lon[i]
tt$lat[ct]<-grid_lat[j]
tt$z[ct]<-temp1[i,j]
}
}
# transform to spatial structure
coordinates(tt)<- ~lon+lat
# make spatial structure gridded
gridded(tt)<-TRUE
# transform to raster
r<-raster(tt)
projection(r)<-crs("+proj=longlat +datum=WGS84")
# plot
plot(r)
map("world2",add=T,fill=TRUE, col="white", bg="white")
I found the answer after few attempts and a tip from colleague. What needs to be done is shift the longitude grid from 0:359 to -179.5:179.5 using following commands after grid_lon is declared:
indexes_to_shift<-180
grid_lon[grid_lon>=180]<-grid_lon[grid_lon>=180]-360
grid_lon<-c(tail(grid_lon, indexes_to_shift), head(grid_lon, indexes_to_shift))

error in mask a raster by a spatialpolygon

I have raster of the following features:
library(raster)
library(rgeos)
test <- raster(nrow=225, ncols=478, xmn=-15.8, xmx=32, ymn=-9.4, ymx=13.1)
I want to mask in this raster the cells that are within a given distance of a point.
I create the spatial points as followed:
p2=readWKT("POINT(31.55 -1.05)")
Then I create a spatial polygon object by adding a 0.5 buffer:
p2_Buffered <- gBuffer(p2, width = 0.5)
mask(test, mask=p2_Buffered,inverse=T)
When I mask my raster given this spatial object, I have the following error message:
Error in .polygonsToRaster(x, y, field = field, fun = fun, background
= background, : number of items to replace is not a multiple of replacement length
I do not understand because this is script I have been running many many times with different point and different buffer width without any problem.
What is strange is that when I change the width of the buffer, it works fine:
p2_Buffered <- gBuffer(p2, width = 0.4)
mask(test, mask=p2_Buffered,inverse=T)
This is also true for a different focal point:
p2=readWKT("POINT(32.55 -1)")
p2_Buffered <- gBuffer(p2, width = 0.5)
mask(test, mask=p2_Buffered,inverse=T)
I would like to identify the specific problem I have for that point because this is a script I should run in a routine (I have been doing it without any problem so far).
Thanks a lot
This is indeed a bug with polygons that go over the edge of a raster. It has been fixed in version 2.3-40 (now on CRAN), so it should go away if you update the raster package.
Here is a workaround (removing the part of the polygon that goes over the edge).
library(raster)
library(rgeos)
r <- raster(nrow=225, ncols=478, xmn=-15.8, xmx=32, ymn=-9.4, ymx=13.1)
e <- as(extent(r), 'SpatialPolygons')
p <- readWKT("POINT(31.55 -1.05)")
pb <- gBuffer(p, width = 0.5)
pbe <- intersect(pb, e)
values(r)
x <- mask(r, mask=pbe, inverse=TRUE)
You usually need to set some values to the raster layer. For a mask layer its always best to set values to 1.
library(raster)
library(rgeos)
# make sample raster
test <- raster(nrow=225, ncols=478, xmn=-15.8, xmx=32, ymn=-9.4, ymx=13.1)
# set values of raster for mask
test <- setValues(test, 1)
# make point buffer
p2=readWKT("POINT(15 5)")
p2_Buffered <- gBuffer(p2, width = 1.5)
# name projection of buffer (assume its the same as raster)
projection(p2_Buffered) <- projection(test)
# visual check
plot(test); plot(p2_Buffered, add=T)
If you want to trim down your raster layer to the just the single polygon then try this workflow.
step1 <- crop(test, p2_Buffered) # crop to same extent
step2 <- rasterize(p2_Buffered, step1) # rasterize polygon
final <- step1*step2 # make your final product
plot(final)
If you just want to poke a hole in your raster layer then use the mask function
# rasterize your polygon
p2_Buffered <- rasterize(p2_Buffered, test, fun='sum')
# now mask it
my_mask <- mask(test, mask=p2_Buffered,inverse=T) # try changing the inverse argument
plot(my_mask)

Create heatmap with distribution of attribute values in R (not density heatmap)

Some of you might have seen Beyond "Soda, Pop, or Coke". I am facing a similar problem and would like to create a plot like that. In my case, I have a very large number of geo-coded observations (over 1 million) and a binary attribute x. I would like to show the distribution of x on a map with a color scale ranging from 0 to 1 for p(x=1).
I am open to other approaches but Katz's approach for Beyond "Soda, Pop, or Coke" is described here and uses these packages: fields, maps, mapproj, plyr, RANN, RColorBrewer, scales, and zipcode. His approach relies on k-nearest neighbor kernal smoothing with Gaussian kernel. He first defines a distance for each location t on the map to all observations and then uses a distance-weighted estimate for p(x=1|t) (probability that x is 1 conditional on the location). The formula is here.
When I understand this correctly, creating such a map in R involves these steps:
Build grid that covers the entire region of the shapefile (let's call the points in the grid t). I tried this approach using polygrid but failed so far. Code is below.
For each t, calculate the distance to all the observations (or just find the k clostest points and calculate the distance for this subset)
calculate p(x=1|t) according to the formula defined here
plot all t with an appropriate colorscale that ranges from 0 to 1
Here is some example data and I two concrete questions. First, how do solve my problem with step 1? As the second map below shows, my current approach fails. That is a clear R implementation question and once that is solved, I should be able to complete the other steps. Second and more broadly, is that the right approach or would you suggest a different way to create heatmap with distribution of attribute values?
load libraries and open shapefile and packages
# set path
path = PATH # CHANGE THIS!!
# load libraries
library("stringr")
library("rgdal")
library("maptools")
library("maps")
library("RANN")
library("fields")
library("plyr")
library("geoR")
library("ggplot2")
# open shapefile
map.proj = CRS(" +proj=lcc +lat_1=40.66666666666666 +lat_2=41.03333333333333 +lat_0=40.16666666666666 +lon_0=-74 +x_0=300000 +y_0=0 +datum=NAD83 +units=us-ft +no_defs +ellps=GRS80 +towgs84=0,0,0")
proj4.longlat=CRS("+proj=longlat +ellps=GRS80")
shape = readShapeSpatial(str_c(path,"test-shape"),proj4string=map.proj)
shape = spTransform(shape, proj4.longlat)
# open data
df=readRDS(str_c(path,"df.rds"))
plot data
# plot shapefile with points
par (mfrow=c(1,1),mar=c(0,0,0,0), cex=0.8, cex.lab=0.8, cex.main=0.8, mgp=c(1.2,0.15,0), cex.axis=0.7, tck=-0.02,bg = "white")
plot(shape#bbox[1,],shape#bbox[2,],type='n',asp=1,axes=FALSE,xlab="",ylab="")
with(subset(df,attr==0),points(lon,lat,pch=20,col="#303030",bg="#303030",cex=0.4))
with(subset(df,attr==1),points(lon,lat,pch=20,col="#E16A3F",bg="#E16A3F",cex=0.4))
plot(shape,add=TRUE,border="black",lwd=0.2)
1) Build grid that covers the entire region of shapefile
# get the bounding box for ROI an convert to a list
bboxROI = apply(bbox(shape), 1, as.list)
# create a sequence from min(x) to max(x) in each dimension
seqs = lapply(bboxROI, function(x) seq(x$min, x$max, by= 0.001))
# rename to xgrid and ygrid
names(seqs) <- c('xgrid','ygrid')
# get borders of entire SpatialPolygonsDataFrame
borders = rbind.fill.matrix(llply(shape#polygons,function(p1) {
rbind.fill.matrix(llply(p1#Polygons,function(p2) p2#coords))
}))
# create grid
thegrid = do.call(polygrid,c(seqs, borders = list(borders)))
# add grid points to previous plot
points(thegrid[,1],thegrid[,2],pch=20,col="#33333333",bg="#33333333",cex=0.4)

How to plot contours on a map with ggplot2 when data is on an irregular grid?

Sorry for the wall of text, but I explain the question, include the data, and provide some code :)
QUESTION:
I have some climate data that I want to plot using R. I am working with data that is on an irregular, 277x349 grid, where (x=longitude, y=latitude, z=observation). Say z is a measure of pressure (500 hPa height (m)). I tried to plot contours (or isobars) on top of a map using the package ggplot2, but I am having some trouble due to the structure of the data.
The data comes from a regular, evenly spaced out 277x349 grid on a Lambert conformal projection, and for each grid point we have the actual longitude, latitude, and pressure measurement. It is a regular grid on the projection, but if I plot the data as points on a map using the actual longitude and latitude where the observations were recorded, I get the following:
I can make it look a little nicer by translating the rightmost piece to the left (maybe this can be done with some function, but I did this manually) or by ignoring the rightmost piece. Here is the plot with the right piece translated to the left:
(An aside) Just for fun, I tried my best to re-apply the original projection. I have some of the parameters for applying the projection from the data source, but I do not know what these parameters mean. Also, I do not know how R handles projections (I did read the help files...), so this plot was produced through some trial and error:
I tried to add the contour lines using the geom_contour function in ggplot2, but it froze my R. After trying it on a very small subset of the data, I found that out after some googling that ggplot was complaining because the data was on an irregular grid. I also found out that that is the reason geom_tile was not working. I am guessing that I have to make my grid of points evenly spaced out - probably by projecting it back into the original projection (?), or by evenly spacing out my data by either sampling a regular grid (?) or by extrapolating between points (?).
My questions are:
How can I draw contours on top of the map (preferably using ggplot2) for my data?
Bonus questions:
How do I transform my data back to a regular grid on the Lambert conformal projection? The parameters of the projection according to the data file include (mpLambertParallel1F=50, mpLambertParallel2F=50, mpLambertMeridianF=253, corners, La1=1, Lo1=214.5, Lov=253). I have no idea what these are.
How do I center my maps so that one side is not clipped (like in the first map)?
How do I make the projected plot of the map look nice (without the unnecessary parts of the map hanging around)? I tried adjusting the xlim and ylim, but it seems to apply the axes limits before projecting.
DATA:
I uploaded the data as rds files on Google drive. You can read in the files using the readRDS function in R.
lat2d: The actual latitude for the observations on the 2d grid
lon2d: The actual longitude for the observations on the 2d grid
z500: The observed height (m) where pressure is 500 millibars
dat: The data arranged in a nice data frame (for ggplot2)
I am told that the data is from the North American Regional Reanalysis data base.
MY CODE (THUS FAR):
library(ggplot2)
library(ggmap)
library(maps)
library(mapdata)
library(maptools)
gpclibPermit()
library(mapproj)
lat2d <- readRDS('lat2d.rds')
lon2d <- readRDS('lon2d.rds')
z500 <- readRDS('z500.rds')
dat <- readRDS('dat.rds')
# Get the map outlines
outlines <- as.data.frame(map("world", plot = FALSE,
xlim = c(min(lon2d), max(lon2d)),
ylim = c(min(lat2d), max(lat2d)))[c("x","y")])
worldmap <-geom_path(aes(x, y), inherit.aes = FALSE,
data = outlines, alpha = 0.8, show_guide = FALSE)
# The layer for the observed variable
z500map <- geom_point(aes(x=lon, y=lat, colour=z500), data=dat)
# Plot the first map
ggplot() + z500map + worldmap
# Fix the wrapping issue
dat2 <- dat
dat2$lon <- ifelse(dat2$lon>0, dat2$lon-max(dat2$lon)+min(dat2$lon), dat2$lon)
# Remake the outlines
outlines2 <- as.data.frame(map("world", plot = FALSE,
xlim = c(max(min(dat2$lon)), max(dat2$lon)),
ylim = c(min(dat2$lat), max(dat2$lat)))[c("x","y")])
worldmap2 <- geom_path(aes(x, y), inherit.aes = FALSE,
data = outlines2, alpha = 0.8, show_guide = FALSE)
# Remake the variable layer
ggp <- ggplot(aes(x=lon, y=lat), data=dat2)
z500map2 <- geom_point(aes(colour=z500), shape=15)
# Try a projection
projection <- coord_map(projection="lambert", lat0=30, lat1=60,
orientation=c(87.5,0,255))
# Plot
# Without projection
ggp + z500map2 + worldmap2
# With projection
ggp + z500map + worldmap + projection
Thanks!
UPDATE 1
Thanks to Spacedman's suggestions, I think I have made some progress. Using the raster package, I can directly read from an netcdf file and plot the contours:
library(raster)
# Note: ncdf4 may be a pain to install on windows.
# Try installing package 'ncdf' if this doesn't work
library(ncdf4)
# band=13 corresponds to the layer of interest, the 500 millibar height (m)
r <- raster(filename, band=13)
plot(r)
contour(r, add=TRUE)
Now all I need to do is get the map outlines to show under the contours! It sounds easy, but I'm guessing that the parameters for the projection need to be inputted correctly to do things properly.
The file in netcdf format, for those that are interested.
UPDATE 2
After much sleuthing, I made some more progress. I think I have the proper PROJ4 parameters now. I also found the proper values for the bounding box (I think). At the very least, I am able to roughly plot the same area as I did in ggplot.
# From running proj +proj=lcc +lat_1=50.0 +lat_2=50.0 +units=km +lon_0=-107
# in the command line and inputting the lat/lon corners of the grid
x2 <- c(-5628.21, -5648.71, 5680.72, 5660.14)
y2 <- c( 1481.40, 10430.58,10430.62, 1481.52)
plot(x2,y2)
# Read in the data as a raster
p4 <- "+proj=lcc +lat_1=50.0 +lat_2=50.0 +units=km +lon_0=-107 +lat_0=1.0"
r <- raster(nc.file.list[1], band=13, crs=CRS(p4))
r
# For some reason the coordinate system is not set properly
projection(r) <- CRS(p4)
extent(r) <- c(range(x2), range(y2))
r
# The contour map on the original Lambert grid
plot(r)
# Project to the lon/lat
p <- projectRaster(r, crs=CRS("+proj=longlat"))
p
extent(p)
str(p)
plot(p)
contour(p, add=TRUE)
Thanks to Spacedman for his help. I will probably start a new question about overlaying shapefiles if I can't figure things out!
Ditch the maps and ggplot packages for now.
Use package:raster and package:sp. Work in the projected coordinate system where everything is nicely on a grid. Use the standard contouring functions.
For map background, get a shapefile and read into a SpatialPolygonsDataFrame.
The names of the parameters for the projection don't match up with any standard names, and I can only find them in NCL code such as this
whereas the standard projection library, PROJ.4, wants these
So I think:
p4 = "+proj=lcc +lat_1=50 +lat_2=50 +lat_0=0 +lon_0=253 +x_0=0 +y_0=0"
is a good stab at a PROJ4 string for your data.
Now if I use that string to reproject your coordinates back (using rgdal:spTransform) I get a pretty regular grid, but not quite regular enough to transform to a SpatialPixelsDataFrame. Without knowing the original regular grid or the exact parameters that NCL uses we're a bit stuck for absolute precision here. But we can blunder on a bit with a good guess - basically just take the transformed bounding box and assume a regular grid in that:
coordinates(dat)=~lon+lat
proj4string(dat)=CRS("+init=epsg:4326")
dat2=spTransform(dat,CRS(p4))
bb=bbox(dat2)
lonx=seq(bb[1,1], bb[1,2],len=277)
laty=seq(bb[2,1], bb[2,2],len=349)
r=raster(list(x=laty,y=lonx,z=md))
plot(r)
contour(r,add=TRUE)
Now if you get a shapefile of your area you can transform it to this CRS to do a country overlay... But I would definitely try and get the original coordinates first.

Resources