Trying to find neighbouring buffers in R with poly2nb() - r

I want to get a list of neighbours for each buffer. However the returning nb list is empty.
require(sf)
require(spdep)
us <- tidycensus::county_laea
us <- st_sf(county_laea) %>% st_transform(, crs = 3857)
us$cent <- st_as_sf(st_centroid(us$geometry))
us$buff <- st_as_sf(st_buffer(us$cent, dist = 100000)) # buffer setting is 100km
plot(st_geometry(us$geometry))
plot(st_geometry(us$cent), pch =4, add=T)
plot(st_geometry(us$buff), add=T, border = "red")
nb <- spdep::poly2nb(us$buff, queen = FALSE)
>nb
Neighbour list object:
Number of regions: 3143
Number of nonzero links: 0
Percentage nonzero weights: 0
Average number of links: 0
When I run poly2nb() on us$geometry everything is fine:
us <- tidycensus::county_laea
us <- st_sf(county_laea) %>% st_transform(, crs = 3857)
nb <- spdep::poly2nb(us$geometry, queen = FALSE)
> nb
Neighbour list object:
Number of regions: 3143
Number of nonzero links: 17572
Percentage nonzero weights: 0.1778822
Average number of links: 5.590837
7 regions with no links:
2788 2836 2995 3135 3140 3141 3143

Since you are running a rook (not queen) style neighborhood list on a bunch of circular buffers getting an empty list result is expected behaviour.
This is what your us$buff object looks like when zoomed in:
Now think again about the definition of rook style neighborhood: two polygons are neighbors if & when they share a boundary consisting of more than one point (one point would be sufficient for queen). When in doubt I always think of Colorado and Arizona - they are queen type neighbors, but not rook type ones.
Given that all your buffer objects are circles they can touch their neighbor at most in a single point. Overlap does not make a boundary, and touching in a single point is ruled out by the rook settings.
On the other hand when you look at the original counties / the us$geometry object you will see a plenty of touching lines, and few rare occasions of touching points.
Which is why the queen vs. rook settings rarely makes a noticeable difference for organically grown admin areas, but a big one for grid based ones.

Related

Create buffer from centroid to 20 m from edges in polyon R

I have a shapefile that consist of sea and river polygons within a state boundary (cropped and masked from landcover map (raster) and state boundaries (polygon shapefile)). Within a state boundary, I have multiple polygons (in my case over 1500 different polygons) and I would like to extract the area from the edges and 20 m inward (like an inner buffer). But for my case, all my polygons aren't perfectly shaped, some are rivers, some are just squares (10*10 m from rasterfile) and some are big lakes. My problem is how to create this "inner buffer" for polygons since all polygons, or even not all parts of polygon need to have the buffer (since they are smaller than 40 m, buffer 20m on each side)).
Let me show you my code and how far I have come.
poly <- jvk_18[53,]
cropped <- crop(mark_data, poly, snap = "near")
masked <- mask(cropped, poly)
sjo <- (masked == 61)
sjo <- clump(sjo, directions = 8, gaps = T)
So here is just the extraction, cropping, masking and clumping sea and rivers within a state boundary.
Further I have transformed my data to MULTIPOLYGON
test <- st_as_stars(sjo)
test <- st_as_sf(test, merge = TRUE)
test <- st_cast(test, "MULTIPOLYGON")
After this, I found the st_centroid function to detect the middle point for the polygon. Here my next question is if it is possible to create the buffer from the centroid to 20 m from the edges? Is this possible, and in that case, how?
pol <- test[904, ]
cent <- st_centroid(pol)
Lastly, as mentioned at the beginning, I would like to remove this "inner part", to in the end only get the 20 m from edges and inward.
Instead of working from the center out, couldn't you work from the edges in, by as you said using an inner buffer?
It would be easier to help you with a reproducible example, but given an sf object poly containing your polygons, I would do something like:
core <- st_buffer(poly, -20) %>% st_union() # this will shrink your edges by your desired amount, 20m (and union to tidy up)
diff <- st_difference(poly, core) # difference will leave you with the 20 m ring, removing the core
Of course that will make small polygons disappear... you could probably set a conditional buffer size, but please post an example if you want help with it!

Intersection of polygons in R using sf

I want to assess the degree of spatial proximity of each point to other equivalent points by looking at the number of others within 400m (5 minute walk).
I have some points on a map.
I can draw a simple 400 m buffer around them.
I want to determine which buffers overlap and then count the number of overlaps.
This number of overlaps should relate back to the original point so I can see which point has the highest number of overlaps and therefore if I were to walk 400 m from that point I could determine how many other points I could get to.
I've asked this question in GIS overflow, but I'm not sure it's going to get answered for ArcGIS and I think I'd prefer to do the work in R.
This is what I'm aiming for
https://www.newham.gov.uk/Documents/Environment%20and%20planning/EB01.%20Evidence%20Base%20-%20Cumulative%20Impact%20V2.pdf
To simplify here's some code
# load packages
library(easypackages)
needed<-c("sf","raster","dplyr","spData","rgdal",
"tmap","leaflet","mapview","tmaptools","wesanderson","DataExplorer","readxl",
"sp" ,"rgisws","viridis","ggthemes","scales","tidyverse","lubridate","phecharts","stringr")
easypackages::libraries(needed)
## read in csv data; first column is assumed to be Easting and second Northing
polls<-st_as_sf(read.csv(url("https://www.caerphilly.gov.uk/CaerphillyDocs/FOI/Datasets_polling_stations_csv.aspx")),
coords = c("Easting","Northing"),crs = 27700)
polls_buffer_400<-st_buffer(plls,400)
polls_intersection<-st_intersection(x=polls_buffer_400,y=polls_buffer_400)
plot(polls_intersection$geometry)
That should show the overlapping buffers around the polling stations.
What I'd like to do is count the number of overlaps which is done here:
polls_intersection_grouped<-polls_intersection%>%group_by(Ballot.Box.Polling.Station)%>%count()
And this is the bit I'm not sure about, to get to the output I want (which will show "Hotspots" of polling stations in this case) how do I colour things? How can I :
asess the degree of spatial proximity of each point to other equivalent points by looking at the number of others within 400m (5 minute walk).
It's probably terribly bad form but here's my original GIS question
https://gis.stackexchange.com/questions/328577/buffer-analysis-of-points-counting-intersects-of-resulting-polygons
Edit:
this gives the intersections different colours which is great.
plot(polls_intersection$geometry,col = sf.colors(categorical = TRUE, alpha = .5))
summary(lengths(st_intersects(polls_intersection)))
What am I colouring here? I mean it looks nice but I really don't know what I'm doing.
How can I : asess the degree of spatial proximity of each point to other equivalent points by looking at the number of others within 400m (5 minute walk).
Here is how to add a column to your initial sfc of pollings stations that tells you how many polling stations are within 400m of each feature in that sfc.
Note that the minimum value is 1 because a polling station is always within 400m of itself.
# n_neighbors shows how many polling stations are within 400m
polls %>%
mutate(n_neighbors = lengths(st_is_within_distance(polls, dist = 400)))
Similarly, for your sfc collection of intersecting polygons, you could add a column that counts the number of buffer polygons that contain each intersection polygon:
polls_intersection %>%
mutate(n_overlaps = lengths(st_within(geometry, polls_buffer_400)))
And this is the bit I'm not sure about, to get to the output I want (which will show "Hotspots" of polling stations in this case) how do I colour things?
If you want to plot these things I highly recommend using ggplot2. It makes it very clear how you associate an attribute like colour with a specific variable.
For example, here is an example mapping the alpha (transparency) of each polygon to a scaled version of the n_overlaps column:
library(ggplot2)
polls_intersection %>%
mutate(n_overlaps = lengths(st_covered_by(geometry, polls_buffer_400))) %>%
ggplot() +
geom_sf(aes(alpha = 0.2*n_overlaps), fill = "red")
Lastly, there should be a better way to generate your intersecting polygons that already counts overlaps. This is built in to the st_intersection function for finding intersections of sfc objects with themselves.
However, your data in particular generates an error when you try to do this:
st_intersection(polls_buffer_400)
# > Error in CPL_nary_intersection(x) :
#> Evaluation error: TopologyException: side location conflict at 315321.69159061194 199694.6971799387.
I don't know what a "side location conflict" is. Maybe #edzer could help with that. However, most subsets of your data do not contain that conflict. For example:
# this version adds an n.overlaps column automatically:
st_intersection(polls_buffer_400[1:10,]) %>%
ggplot() + geom_sf(aes(alpha = 0.2*n.overlaps), fill = "red")

How to calculate geographic distance between two points along a line in R?

Inputs
I have two shapefiles that I Import into R, so that I end up with.
A spatiallinesdataframe containing bus routes.
A spatialpointsdataframe containing bus stops.
Plotting a given route with its stops looks like this.
Sample Data
This link includes two shapefiles to download as a zip with a sample two routes.
Target
My aim is to calculate the geographic distance in meters between every pair of stops: Stop 1 to Stop 2, Stop 2 to Stop 3, etc. across the length of the underlying bus route.
Most methods I found calculate the euclidean distance, or as 'the crow flies'; which will not work here.
This post mentions the PBSmapping which has a calcLength function that does a great job calculating the total distance of the route, but I can't find a way to match it to the stop pairs situation, nor can I find a way to actually subset the shapefile by its attributes.
The riverdist package is equally interesting, but highly optimized for rivers that I can't find a way to apply it.
Try gProject from the rgeos package:
library("rgdal")
library("rgeos")
# read shapefile and transfrom to UTM zone 36N (distances in m)
route <- spTransform(readOGR(".", "Trips"), CRS("+init=epsg:32636"))
stops <- spTransform(readOGR(".", "Stops"), CRS("+init=epsg:32636"))
l <- subset(route, route_id==1137)
p <- subset(stops, grepl("^1137_", UID))
plot(l, axes=TRUE, col="orange")
plot(p, add=TRUE, pch=19, cex=0.1)
text(p)
# distance along route
d <- sort(gProject(l, p))
d
# [1] 0 3051 3057 7221 10379 15657 20326 20326 22141 24262
# distance between stops
diff(d)
#[1] 3050.9166 5.9720 4164.2480 3157.7702 5278.5812 4668.1810 0.5878
#[8] 1814.9612 2120.8470

R code that evaluates line-of-sight (LOS) between two (lat, lon) points

I'm having trouble figuring out how to calculate line-of-sight (LOS) between two (lat, lon) points, within R code. Any advice on how to approach this problem would be appreciated. I would like to use the R package - raster - for reading in the terrain elevation data. It seems the spgrass package could be leveraged (based on http://grass.osgeo.org/grass70/manuals/r.viewshed.html) but I wanted to avoid loading up a GIS. Thanks.
If you just want to know if point A can see point B then sample a large number of elevations from the line joining A to B to form a terrain profile and then see if the straight line from A to B intersects the polygon formed by that profile. If it doesn't, then A can see B. Coding that is fairly trivial. Conversely you could sample a number of points along the straight line from A to B and see if any of them have an elevation below the terrain elevation.
If you have a large number of points to compute, or if your raster is very detailed, or if you want to compute the entire area visible from a point, then that might take a while to run.
Also, unless your data is over a large part of the earth, convert to a regular metric grid (eg a UTM zone) and assume a flat earth.
I don't know of any existing package having this functionality, but using GRASS really isn't that much of a hassle.
Here's some code that uses raster and plyr:
cansee <- function(r, xy1, xy2, h1=0, h2=0){
### can xy1 see xy2 on DEM r?
### r is a DEM in same x,y, z units
### xy1 and xy2 are 2-length vectors of x,y coords
### h1 and h2 are extra height offsets
### (eg top of mast, observer on a ladder etc)
xyz = rasterprofile(r, xy1, xy2)
np = nrow(xyz)-1
h1 = xyz$z[1] + h1
h2 = xyz$z[np] + h2
hpath = h1 + (0:np)*(h2-h1)/np
return(!any(hpath < xyz$z))
}
viewTo <- function(r, xy, xy2, h1=0, h2=0, progress="none"){
## xy2 is a matrix of x,y coords (not a data frame)
require(plyr)
aaply(xy2, 1, function(d){cansee(r,xy,d,h1,h2)}, .progress=progress)
}
rasterprofile <- function(r, xy1, xy2){
### sample a raster along a straight line between two points
### try to match the sampling size to the raster resolution
dx = sqrt( (xy1[1]-xy2[1])^2 + (xy1[2]-xy2[2])^2 )
nsteps = 1 + round(dx/ min(res(r)))
xc = xy1[1] + (0:nsteps) * (xy2[1]-xy1[1])/nsteps
yc = xy1[2] + (0:nsteps) * (xy2[2]-xy1[2])/nsteps
data.frame(x=xc, y=yc, z=r[cellFromXY(r,cbind(xc,yc))])
}
Hopefully fairly self-explanatory but maybe needs some real documentation. I produced this with it:
which is a map of the points where a 50m high person can see a 2m high tower at the red dot. Yes, I got those numbers wrong when I ran it. It took about 20 mins to run on my 4 year old PC. I suspect GRASS could do this almost instantaneously and more correctly too.

Testing if geometries have at least one boundary point in common regardless of interior points (not like `gTouches`)

the gTouches function in the rgeos package tests whether "geometries have at least one boundary point in common, but no interior points". I am looking for a way to test whether "geometries have at least one boundary point in common" without the criteria related to interior points.
Here is the basic setup: I have two shapefiles that are mostly embedded in each other. I want to find the polygons in the file with the smaller areas that are at the border of the larger areas. Here is a graph to describe what I am trying to do:
plot(map2, col=NA, border='black', lwd=0.4)
plot(map1, col=NA, border='#666666', lwd=0.2, add=TRUE)
The figure shows census blocks in Staten Island, NY. The green highlighting in one of the larger areas illustrates the blocks I want to identify. Only those that share or cross a border of the larger areas (thick lines). Not the blocks that are in the middle of the larger areas. I tried to do this with with gTouches(map2,map1, byid=TRUE) and other function in the rgeos package but without success. gTouches only returns FALSE probably because the criteria is that "geometries have at least one boundary point in common, but no interior points". Basically, I am looking for a function that tests whether "geometries have at least one boundary point in common" regardless of the interior.
A follow-up question is whether I can get the length of the mutual border?
Data: You can download the two maps here and here. Both are rds files so you can open them like this:
library('rgdal')
library('rgeos')
library('sp')
map1 = readRDS('map1.rds')
map2 = readRDS('map2.rds')
You can use a combo of gIntersects() (to find all little polygons that intersect any part of the school district) and gContainsProperly() (to find all little polygons that are fully contained within and not intersecting the boundary of the school district). Then simply combine the two resulting logical matrices to identify the polygons you're after.
## Identify polygons that intersect but aren't fully contained within the
## school district whose polygon is given by SD = map2[13,]
SD <- map2[13,]
ii <- gIntersects(SD, map1, byid=TRUE) &
!gContainsProperly(SD, map1, byid=TRUE)
ii <- apply(ii, 1, any) ## Handy construct if both layers contain >1 polygon
## Plot that area, to show that results are correct
plot(SD, col=NA, border='black') ## Establish plotted area
plot(map1, col=NA, border='#666666', lwd=0.2, add=TRUE)
plot(map1[ii,], col="lightgreen", add=TRUE)
plot(SD, col=NA, border='black', lwd=2, add=TRUE) ## Put SD boundary on top
EDIT :
That's not quite right, however. As can be seen in the map above, many small polygons along the SW and SE interiors of the school district which should have been identified have not been. Outcomes like this occur pretty frequently with rgeos operations, and arise from tiny misregistrations of the pair of layers (or of their intermediate representations by the GEOS engine).
The solution is to use gBuffer() to buffer out one of the layers by a small amount before performing the topological queries. Here, the coordinates are in meters, and a bit of trial and error showed that a 20-meter buffer turns out to be mostly sufficient to fix the problem:
## Expand every polygon in map1 by a 20-meter wide buffer
map1_buff <- gBuffer(map1, byid=TRUE, width=20)
## and then use the buffered version of map1 in the topological queries
ii <- gIntersects(SD, map1_buff, byid=TRUE) &
!gContainsProperly(SD, map1_buff, byid=TRUE)
ii <- apply(ii, 1, any) ## Handy construct if both layers contain >1 polygon
## Plot that area, to show that results are correct
plot(SD, col=NA, border='black') ## Establish plotted area
plot(map1, col=NA, border='#666666', lwd=0.2, add=TRUE)
plot(map1[ii,], col="lightgreen", add=TRUE)
plot(SD, col=NA, border='black', lwd=2, add=TRUE)
This still misses a couple of polygons along the coast, but at some point a complete solution may have to involve getting a pair of maps that match up better in their level of detail. If the buffer size is made much larger, this analysis will start to produce false positives, picking up, for example, a few of the truly interior polygons in the NW corner of the school district.

Resources