Making a circular mask for an arctic sf map - r

I'm making a fairly detailed map of the northern high latitudes that I want to show with an Arctic projection. I'd like to have a map that has a transparent circle from 50N to 90N as a mask for the final image. Seems easy. But I'm stuck. What I'd like is for the map in p1 below to be reprojected into North Pole Azimuthal Equidistant projection with the data below 50N to be greyed out and the data above 50N to show through. Any tips?
library(sf)
library(tidyverse)
#get coastlines as a demo
coastlines <- rnaturalearth::ne_coastline(scale = 50, returnclass = "sf")
st_crs(coastlines) <- "EPSG:4326"
# create arctic(ish) bounding box
arcticBox <- data.frame(id="A",
lon = c(-180,180,180,-180,-180),
lat = c(90,90,50,50,90))
otherBox <- data.frame(id="B",
lon = c(-180,180,180,-180,-180),
lat = c(50,50,-90,-90,50))
boxes <- bind_rows(arcticBox,otherBox)
boxesSF <- st_as_sf(boxes,coords=c("lon","lat"),crs="EPSG:4326") %>%
group_by(id) %>% summarise(geometry = st_combine(geometry)) %>%
st_cast("POLYGON")
p1 <- ggplot() +
geom_sf(data=coastlines,color="blue",size=0.25) +
geom_sf(data=boxesSF,mapping = aes(fill=id),color=NA) +
scale_fill_manual(values=alpha(colour=c("blue", "grey"),
alpha = c(0,1))) +
coord_sf(ylim = c(0,90)) +
theme(legend.position = "none")
p1
p1 + coord_sf(crs = sf::st_crs("ESRI:102016"))
Where did the masking polygons go? Something weird with having -180 to 180 meeting?

Related

R mapping - plot area boundaries + add layer plotting 2,500 metre buffers for a set of plot points

I have the below code which is intended to
a) Draw a base outline layer of all Middle Super Output Areas in the East of England
b) Generate 2,500 buffer boundaries around each plotted point from an imported dataset
c) Plot the buffer boundary layer over the base outline layer.
#Call necessary packages
library(tidyverse)
library (readxl)
library (openxlsx)
library(maptools)
library(classInt)
library(RColorBrewer)
library(sf)
library(tmap)
library(tmaptools)
library(geodata)
#Read in shape file for mapping
shp_name <- C:/Users/JWP/East of England/MSOA/Middle_Layer_Super_Output_Areas_December_2011_Generalised_Clipped_Boundaries_in_England_and_Wales.shp"
EofEMSOAsFinalList <- st_read(shp_name)%>%
st_as_sf
# Create union shape of polygons
union <- st_union(EofEMSOAsFinalList)
#Read in point location data
LocationData <- read_excel("C:/Users/JWP/LocationData.xlsx",
sheet = "Location Data")
#Geocode the address list with 2,500m boundaries around each point
LocationDataPlotted <- st_as_sf(LocationData, coords = c('Latitude', 'Longitude'), crs = 4326)
#Remove geometry
LocationDataPlotted2 <- LocationDataPlotted %>%
as.data.frame() %>%
# calculate around each point a buffer zone of 2,500m
mutate(buffer = st_buffer(geometry, dist = 2500)) %>%
select(-geometry) %>%
st_as_sf()
#Generate bounding box
mask_union <- union %>% as_tibble() %>%
mutate(bbox = st_as_sfc(st_bbox(c(xmin = -5.5, xmax = 9, ymax = 51.5, ymin = 42), crs = st_crs(4326)))) %>%
st_as_sf()
# compute difference between bounding box and union polygon to
# use as mask in the final layer
diff <- st_difference(mask_union$bbox, mask_union$geometry)
# Build map
OutputMap <-
# plot only shapes filled red
tm_shape(EofEMSOAsFinalList) +
tm_fill(col = "red") +
# plot only buffer zones of each point in green
tm_shape(LocationDataPlotted2)+
tm_fill(col = "forestgreen") +
# add mask
tm_shape(diff) +
tm_fill(col = "white") +
# plot borders of shape
tm_shape(EofEMSOAsFinalList) +
tm_borders(col = "white",
lwd = 1,
lty = "solid") +
# add custom legend
tm_add_legend(type = "symbol",
labels = c("Not Within 2500m", "Within 2500m"),
col = c("red", "forestgreen"),
title = "Access type",
size = 1.5,
shape = 21)
The correct output should therefore look similar to the above:
However I am now getting output like the below:
Can anyone please amend the above so it works correctly?
Many thanks

Projecting a quartered circle with a 50km radius in r/sf?

I'm hoping to create a series of quartered circles (i.e. circles split into 4 equal quadrants), each with a 50km radius, that I can map onto various longitudes and latitudes throughout the United States. I'd also like the option to rotate these quartered circles as desired.
Using the code below (and guidance from here), I've been able to make the following start:
New York State Map
I have two questions:
How can I meaningfully set the radius of these circles? Is there a way to draw shapes a certain distance (in km) from a coordinate in a projected CRS? So far I'm defining the radius in terms of degrees of longitude and latitude, but distance would be more useful.
My circles appear to be turning into ellipses after projecting them and mapping them in WGS84. Is there any way to prevent this from happening?
I would be happy to consider alternative approaches. Thanks!
library(sf)
library(ggplot2)
library(maps)
#Two functions to create coordinate quartered circle polygons
#x = long, y = lay, r = radius, theta_rotate = rotation
st_wedge <- function(x,y,r,start,width, theta_rotate){
n <- 20
theta = seq(start+theta_rotate, start+width+theta_rotate, length=n)
xarc = x + r*sin(theta)
yarc = y + r*cos(theta)
xc = c(x, xarc, x)
yc = c(y, yarc, y)
st_polygon(list(cbind(xc,yc)))
}
st_wedges <- function(x, y, r, nsegs, theta_rotatex){
width = (2*pi)/nsegs
starts = (1:nsegs)*width
polys = lapply(starts, function(s){st_wedge(x,y,r,s,width, theta_rotatex)})
#Cast to crs 4326, WGS84
mpoly = st_cast((st_sfc(polys, crs = 4326)), "MULTIPOLYGON")
mpoly
}
#Create quartered sf circle polygon
custom_circle_sf <- st_wedges(x = -76, y = 43, r = .3, nsegs = 4, theta_rotatex = 200) %>%
st_sf() %>%
mutate(group = row_number()) %>% dplyr::select(group, geometry)
#Create New York State sf polygon
ny_map_sf <- map_data("state", region="new york") %>%
st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
group_by(group) %>%
summarise(geometry = st_combine(geometry)) %>%
st_cast("POLYGON")
#Plot results
ggplot() +
geom_sf(data=ny_map_sf,
size = 1,
colour = "blue",
fill = "white") +
geom_sf(data=custom_circle_sf,
size = .1,
aes(fill=group),
colour = "white")
For anyone who is curious about splitting polygons in sf using R, this was how I went about solving this:
#Function to create circle with quadrants. Save desired projection as projected_crs
create_circle <- function(lat_x, long_y, theta_x, buffer_m){
#Create circle with radius buffer_m centered at (lat_x, long_y)
circle_buffer <- st_point(c(lat_x, long_y)) %>% st_sfc(crs = 4326) %>%
st_cast("POINT") %>%
st_transform(projected_crs) %>%
st_buffer(buffer_m)
#Create two orthogonal lines at origin
p1 <- rbind(c(lat_x,long_y - 1), c(lat_x,long_y + 1))
p2 <- rbind(c(lat_x+1,long_y), c(lat_x-1,long_y))
mls <- st_multilinestring(list(p1,p2)) %>% st_sfc(crs = 4326) %>%
st_transform(projected_crs)
#Use orthogonal lines to split circle into 4 quadrants
x1 <- st_split(circle_buffer, mls)
#Convert origin into projected CRS
center_in_crs <- st_point(c(lat_x, long_y)) %>%
st_sfc(crs = 4326) %>%
st_transform(projected_crs)
sp_obj <- x1 %>% st_collection_extract(type="POLYGON") %>%
#Convert to spatial to use sp functions
as_Spatial() %>%
#rotate x degrees
elide(rotate = theta_x + 45, center = center_in_crs[[1]]) %>%
#return to sf
st_as_sf()
Regarding your question 2: "circles appear to be turning into ellipses". If you add to your ggplot the coord_equal() function then the grid will be square, and the ellipses will be shown as circles.

R: Polar map projection of polygon data

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)

Convert latitude/longitude points to map with geom_sf

I have a data set of latitude/longitude points that seek to convert to a simple feature (sf) in R.
My goal is to plot these locations on a US map with polygons retrieved from the urbnmapr library.
Plotting with our a geographic reference, as shown in the code, results in all points being displayed.
When the points are plotted using geom_sf() they end up in South Dakota. It seems the latitude/longitude points are not being converted into the correct coordinate reference system, despite what I think is the correct use of the st_as_sf() function.
What correction needs to be made to this code to show the distribution of wind turbine locations properly on the US map?
# Map the locations of US Wind Turbines
library(urbnmapr)
library(ggplot2)
library(readr)
library(dplyr)
library(sf)
# This file is available from https://eerscmap.usgs.gov/uswtdb/assets/data/uswtdbCSV.zip
turbine <- read_csv("C:\\mydir\\uswtdb_v3_1_20200717.csv")
# Convert lat/long to a sf
turbine_sf <- turbine %>%
st_as_sf(coords = c("xlong", "ylat"), crs=2163)
# obtain state geometries
states_sf <- get_urbn_map(map = "states", sf = TRUE)
# Remove AK, HI from state and PR and GU from turbines as well
states_sf <- states_sf[!(states_sf$state_abbv %in% c("HI","AK")),]
turbine <- turbine [!(turbine$t_state %in% c('HI','AK','PR','GU')),]
# simple plot shows all locations
ggplot(turbine, aes(x=xlong, y=ylat)) + geom_point()
#plot locations over map
ggplot() +
geom_sf(data = turbine_sf) +
geom_sf(data = states_sf, fill = NA, color = "black", size = 0.15, alpha = 0) +
coord_sf(datum = st_crs(2163)) +
labs(fill = "",
title = "",
caption='') +
theme_bw()
Your turbine dataset contains "xlong" and "ylat" in degrees i.e. geographic coordinate system with WGS84 datum (EPSG code: 4326). So, first, make it as crs = 4326 and then use st_transform(turbine_sf, crs=2163) to make same coordinate system with states_sf. You can use the following code
# Map the locations of US Wind Turbines
library(urbnmapr)
library(ggplot2)
library(readr)
library(dplyr)
library(sf)
# This file is available from https://eerscmap.usgs.gov/uswtdb/assets/data/uswtdbCSV.zip
turbine <- read_csv("uswtdb_v3_1_20200717.csv")
# Convert lat/long to a sf
turbine_sf <- turbine %>%
st_as_sf(coords = c("xlong", "ylat"), crs=4326)
turbine_sf_t <- st_transform(turbine_sf, crs=2163)
# obtain state geometries
states_sf <- get_urbn_map(map = "states", sf = TRUE)
st_crs(states_sf)
# Remove AK, HI from state and PR and GU from turbines as well
states_sf <- states_sf[!(states_sf$state_abbv %in% c("HI","AK")),]
turbine <- turbine [!(turbine$t_state %in% c('HI','AK','PR','GU')),]
# simple plot shows all locations
ggplot(turbine, aes(x=xlong, y=ylat)) + geom_point()
#plot locations over map
ggplot() +
geom_sf(data = turbine_sf_t) +
geom_sf(data = states_sf, fill = NA, color = "black", size = 0.15, alpha = 0) +
coord_sf(datum = st_crs(2163)) +
labs(fill = "",
title = "",
caption='') +
theme_bw()
By doing st_as_sf(coords = c("xlong", "ylat"), crs=2163) you're saying that the original long, lat from your turbine table are based on CRS of 2163. I think you want to set them as 4326 which is the long lat under WGS84.
After setting the initial CRS, use st_transform() to transform the CRS of your shape to new CRS, e.g. turbine_sf <- st_transform(turbine_sf, crs=2163)

map with ggplot2 - create mask filling a box excluding a single country

Is it possible to have a layer in ggplot that acts as a mask for a ggmap layer? Here they added a country polygon on top of a ggmap.
What I am looking for is that the country would be a "hole" in a layer (with alpha) covering everything but the country. In a way the inverse of the example above. The code from that answer (with transparency added and updated to use geom_cartogram).
library(mapdata)
library(ggmap)
library(ggplot2)
library(ggalt)
# Get Peru map
Peru <- get_map(location = "Peru", zoom = 5, maptype="satellite")
# This is the layer I wish to put over the top
coast_map <- fortify(map("worldHires", fill = TRUE, plot = FALSE))
# Subset data for Peru
peru.coast <- subset(coast_map, region == "Peru")
# Draw a graphic
ggmap(Peru) +
geom_cartogram(data = peru.coast, map = peru.coast, aes(x = long, y = lat, map_id = region),
fill="white", color="grey", alpha=.1) +
xlim(-86, -68) +
ylim(-20, 0) +
labs(x = "Longitude", y = "Latitude") +
coord_map() +
theme_classic()
Is there a way to fill everything but a polygon in ggplot2?
Is there a way to fill everything but a polygon in ggplot2?
This method may be a bit unorthodox, but anyway:
library(mapdata)
library(ggmap)
library(ggplot2)
library(raster)
ggmap_rast <- function(map){
map_bbox <- attr(map, 'bb')
.extent <- extent(as.numeric(map_bbox[c(2,4,1,3)]))
my_map <- raster(.extent, nrow= nrow(map), ncol = ncol(map))
rgb_cols <- setNames(as.data.frame(t(col2rgb(map))), c('red','green','blue'))
red <- my_map
values(red) <- rgb_cols[['red']]
green <- my_map
values(green) <- rgb_cols[['green']]
blue <- my_map
values(blue) <- rgb_cols[['blue']]
stack(red,green,blue)
}
Peru <- get_map(location = "Peru", zoom = 5, maptype="satellite")
data(wrld_simpl, package = "maptools")
polygonMask <- subset(wrld_simpl, NAME=="Peru")
peru <- ggmap_rast(Peru)
peru_masked <- mask(peru, polygonMask, inverse=T)
peru_masked_df <- data.frame(rasterToPoints(peru_masked))
ggplot(peru_masked_df) +
geom_point(aes(x=x, y=y, col=rgb(layer.1/255, layer.2/255, layer.3/255))) +
scale_color_identity() +
coord_quickmap()
Via this, this, and this questions/answers.
What I am looking for is the surroundings with a transparent fill
layer and Peru with alpha=1
If first thought this is easy. However, then I saw and remembered that geom_polygon does not like polygons with holes very much. Luckily, geom_polypath from the package ggpolypath does. However, it will throw an "Error in grid.Call.graphics(L_path, x$x, x$y, index, switch(x$rule, winding = 1L..." error with ggmaps default panel extend.
So you could do
library(mapdata)
library(ggmap)
library(ggplot2)
library(raster)
library(ggpolypath) ## plot polygons with holes
Peru <- get_map(location = "Peru", zoom = 5, maptype="satellite")
data(wrld_simpl, package = "maptools")
polygonMask <- subset(wrld_simpl, NAME=="Peru")
bb <- unlist(attr(Peru, "bb"))
coords <- cbind(
bb[c(2,2,4,4)],
bb[c(1,3,3,1)])
sp <- SpatialPolygons(
list(Polygons(list(Polygon(coords)), "id")),
proj4string = CRS(proj4string(polygonMask)))
sp_diff <- erase(sp, polygonMask)
sp_diff_df <- fortify(sp_diff)
ggmap(Peru,extent="normal") +
geom_polypath(
aes(long,lat,group=group),
sp_diff_df,
fill="white",
alpha=.7
)

Resources