Cut polygons using contour line beneath the polygon layers - r

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.

Related

How to obtain hexagonal type sample from st_sample (R package sf)?

I want to create some sample points from an area. The points have to give an impression of density. I want them not to be random, to avoid people thinking they are "real" observations. I want them to be hexagonal distributed across the area. How to get such a sample? st_sample with type = "hexagonal" does not do the trick.
A reproducible example:
library(sf)
nc <- st_read(system.file("shape/nc.shp", package="sf"))
# this works:
nc_samples_random <- st_sample(nc[1,], 100, type = "random")
# this does not:
nc_samples_hexagonal <- st_sample(nc[1,], 100, type = "hexagonal")
The last line of code gives this error message:
Error in seq_len(nrow(xy)) : argument must be coercible to non-negative integer
Any help is much appreciated!
EDITED: See previous answer on the bottom
I think there is a bug on st_sample source code. For unprojected shapes (i.e. EPSG:4326) the area is computed in meters whereas the bbox limits are taken as longitude and latitude, which gives the exception described in your question.
As long as you are fine projecting your shape you can achieve your goal. A point on that, it seems that there is some degree of randomness on st_sample, so if you need an exact number of points you can play with the seed to get the right number.
library(sf)
library(units)
nc <- st_read(system.file("shape/nc.shp", package = "sf"))
# Project shape
nc_3857 = st_transform(nc[1, ], 3857)
#Reduce a little bit via negative buffer to avoid dots on the edge
nc_3857_red = st_buffer(nc_3857, dist = set_units(-2, "km"))
#Seed and sample
set.seed(2421)
nc_samples_hexagonal <-
st_sample(nc_3857_red, 100, type = "hexagonal")
nc_unproj = st_transform(nc_3857, 4326)
nc_samples_hexagonal_unproj = st_transform(nc_samples_hexagonal, 4326)
plot(st_geometry(nc_unproj))
plot(st_geometry(nc_samples_hexagonal_unproj), add = T)
title(main = paste("N Dots Grid =", length(nc_samples_hexagonal)))
PREVIOUS ANSWER W/ ALTERNATIVE APPROACH
Alternative approach for sampling non-random hexagonal points by using st_make_grid:
library(sf)
nc <- st_read(system.file("shape/nc.shp", package = "sf"))
# Hexagonal grid
nc_samples_hexagonal = st_make_grid(nc[1,],
what = "corners",
square = F,
n = 20)
# Extra: Shrink original shape to 95% to erase dots close to the edge
polys = st_geometry(st_cast(nc[1,] , "POLYGON"))
cntrd = st_geometry(st_centroid(polys))
polyred = (polys - cntrd) * 0.95 + cntrd
st_crs(polyred) <- st_crs(nc[1,])
nc_samples_hexagonal = nc_samples_hexagonal[st_contains(polyred, nc_samples_hexagonal, sparse = F)]
plot(st_geometry(nc[1,]))
plot(st_geometry(nc_samples_hexagonal) , add = T)
Density can be adjusted either by the cellsize or the n paramater, in the reprex n=20.

Rasterizing coordinates for an irregular polygon changes original shape

I am trying to smoothen the edges of an irregular polygon in R, namely to turn its sharp corners into round edges. I am trying to do this using smoothr::smooth, but this function operates on objects from packages sf or sp while all I have is a set of coordinates. Somehow, the result of turning my data.frame into a SpatialPolygonsDataFrame object (an object class from package sp) is a rectangle whose limits are the extreme limits of the original polygon. Does anyone know how to turn my set of coordinates in an object of a class compatible with smoothr::smooth while maintaining the original polygon shape? Here is what I did, partially following instructions at this page:
rm(list=ls()) # my compulsive habit of making sure R's memory is a clean slate
# Example dataset:
dd <- data.frame(
Lon = c(18.95379, 18.82409, 18.58987, 18.80541, 18.92427, 19.00264),
Lat = c(-32.42492, -32.32498, -31.89642, -31.73606, -32.16217, -32.37052)
)
plot(0,0,
xlim=c(18.5,19.1), ylim=c(-32.5,-31.6),
xlab="Longitude", ylab="Latitude"
)
polygon(dd[,"Lon"],dd[,"Lat"], border="red")
# To make it smooth I plan on using
library(smoothr)
# But smoothr:: smooth works on objects from packages sf or sp so I need to convert dd.
#convert to spatial points
library(sp)
coordinates(dd) = ~Lon + Lat
# convert to raster
library(raster)
rr <- raster::raster(dd)
#convert raster to polygons
sp = rasterToPolygons(rr, dissolve = T)
map(sp, add=T, col="green", fill=F)
# somehow my irregular polygon turned into a rectangle.
sps <- smooth(sp, method = "ksmooth", smoothness=5)
# this works, but of course is only rounding the corners of sp
map(sps, add=T, col="blue", fill=F)
In red is my original polygon from the data.frame dd, in green is object sp, in blue is the smooth version of sp, sps. Function smooth does the job, the problem is somewhere in the conversion of dd into an sp-compatible object. I suspect the problem is caused by raster() but I am not sure why or of how to fix it.
Many thanks in advance.
Here I've used sf because I personally find that much easier:
library(sf)
library(smoothr)
# Example dataset:
dd <- data.frame(
Lon = c(18.95379, 18.82409, 18.58987, 18.80541, 18.92427, 19.00264),
Lat = c(-32.42492, -32.32498, -31.89642, -31.73606, -32.16217, -32.37052)
)
# cast to polygon, use multipoint first though.
polygon <- as.matrix(dd) %>%
sf::st_multipoint() %>%
sf::st_cast("POLYGON")
# smooth polygon
polygon_smoothed <- smoothr::smooth(polygon, method = "ksmooth", smoothness = 0.5)
# plot to check
plot(polygon, col = "red")
plot(polygon_smoothed, col = "blue", add = T)
I found another solution here: https://rstudio-pubs-static.s3.amazonaws.com/202536_7a122ff56e9f4062b6b012d9921afd80.html
# Example dataset:
dd <- data.frame(
Lon = c(18.95379, 18.82409, 18.58987, 18.80541, 18.92427, 19.00264),
Lat = c(-32.42492, -32.32498, -31.89642, -31.73606, -32.16217, -32.37052)
)
plot(0,0,
xlim=c(18.5,19.1), ylim=c(-32.5,-31.6),
xlab="Longitude", ylab="Latitude"
)
polygon(dd[,"Lon"],dd[,"Lat"], border="red")
library(sp)
p = Polygon(dd)
p2 = Polygons(list(p),1) # I believe this aggregates polygons, so in this case it doesn't do anything.
sp = SpatialPolygons(list(p2))
sps <- smooth(sp, method = "ksmooth", smoothness=0.7)
plot(sps, add=T, border="blue")

Find Polygon Intercepts on a Map

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")

How to get contour lines around the grids in R-raster?

Having a raster in R, how can I draw a contour line around the grids (not joining the centers or anything else, really following the boundaries of the grids) having some value (or identified by some mask)?
The following example shows how to get the contour lines around areas with value 0.6: how to do the same but with the lines following the borders of the grids?
The function should return an object to add to a plot (as a SpatialLinesDataFrame for rasterToContour), and adjacent grids should be included in one single contour line (i.e., only the outer boundaries of a polygon should be drawn). I couldn't find the solution with rasterToPolygons (see here for a visual aspect, but it didn't help me here).
set.seed(2)
r <- raster(nrow=10, ncol=10)
r[] <- runif(ncell(r))
r[r>0.6] <- 0.6
rc <- rasterToContour(r, levels=c(0.6))
plot(r)
plot(rc, add=TRUE)
I'd use a combination of clump() and rasterToPolygons():
library(raster)
library(rgeos) ## For dissolve = TRUE in rasterToPolygons()
## Recreate your data
set.seed(2)
r <- raster(nrow = 10, ncol = 10)
r[] <- runif(ncell(r))
plot(r)
## Compute and then plot polygons surrounding cells with values greater than 0.6
SP <- rasterToPolygons(clump(r > 0.6), dissolve = TRUE)
plot(SP, add = TRUE)

Create square polygons from single centre coordinates and area in R

I am having issues plotting true to geographic extent pixels in R. the files come with a list of daily single coordinates and pixel size (area). There is also a Z element separate from this. The data structure looks this way:
X <- c(1,3,6,7)
Y <- c(3,2,7,8)
Z <- c(38,23,12,12)
Area <- c(32,23,45,67)
The X and Y are in degrees longitude and latitude while the area is in square kilometres. I create the point features easily using:
library(sp)
A <- cbind(X,Y,Z,Area)
B <- SpatialPoints(A)
I plot these easily using the area values to determine the "cex" for plotting. The Z column is intensity and I use these values to determine the colours . How do I create spatial polygons features using the areas for each point in R? I would be using these points to create gridded rasters.
This should do the trick:
library(rgeos) ## for gBuffer()
library(raster) ## for bind()
ww <- sqrt(B$Area)/2 ## Widths of buffers needed to produce desired areas
pp <- list()
for(i in seq_along(B)) {
pp[i] <- gBuffer(B[i], width=ww[i], quadsegs=1, capStyle="SQUARE")
}
PP <- do.call(bind, pp)
## Check that it worked
plot(PP)
plot(B, add=TRUE)
text(B, labels=1:4, adj=c(-1,0), col="red")
Just to update this a bit, here is an sf solution.
Function to create the square buffers
bSquare <- function(x, a) {
a <- sqrt(a)/2
return( sf::st_buffer(x, dist = a, nQuadSegs=1,
endCapStyle = "SQUARE") )
}
Some example data
library(sf)
xy <- st_as_sf(data.frame(x = c(1,3,6,7),
y = c(3,2,7,8), z = c(38,23,12,12),
area = c(32,23,45,67)),
coords = c("x", "y"),
agr = "constant")
With variable buffer
sb.var <- bSquare(xy, xy$area)
plot(st_geometry(sb.var))
plot(st_geometry(xy), pch=20, add=TRUE)
With fixed buffer
sb <- bSquare(xy, 32)
plot(st_geometry(sb))
plot(st_geometry(xy), pch=20, add=TRUE)

Resources