Add graticule to map using levelplot R - r

Often there is the need to produce stylish maps for inclusion in publications.
How can one possibly include projected grid coordinates in a map generated preferably with levelplotto look like those in the map shown here:
I provide sample data (for Canada) below for reproducibility. A typical projcetion for Canada is dat = projectRaster(dem, crs = ('+proj=stere +lat_0=90 +lat_ts=60 +lon_0=-110 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs')) and SpTransform can be used to tranform the boundary lines (can1).
require(colorRamps)
require(raster)
require(rasterVis)
require(mapproj)
library(raster)
library(proj4)
# Get province borders and project it to same CRS than raster
can1 <- getData('GADM', country="CAN", level=1)
getData('ISO3') # country name
dem=getData('alt', country='CAN', mask=TRUE)
require( colorRamps )
my.at <- unique(round(seq(ceiling(5800), floor(1), length.out = 51),0))#at: numeric vector specifying where the colors change. must be of length 1 more than the col vector.
col<-colorRampPalette(c("#d9d9d9", "#bdbdbd", "#969696", "#737373", "#525252", "#252525", "#000000"))
levelplot(dem,maxpixel=ncell(dem),panel=panel.levelplot.raster,names.attr=names(dem),
interpolate=F,margin=FALSE,xlab=list(label="Longitude",cex=1.5),yscale.components = yscale.raster.subticks,
xscale.components = xscale.raster.subticks,
ylab=list(label="Latitude",cex=1.5),
par.strip.text=list(cex=1),xlim=c(-158, -48.99485),
ylim=c(38.00513, 85),col.regions=col,at = seq(0, 5800,100),
colorkey = list(space = "bottom", labels = list(at = seq(0, 5800,800), rot=0,cex=1.1,font=6,fontface=1,
labels =c("0", "800", "1600", "2400", "3200", "4000", "4800", "5600")),
height=0.99,width=1.8,tck = c(0,0)),
par.settings=list(panel.background=list(col="white"),axis.line=list(lwd=1.9), strip.border=list(lwd=1.9),layout.heights=list(xlab.key.padding=-0.2)),
cex=0.8, scales = list(x=list(draw=TRUE,cex=1.2), y=list(draw=TRUE,cex=1.2)))+
layer(sp.polygons(can1,lwd=0.5,col="gray40"))

Next code provides a solution using the graticule package:
library(raster)
library(rasterVis)
library(graticule)
r <- getData('alt', country='CAN', mask=TRUE)
## Here is where the graticule routine starts
crs.longlat <- CRS("+init=epsg:4326")
prj <- CRS(projection(r))
extLL <- projectExtent(r, crs = crs.longlat)
lons <- pretty(c(xmin(extLL), xmax(extLL)))
lats <- pretty(c(ymin(extLL), ymax(extLL)))
## optionally, specify the extents of the meridians and parallels
## here we push them out a little on each side
xl <- range(lons) + c(-0.4, 0.4)
yl <- range(lats) + c(-0.4, 0.4)
## build the lines with our precise locations and ranges
grat <- graticule(lons, lats, proj = prj,
xlim = xl, ylim = yl)
## Labels
labs <- graticule_labels(lons, lats,
xline = lons[2],
yline = lats[2],
proj = prj)
labsLon <- labs[labs$islon,]
labsLat <- labs[!labs$islon,]
## Display the raster
levelplot(r) +
## and the graticule
layer(sp.lines(grat)) +
layer(sp.text(coordinates(labsLon),
txt = parse(text = labsLon$lab),
adj = c(1.1, -0.25),
cex = 0.6)) +
layer(sp.text(coordinates(labsLat),
txt = parse(text = labsLat$lab),
adj = c(-0.25, -0.25),
cex = 0.6))

Related

calculate distance of points to polygon boundary using terra package in R

I am trying to calculate distance of points within a country to country boundary
library(terra)
library(geodata)
library(ggplot2)
library(geodata)
# get a shapefile of a country
gabon <- geodata::gadm('GAB', level = 0, path = getwd())
canvas <- terra::rast(xmin = ext(gabon)[1],
xmax = ext(gabon)[2],
ymin = ext(gabon)[3],
ymax = ext(gabon)[4],
resolution = 0.08,
crs = crs(gabon),
vals = 0)
pts <- as.points(canvas)
pts <- terra::crop(pts, gabon) # extract the points in the limits of Gabon
plot(pts)
plot(gabon, border = "blue", add = T)
I want to calculate shortest distance of each point in pts to the boundary of the country
gabon_lines <- terra::as.lines(gabon)
# calculation of the distance between the boundary and points
dis_pts <- terra::distance(pts, gabon_lines, pairwise = FALSE, unit="km")
range(dis_pts)
# 0.00000046 1.63706213. seems quite low
dat <- data.frame(dist = as.vector(dis_pts),
crds(pts))
col_dist <- brewer.pal(11, "RdGy")
ggplot(dat, aes(x, y, fill = dist)) + #variables
geom_tile() + #geometry
scale_fill_gradientn(colours = rev(col_dist))+ # colors for plotting the distance
labs(fill = "Distance (km)")+ #legend name
theme_void()+ #map theme
theme(legend.position = "bottom") #legend position
I think the range of distance I am getting is very low since Gabon is quite big so I was expecting
distance of points in the middle to be larger. Is there anything I am doing wrong here?
The problem seems to be with the crs used. The result you have above is accurate, but the units are in degrees (latitude & longitude). A relatively quick fix is to reproject the data using crs 5223.
Most of the code below is copied, changes are below ####
library(terra)
library(geodata)
library(ggplot2)
library(scales)
library(RColorBrewer)
# get a shapefile of a country
gabon <- geodata::gadm('GAB', level = 0, path = getwd())
canvas <- terra::rast(xmin = ext(gabon)[1],
xmax = ext(gabon)[2],
ymin = ext(gabon)[3],
ymax = ext(gabon)[4],
resolution = 0.08,
crs = crs(gabon),
vals = 0)
pts <- as.points(canvas)
pts <- terra::crop(pts, gabon) # extract the points in the limits of Gabon
plot(pts)
plot(gabon, border = "blue", add = T)
gabon_lines <- terra::as.lines(gabon)
####
# reproject pts & gabon lines to this new crs:
new_crs <- "+proj=tmerc +lat_0=0 +lon_0=12 +k=0.9996 +x_0=500000 +y_0=500000 +datum=WGS84 +units=m +no_defs +type=crs"
pts2 <- terra::project(pts, new_crs)
gabon_lines2 <- terra::project(gabon_lines, new_crs)
# calculation of the distance between the boundary and points
dis_pts <- terra::distance(pts2, gabon_lines2, pairwise = FALSE, unit="km")
range(dis_pts)
## Now from 1 to about 180 km
## a quick check on google maps & the interior of Gabon is ~180km from the nearest border
dat <- data.frame(dist = as.vector(dis_pts),
crds(pts))
col_dist <- brewer.pal(11, "RdGy")
## Not much change from the plot before, but lat & lon degrees are approximately the same near the equator
ggplot(dat, aes(x, y, fill = dist)) + #variables
geom_tile() + #geometry
scale_fill_gradientn(colours = rev(col_dist))+ # colors for plotting the distance
labs(fill = "Distance (km)")+ #legend name
theme_void()+ #map theme
theme(legend.position = "bottom") #legend position
The dimensions come out a little wonky since the plot isn't using a crs. Changing the data to sf points makes things look a little better:
library(sf)
st_as_sf(dat, coords = c("x", "y")) %>%
ggplot() +
geom_sf(aes(color = dist)) +
scale_color_gradientn(colours = rev(col_dist))
That needs to be fixed, but you can do this
library(terra)
library(geodata)
# get a shapefile of a country
gabon <- geodata::gadm('GAB', level = 0, path = getwd())
canvas <- terra::rast(gabon, resolution = 0.08, vals=0)
m <- mask(canvas, gabon, inverse=TRUE)
d <- distance(m)
plot(d)

How to straighten skewed ggplot2 map with raster data?

When plotting my map of NLCD tree canopy data (a raster), the map is not straight or aligned with the map border. The skew seems to occur when using the projectRaster function. Is there a way to adjust the raster to be level and even with the border? When running the code below/looking at the uploaded image, the skew that I would like to remove is the dark grey uneven border while having the tree data fill the entire frame. I have been unable to find any solutions to this, so I appreciate any advice!
Picture of skew: 1
library(sf)
#devtools::install_github("ropensci/FedData")
library(FedData)
library(ggplot2)
library(raster)
library(RColorBrewer)
ext <- extent(734666.5, 795961.6, 4017870, 4053632)
extent <- polygon_from_extent(raster::extent(ext), proj4string='+proj=utm +datum=NAD83 +zone=16N')
WMAtc <- get_nlcd(template = polygon_from_extent(ext, (proj4string = "+proj=utm +zone=16N ellps+NAD83")), year = 2016, dataset = "Tree_Canopy", label = "Can", force.redo = T)
WMAtc_projected <- projectRaster(WMAtc, crs = "+proj=utm +zone=16N +datum=NAD83")
tc_df <- as.data.frame(WMAtc_projected, xy=TRUE)
ggplot() +
geom_raster(data = tc_df, aes(x = x, y = y, fill=tc_df[,3])) +
scale_fill_gradientn(colors = brewer.pal(8, "Greens"), name = "Tree Canopy Cover")
A professor graciously helped me fix the problem. With his code you can see where the extent bounding box is in relation to the downloaded NLCD data. When projected, the NLCD data is adjusted and extended past the original extent. To fix this, you can crop the extra data and it will realign the imagery of your maps.
library(FedData)
library(ggplot2)
library(raster)
library(RColorBrewer)
library(sf)
ext <- extent(734666.5, 795961.6, 4017870, 4053632)
extent <- polygon_from_extent(raster::extent(ext), proj4string='+proj=utm +datum=NAD83 +zone=16N')
WMAtc <- get_nlcd(template = polygon_from_extent(ext, (proj4string = "+proj=utm +zone=16N ellps+NAD83")),year = 2016, dataset = "Tree_Canopy", label = "Can")
WMAtc_projected <- projectRaster(WMAtc, crs = "+proj=utm +zone=16N +datum=NAD83")
tc_df <- as.data.frame(WMAtc_projected, xy=TRUE)
ggplot() +
geom_raster(data = tc_df, aes(x = x, y = y, fill=tc_df[,3])) +
scale_fill_gradientn(colors = brewer.pal(8, "Greens"), name = "Tree Canopy Cover") +
geom_sf(data=st_as_sf(extent), fill=NA, col="red") # show desired raster extent
WMAtc_projected_cropped = crop(WMAtc_projected, extent) #crop to remove extra bits
tc_df_cropped <- as.data.frame(WMAtc_projected_cropped, xy=TRUE)
ggplot() +
geom_raster(data = tc_df_cropped, aes(x = x, y = y, fill=tc_df_cropped[,3])) +
scale_fill_gradientn(colors = brewer.pal(8, "Greens"), name = "Tree Canopy Cover") +
geom_sf(data=st_as_sf(extent), fill=NA, col="red")

Trouble overlaying kriged data on google map

In the code below, I am trying to overlay kriged meuse data on to google map usingggmap().The code seems to work ok all the way down toget_map(),but gets stuck in some kind of huge computation (RAM usage jumps to 7G on my 8G machine - be warned!) at the lastprint(ggmap())execution. What am I doing wrong?
UPDATE: I think I figured out the problem =>stat_contour()does not seem to work with the kriged data (still not sure why). When I replace it with the binning functionstat_summary_2d(),the code now works. I'd still like to show contour lines, if possible. Can someone help with that?
Thanks
# transform meuse data to SpatialPointsDataFrame
suppressMessages(library(sp))
data(meuse)
coordinates(meuse) <- ~ x + y
proj4string(meuse) <- CRS("+proj=stere
+lat_0=52.15616055555555 +lon_0=5.38763888888889
+k=0.999908 +x_0=155000 +y_0=463000
+ellps=bessel +units=m +no_defs
+towgs84=565.2369,50.0087,465.658,
-0.406857330322398,0.350732676542563,-1.8703473836068, 4.0812")
# define sample grid for kriging
set.seed(42)
grid <-spsample(meuse, type = "regular", n = 10000)
# do kriging
suppressMessages(library(automap))
krg <- autoKrige(formula = copper ~ 1,
input_data = meuse,
new_data = grid)
# extract kriged data
krg_df <- data.frame(krg$krige_output#coords,
pred = krg$krige_output#data$var1.pred)
names(krg_df) <- c("x", "y", "pred")
# transform to SpatialPointsDF & assign original (meuse) projection
krg_spdf <- krg_df
coordinates(krg_spdf) <- ~ x + y
proj4string(krg_spdf) <- proj4string(meuse)
# transform again to longlat coordinates (for overlaying on google map below)
krg_spdf <- spTransform(krg_spdf, CRS("+init=epsg:4326"))
krg_df <- data.frame(krg_spdf#coords, pred = krg_spdf#data$pred)
# get meuse map and overlay kriged data
suppressMessages(library(ggmap))
lon <- range(krg_df$x)
lat <- range(krg_df$y)
meuse_map <- get_map(location = c(lon = mean(lon), lat = mean(lat)),
zoom = 13)
print(ggmap(meuse_map, extent = "normal", maprange = F) +
#### old code (does not work) ####
#stat_contour(aes(x = x, y = y, z = pred, fill = ..level..),
# alpha = 0.5,
# color = "gray80",
# geom = "polygon",
# data = df) +
#### replaced with stat_summary_2d() ####
stat_summary_2d(aes(x = x, y = y, z = pred),
binwidth = c(0.0005,0.0005),
alpha = 0.5,
data = krg_df) +
scale_fill_gradient(low = "yellow",
high = "red",
name = "Copper") +
coord_cartesian(xlim = lon, ylim = lat, expand = 0) +
theme(aspect.ratio = 1))

Mapping location in R from a data frame

I just got my location data from Falkland Island, and i tried to map the locations that I got from the tags, however, when i run this code r stop working.
I have a data frame for 30 penguins, with different amount of location each, thus, the table looks like this:
This is the code that i tried:
gentoo<-read.csv("Regularised Gentoos.csv", header=F)
plot(gentoo$V3~gentoo$V4,ylab="Latitude",xlab="Longitude",
col=gentoo$V1,aspect="iso")
I could finally plot my data, with the bathymetry of the area:
#Load in libraries
library(sp)
library(rgdal)
library(rgeos)
library(maptools)
library(raster)
library(ggplot2)
library(scales)
library(gridExtra)
library(adehabitatHR)
library(maptools)
library(marmap)
library(maptools)
#Load in shapefile from NaturalEarthData.com
#Load in shapefile from NaturalEarthData.com
world_shp = rgdal::readOGR("/Users/danielgonzalez/Desktop/Thesis/DATA EMAILS/natural_earth_vector/10m_physical",layer = "ne_10m_land")
world_shp
#Load in .csv file
gentoo = read.csv("/Users/danielgonzalez/Desktop/Thesis/DATA EMAILS/Regularised Gentoos.csv")
#Create a spatial points dataframe
locs = sp::SpatialPointsDataFrame(coords = cbind(gentoo$lon, gentoo$lat), data = gentoo, proj4string=CRS("+proj=longlat +datum=WGS84"))
locs
#Extra...
#To download bathymetry data FALKLAND ISLAND MAP
#ETOPO1 database hosted on the NOAA website
library(marmap)
getNOAA.bathy(lon1=-70, lon2=-52, lat1=-57, lat2=-46, resolution = 1) -> bathy
plot(bathy, image=TRUE, deep=-6000, shallow=0, step=1000)
bat = as.raster(bathy)
#Write
writeRaster(bat, filename = "~/bathy.asc")
#Read
bat = readGDAL("~/bathy.asc")
#Load in Raster data
#This is 1 min resolution bathymetry from ETOPO1 database hosted on the NOAA website
bathy = raster::raster("/Users/danielgonzalez/bathy.asc")
#Define projection of bathymetry data
raster::projection(bathy) = CRS("+proj=longlat +datum=WGS84")
#Create a spatialpoints object of the colony
Colonsay = sp::SpatialPoints(coords = cbind(-6.25, 56.07), proj4string = CRS("+proj=longlat +datum=WGS84"))
#Quick plot
#png("gentoo distribution.png",width=8,height=6,units="in",res=1800)
image(bathy,ylab="Latitude",xlab="Longitud")
lines(world_shp)
points(gentoo$lon,gentoo$lat, pch = 19, cex = 0.3,col=gentoo$id)
#dev.off()
Just use ggmap
library(ggmap)
library(ggplot2)
#lat/lon data
df <- as.data.frame(matrix(nrow = 3, ncol =3))
colnames(df) <- c("lat", "lon", "id")
df$lon <- c(-51.2798, -51.3558, -51.9)
df$lat <- c( -59.6387, -59.7533, -59.4)
df$id <- c("1", "2", "3")
df
lat lon id
1 -59.6387 -51.2798 1
2 -59.7533 -51.3558 2
3 -59.4000 -51.9000 3
#get the map
library(ggmap)
mapImageData <- get_map(location = "Falkland Islands",
source = "google", zoom = 9)
#plot the points
ggmap(mapImageData,
extent = "panel",
ylab = "Latitude",
xlab = "Longitude",
legend = "right") +
geom_point(aes(x = lat, # path outline
y = lon),
data = df,
colour = "black") +
labs(x = "Longitude",
y = "Latitude") + ggtitle("Penguin Sightings") +
theme(plot.title = element_text(lineheight=.8, face="bold"))

google map from dismo::gmap() and ggplot2

I obtained a map with the function dismo::gmap() and want to plot it with ggplot2 because I want to add different feautures using geom_point and other ggplot functions. I prefer to use dismo::gmap instead of ggmap::get_map() to download the google map layer. This is because dismo::gmap(), unlike ggmap::get_map(), returns a raster layer from package raster including complete CRS information and therefore is should be possible to modify the projection of the layer.
> head(data_info$latitude, 20)
#[1] 49.11306 49.39333 48.78083 51.85000 53.57361 50.67806 52.69083 52.21389 53.46361 50.99917 53.99750 53.54528 53.61417 48.00556 48.01306 53.45000
#[17] 51.93667 54.53083 51.95500 54.29639
> head(data_info$longitude, 20)
#[1] 13.134722 12.323056 13.803889 12.177778 14.143611 13.175833 12.649444 13.454167 11.629722 10.906111 11.415556 8.426944 7.160000 11.123889 10.786111
#[16] 12.766667 11.987222 13.091389 10.967500 13.684167
e = extent(-14 , 58 , 28 , 64)
mapImageData2 <- gmap(e, type = c("terrain"), lonlat = TRUE,
path = "&style=feature:all|element:labels|visibility:off&style=feature:administrative.country|element:geometry.stroke|visibility:off")
mapImageData2_proj <- projectExtent(mapImageData2, crs = "+proj=utm +zone=31 +datum=WGS84")
# plot the points on the map
ggplot(mapImageData2_proj, extent = "device") +
geom_point(inherit.aes = FALSE, aes(x = data_info$longitude, y = data_info$latitude),
data = gps, colour = "red", size = 1, pch = 20)
After trying this, I get the following error:
Error: ggplot2 doesn't know how to deal with data of class
RasterLayer
If I try this
plot(mapImageData2_proj)
Error in .plotraster2(x, col = col, maxpixels = maxpixels, add = add,
: no values associated with this RasterLayer
There are two issues in this question. One is how to get ggplot2 to plot a Raster* object. The other is how to reproject a raster while retaining its values.
The OP contains the code
library(dismo)
e = extent(-14 , 58 , 28 , 64)
mapImageData2 <- gmap(e, type = c("terrain"), lonlat = TRUE,
path = "&style=feature:all|element:labels|visibility:off&style=feature:administrative.country|element:geometry.stroke|visibility:off")
If we run this and then do plot(mapImageData2) we get a nice plot. The OP then runs
mapImageData2_proj <- projectExtent(mapImageData2, crs = "+proj=utm +zone=31 +datum=WGS84")
Now if we run plot(mapImageData2_proj) we get an error! That's because projectExtent returns a RasterLayer with no values. We need to use projectRaster() instead. See ?projectExtent for details. So we run:
mapImageData2_proj <- projectRaster(mapImageData2, crs = "+proj=utm +zone=31 +datum=WGS84")
plot(mapImageData2_proj)
Now we see the reprojected map. Progress! But we still can't plot mapImageData2_proj using ggplot2, because ggplot2 doesn't know how to handle a Raster* object. We need to convert our raster to a dataframe. There are a few ways to do this, but without loading any additional packages, a good option is raster::rasterToPoints(). For example:
myPoints <- raster::rasterToPoints(myRaster)
myDataFrame <- data.frame(myPoints)
colnames(myDataFrame) <- c("Longitude", "Latitude", "Values")
ggplot(data=myDataFrame, aes_string(y = "Latitude", x = "Longitude")) +
geom_raster(aes(fill = Values))
So to put it all together in the OP's example:
library(dismo)
e = extent(-14 , 58 , 28 , 64)
mapImageData2 <- gmap(e, type = c("terrain"), lonlat = TRUE,
path = "&style=feature:all|element:labels|visibility:off&style=feature:administrative.country|element:geometry.stroke|visibility:off")
plot(mapImageData2)
mapImageData2_proj <- projectRaster(mapImageData2, crs = "+proj=utm +zone=31 +datum=WGS84")
plot(mapImageData2_proj)
myRaster <- mapImageData2_proj
myPoints <- raster::rasterToPoints(myRaster)
myDataFrame <- data.frame(myPoints)
colnames(myDataFrame) <- c("X", "Y", "Values")
ggplot(data=myDataFrame, aes_string(y = "Y", x = "X")) +
geom_raster(aes(fill = Values))
To directly plot a Raster* object in ggplot, you can use the library RasterVis as follows:
r <- raster(system.file("external/test.grd", package="raster"))
s <- stack(r, r*2)
names(s) <- c('meuse', 'meuse x 2')
library(ggplot2)
theme_set(theme_bw())
gplot(s) + geom_tile(aes(fill = value)) +
facet_wrap(~ variable) +
scale_fill_gradient(low = 'white', high = 'blue') +
coord_equal()
As you see, we use gplot and not ggplot.
This function is for Raster* objects as it allows to load only a part of the Raster* object in RAM. You can even choose the maximum number of pixels to load on the map with gplot(s, maxpixels=50000).
Indeed, I recommend not to transform your Raster as points, because, if your raster is huge, you will not be able to load it in the RAM...

Resources