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)
Related
In my example, I have:
# Packages
library(sf)
library(ggplot2)
# Create some points
set.seed(1)
df <- data.frame(
gr = c(rep("a",5),rep("b",5)),
x = rnorm(10),
y = rnorm(10)
)
df <- st_as_sf(df,coords = c("x","y"),remove = F, crs = 4326)
df.laea = st_transform(
df,
crs = "+proj=laea +x_0=4600000 +y_0=4600000 +lon_0=0.13 +lat_0=0.24 +datum=WGS84 +units=m"
)
# Create a countour of the area
ch <- st_convex_hull(st_union(df.laea))
ggplot() +
geom_sf(data = ch, fill = "white", color = "black") +
geom_sf(data = df.laea,color = "black")
Now, I'd like to create 10 random points but the conditions are that this points must be inside the ch boundaries and a minimum distance of 10 meters of each df.laea points that exist inside this ch area.
Please, any help with it?
I think the only tricky thing here is that a simple st_difference() of your polygon and the buffered points will return ten polygons, each with one of the points removed. Thus you have to either use a for loop or reduce() to remove one buffered point after the other from the polygon. To use reduce() you have to transform the vector to a proper list of sf instead of an sfc vector. This is what I did below.
# Packages
library(sf)
library(ggplot2)
library(purrr)
ch_minus <- df.laea$geometry |>
st_buffer(10000) |>
{\(vec) map(seq_along(vec), \(x) vec[x])}() |> # Transform buffered points to reducible list
reduce(.init = ch, st_difference)
sampled_points <- st_sample(ch_minus, 10)
ch_minus |>
ggplot() +
geom_sf() +
geom_sf(data = sampled_points)
You can buffer the points by the distance you'd like, then intersect those polygons with the ch polygon. From there, use st_sample and the associated arguments to get the points you want.
Example code:
## buffer df.laea 10m
laea_buff <- st_buffer(df.laea, dist = 10000) #changed dist to 10km to make it noticable in plot
# area to sample from:
sample_area <- st_intersection(ch, laea_buff)
# sample above area, all within 10km of a point and inside the `ch` polygon
points <- st_sample(sample_area, size = 10)
#plotting:
ggplot() +
geom_sf(data = points, color = 'red') +
geom_sf(data = laea_buff, color = 'black', fill = NA) +
geom_sf(data = ch, color = 'black', fill = NA) +
geom_sf(data = sample_area, color = 'pink', fill = NA) +
geom_sf(data = df.laea, color = 'black', size = .5)
Created on 2023-02-14 by the reprex package (v2.0.1)
As a comment on the nice answer by shs: it is possible to first use a sf::st_combine() call on the df.laea object & merge the 10 points to a single multipoint geometry.
This, when buffered, will work as an input for the necessary sf::st_difference() call to form a sampling area with holes, removing the need for a for cycle / map & reduce call.
# Packages
library(sf)
library(ggplot2)
# Create some points
set.seed(1)
df <- data.frame(
gr = c(rep("a",5),rep("b",5)),
x = rnorm(10),
y = rnorm(10)
)
df <- st_as_sf(df,coords = c("x","y"),remove = F, crs = 4326)
df.laea = st_transform(
df,
crs = "+proj=laea +x_0=4600000 +y_0=4600000 +lon_0=0.13 +lat_0=0.24 +datum=WGS84 +units=m"
)
# merge 10 points to 1 multipoing
mod_laea <- df.laea %>%
st_combine()
# sampling area = difference between hull and buffered points
sampling_area <- mod_laea %>%
st_convex_hull() %>%
st_difference(st_buffer(mod_laea, 10000))
# sample over sampling area
sampled_points <- st_sample(sampling_area, 10)
# a visual overview
ggplot() +
geom_sf(data = sampling_area, fill = "white", color = "black") +
geom_sf(data = df.laea, color = "black") +
geom_sf(data = sampled_points, color = "red", pch = 4)
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
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)
I need to add labels to polygons and I normally use the centroid, however the centroid does not fall inside the polygon. I found this question Calculate Centroid WITHIN / INSIDE a SpatialPolygon but I'm using the sf package.
Below is a toy data
rm(list = ls(all = TRUE)) #start with empty workspace
library(sf)
library(tidyverse)
library(ggrepel)
pol <- st_polygon(list(rbind(c(144, 655),c(115, 666)
,c(97, 660),c(86, 640)
,c(83, 610),c(97, 583)
,c(154, 578),c(140, 560)
,c(72, 566),c(59, 600)
,c(65, 634),c(86, 678)
,c(145, 678),c(144, 655)))) %>%
st_sfc()
a = data.frame(NAME = "A")
st_geometry(a) = pol
a <- a %>%
mutate(lon = map_dbl(geometry, ~st_centroid(.x)[[1]]),
lat = map_dbl(geometry, ~st_centroid(.x)[[2]]))
ggplot() +
geom_sf(data = a, fill = "orange") +
geom_label_repel(data = a, aes(x = lon, y = lat, label = NAME))
which results in the following
The simple answer is to replace st_centroid with st_point_on_surface. This won't return the true centroid in cases where the centroid is inside the polygon.
a2 <- a %>%
mutate(lon = map_dbl(geometry, ~st_point_on_surface(.x)[[1]]),
lat = map_dbl(geometry, ~st_point_on_surface(.x)[[2]]))
ggplot() +
ggplot2::geom_sf(data = a2, fill = "orange") +
geom_label_repel(data = a2, aes(x = lon, y = lat, label = NAME))
Alternatively
If the polygon has a centroid that is inside the polygon, use that, otherwise, find a point within the polygon.
st_centroid_within_poly <- function (poly) {
# check if centroid is in polygon
centroid <- poly %>% st_centroid()
in_poly <- st_within(centroid, poly, sparse = F)[[1]]
# if it is, return that centroid
if (in_poly) return(centroid)
# if not, calculate a point on the surface and return that
centroid_in_poly <- st_point_on_surface(poly)
return(centroid_in_poly)
}
a3 <- a %>%
mutate(lon = map_dbl(geometry, ~st_centroid_within_poly(.x)[[1]]),
lat = map_dbl(geometry, ~st_centroid_within_poly(.x)[[2]]))
ggplot() +
ggplot2::geom_sf(data = a3, fill = "orange") +
geom_label_repel(data = a3, aes(x = lon, y = lat, label = NAME))
The function above st_centroid_within_polygon is adapted from the question you reference for the sf package. A more thorough review of how st_point_on_surface works can be found here.
Expanding on Mitch's answer because the st_centroid_within_poly function provided above only works on single polygons.
To use on multiple polygons, use:
st_centroid_within_poly <- function (poly) {
# check if centroid is in polygon
ctrd <- st_centroid(poly, of_largest_polygon = TRUE)
in_poly <- diag(st_within(ctrd, poly, sparse = F))
# replace geometries that are not within polygon with st_point_on_surface()
st_geometry(ctrd[!in_poly,]) <- st_geometry(st_point_on_surface(poly[!in_poly,]))
ctrd
}
I've been trying to plot a buffer around a point on a map but when I do the buffer doesn't appear in the right place like this.
Faulty R Map
The correct location is in California.
Here's my code:
library(tigris)
library(sf)
library(tidyverse)
projection <- 102003
options(tigris_use_cache = TRUE)
county_polys <- counties(class = 'sf') %>%
filter(STATEFP %in% c('06','41','53','04','16','32','49')) %>%
st_transform(projection)
centroids <- county_polys %>%
as_tibble %>% select(INTPTLON,INTPTLAT) %>%
mutate(
INTPTLON = as.double(INTPTLON),
INTPTLAT = as.double(INTPTLAT)) %>%
st_as_sf(coords = c('INTPTLON','INTPTLAT'), crs = projection)
pt <- centroids[2,]
pt_buffer <- st_buffer(pt,150000)
ggplot() + geom_sf(data = county_polys) + geom_sf(data = pt_buffer,color = 'red')
We can use the st_centroid function to get the centroid to avoid errors. There is no need to convert the sf object to other classes.
# This is the only thing I changed from your original code
# Get the centroid by st_centroid
centroids <- county_polys %>% st_centroid()
pt <- centroids[2,]
pt_buffer <- st_buffer(pt,150000)
ggplot() + geom_sf(data = county_polys) + geom_sf(data = pt_buffer,color = 'red')