create density raster and extract sum by polygon feature - r

I have a polygon (zones) and a set of coordinates (points). I'd like to create a spatial kernal density raster for the entire polygon and extract the sum of the density by zone. Points outside of the polygon should be discarded.
library(raster)
library(tidyverse)
library(sf)
library(spatstat)
library(maptools)
load(url("https://www.dropbox.com/s/iv1s5butsx2v01r/example.RData?dl=1"))
# alternatively, links to gists for each object
# https://gist.github.com/ericpgreen/d80665d22dfa1c05607e75b8d2163b84
# https://gist.github.com/ericpgreen/7f4d3cee3eb5efed5486f7f713306e96
ggplot() +
geom_sf(data = zones) +
geom_sf(data = points) +
theme_minimal()
I tried converting to ppp with {spatstat} and then using density(), but I'm confused by the units in the result. I believe the problem is related to the units of the map, but I'm not sure how to proceed.
Update
Here's the code to reproduce the density map I created:
zones_owin <- as.owin(as_Spatial(zones))
pts <- st_coordinates(points)
p <- ppp(pts[,1], pts[,2], window=zones_owin, unitname=c("metre","metres"))
ds <- density(p)
r <- raster(ds)
plot(r)

Units are difficult when you work directly with geographic coordinates (lon, lat). If possible you should convert to planar coordinates (which is a requirement for spatstat) and proceed from there. The planar coordinates would typically be in units of meters, but I guess it depends on the specific projection and underlying ellipsoid etc. You can see this answer for how to project to planar coordinates with sf and export to spatstat format using maptools. Note: You have to manually choose a sensible projection (you can use http://epsg.io to find one) and you have to project both the polygon and the points.
Once everything is in spatstat format you can use density.ppp to do kernel smoothing. The resulting grid values (object of class im) are intensities of points, i.e., number of points per square unit (e.g. square meter). If you want to aggregate over some region you can use integral.im(..., domain = ...) to get the expected number of points in this region for a point process model with the given intensity.

I'm not sure if this answers all of your question, but should be a good start. Clarify in a comment or in your question should you need a different type of output.
It removes all points that are not inside one of the 'zone' polygons, counts them by zone and plots the zones colored by the number of points that fall within.
library(raster)
library(tidyverse)
library(sf)
#> Linking to GEOS 3.6.2, GDAL 2.2.3, PROJ 4.9.3
library(spatstat)
library(maptools)
#> Checking rgeos availability: TRUE
load(url("https://www.dropbox.com/s/iv1s5butsx2v01r/example.RData?dl=1"))
# alternatively, links to gists for each object
# https://gist.github.com/ericpgreen/d80665d22dfa1c05607e75b8d2163b84
# https://gist.github.com/ericpgreen/7f4d3cee3eb5efed5486f7f713306e96
p1 <- ggplot() +
geom_sf(data = zones) +
geom_sf(data = points) +
theme_minimal()
#Remove points outside of zones
points_inside <- st_intersection(points, zones)
#> although coordinates are longitude/latitude, st_intersection assumes that they are planar
#> Warning: attribute variables are assumed to be spatially constant throughout all
#> geometries
nrow(points)
#> [1] 308
nrow(points_inside)
#> [1] 201
p2 <- ggplot() +
geom_sf(data = zones) +
geom_sf(data = points_inside)
points_per_zone <- st_join(zones, points_inside) %>%
count(LocationID.x)
#> although coordinates are longitude/latitude, st_intersects assumes that they are planar
p3 <- ggplot() +
geom_sf(data = points_per_zone,
aes(fill = n)) +
scale_fill_viridis_c(option = 'C')
points_per_zone
#> Simple feature collection with 4 features and 2 fields
#> geometry type: POLYGON
#> dimension: XY
#> bbox: xmin: 34.0401 ymin: -1.076718 xmax: 34.17818 ymax: -0.9755066
#> epsg (SRID): 4326
#> proj4string: +proj=longlat +ellps=WGS84 +no_defs
#> # A tibble: 4 x 3
#> LocationID.x n geometry
#> * <dbl> <int> <POLYGON [°]>
#> 1 10 129 ((34.08018 -0.9755066, 34.0803 -0.9757393, 34.08046 -0.975…
#> 2 20 19 ((34.05622 -0.9959458, 34.05642 -0.9960835, 34.05665 -0.99…
#> 3 30 29 ((34.12994 -1.026372, 34.12994 -1.026512, 34.12988 -1.0266…
#> 4 40 24 ((34.11962 -1.001829, 34.11956 -1.002018, 34.11966 -1.0020…
cowplot::plot_grid(p1, p2, p3, nrow = 2, ncol = 2)
It seems I underestimated the difficulty of your problem. Is something like the plot below (& underlying data) what you're looking for?
It uses raster with ~50x50 grid, raster::focal with a window of 9x9 using the mean to interpolate the data.

Related

Spatial Points to Polygons query

I have a question regarding converting spatial data in R and bringing it from R into QGIS.
I have a GeoTiff of Antarctic sea ice concentration, downloaded from the link below:
https://seaice.uni-bremen.de/databrowser/#day=13&month=10&year=2022&img=%7B%22image%22%3A%22image-1%22%2C%22product%22%3A%22AMSR%22%2C%22type%22%3A%22visual%22%2C%22region%22%3A%22Antarctic3125%22%7D
I want to extract the contour of the sea ice edge (defined as 15%), and then have this contour in a file type that I can open in QGIS and reproject for use in making other maps. My current understanding is that to do this, I would need to convert the contour to a spatial points df, and then convert that to a spatial polygons df which I would then be able to open as a shapefile in QGIS. However, I think I'm going wrong here as I cannot make the conversion with the below code - any suggestions?
**This is my current workflow:**
library(raster)
library(tidyverse)
library(sp)
library(sf)
#Load in sea ice geotiff
sic <- raster('Environmental_Data/SIC/AMSR2/asi-AMSR2-s3125-20220107-v5.4.tif')/1
plot(sic)
#Make all values over land NA
sic[sic>100] = NA
#Crop to make area smaller (I have a specific area of interest)
sic = crop(sic, extent(sic)*c(0.5,0.5,0,1))
plot(sic)
#Pull out the sea ice edge (15% contour) (this makes it a spatial lines df)
ie = rasterToContour(sic, levels=15)
#Convert to spatial points
ie.pt = as(ie, "SpatialPointsDataFrame") plot(ie.pt, add=T, pch=16, cex=0.4)
#Convert to spatial polygons
ie.pt_poly <-as(ie.pt, "SpatialPolygons")
#Then I get this error:
Error in as(ie.pt, "SpatialPolygons"):
no method or default for coercing “SpatialPointsDataFrame” to “SpatialPolygons”
reworking your process to terra and sf...
library(terra)
library(sf)
sic <- rast('~/Downloads/asi-AMSR2-s3125-20221113-v5.4.tif')
sic[sic>100] = NA
sic2 = crop(sic, ext(sic)*c(0.5,0.5,0,1))
sic2_contour <- terra::contour(sic2, maxcells=100000, filled = TRUE) # plot side effect
sic2_cont <- as.contour(sic2)
sic2_cont_disagg <- disagg(sic2_cont)
y <- sf::st_as_sf(sic2_cont_disagg)
y
Simple feature collection with 6519 features and 1 field
Geometry type: LINESTRING
Dimension: XY
Bounding box: xmin: -1968608 ymin: 206384.6 xmax: 1968608 ymax: 3660462
Projected CRS: WGS 84 / NSIDC Sea Ice Polar Stereographic South
First 10 features:
level geometry
1 10 LINESTRING (-1968608 340765...
2 10 LINESTRING (-1955825 232458...
3 10 LINESTRING (-1968608 259539...
4 10 LINESTRING (-1968608 262189...
5 10 LINESTRING (-1960827 264530...
6 10 LINESTRING (-1968608 265308...
7 10 LINESTRING (-1968608 278293...
8 10 LINESTRING (-1943042 251270...
9 10 LINESTRING (-1943042 275001...
10 10 LINESTRING (-1930259 331948...
unique(y$level)
[1] 10 20 30 40 50 60 70 80 90 100
y10 <- y[which(y$level == 10),]
plot(sic2)
plot(y10, col = 'pink', lwd =3, add = TRUE)
I can't think why one would go to points, except perhaps to then buffer and fill one's contour. But terra::writeRaster(sic2..., and terra::writeVector(y,..., or y10 pull into QGIS and see.
There are pink(s) interior to sic2 as these presumably are holes in sea ice that have the same value as northernmost contour that could perhaps be further removed by testing for within.
I think this is what you are looking for.
library(terra)
r <- rast("asi-AMSR2-s3125-20221113-v5.4.tif")
# crop to the area of interest
e <- ext(-1975000, 1975000, 2e+05, 4350000)
re <- crop(r, e)
# get contour and save to file
v <- as.contour(re, levels=15)
writeVector(v, "contour_lines.shp")
Contours are normally lines (neither points nor polygons). But if you wanted a polygon you could do
x <- ifel(x <15 | x>100, NA, 1)
p <- as.polygons(x)
writeVector(p, "contour_polygons.shp")
Or, more generally, use terra::classify to create regions before using as.polygons.

R intersecting multiple (2+) overlapping polygons

I am having some issues with st_intersection. I am trying to intersect polygons from bus stop buffers in preparation for areal interpolation. Here are the data: Here is the data: https://realtime.commuterpage.com/rtt/public/utility/gtfs.aspx
Here is my code:
ART2019Path <- file.path(GTFS_path, "2019-10_Arlington.zip")
ART2019GTFS <- read_gtfs(ART2019Path)
ART2019StopLoc <- stops_as_sf(ART2019GTFS$stops) ### Make a spatial file for stops
ART2019Buffer <- st_buffer(ART2019StopLoc, dist = 121.92) ### Make buffer with 400ft (121.92m) radius
It creates something that looks like the image below (created using mapview); as you can see, there are multiple overlapping buffers.
I tried intersecting the polygons using the following:
BufferIntersect <- st_intersection(ART2019Buffer, ART2019Buffer)
BufferIntersect <- st_make_valid(BufferIntersect) ### Fix some of the polygons that didn't quite work
But it only intersects two layers of polygons, meaning there is still overlap. How do I make all buffers intersect?
I have looked at similar questions on here like this: Loop to check multiple polygons overlap in r SF package
But there is no answer.
One of the comments suggested the following links:
https://r-spatial.org/r/2017/12/21/geoms.html
https://r-spatial.github.io/sf/reference/geos_binary_ops.html#details-1
But I can't get either to work. Any help would be greatly appreciated.
Edit
Couple of clarifying points in response to some comments.
I am interested in the area of each unique polygon within bus stop buffers as I will be using these polygons in an areal interpolation with census data to estimate population with access to bus stops
400ft walking distance is standard practice for bus stop accessibility
It sounds like you just want the buffer(s), but without having to deal with all of the overlapping sections. It doesn't matter if a person is within 400ft of one bus-stop or three, right?
If so, you can use the st_union function to "blend" the buffers together.
library(tidytransit)
library(sf)
library(mapview)
library(ggplot2)
# s2 true allows buffering in meters, s2 off later speeds things up
sf::sf_use_s2(TRUE)
ART2019Path <- file.path("/your/file/path/")
ART2019GTFS <- read_gtfs(ART2019Path)
ART2019StopLoc <- stops_as_sf(ART2019GTFS$stops) ### Make a spatial file for stops
ART2019Buffer <- st_buffer(ART2019StopLoc, dist = 121.92) ### Make buffer with 400ft (121.92m) radius
# might be needed due to some strange geometries in buffer, and increase speed
sf::sf_use_s2(FALSE)
#> Spherical geometry (s2) switched off
# MULTIPOLYGON sfc object covering only the buffered areas,
# there are no 'overlaps'.
buff_union <- st_union(st_geometry(ART2019Buffer))
#> although coordinates are longitude/latitude, st_union assumes that they are planar
buff_union
#> Geometry set for 1 feature
#> Geometry type: MULTIPOLYGON
#> Dimension: XY
#> Bounding box: xmin: -77.16368 ymin: 38.83828 xmax: -77.04768 ymax: 38.9263
#> Geodetic CRS: WGS 84
#> MULTIPOLYGON (((-77.08604 38.83897, -77.08604 3...
# Non-overlapping buffer & stops
ggplot() +
geom_sf(data = buff_union, fill = 'blue', alpha = .4) +
geom_sf(data = ART2019StopLoc, color = 'black') +
coord_sf(xlim = c(-77.09, -77.07),
ylim = c(38.885, 38.9))
# Overlapping buffer & stops
ggplot() +
geom_sf(data = ART2019Buffer, fill = 'blue', alpha = .4) +
geom_sf(data = ART2019StopLoc, color = 'black') +
coord_sf(xlim = c(-77.09, -77.07),
ylim = c(38.885, 38.9))
# Back to original settings
sf::sf_use_s2(TRUE)
#> Spherical geometry (s2) switched on
Created on 2022-04-18 by the reprex package (v2.0.1)
Something like this works for me, albeit a bit slowly. Here I loop through each stop buffer and run the intersection process on an object containing all other stop buffers excluding that stop buffer.
library(sf)
library(tidyverse)
df<-read.csv("YOUR_PATH/google_transit/stops.txt")
# Read data
ART2019StopLoc <- st_as_sf(df, coords=c('stop_lon', 'stop_lat'))
ART2019StopLoc <- st_set_crs(ART2019StopLoc, value=4326)
# Make buffer
ART2019Buffer <- st_buffer(ART2019StopLoc, dist=121.92)
# Create empty data frame to store results
results <- data.frame()
# Loop through each stop and intersect with other stops
for(i in 1:nrow(ART2019Buffer)) {
# Subset to stop of interest
stop <- ART2019Buffer[i,]
# Subset to all other stops excl. stop of interest
stop_check <- ART2019Buffer[-i,]
# Intersect and make valid
stop_intersect <- st_intersection(stop, stop_check) %>%
st_make_valid()
# Create one intersected polygon
stop_intersect <- st_combine(stop_intersect) %>%
st_as_sf() %>%
mutate(stop_name=stop$stop_name)
# Combine into one results object
results <- rbind(results, stop_intersect)
print(i)
}
ggplot() +
geom_sf(data=ART2019Buffer %>% filter(stop_name %in% results$stop_name),
fill='gray70') +
geom_sf(data=results, aes(fill=stop_name), alpha=0.5)
The plot below shows the results for the first 8 stops. The gray circles are the original stop buffers and the colored buffers show the intersection with adjacent buffers.

Make a vector of coordinates to filter data within a certain area

Rookie R user here and I would greatly appreciate any help you someone could give me.
My project requires me to create a vector boundary box around a city of my choice and then filter a lot of data so I only have the data relative to the area. However, it is several years since I have used R studio and its fair to say I remember little to nothing about the language.
I have initially used
geocode("Hereford, UK")
bbox <-c(Longitude=-2.72,Latitude=52.1)
myMap <- get_map(location = "Hereford, UK",source="google",maptype="roadmap")
I then must create a new tibble which filters out and gives only the relevant data to the area.
I am unsure how to proceed with this and I then must overlay the data onto the map which I have created.
As I only have a centre point of coordinates, is it possible to create a circle with a radius of say 3 miles around the centre of my location so I can then filter this area?
Thank you all for taking the time to read my post. Cheers!
Most spatial work can now be done pretty easily using the sf package.
Example code for a similar problem is below. The comments explain most of what it does.
The difficult part may be in understanding map projections (the crs). Some use units(meters, feet, etc) and others use latitude / longitude. Which one you choose depends on what area of the globe you're working with and what you're trying to accomplish. Most web mapping uses crs 4326, but that does not include an easily usable distance measurement.
The map below shows points outside ~3 miles from Hereford as red, and those inside in dark maroon. The blue point is used as the center for Hereford & the buffer zone.
library(tidyverse)
library(sf)
#> Linking to GEOS 3.6.2, GDAL 2.2.3, PROJ 4.9.3
library(mapview)
set.seed(4)
#hereford approx location, ggmap requires api key
hereford <- data.frame(place = 'hereford', lat = -2.7160, lon = 52.0564) %>%
st_as_sf(coords = c('lat', 'lon')) %>% st_set_crs(4326)
#simulation of data points near-ish hereford
random_points <- data.frame(point_num = 1:20,
lat = runif(20, min = -2.8, max = -2.6),
lon = runif(20, min = 52, max = 52.1)) %>%
st_as_sf(coords = c('lat', 'lon')) %>% st_set_crs(4326) %>%st_transform(27700)
#make a buffer of ~3miles (4800m) around hereford
h_buffer <- hereford %>% st_transform(27700) %>% #change crs to one measured in meters
st_buffer(4800)
#only points inside ~3mi buffer
points_within <- random_points[st_within( random_points, h_buffer, sparse = F), ]
head(points_within)
#> Simple feature collection with 6 features and 1 field
#> geometry type: POINT
#> dimension: XY
#> bbox: xmin: 346243.2 ymin: 239070.3 xmax: 355169.8 ymax: 243011.4
#> CRS: EPSG:27700
#> point_num geometry
#> 1 1 POINT (353293.1 241673.9)
#> 3 3 POINT (349265.8 239397)
#> 4 4 POINT (349039.5 239217.7)
#> 6 6 POINT (348846.1 243011.4)
#> 7 7 POINT (355169.8 239070.3)
#> 10 10 POINT (346243.2 239690.3)
#shown in mapview
mapview(hereford, color = 'blue') +
mapview(random_points, color = 'red', legend = F, col.regions = 'red') +
mapview(h_buffer, legend = F) +
mapview(points_within, color = 'black', legend = F, col.regions = 'black')
Created on 2020-04-12 by the reprex package (v0.3.0)

Why is st_buffer function not creating an R object that correctly displays in mapview?

Trying to get st_buffer function to display a buffer within mapview. Got it to work, but I had to first perform a transform (I doubt this is necessary). Looking for a more straightforward way to do this.
EDIT: To clarify...the buffers (in this case, polygons) I'd like to draw around the points would be a distance (say, kilometers) around the points.
library(sf)
library(mapview)
data("breweries")
test_coords <- st_geometry(breweries[1:2,])
# This code doesn't work. Not sure why.
# buff_test_coords <- st_buffer(test_coords, dist = 10000)
# mapview(test_coords) + mapview(buff_test_coords)
# This code words. Not sure what's special about transforming to 3488
sf_test_coords <- test_coords %>% st_transform(3488)
sf_buff_test_coords <- st_buffer(sf_test_coords, 10000)
sf_buff_test_coords2 <- st_transform(sf_buff_test_coords, 4326)
mapview(test_coords) + mapview(sf_buff_test_coords2)
Well, the warning is pretty clear, buffering doesn't work well for non-projected data.
#> Warning in st_buffer.sfc(test_coords, dist = 2): st_buffer does not correctly
#> buffer longitude/latitude data
#> dist is assumed to be in decimal degrees (arc_degrees).
Your data shows proj4string: "+proj=longlat +datum=WGS84 +no_defs" so you either project it or change the approach. On top of that, you tried to project lonlat (-180,180 degrees) by 10000, meaning 10000 degrees. So that is a non-sense buffer, buffering works on the same units of the projection.
You have here two approaches without projecting:
Buffering by 2 degrees, it works but the buffer is quite strange.
Another option is just to plot two times the same point, but not passing it to POLYGON, that is what the buffer does. Just plot it the second time with a bigger cex.
library(sf)
#> Warning: package 'sf' was built under R version 3.5.3
#> Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3
library(mapview)
#> Warning: package 'mapview' was built under R version 3.5.3
data("breweries")
test_coords <- st_geometry(breweries[1:2,])
st_crs(test_coords)
#> Coordinate Reference System:
#> EPSG: 4326
#> proj4string: "+proj=longlat +datum=WGS84 +no_defs"
buff_test_coords <- st_buffer(test_coords, dist = 2)
#> Warning in st_buffer.sfc(test_coords, dist = 2): st_buffer does not correctly
#> buffer longitude/latitude data
#> dist is assumed to be in decimal degrees (arc_degrees).
#Buffering non-projected coords
mapview(test_coords) + mapview(buff_test_coords)
#Plotting the same points with a bigger cex
mapview(test_coords) + mapview(test_coords, cex=100, col.regions ="red")
Created on 2020-03-28 by the reprex package (v0.3.0)

Calculate longitude/latitude for geographic centroid

I want to do some spatial statistic analysis with the county-level crop yield data in Nebraska for the STAT class. For that I need the longitude and latitude of the geographic centroids of each county. Anybody know how to do it in R? I know it can be done in ArcGIS but I have no access to it now.
You didn't give any details where you got your shapefile from, but I got one from here and you can use gCentroid from rgeos thusly:
library(rgdal)
library(sp)
library(rgeos)
nebraska <- readOGR("CountyBoundsUTM/", "CountyUTM")
gCentroid(nebraska, byid=TRUE)
## SpatialPoints:
## x y
## 0 721768.5 4636738
## 1 430938.8 4524651
## 2 698036.4 4566570
## 3 370970.6 4641340
## ...
## 89 623301.6 4603228
## 90 618883.0 4486931
## 91 439295.3 4582756
## 92 493680.8 4522680
## Coordinate Reference System (CRS) arguments: +proj=utm +zone=14 +datum=NAD83
## +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0
You can also extract centroids of SpatialPolygons* objects with coordinates, though the centroids won't be returned as SpatialPoints as with rgeos::gCentroid.
For example:
library(rgdal)
download.file('http://dds.cr.usgs.gov/pub/data/nationalatlas/countyp020_nt00009.tar.gz',
f <- tempfile()) # ~ 4.5 Mb
untar(f, exdir=tempdir())
counties <- readOGR(tempdir(), 'countyp020')
xy <- coordinates(counties)
head(xy)
# [,1] [,2]
# 0 -153.3905 69.30193
# 1 -156.0582 71.33094
# 2 -155.6695 71.24763
# 3 -155.5164 71.23148
# 4 -155.1846 71.18189
# 5 -155.6126 71.00725
Note that, as pointed out by #Spacedman in the comments, the polygons should be projected to a planar coordinate system first.
Recent versions of the sf package (I think since version 1) use the S2 library from Google for spherical geometry calculations. The advantage is that centroid calculations are not simply planar. The relevant method is st_centroid(). An example for a region with a significant spatial extent:
library(rnaturalearth)
# ne_countries() returns 'sp'-type data by default
nc <- ne_countries(continent = "Asia", returnclass = "sf")
library(sf)
# long-lat data in WGS84
st_crs(nc)
# use st_geometry() to plot only the polygons and not the associated data
plot(st_geometry(nc), axes = T)
plot(st_centroid(st_geometry(nc)), pch = "+", col = "red", add = T)
# 'sf' integrates nicely with 'ggplot2':
library(ggplot2)
ggplot(nc) + geom_sf() +
geom_sf(aes(geometry = st_centroid(st_geometry(nc))), colour = "red")
You can use the get_map() function from the ggplot2 package to extract the US county map data from the maps package to a dataframe. Then you can calculate the mid points of the ranges of the lat/lon columns by county (or whatever method you want to use to define geographic center).

Resources