R: mask() and rasterize() with spatialPolygonsDataFrame having holes - r

I have a spatialPolygonsDataFrame consisting of 3 polygons. The third polygon has the same shape as the first but has a hole where the second polygon is located.
I built the hole in the using the answer from another question (How to add a hole to a polygon within a SpatialPolygonsDataFrame?).
library(raster)
library(sp)
# create rasters and store them in a list
r1 <- raster(xmn=1, xmx=5, ymn=1, ymx=5, nrows=4, ncols=4)
r1[] <- 1:length(r1)
# create SpatialPolygonsDataFrame
Sr1 = Polygon(cbind(c(1,5,4,1,1),c(1,2,5,4,1)))
Sr2 = Polygon(cbind(c(2,4,3,2),c(3,2,4,3)))
SpP = SpatialPolygons(list(Polygons(list(Sr1), "s1"), Polygons(list(Sr2), "s2")),
1:2)
dat = data.frame(ID = c("s1", "s2"), value = c("a", "b"))
row.names(dat) <- c("s1", "s2")
p <- SpatialPolygonsDataFrame(SpP, data = dat,
match.ID = TRUE)
AddHoleToPolygon <-function(poly,hole){
# invert the coordinates for Polygons to flag it as a hole
coordsHole <- hole#polygons[[1]]#Polygons[[1]]#coords
newHole <- Polygon(coordsHole,hole=TRUE)
# punch the hole in the main poly
listPol <- poly#polygons[[1]]#Polygons
listPol[[length(listPol)+1]] <- newHole
punch <- Polygons(listPol,poly#polygons[[1]]#ID)
# make the polygon a SpatialPolygonsDataFrame as the entry
new <- SpatialPolygons(list(punch),proj4string=poly#proj4string)
new <- SpatialPolygonsDataFrame(new,data=as(poly,"data.frame"))
return(new)
}
punchedPoly <-AddHoleToPolygon(p[1,],p[2,])
p1 <- rbind(p, punchedPoly, makeUniqueIDs = TRUE)
p1 <- p1[2:3,]
When I use mask() to "crop" the raster r1, then the hole is created, although the triangular polygon has a value and indeed is not a real hole. But it gets "overridden" by the third polygon with the hole:
masked_hole <- mask(r1, p1)
plot(masked_hole)
When I change the order of the polygons, then no hole is created:
m3 <- mask(r1, p1[c(2,1),])
plot(m3)
The function rasterize is affected in the same manner:
r2 <- rasterize(p1, r1, field = "value")
plot(r2)
r3 <- rasterize(p1[c(2,1),], r1, field = "value")
plot(r3)
In my real data I have holes where there are no "filling" polygons and those ones I want to keep as holes.
How can I fix the spatialPolygonsDataFrame for polygons that are creating holes where there are none?
How can I fix this issue without reordering but "transform" the hole-creating polygons?

It was a bug in the raster package which has been fixed meanwhile (see https://github.com/rspatial/raster/issues/60).

Related

Create voronoi cells within each polygon seperately

Data:
In the data below I have clusters, which are 2 large groupings of the data. Within each cluster are 5 districts. I use the points within each cluster to create a polygon for the cluster.
Problem: I'm attempting to calculate voronoi for each district within each cluster. So each of the 2 cluster polygons should have 5 voronoi cells within it.
How can I create 5 voronoi cells bounded by each cluster polygon?
library(dbplyr)
library(sf)
library(purrr)
library(concaveman)
# Create raw data
df <- data.frame(
"cluster" = c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2),
"district" = c('1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_1','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_2','1_3','1_3','1_3','1_3','1_3','1_3','1_3','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_4','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','1_5','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_1','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_2','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_3','2_4','2_4','2_4','2_4','2_4','2_4','2_4','2_4','2_4','2_4','2_4','2_4','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5','2_5'),
"mx" = c(0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,0.973009090909091,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,1.10794444444444,0.983014285714286,0.983014285714286,0.983014285714286,0.983014285714286,0.983014285714286,0.983014285714286,0.983014285714286,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.20296666666667,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,1.31765526315789,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.560226315789474,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.377593333333333,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.7201725,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.215625,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571,0.369878571428571),
"my" = c(-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.27477272727273,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.49177777777778,-1.07938571428571,-1.07938571428571,-1.07938571428571,-1.07938571428571,-1.07938571428571,-1.07938571428571,-1.07938571428571,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.0937,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.15119473684211,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.02930526315789,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-1.10028666666667,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.9094475,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.642783333333333,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286,-0.795914285714286),
"ID" = 1:200,
"X" = c(1.0083,0.9068,1.0232,1.0005,0.8388,0.8655,1.0133,1.0106,1.0139,1.0537,0.8759,1.0063,1.0187,1.0241,1.0004,0.8886,1.0803,0.8518,0.9998,1.0154,0.8851,1.0252,1.0926,1.064,1.1015,1.0354,1.1511,1.1074,1.202,1.1063,1.0173,1.137,1.1156,1.0776,1.1315,1.2281,0.9974,1.1487,1.0098,1.2197,0.9598,0.9695,0.9268,1.0008,1.0827,0.9331,1.0084,1.1311,1.1856,1.1932,1.2464,1.2331,1.1944,1.1846,1.2203,1.1753,1.2245,1.2396,1.2682,1.2359,1.1918,1.1205,1.3166,1.3072,1.2984,1.2842,1.3451,1.3197,1.2996,1.3482,1.28,1.3051,1.4471,1.315,1.3177,1.3387,1.32,1.3508,1.2747,1.3681,1.2735,1.325,1.3093,1.3244,1.2626,1.3123,1.2819,1.2619,1.3639,1.3099,1.2783,1.3313,1.3895,1.3559,1.3521,1.2589,1.4204,1.2303,1.2808,1.3125,0.55,0.5483,0.6329,0.5006,0.5233,0.566,0.5673,0.4864,0.5658,0.5636,0.542,0.6146,0.5648,0.6092,0.5329,0.5726,0.574,0.62,0.51,0.3787,0.3769,0.3579,0.3881,0.3806,0.403,0.3962,0.409,0.3422,0.4361,0.3853,0.3568,0.3105,0.3674,0.3752,0.6694,0.6492,0.6568,0.6773,0.6237,0.7265,0.7201,0.7596,0.7049,0.7699,0.6555,0.7105,0.731,0.6376,0.8865,0.754,0.7983,0.699,0.7223,0.7214,0.6496,0.7907,0.7418,0.7825,0.7417,0.8978,0.7875,0.6874,0.7761,0.6189,0.706,0.7037,0.7149,0.7059,0.687,0.7888,0.6514,0.7271,0.6679,0.7067,0.2631,0.2701,0.0822,0.069,0.2196,0.2848,0.2661,0.2343,0.2905,0.0684,0.2874,0.252,0.3301,0.5509,0.3343,0.343,0.2951,0.2524,0.5442,0.3187,0.3143,0.3731,0.3352,0.2711,0.455,0.4609),
"Y" = c(-1.2547,-1.2297,-1.3071,-1.237,-1.362,-1.3776,-1.2552,-1.2354,-1.2396,-1.3493,-1.3019,-1.2484,-1.2435,-1.233,-1.217,-1.2715,-1.3396,-1.34,-1.233,-1.2511,-1.3333,-1.1851,-1.5461,-1.5043,-1.5452,-1.5412,-1.4937,-1.5425,-1.4155,-1.523,-1.549,-1.5077,-1.5458,-1.369,-1.5033,-1.3805,-1.5183,-1.4288,-1.5429,-1.3952,-1.0349,-1.0838,-1.0615,-1.0702,-1.0446,-1.1367,-1.124,-1.0626,-1.0958,-1.0808,-1.0775,-1.0499,-1.0963,-1.0341,-1.0348,-1.0838,-1.162,-1.0487,-1.0924,-1.1537,-1.2107,-1.1224,-1.1499,-1.1803,-1.2877,-1.1151,-1.1339,-1.1431,-1.1521,-1.1675,-1.1407,-1.1916,-1.1229,-1.1308,-1.1154,-1.183,-1.1214,-1.0793,-1.1857,-1.0679,-1.1633,-1.075,-1.1354,-1.1494,-1.162,-1.1582,-1.18,-1.1234,-1.1077,-1.1144,-1.1305,-1.1482,-1.2058,-1.1685,-1.2152,-1.1439,-1.1252,-1.2113,-1.1632,-1.1965,-0.9917,-0.9861,-1.064,-0.9898,-0.9799,-1.1048,-1.0085,-0.9395,-1.0425,-1.0806,-1.0132,-1.0785,-1.1109,-1.0632,-0.945,-1.009,-1.1005,-1.0759,-0.9732,-1.1279,-1.1746,-1.1957,-1.0738,-0.9896,-1.0601,-0.9735,-1.0953,-1.0849,-1.0406,-1.1202,-1.0781,-1.2002,-1.157,-1.1328,-0.7416,-0.9323,-0.9372,-0.7013,-0.9191,-0.9356,-0.9838,-0.9302,-0.9407,-1.044,-0.6478,-0.9147,-0.9688,-0.9272,-0.9494,-1.0817,-0.9915,-0.9329,-0.8514,-0.9665,-0.783,-0.9601,-0.8996,-0.7717,-1.0067,-0.9839,-1.0594,-0.9705,-1.01,-0.9163,-1.0049,-0.6829,-0.7918,-0.7353,-0.9295,-0.9944,-0.9524,-0.9257,-0.936,-0.7661,-0.5825,-0.5989,-0.7375,-0.7262,-0.594,-0.6145,-0.571,-0.7069,-0.6377,-0.7865,-0.5962,-0.5615,-0.7729,-0.7873,-0.7713,-0.7774,-0.816,-0.8865,-0.7689,-0.8591,-0.7913,-0.7231,-0.7859,-0.8542,-0.7447,-0.8042)
)
#Create cluster polygons from data
sf <- st_as_sf(df, coords = c("X","Y"), crs = 4326)
shapes <- map(unique(sf$cluster),
~ concaveman(sf[sf$cluster %in% .,])
) %>%
map2(unique(sf$cluster), ~ mutate(.x, cluster = .y)) %>%
reduce(rbind)
###################################################
# OK, here is where I start running into problems #
###################################################
# Attempt to calculate voronoi cells within each cluster polygon
bbox_polygon <- function(x) {
bb <- sf::st_bbox(x)
p <- matrix(
c(bb["xmin"], bb["ymin"],
bb["xmin"], bb["ymax"],
bb["xmax"], bb["ymax"],
bb["xmax"], bb["ymin"],
bb["xmin"], bb["ymin"]),
ncol = 2, byrow = T
)
sf::st_polygon(list(p))
}
sf_district <- df %>%
select(district, mx, my) %>%
st_as_sf(coords = c("mx","my"), crs = 4326)
sfbox <- st_sfc(bbox_polygon(sf_district))
v <- st_voronoi(st_union(sf_district), sfbox)
# Plot to see what it looks like
plot(st_intersection(st_cast(v), st_union(shapes)), col = 0)
If you look at the picture, you can see that I'm doing something wrong because the northwest polygon has 6 voronoi cells when there are only 5 districts in the data. I think the problem is that my script is just creating one big voronoi tesselation and then laying the polygon shapes on top of it, rather than calculating the voronoi for each cluster separately and then bounding them within each cluster polygon.
To get separate voronoi polygons for each "cluster", you can run a for loop. Instead of the expression v <- st_voronoi(st_union(sf_district), sfbox), as follows:
sf_district = st_join(sf_district, shapes)
result = list()
for(i in unique(sf_district$cluster)) {
u = sf_district[sf_district$cluster == i, ]
v = st_voronoi(st_union(u), sfbox)
v = st_intersection(st_cast(v), shapes[shapes$cluster == i, ])
result[[i]] = v
}
result = do.call(c, result)
This ensures that the voronoi polygons in each cluster are unaffected by other points, and that each cluster has as many polygons as there are points.
Here is a plot of the result:
plot(result, col = hcl.colors(length(result), "Set 2"))
plot(st_geometry(sf_district), add = TRUE)

Find coordinates of grid points within polygon

I'm trying to get the coordinates of a set of points defining a grid within a polygon (which I have a shapefile for). It seemed like the simplest thing to do would be to create a grid of points, and then filter those points down to only the ones within the polygon. I looked at https://gis.stackexchange.com/questions/133625/checking-if-points-fall-within-polygon-shapefile and Convert a shapefile from polygons to points?, and based on the answers there I tried this:
library(rgdal)
city_bdry <- readOGR("Boundaries - City",
"geo_export_32ded882-2eab-4eaa-b9da-a18889600a40")
res <- 0.01
bb <- bbox(city_bdry)
gt <- GridTopology(cellcentre.offset = bb[,1], cellsize = c(res, res),
cells.dim = c(diff(bb[,1]), diff(bb[2,])) / res + 1)
pts <- SpatialPoints(gt, proj4string = CRS(proj4string(city_bdry)))
ov <- over(pts, city_bdry)
The result, however, doesn't include the actual coordinates of the points that overlap the polygon, so it's useless to me. How can I get that information to be included in the dataframe? Or, is there a simpler way to do what I'm trying to do?
The shapefile I'm using can be downloaded from https://data.cityofchicago.org/Facilities-Geographic-Boundaries/Boundaries-City/ewy2-6yfk
If I got you right, you could try
library(rgdal)
download.file("https://data.cityofchicago.org/api/geospatial/ewy2-6yfk?method=export&format=Shapefile", tf<-tempfile(fileext = ".zip"), mode="wb")
unzip(tf, exdir=dir<-file.path(tempdir(), "Boundaries - City"))
city_bdry <- readOGR(dir, tools::file_path_sans_ext((list.files(dir)[1])))
res <- 0.01
bb <- bbox(city_bdry)
gt <- GridTopology(cellcentre.offset = bb[,1], cellsize = c(res, res),
cells.dim = c(diff(bb[,1]), diff(bb[2,])) / res + 1)
pts <- SpatialPoints(gt, proj4string = CRS(proj4string(city_bdry)))
ov <- sp::over(pts, as(city_bdry, "SpatialPolygons"))
pts_over <- pts[!is.na(ov)]
plot(city_bdry)
points(pts_over)
coordinates(pts_over)
Use splancs::inout().
1. Get the outline of your polygon
outline <- mySpatialPolygonsDataFrame#polygons[[2]]#Polygons[[1]]#coords
2. Use inout() to find what points are within the outline
library(splancs)
pts_in_polygon <- points[inout(points,outline), ]
Note: very similar to the answer I provide to create an irregularly shaped grid (especially for kriging.)
You can also achieve this by simply subsetting the data with [ like yourPoints[yourPolygons, ]:
library(raster)
bra <- getData(country = "BRA", level = 1)
pts <- makegrid(bra, 100)
pts <- SpatialPoints(pts, proj4string = CRS(proj4string(bra)))
coordinates(pts[bra, ])

Reverse cluster analysis; identifying empty space or a lack of density in R with longitude and latitude?

I'm working on a project where I have a very large amount of points and I am looking to identify regions (defined by a lack of clustering) where the density of these points is statistically significantly less relative to others. Normally a visual would be enough but I have so many points that it is to difficult to tell where these empty spaces are and a density heat map doesn't help me zero in on smaller regions. Maybe I'm missing something very simpler here, but I am hoping someone can at least send me in the right direction of where to look. Below is a reproducible sample quick and dirty lets take these points from open data and map them to the borough file for NYC:
#libraries--------------------------
library(ggplot2)
library(ggmap)
library(sp)
library(jsonlite)
library(RJSONIO)
library(rgdal)
#call api data--------------------------
df = fromJSON("https://data.cityofnewyork.us/resource/24t3-xqyv.json?$query= SELECT Lat, Long_")
df <- data.frame(t(matrix(unlist(df),nrow=length(unlist(df[1])))))
names(df)[names(df) == 'X2'] = 'x'
names(df)[names(df) == 'X1'] = 'y'
df = df[, c("x", "y")]
df$x = as.numeric(as.character(df$x))
df$y = as.numeric(as.character(df$y))
df$x = round(df$x, 4)
df$y = round(df$y, 4)
df$x[df$x < -74.2] = NA
df$y[df$y < 40.5] = NA
df = na.omit(df)
#map data----------------------------
cd = readOGR("nybb.shp", layer = "nybb")
cd = spTransform(cd, CRS("+proj=longlat +datum=WGS84"))
cd_f = fortify(cd)
#map data
nyc = ggplot() +
geom_polygon(aes(x=long,
y=lat, group=group), fill='grey',
size=.2,color='black', data=cd_f, alpha=1)
nyc + geom_point(aes(x = x, y = y), data = df, size = 1)
#how would I go about finding the empty spaces? That is the regions where there are no clusters?
In this case there aren't a lot of points but for the sake of demonstration, how would I:
identify pockets of low density
potentially draw polygon boundaries on those pockets?
Appreciate the help!
One way to get polygonal areas of low density would be to construct the
Dirichlet/Voronoi tesselation and choose the largest ones.
Below I use spatstat and deldir (loaded by spatstat) to do this.
It is not so fast so with many more points I don't know how well it will
go.
To use the results in ggmap and other spatial packages you can convert
back from owin and ppp to the spatial classes from sp and use
spTransform to get lat, long coordinates.
First load the packages:
library(maptools)
library(spatstat)
library(jsonlite)
Map and points in coordinates of shapefile (note I read in data from
local files downloaded from www):
cd = readOGR("nybb.shp", layer = "nybb")
#> OGR data source with driver: ESRI Shapefile
#> Source: "nybb.shp", layer: "nybb"
#> with 5 features
#> It has 4 fields
df <- fromJSON("NYC_data.json")
df <- as.data.frame(matrix(as.numeric(unlist(df)), ncol = 2, byrow = TRUE))
df <- df[, c(2, 1)]
names(df) <- c("x", "y")
df <- df[df$x > -74.2 & df$y > 40.5, ]
coordinates(df) <- ~x+y
proj4string(df) <- CRS("+proj=longlat +datum=WGS84")
df2 <- spTransform(df, proj4string(cd))
Switch to spatstat classes:
cd2 <- as(cd, "SpatialPolygons")
W <- as(cd2, "owin")
X <- as(df2, "ppp")
Window(X) <- W
plot(X, main = "")
Compute Dirichlet tessellation and areas and plot the tessellation:
d <- dirichlet(X)
#> Warning: 96 duplicated points were removed
a <- tile.areas(d)
plot(d, main = "")
Combine the n_areas biggest areas of the tessellation:
n_areas <- 30
empty <- tess(tiles = d$tiles[tail(order(a), n = n_areas)])
empty2 <- as.owin(empty)
Plot the result:
plot(W, main = "")
plot(empty2, col = "red", add = TRUE)
plot(X, add = TRUE)

Generate regularly spaced points in polygon

Is there a way to generate regularly spaced (e.g., 500 meters apart) points within a polygon using R? I have been trying to use the sp package but can't seem to define a set of points that are spaced a certain distance apart from one another. My aim is to generate the points, then extract their lat/long coordinates into a new dataframe. Any help would be much appreciated! Thanks
Quite straight forward and almost out-of-the-box.
As OP did not share data, buckle up, put your seats in a vertical position and let us fly to Paris. There, we will adapt a geosphere function, and with its help we will divide up Paris' shape into lon / lat coordinates that are 500 meters apart each (vertically and horizontally).
# Load necessary libraries.
library(raster)
library(geosphere)
library(tidyverse)
library(sp)
# This is an adapted version of geosphere's destPoint() function that works with
# changing d (distance).
destPoint_v <- function (x, y, b, d, a = 6378137, f = 1/298.257223563, ...)
{
r <- list(...)$r
if (!is.null(r)) {
return(.old_destPoint(x, y, b, d, r = r))
}
b <- as.vector(b)
d <- as.vector(d)
x <- as.vector(x)
y <- as.vector(y)
p <- cbind(x, y, b, d)
r <- .Call("_geodesic", as.double(p[, 1]), as.double(p[, 2]),
as.double(p[, 3]), as.double(p[, 4]),
as.double(a), as.double(f),
PACKAGE = "geosphere")
r <- matrix(r, ncol = 3, byrow = TRUE)
colnames(r) <- c("lon", "lat", "finalbearing")
return(r[, 1:2, drop = FALSE])
}
# Data can be downloaded from
# http://osm13.openstreetmap.fr/~cquest/openfla/export/communes-20190101-shp.zip
# or
# https://www.data.gouv.fr/en/datasets/decoupage-administratif-communal-francais-issu-d-openstreetmap/
# ("Export simple de janvier 2019 (225Mo)")
# Load shapefile.
# shp <- raster::shapefile("Dropbox/work/crema/communes-20190101-shp/communes-20190101.shp")
# Extract Paris.
paris <- shp[shp$nom == "Paris", ]
# Set distance of points in meters.
dist <- 500
# Extract bounding box from Paris' SpatialPolygonDataFrame.
bbox <- raster::extent(paris)
# Calculate number of points on the vertical axis.
ny <- ceiling(geosphere::distGeo(p1 = c(bbox#xmin, bbox#ymin),
p2 = c(bbox#xmin, bbox#ymax)) / dist)
# Calculate maximum number of points on the horizontal axis.
# This needs to be calculated for the lowermost and uppermost horizontal lines
# as the distance between latitudinal lines varies when the longitude changes.
nx <- ceiling(max(geosphere::distGeo(p1 = c(bbox#xmin, bbox#ymin),
p2 = c(bbox#xmax, bbox#ymin)) / dist,
geosphere::distGeo(p1 = c(bbox#xmin, bbox#ymax),
p2 = c(bbox#xmax, bbox#ymax)) / dist))
# Create result data frame with number of points on vertical axis.
df <- data.frame(ny = 1:ny)
# Calculate coordinates along the vertical axis.
pts <- geosphere::destPoint(p = c(bbox#xmin, bbox#ymin),
b = 0, d = dist * (1:ny - 1))
df$x <- pts[, 1]
df$y <- pts[, 2]
# Add points on horizontal axis.
df <- tidyr::crossing(nx = 1:nx, df)
# Calculate coordinates.
pts <- destPoint_v(df$x, df$y, b = 90, 500 * (df$nx - 1))
# Turn coordinates into SpatialPoints.
pts <- SpatialPoints(cbind(pts[, 1], pts[, 2]), proj4string = CRS(proj4string(paris)))
# Cut to boundaries of Paris.
result <- raster::intersect(pts, paris)
# Plot result.
plot(result)
title("Paris in Points")
Kind of looks like a fish, doesn't it?
Here is a way to do assuming you have a lonlat polygon by first transforming it to a planar crs (not as nifty as Roman's solution with destPoint).
Packages and example data
library(raster)
library(rgdal)
p <- shapefile(system.file("external/lux.shp", package="raster"))[1,]
Transform to planar crs (pick one that matches your data!)
putm <- spTransform(p, "+proj=utm +zone=32 +datum=WGS84")
Create a raster with 500 m resolution, rasterize the polygon and transform to points
r <- raster(putm, res=500)
r <- rasterize(putm, r)
pts <- rasterToPoints(r, spatial=TRUE)
Transform the points to lon/lat and plot the results
pts_lonlat <- spTransform(pts, "+proj=longlat +datum=WGS84")
result <- coordinates(pts_lonlat)
plot(p)
points(result, pch="+", cex=.5)
(looks like an elephant)

extract value from raster stack from spatialpolygondataframe

I have a raster stack with 27 rasters in it. I have 27 corresponding polygons in a spatial polygon data frame. I want to take polygon[i] overlay it on raster[i], extract and sum the values from raster [i], get a count of the number of cells within the polygon[i] and then divide the sum value by the # of cells. In other words, the raster is a utilization distribution or a kernel density of use. I want to know much use is occurring in the area of the polygon where it is overlapping the raster. I want to divide by the number of cells in the polygon to take into account the size of the polygon.
I have a script that was given to me that does this, only it was written with the intention of extracting data from 1 raster only by any number of spatial polygons in the data frame. It works, its ugly, and I now would like to convert it to something more stream line. I only wish I had someone around me who could help because this might take a while?
This is code Ive been given and my summary of what I think is going on:
msum99Kern07 = SpatialPolygonDataFrame (many polygons)
KERNWolfPIX07m = Raster (this is a single raster, I have 27 rasters I put into a stack
)
#Extracting value from raster to many polygons
sRISK_Moose07m<- extract(KERNWolfPIX07m, msum99Kern07,df=FALSE,method='bilinear')
#Calculate THE SUM FOR EACH polygon#
sRISK_Moose07m<-unlist(lapply(sRISK_Moose07m, function(x) if (!is.null(x)) sum(x, na.rm=TRUE) else NA ))
sRISK_Moose07m<-as.data.frame(sRISK_Moose07m)
#Im not sure why these next commands are needed Im only guessing
#data.frame(levels) as there are many polygons creating a dataframe to put the info into
ID_SUM_07<-as.data.frame(levels(as.factor(msum07locs$ID2)))
#ADD ID TO THE risk data frame
sRISK_Moose07m$ID<-ID_SUM_07[,1]
#NUMBER OF CELLS WITHIN POLYGON EXTRACT CELLS/ POLYGON
NB_SUM2007m<-cellFromPolygon(KERNWolfPIX07m, msum99Kern07)
NB_SUM07m<-unlist(lapply(NB_SUM2007m, function(x) if (!is.null(x)) length(x) else NA ))
#####CONVERT TO DATA FRAME
NB_SUM07m<-as.data.frame(NB_SUM07m)
###ADD THE NB OF CELLS TO THE RISK_SUM FILE###
sRISK_Moose07m$NB_CELLS<-NB_SUM07m[,1]
###DIVIDING VALUE by NB CELLS##
sRISK_Moose07m$DIVID<-sRISK_Moose07m$sRISK_Moose07m/sRISK_Moose07m$NB_CELLS
Now, I have my spatial polygon data frame with 27 polygons and my raster stack with 27 rasters. I want to select the raster[i] and polygon[i] and extract, sum, and calculate the kernel density of the overlapping area. One side thing to keep in mind, I may get an error because it is possible that the polygon and raster do not overlap...I don't know how to check for this in R at all.
My script I have started:
moose99kern = spatial polygon data frame 27 moose
Rastwtrial = stack of 27 rasters having the same unique name as the ID in moose99kern
mkernID=unique(moose99kern$id)
for (i in length(mkernID)){
r = Rastwtrial[Rastwtrial[[i]]== mkernID[i]] #pick frm Rasterstack the raster that has the same name
mp = moose99kern[moose99kern$id == mkernID[i]] #pick from spatialpolygondataframe the polygon that has the same name
RISK_MooseTrial<- extract(r, mp, df=T, method'bilinear')
risksum = (RISK_MooseTrial, function(x) if (!is.null(x)) sum(x, na.rm=TRUE) else NA )#sum all the values that were extracted from the raster
My script doesn't even start to work because I don't know how to index a raster stack. But even still, going through 1 raster/1polygon at a time, Im not sure what to do next in the code. If this is too much for StackOverflow I apologize. Im just seriously stuck and have no where to turn.
Here is test data with 2 individuals for polygons
dput(mtestpoly)
new("SpatialPolygonsDataFrame"
, data = structure(list(id = structure(1:2, .Label = c("F01001_1", "F07002_1"
), class = "factor"), area = c(1259.93082578125, 966.364499511719
)), .Names = c("id", "area"), row.names = c("F01001_1", "F07002_1"
), class = "data.frame")
, polygons = list(<S4 object of class structure("Polygons", package = "sp")>,
<S4 object of class structure("Polygons", package = "sp")>)
, plotOrder = 1:2
, bbox = structure(c(6619693.77161797, 1480549.31292137, 6625570.48348294,
1485861.5586371), .Dim = c(2L, 2L), .Dimnames = list(c("x", "y"
), c("min", "max")))
, proj4string = new("CRS"
, projargs = NA_character_
dput(Rastwtest)
new("RasterStack"
, filename = ""
, layers = list(<S4 object of class structure("RasterLayer", package = "raster")>,
<S4 object of class structure("RasterLayer", package = "raster")>)
, title = character(0)
, extent = new("Extent"
, xmin = 1452505.6959799
, xmax = 1515444.7110552
, ymin = 6575235.1959799
, ymax = 6646756.8040201
)
, rotated = FALSE
, rotation = new(".Rotation"
, geotrans = numeric(0)
, transfun = function ()
NULL
)
, ncols = 176L
, nrows = 200L
, crs = new("CRS"
, projargs = NA_character_
)
, z = list()
, layernames = "Do not use the layernames slot (it is obsolete and will be removed)\nUse function 'names'"
)
Maybe I miss something , but I think you over complicated the problem. For me you have :
stack of raster : a list of raster : ss
a list of polygons of the same size as ss : polys
You need to apply extract for each pair(layer,poly) from (ss,polys)
sapply(1:nlayers(ss), function(i) {
m <- extract(ss[[i]],polys[i], method='bilinear', na.rm= T)[[1]]
d <- ifelse (!is.null(m) , sum(m)/length(m), NA)
d
})
Here an example of 2 legnths since you don't give a reproducible example :
## generate some data
library(raster)
cds1 <- rbind(c(-180,-20), c(-160,5), c(-60, 0), c(-160,-60), c(-180,-20))
cds2 <- rbind(c(80,0), c(100,60), c(120,0), c(120,-55), c(80,0))
## In your case you need something like SpatialPolygons(moose99kern)
polys <- SpatialPolygons(list(Polygons(list(Polygon(cds1)), 1),
Polygons(list(Polygon(cds2)), 2)))
r <- raster(ncol=36, nrow=18)
r[] <- 1:ncell(r)
r1 <- raster(ncol=36, nrow=18)
r1[] <- seq(-1,-2,length.out=ncell(r1))
ss <- stack(r,r1)
## density compute
sapply(1:nlayers(ss), function(i) {
## sum of values of the cells of a Raster ss[[i]] covered by the poly polys[i]
m <- extract(ss[[i]],polys[i], method='bilinear', na.rm= T)[[1]]
d <- ifelse (!is.null(m) , sum(m)/length(m), NA)
})
[1] 387.815789 -1.494714
When you are asking questions about R, always use simple reproducible examples, not your own data; unless perhaps what you want to do works for such an example, but not for your data, but then still show the example that works and the error message you are getting. You can typically start with the examples in the help files, as in below from ?extract
r <- raster(ncol=36, nrow=18)
r[] <- 1:ncell(r)
s <- stack(r, r*2)
cds1 <- rbind(c(-180,-20), c(-160,5), c(-60, 0), c(-160,-60), c(-180,-20))
cds2 <- rbind(c(80,0), c(100,60), c(120,0), c(120,-55), c(80,0))
polys <- SpatialPolygons(list(Polygons(list(Polygon(cds1)), 1),
Polygons(list(Polygon(cds2)), 2)))
v <- extract(s, polys, small=TRUE)
#cellnumbers for each polygon
sapply(v, NROW)
# mean for each polygon
sapply(v, function(x) apply(x, 2, mean, na.rm=T))
the functions in sapply need to be refined if some of your polgyons our outside of the raster (i.e. returning NULL, but the "small=TRUE" option should avoid problems with very small polygons inside the raster. Also note that there is no "method" argument when extracting with SpatialPolygon* objects.
Do not use a loop, unless to prevent memory problems if you have very many cells for each polygon.

Resources