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")
Related
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)
I'm trying to create a map of Europe with grid cells coloured based on the number of records within a cell. Here I attach an image as illustrative of the desired output (see Fig 1 of https://doi.org/10.3897/phytokeys.74.9723).
In order to produce this image I have developed a minimal reproducible example with random points distributed across Europe. I have been able to produce a similar figure with levelplot but I'm particulary interested in doing this with ggplot as it will allow further customising. Is it possible to do produce a similar figure with ggplot? And if so, any advice of what path should I follow?
Note: The size of the grids/cells is irrelevant at the moment but I'll adjust it depending on point density. All of them have to be the same size as in the first example and they only will differ on the pattern of colour.
#Load libraries
library(rgdal) #v1.5-28
library(rgeos) #v.0.5-9
library(ggplot2) # 3.3.5
library(rworldmap) #plot worldmap v.1.3-6
library(dplyr) #v.1.0.7
#Create dataframe of coordinates that fall in Europe
coord <- data.frame(cbind(runif(1000,-15,45),runif(1000,30,75)))
colnames(coord) <- c("long","lat")
#Exlude ocean points following this post
URL <- "http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/physical/ne_110m_ocean.zip"
fil <- basename(URL)
if (!file.exists(fil)) download.file(URL, fil)
fils <- unzip(fil)
oceans <- readOGR(grep("shp$", fils, value=TRUE), "ne_110m_ocean",
stringsAsFactors=FALSE, verbose=FALSE)
europe_coord <- data.frame(long = coord$long,
lat = coord$lat)
coordinates(europe_coord) <- ~long+lat
proj4string(europe_coord) <- CRS(proj4string(oceans))
ocean_points <- over(europe_coord, oceans)
#Add ocean points to dataset
coord$ocean <- ocean_points$featurecla
#Exlude ocean points
europe_land <- coord %>% filter(is.na(ocean))
#Load worldmap
world <- map_data("world")
#Plot europe spatial data
ggplot() + geom_map(data = world, map = world,
aes(long, lat, map_id = region), color = "white",
fill = "lightgray", size = 0.1) +
geom_point(data = europe_land,aes(long, lat),
alpha = 0.7, size = 0.05) + ylim(0,70) +
coord_sf(xlim = c(-15, 45), ylim = c(30, 75), expand = FALSE)
I want to produce a 2d-density plot based on spatial point data. In the background I want to show an open map (e.g. stamen terrain). Besides I want to plot the borders of Austria. Both datasets (data points and border) are shapefiles in EPSG 4326.
I managed to produce such a plot (see screenshots and code V1 below), but the problem is that there is a shift between the map in the background on the one side and the plotted points and the borders of Austria on the other side, as you can see below.
2D-Density Plot V1 - full
2D-Density Plot V1 - detail
Here is the code (V1):
library(sf)
library(rgdal)
library(ggplot2)
library(ggmap)
# Read point data (EPSG: 4326)
sk <- st_read("points.shp")
# Read country border polygon (EPSG: 4326)
blogr4326 <- readOGR(<path>, <layer name>)
bl4326_df <- fortify(blogr4326)
# Austria box (extent)
# Longitude: 9.6 to 16.94504
# Latitude: 46.52694 to 48.81667
map <- get_map(c(left = +9.6, bottom = 46.52694, right = +16.90, top = 48.99), color = "color", crop = FALSE)
hm_sk <- ggmap(map, extent = "panel", maprange=FALSE, darken=0.0) +
geom_point(data = sk, aes(x=X_WGS84, y=Y_WGS84)) +
stat_density2d(data = sk, aes(x=X_WGS84, y=Y_WGS84, fill = ..density.., alpha=cut(..density..,breaks=c(-Inf,0.08,Inf))), contour = FALSE, bins=16, geom = 'raster', n=500) +
ggtitle("Schwarzkiefer 2016/2020") + xlab("X_WGS84") + ylab("X_WGS84") +
scale_fill_distiller(palette= "Spectral", direction=-1, limits = c(0.08, 8.50)) +
scale_alpha_manual(values=c(0,0.7), guide="none") +
geom_polygon(data=bl4326_df, aes(long, lat, group=group), color='black', fill='NA', inherit.aes = TRUE) +
coord_fixed(1.5)
hm_sk
I found out that the shift is caused by the fact that the map in the background is in the projection EPSG:3857 and my shapefiles are in the projection EPSG:4326, as explained in this post. So I projected my shapefiles to EPSG 3857 and inserted the provided code into my code, as you can see here (V2):
library(sf)
library(rgdal)
library(ggplot2)
library(ggmap)
# Read point data (EPSG: 3857)
sk <- st_read("points.shp")
# Read country border polygon (EPSG: 3857)
blogr3857 <- readOGR(<path>, <layer name>)
bl3857_df <- fortify(blogr3857)
# Austria box (extent)
# Longitude: 9.6 to 16.94504
# Latitude: 46.52694 to 48.81667
map <- get_map(c(left = +9.6, bottom = 46.52694, right = +16.90, top = 48.99), color = "color", crop = FALSE)
#-------------------------------------------------------------------------------------------------
# Following code according to this link to avoid the shift between map and country border polygon:
# https://stackoverflow.com/questions/47749078/how-to-put-a-geom-sf-produced-map-on-top-of-a-ggmap-produced-raster
# Define a function to fix the bbox to be in EPSG:3857
ggmap_bbox <- function(map) {
if (!inherits(map, "ggmap")) stop("map must be a ggmap object")
# Extract the bounding box (in lat/lon) from the ggmap to a numeric vector,
# and set the names to what sf::st_bbox expects:
map_bbox <- setNames(unlist(attr(map, "bb")),
c("ymin", "xmin", "ymax", "xmax"))
# Convert the bbox to an sf polygon, transform it to 3857,
# and convert back to a bbox (convoluted, but it works)
bbox_3857 <- st_bbox(st_transform(st_as_sfc(st_bbox(map_bbox, crs = 4326)), 3857))
# Overwrite the bbox of the ggmap object with the transformed coordinates
attr(map, "bb")$ll.lat <- bbox_3857["ymin"]
attr(map, "bb")$ll.lon <- bbox_3857["xmin"]
attr(map, "bb")$ur.lat <- bbox_3857["ymax"]
attr(map, "bb")$ur.lon <- bbox_3857["xmax"]
map
}
# Use the function:
map <- ggmap_bbox(map)
#-------------------------------------------------------------------------------------------------
hm_sk <- ggmap(map,extent = "device", maprange=FALSE) +#, extent = "panel", maprange=FALSE, darken=0.0) +
coord_sf(crs = st_crs(3857)) + # f867orce the ggplot2 map to be in 3857
geom_point(data = sk, aes(x=X_PM, y=Y_PM)) +
stat_density2d(data = sk, aes(x=X_PM, y=X_PM, fill = ..density.., alpha=cut(..density..,breaks=c(-Inf,0.08,Inf))), contour = FALSE, bins=16, geom = 'raster', n=500) +
scale_fill_distiller(palette= "Spectral", direction=-1, limits = c(0.08, 8.50)) +
scale_alpha_manual(values=c(0,0.7), guide="none") +
geom_polygon(data=bl3857_df, aes(long, lat, group=group), color='black', fill='NA', inherit.aes = FALSE) +
ggtitle("Schwarzkiefer 2016/2020") + xlab("X_3857") + ylab("X_3857")
hm_sk
Now, the problem with the shift is solved, but the density plot is not visible anymore (only map, points and borders are plotted), as you can see here:
2D-Density Plot V2 - full
2D-Density Plot V2 - detail
Any suggestions, how I can produce a plot that is proper aligned AND includes the density plot? Thanks a lot in advance!
What I have:
points in the arctic and antarctic
raster data from various geophysical entities in arctic and antarctic
What I want:
A map in stereographic or any other polar projection with background map or coastlines, cropped to the extent of the points. In other words: A map like above with base map of my own choice.
What I did so far:
I loaded all the data (including land surface data from naturalearthdata; see MWE), projected them into stereographic and plotted that. The result including the polygon data looks then like this:
My MWE:
library(raster)
library(sf)
library(ggplot2)
library(rgdal)
# file load ---------------------------------------------------------------
# sea ice raster data
if (!file.exists("seaiceraster.tif")) {
url = "https://seaice.uni-bremen.de/data/smos/tif/20100514_hvnorth_rfi_l1c.tif"
download.file(url, destfile = 'seaiceraster.tif')
}
si.raster = raster::raster('seaiceraster.tif')
# land surface shapefile
if (!file.exists("110m-admin-0-countries")) {
url_land = "https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/10m/physical/ne_10m_land.zip"
download.file(url_land, destfile = "110m-admin-0-countries")
unzip("110m-admin-0-countries")
}
world_shp = rgdal::readOGR("ne_10m_land.shp")
# points
p.data = structure(
list(
Lat = c(
73.0114126168676,70.325555278764,77.467797903163,
58.6423827457304,66.3616310851294,59.2097857474643,
75.3135274436283,60.1983078512275,72.6614399747201,
61.1566678672946,73.0822309615673,55.7759666826898,
75.1651656433833,69.0130753414173,62.3288262448589
),
Lon = c(
-59.9175490701543,-80.1900239630732,-40.4609968914928,
-61.0914448815381,-60.0703668488408,-21.027205418284,
-100.200463810276,-74.861777073788,-55.1093773178206,
-29.4108649230234,-64.5878251008461,-36.5343322019187,
-31.647365623387,-67.466355105829,-64.1162329769077
)
),
row.names = c(
1911L, 592L,2110L,3552L,3426L,1524L,635L,4668L,
3945L,2848L,3609L,36L,4262L,3967L,2725L
),
class = "data.frame"
)
p = sf::st_as_sf(p.data, coords = c("Lon", "Lat"),
crs = "+init=epsg:4326")
# project -----------------------------------------------------------------
polar.crs = CRS("+init=epsg:3995")
si.raster.proj = projectRaster(si.raster, crs = polar.crs)
world_shp.proj = sp::spTransform(world_shp, polar.crs)
p.proj = sf::st_transform(p, polar.crs)
# preparation -------------------------------------------------------------
AG = ggplot2::fortify(world_shp.proj)
# make raster to data.frame
si.raster.df = si.raster.proj %>%
raster::crop(., p.proj) %>%
raster::rasterToPoints(., spatial = TRUE) %>%
as.data.frame(.)
colnames(si.raster.df) = c("val", "x", "y")
# plot --------------------------------------------------------------------
ggplot() +
# geom_polygon(data = AG, aes(long, lat, group = group)) + # un-comment to see
geom_raster(data = si.raster.df, aes(x = x, y = y, fill = val)) +
geom_sf(data = p.proj, color = "green", size = 3)
I've changed the workflow in your example a bit to add the stars package for the sea ice data, but I think it should get you what you're looking for. You'll need to adjust the crop size to expand it a little, as the points p are right on the edge of the plotted area. st_buffer might help with that.
I used the crs from the seaicebuffer.tif file for all of the objects.
The .tif file has a crs that I'm not able to easily transform on my computer. It seems to be able to use meters as a lengthunit and might be a polar stereographic (variant B) projection. The points & world data don't seem to have a problem transforming to it though, which is why I've used it throughout.
library(raster)
library(sf)
library(ggplot2)
library(rgdal)
library(stars)
si <- stars::read_stars('seaiceraster.tif')
world_sf = rgdal::readOGR("ne_10m_land.shp") %>%
st_as_sf() %>%
st_transform(st_crs(si))
# p <- ... same as example and then:
p <- st_transform(p, st_crs(si))
# get a bounding box for the points to crop si & world.
p_bbox <- st_bbox(p) %>%
st_as_sfc() %>%
st_as_sf() %>%
st_buffer(100000)
# crop si & world_sf to an area around the points (p)
world_cropped <- st_crop(world_sf, p_bbox)
si_cropped <- st_crop(si, p_bbox)
#Plot
ggplot() +
geom_sf(data = world_cropped,
color = 'black',
fill = 'NA',
size = .2) +
geom_stars(data = si_cropped) +
geom_sf(data = p, color = 'red') +
scale_fill_continuous(na.value = 0)
Ugly hack for the southern .tif that stars reads as factors:
si <- stars::read_stars('20150324_hvsouth_rfi_l1c.tif', NA_value = 0 )
si$"20150324_hvsouth_rfi_l1c.tif" <- as.numeric(si$"20150324_hvsouth_rfi_l1c.tif")
ggplot() + geom_stars(data = si)
I'm trying to limit a map plot to a specific area. coord_map is preferred to scale_x_continuous and y equivalent, since the latter mess up the polygons. But here I'm finding it fails for some reason. Here's my code (downloads a 57kb shapefile):
require(maptools)
require(ggplot2)
download.file('https://dl.dropboxusercontent.com/u/46043231/UK.zip', "uk.zip", method="internal", mode="wb")
unzip('uk.zip')
uk = readShapePoly('uk_outline_1000m.shp')
print(bbox(uk))
min max
x 259.9625 655566.4
y 7211.7025 1218558.9
uk2 = fortify(uk)
(p = ggplot(uk2, aes(x=long, y=lat, group=group)) + geom_polygon() + coord_equal())
But when coord_map is used the plot disappears:
p + coord_map(xlim=c(0, 630000), ylim=c(0, 1000000))
Any idea what's going on??
I would try something like this to test a few options.
library(maptools)
library(ggplot2)
library(rgdal)
library(raster)
library(latticeExtra)
Download and read the data
download.file('https://dl.dropboxusercontent.com/u/46043231/UK.zip',
"uk.zip", method="internal", mode="wb")
unzip('uk.zip')
uk <- readOGR(dsn = getwd(), layer = 'uk_outline_1000m')
Data is assumed to use OSGB 1936 / British National Grid.
More about at SpatialReference
proj4string(uk) <- CRS('+init=epsg:27700') # EPSG 27700
extent(uk)
bb.uk <- as(extent(uk), 'SpatialPolygons') # a spatial object
proj4string(bb.uk) <- CRS('+init=epsg:27700')
Write projected shapefile of uk bbox. I'll write it out to map layers with QGIS. It will be my reference system.
writeOGR(as(bb.uk, 'SpatialPolygonsDataFrame'),
dsn = getwd(),
layer = 'bbuk2_bng', driver = 'ESRI Shapefile')
The desired bounding box. Using projected coordinates
bb.uk2 <- as(extent(c(0, 630000), c(0, 1000000)), 'SpatialPolygons')
proj4string(bb.uk2) <- CRS('+init=epsg:27700')
Write projected shapefile of user bbox
writeOGR(as(bb.uk2, 'SpatialPolygonsDataFrame'),
dsn = getwd(),
layer = 'bbuk2user_bng', driver = 'ESRI Shapefile')
QGis map using British National Grid EPSG:27700
Plot projected layers
Base plot
plot(uk, col = 'grey50', axes = T, xlim=c(-50000, 705566.4),
ylim=c(-50000, 1325000))
plot(bb.uk, add = T)
plot(bb.uk2, border = 'red', add = T)
spplot
I took a arbitrary window to expand plot area.
sp::spplot(uk, zcol = 'NAME_ISO', scales = list(draw = TRUE),
xlim=c(-50000, 705566.4), ylim=c(-50000, 1325000),
col.regions="grey90") +
latticeExtra::layer(sp.polygons(bb.uk, fill = NA, col = 'blue')) +
latticeExtra::layer(sp.polygons(bb.uk2, fill = NA, col = 'red'))
ggmap with projected layers
uk.df = fortify(uk) # admin
bbuk.df <- fortify(bb.uk) # country bbox extent
bbuk2.df <- fortify(bb.uk2) # user bbox extent
plot it
p <- ggplot() + geom_polygon(data = uk.df, aes(x=long, y=lat, group=group)) +
geom_polygon(data = bbuk.df, aes(x=long, y=lat, group=group),
colour = 'blue', fill = NA) +
geom_polygon(data = bbuk2.df, aes(x=long, y=lat, group=group),
colour = 'red', fill = NA) +
coord_equal() # cartesian
p
plot it with user bounding box
p + coord_equal(xlim=c(0, 630000), ylim=c(0, 1000000))
Now ggplot with geographic (unprojected) coordinates
WGS84 Unprojected Coordinate Reference System
p.wgs84 <- CRS("+init=epsg:4326") # WGS84 Long Lat
Convert projected layer to WGS84
uk.wgs89 <- spTransform(uk, p.wgs84)
Geographic bbox uk
bbuk.wgs84 <- as(as(extent(uk.wgs89), 'SpatialPolygons'),
'SpatialPolygonsDataFrame')
Geographic bbox of user extent
bbuk2.wgs84 <- spTransform(bb.uk2, p.wgs84)
bbuk2.wgs84 <- as(bbuk2.wgs84, 'SpatialPolygonsDataFrame')
Plot it with ggplot and cartesian map
uk.df = fortify(uk.wgs89) # admin
bbuk.df <- fortify(bbuk.wgs84) # country bbox extent
bbuk2.df <- fortify(bbuk2.wgs84) # user bbox extent
The result is not what I'd expect. I don't figure out why the red box is distorted.