Find Polygon Intercepts on a Map - r

I'm trying to find the Radii on this map that intercept state borders in R.
Here is my code so far. Thanks to user Gregoire Vincke for providing much of the solution.
library("maps")
library("mapproj")
library("RColorBrewer")
library("mapdata")
library("ggplot2")
library("rgeos")
library("dismo")
library("ggmap")
library("rgdal")
data("stateMapEnv") #US state map
dat <- read.csv("R/longlat.csv",header = T)
map('state',fill = T, col = brewer.pal(9,"Pastel2"))
#draws circles around a point, given lat, long and radius
plotCircle <- function(lonDec, latDec, mile) {
ER <- 3959
angdeg <- seq(1:360)
lat1rad <- latDec*(pi/180)
lon1rad <- lonDec*(pi/180)
angrad <- angdeg*(pi/180)
lat2rad <- asin(sin(lat1rad)*cos(mile/ER) + cos(lat1rad)*sin(mile/ER)*cos(angrad))
lon2rad <- lon1rad + atan2(sin(angrad)*sin(mile/ER)*cos(lat1rad),cos(mile/ER)-sin(lat1rad)*sin(lat2rad))
lat2deg <- lat2rad*(180/pi)
lon2deg <- lon2rad*(180/pi)
polygon(lon2deg,lat2deg,lty = 1 , col = alpha("blue",0.35))
}
point <- mapproject(dat$lng,dat$lat)
points(point, col = alpha("black",0.90), cex = 0.4, pch = 20) #plots points
plotCircle(-71.4868,42.990684,20)
plotCircle(-72.57085,41.707932,12)
...
#this goes on for every point
I want to store the points that intercept state borders in a new data frame, any help would be appreciated!

EDIT: Here's a broad overview of the workflow using the geospatial analyses packages in R (sp, rgdal, rgeos).
Instead of using the maps package and stateMapEnv, you want a polygon shapefile of state boundaries, like one that can be found here:
https://www.census.gov/geo/maps-data/data/cbf/cbf_state.html
You can then load that shapefile in R with readOGR from the rgdal package to get a SpatialPolygons (let's call it state_poly) with one Polygons object per state.
Create a SpatialPoints object from your long/lat coordinates:
pts <- SpatialPoints(dat[, c("lng", "lat")], proj4string = CRS("+proj=longlat"))
At this point your pts and state_poly should be in longitude/latitude coordinates, but to draw circles of a fixed radius around points, you need to convert them to projected coordinates (i.e. in meters). See this question for more details:
Buffer (geo)spatial points in R with gbuffer
Create a vector with the radii of your circles around each point, and use it with gBuffer (from rgeos) and your points layer:
circ <- gBuffer(pts, width = radii, byid = TRUE)
The byid argument means it does it separately for each point, using the different values in radii in the same order as the points.
Convert the state polygons to lines: state_lines <- as(state_poly, "SpatialLines")
Use gIntersects(circ, state_lines, byid = TRUE) .
Because of byid = TRUE, the return value is a matrix with one row per circle in your spgeom1 and one column per state boundaries in spgeom2. Note that if the circle intersect a boundary between two states, it should have two "TRUE" values in that row (one for each state). If it intersects with water or the external perimeter of the US it may have only one "TRUE" value in the row.

Here is the Final Code!
library("maps")
library("mapproj")
library("RColorBrewer")
library("mapdata")
library("ggplot2")
library("rgeos")
library("dismo")
library("ggmap")
library("rgdal")
#import shape file (.shp), make sure all the other files in the zip are included in
#your file location!
state_poly <- readOGR(dsn = 'C:/Users/chopp/Documents/R', layer='cb_2015_us_state_500k')
#data containing lng and lat coordinates with radii
data <- read.csv("R/longlat.csv", header = T)
#create spatial point objects out of your lng and lat data
pts <- SpatialPoints(data[,c("lng","lat")], proj4string = CRS("+proj=longlat"))
#convert spatial points to projected coordinates (points and map lines)
ptsproj <- spTransform(pts, CRS("+init=epsg:3347"))
state_poly_proj<- spTransform(state_poly, CRS("+init=epsg:3347"))
#convert radii units to meters, used in our gBuffer argument later on
radii <- data$rad*1609.344
#create circular polygons with. byid = TRUE will create a circle for each point
circ <- gBuffer(ptsproj, width = radii, byid = TRUE)
#convert state polygons to state lines
state_lines<- as(state_poly_proj, "SpatialLines")
#use gIntersects with byid = TRUE to return a matrix where "TRUE" represents
#crossing state boundaries or water
intdata <- gIntersects(circ, state_lines, byid = TRUE)
#write the matrix out into a csv file
write.csv(intdata,"R/Agents Intercepts 2.csv")

Related

Plot an ellipse between two geographical foci in R

I am trying to find out the geographical area that is equidistant from two points, and to plot this as an ellipse.
I can produce plots for one point easily using st_buffer, and can find numerous R functions that will plot ellipse from a known centroid if I define the axis, but have not been able to find one that will plot an ellipse given two known foci and a defined distance.
The similar question here gets some way towards an answer, but is not readily applicable to geographic situations - Draw an ellipse based on its foci
My code is pretty simple at the moment, and given each coordinate with a 100km radius. However, I would like to find out all the positions that would be reachable by a 200km (or other defined distance) trip between both sites.
library(tidyverse)
library(sf)
#Give Coordinates
citylocations <- tibble::tribble(
~city, ~lon, ~lat,
"London", -0.1276, 51.5072,
"Birmingham", -1.8904, 52.4862,
)
citydflocations <- as.data.frame(citylocations)
#Convert to SF
citysflocations <- sf::st_as_sf(citydflocations, coords = c("lon","lat" ), crs = 4326)
#Convert location file to National Grid Planar
cityBNGsflocations <- citysflocations %>%
st_transform(citysflocations, crs = 27700)
#Produce circles with 100km buffer
dat_circles <- st_buffer(cityBNGsflocations, dist = 100000)
join_circles <- st_union(dat_circles) %>%
st_transform(4326)
plot(join_circles, col = 'lightblue')```
The function below should create buffers of varying distances for each of the two points it is given, finds the intersection the two buffers, unions the intersections, and finally returns a convex hull of those intersections. The output should be a near approximation of an ellipse with the two points as foci.
The straight-line(s) distance from one city to any edge of the polygon and then to the other city should equal the distance given in the function (200,000m in the example below).
It works on the data provided, but is fragile as there's no error checking or warning suppression. Make sure the dist argument is greater than the distance between the two points, and that the points have a crs that can use meters as a distance. (lat/lon might not work)
The example below only uses 20 points for the 'ellipse', but changing the function should be relatively straightforward.
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUE
library(tidyverse)
#Give Coordinates
citylocations <- tibble::tribble(
~city, ~lon, ~lat,
"London", -0.1276, 51.5072,
"Birmingham", -1.8904, 52.4862,
)
citydflocations <- as.data.frame(citylocations)
#Convert to SF
citysflocations <- sf::st_as_sf(citydflocations, coords = c("lon","lat" ), crs = 4326)
#Convert location file to National Grid Planar
cityBNGsflocations <- citysflocations %>%
st_transform(citysflocations, crs = 27700)
#Produce circles with 100km buffer
dat_circles <- st_buffer(cityBNGsflocations, dist = 100000)
join_circles <- st_union(dat_circles) %>%
st_transform(4326)
#plot(join_circles, col = 'lightblue')
### the ellipse function using 20 buffers ####
ellipse_fn <- function(x_sf, y_sf, distance){
#set distance argument to meters, get sequence of distances for buffers
distance = units::set_units(distance, 'm')
dists_1 <- seq(units::set_units(0, 'm'), distance, length.out = 22)
# create empty sf object to place for loop objects in
# purrr would probably be better here
nrows <- 20
df <- st_sf(city = rep(NA, nrows), city.1 = rep(NA, nrows), geometry = st_sfc(lapply(1:nrows, function(x) st_geometrycollection())))
intersections <- for(i in 2:21){
buff_1 <- st_buffer(cityBNGsflocations[1,], dist = dists_1[i])
buff_2 <- st_buffer(cityBNGsflocations[2,], dist = distance - dists_1[i])
intersection <- st_intersection(buff_1, buff_2)
df[i-1,] <- intersection
}
df %>%
st_set_crs(st_crs(x_sf)) %>%
st_union() %>%
st_convex_hull()
}
### end ellipse function ###
# Using the ellipse function with 2 points & 200000m distance
ellipse_sf <- ellipse_fn(cityBNGsflocations[1,], cityBNGsflocations[2,], dist = 200000)
# You'll get lots of warnings here about spatial constance...
ggplot() +
geom_sf(data = ellipse_sf, fill = 'black', alpha = .2) +
geom_sf(data = cityBNGsflocations, color = 'red')
Created on 2022-06-03 by the reprex package (v2.0.1)
mapview plot of the cities & 'ellipse' on a map:

Snapping a point on the raster based on condition

I have a raster and some points. I want to snap the points closest to the raster based on some general conditions.
library(raster)
##create a diagonal matrix
xy = diag(1, 100, 100)
# Turn the matrix into a raster
rast <- raster(xy)
# Give it lat/lon coords
extent(rast) <- c(-180,180,-90,90)
# ... and assign a projection
projection(rast) <- CRS("+proj=longlat +datum=WGS84")
##create two points just for reference
lonlat <- data.frame(x = c(50,130), y = c(75,-50))
coordinates(lonlat)<-~x+y
crs(lonlat)<- CRS("+proj=longlat +datum=WGS84")
plot(rast)
plot(lonlat,add=T)
It results in
Now I want to snap the points(+) on the green diagonal line. Here, I have provided a diagonal matrix to make it easy but it could be of any shape (for instance curved shape like rivers).
I have found some methods which only snaps the closest raster grid to the points.
##snap raster grid closest to point
Idx = sapply(lonlat$x,function(i) which.min(abs(unique(rasterToPoints(rast, spatial = TRUE)#coords[,1])-i)))
Idy = sapply(lonlat$y,function(i) which.min(abs(unique(rasterToPoints(rast, spatial = TRUE)#coords[,2])-i)))
I basically want two things (a) snap the closest point based on some simple condition ( rast == 1 ). (b) snap the points based on some search radius (lets say neighboring some points).

Calculate Centroid WITHIN / INSIDE a SpatialPolygon

In Software like ArcMap one can create centroids for polygons within a polygon. In cases like the one shown below this is necessary.
In R it is possible to calculate centroids of spatial polygons with rgeos::gCentroid(). However there is no way to force the calculation of centroids within the polygon.
library(rgdal)
library(rgeos)
x <- readWKT("POLYGON ((1441727.5096940901130438 6550163.0046194596216083,
1150685.2609429201111197 6669225.7427449300885201,
975398.4520359700545669 6603079.7771196700632572,
866257.6087542800232768 6401334.5819626096636057,
836491.9242229099618271 6106985.0349301798269153,
972091.1537546999752522 5835786.5758665995672345,
1547561.0546945100650191 5782869.8033663900569081,
1408654.5268814601004124 5600968.3978968998417258,
720736.4843787000281736 5663807.0652409195899963,
598366.4479719599476084 6001151.4899297598749399,
654590.5187534400029108 6341803.2128998702391982,
869564.9070355399744585 6784981.1825891500338912,
1451649.4045378800947219 6788288.4808704098686576,
1441727.5096940901130438 6550163.0046194596216083))")
plot(x)
This is the polygon x
gCentroid() creates a centroid which in this specific case is located outside of the polygon. Despite being geometrically correct, some applications require centroids within the polygon, as they can be calculated by ArcMap.
xCent <- gCentroid(x, byid = TRUE)
points(xCent, col = "red", pch = 16)
A desired output (from ArcMap) looks like this:
Is there any possibility to generate centroids like this in R?
EDIT:
After some digging, it turns out that ArcMap picks a random point within the Polygon:
"For an input polygon: the output point will be inside the polygon."
Thus the question has to be: is there a function that creates a point at any random position WITHIN the polygons?
sf solution
With the advent of the sf package, things got a bit easier. Just use:
library(sf)
y <- st_as_sf(x) # only necessary when you don't already have an sf object
st_point_on_surface(y)
It "returns a point guaranteed to be on the (multi)surface."
sp solution
As pointed out in the updates of the Question, it seems that ArcMap is just putting a point at a random location within the polygon. This can be achieved by gPointsOnSurface(..., n = 1, type = 'random') as well.
xCent2 <- gPointOnSurface(x, byid = T)
points(xCent2, col = "blue", pch = 16)
I wrote this function which first finds the centroid and, if it is not on within (i.e. it does not overlap / intersect the polygon), it is substituted by a point on the surface. Furhtermore, it returns a new column which indicates if a point is the real centroid or not.
gCentroidWithin <- function(pol) {
require(rgeos)
pol$.tmpID <- 1:length(pol)
# initially create centroid points with gCentroid
initialCents <- gCentroid(pol, byid = T)
# add data of the polygons to the centroids
centsDF <- SpatialPointsDataFrame(initialCents, pol#data)
centsDF$isCentroid <- TRUE
# check whether the centroids are actually INSIDE their polygon
centsInOwnPoly <- sapply(1:length(pol), function(x) {
gIntersects(pol[x,], centsDF[x, ])
})
if(all(centsInOwnPoly) == TRUE){
return(centsDF)
}
else {
# substitue outside centroids with points INSIDE the polygon
newPoints <- SpatialPointsDataFrame(gPointOnSurface(pol[!centsInOwnPoly, ],
byid = T),
pol#data[!centsInOwnPoly,])
newPoints$isCentroid <- FALSE
centsDF <- rbind(centsDF[centsInOwnPoly,], newPoints)
# order the points like their polygon counterpart based on `.tmpID`
centsDF <- centsDF[order(centsDF$.tmpID),]
# remove `.tmpID` column
centsDF#data <- centsDF#data[, - which(names(centsDF#data) == ".tmpID")]
cat(paste(length(pol), "polygons;", sum(centsInOwnPoly), "actual centroids;",
sum(!centsInOwnPoly), "Points corrected \n"))
return(centsDF)
}

Finding the minimum distance between all points and the polygon boundary

I would like to find the minimum distance between points and polygon boundary (all points lie inside the polygon). If that is possible, how can I extract the values?, so I can find a correlation between numbers of individuals and the distance from the border.
The polygon is on .SHP format and points on X/Y coordinates.
Any missing information please let me know! Your help is greatly appreciated!
unit square polygon:
library(sp)
x = cbind(c(0,1,1,0,0),c(0,0,1,1,0))
pol = SpatialPolygons(list(Polygons(list(Polygon(x)), "ID")))
random points in unit square:
set.seed(131)
pts = SpatialPoints(cbind(runif(10), runif(10)))
plot(pol)
points(pts, col = 'red')
compute distances:
library(rgeos)
gDistance(pts, pol, byid = TRUE) # will be 0, all inside
gDistance(pts, as(pol, "SpatialLines"), byid = TRUE) # dist to line
add to plot:
text(coordinates(pts),
as.character(
round(as.vector(gDistance(pts, as(pol, "SpatialLines"), byid = TRUE)), 3)),
pos = 4)
read your polygon data from a shapefile into R by using readOGR in package rgdal
The spatstat package has a function nncrossthat finds the nearest neighbour between two sets of point or one set of points and a set of segments.
It is relatively easy to load a set of x/y values to create a spatstat point pattern object: if X and Y are two vectors containing your coordinates, you can create a point pattern object with
library(spatstat)
p = ppp(x,y)
You need to convert your shp data to spatstat segment pattern object. To do so, you can load the shp file with commands from maptools and than convert into a spatstat object:
library(maptools)
shp = readShapeSpatial("yourdata.shp") #read shp file
shp = as.psp(shp) # convert to psp object
To calculate your nearest neighbour distance, you have to use nncross
nncross(p,shp)
Follow the steps of #xraynaud (slightly modified):
library(maptools)
shp = readShapeSpatial("yourdata.shp") #read shp file
W = as.owin(shp) # convert to owin object
library(spatstat)
p = ppp(x, y, window = W)
Now p is a point pattern containing the points bounded by the polygon. To compute the distance from each point to the bounding polygon (usually called the window in spatstat terminology):
d = bdist.points(p)
Now d is a vector of distances.

Cut polygons using contour line beneath the polygon layers

I would like to cut a polygon layer, according to the elevation, into two parts (upper and lower part). The polygon might convex or concave, and the position to cut might vary from each other. The contour line has an interval of 5m, which means I might need to generate a contour with much condensed contour lines, e.g, 1m interval. Any idea on how to do it, better in ArcGIS, or in R?
Below is the running example for the Q:
library(sp)
library(raster)
r<-raster(ncol=100,nrow=100)
values(r)<-rep(1:100,100)
plot(r) ### I have no idea why half of the value is negative...
p1<-cbind(c(-100,-90,-50,-100),c(60,70,30,30,60))
p2<-cbind(c(0,50,100,0),c(0,-25,10,0))
p1p<-Polygons(list(Polygon(p1,hole=T)),"p1")
p2p<-Polygons(list(Polygon(p2,hole=T)),"p2")
p<-SpatialPolygons(list(p1p,p2p),1:2)
plot(p,add=T)
segments(-90,80,-90,20) ##where the polygon could be devided
segments(50,20,50,-30) ##
Thanks in advance~
Marco
If I understand correctly, you can use the rgeos package and related Spatial tools in R.
I took the trick to buffer an intersected line and then generate the "difference" polygon from this site:
http://www.chopshopgeo.com/blog/?p=89
Generate example raster, and an overlying polygon.
vdata <- list(x = 1:nrow(volcano), y = 1:ncol(volcano), z = volcano)
## raw polygon data created using image(vdata); xy <- locator()
xy <- structure(list(x = c(43.4965355534823, 41.7658494766076, 36.2591210501883,
25.560334393145, 13.7602020508178, 18.7949251835441, 29.179041644792,
40.6645037913237, 44.2832110429707, 47.272577903027, 47.5872480988224
), y = c(30.0641086410103, 34.1278207016757, 37.6989616034726,
40.900674136118, 32.7732500147872, 27.4781100569505, 22.5523984682652,
22.7986840476995, 24.5226831037393, 29.3252519027075, 33.8815351222414
)), .Names = c("x", "y"))
## close the polygon
coords <- cbind(xy$x, xy$y)
coords <- rbind(coords, coords[1,])
library(sp)
## create a Spatial polygons object
poly <- SpatialPolygons(list(Polygons(list(Polygon(coords, hole = FALSE)), "1")))
## create a contour line that cuts the polygon at height 171
cl <- contourLines(vdata, levels = 171)
## for ContourLines2SLDF
library(maptools)
clines <- ContourLines2SLDF(cl)
Now, intersect the polygon with the line, then buffer the line slightly and difference that again with the polygon to give a multipart poly.
library(rgeos)
lpi <- gIntersection(poly, clines)
blpi <- gBuffer(lpi, width = 0.000001)
dpi <- gDifference(poly, blpi)
Plot the original data, and the polygon halves extracted manually from the Spatial object.
par(mfrow = c(2,1))
image(vdata)
plot(poly, add = TRUE)
plot(SpatialPolygons(list(Polygons(list(dpi#polygons[[1]]#Polygons[[1]]), "1"))),
add = TRUE, col = "lightblue")
image(vdata)
plot(poly, add = TRUE)
cl <- contourLines(vdata, levels = 171)
plot(SpatialPolygons(list(Polygons(list(dpi#polygons[[1]]#Polygons[[2]]), "2"))),
add = TRUE, col = "lightgreen")
That works for this fairly simple case, it might be useful for your scenario.

Resources