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, ])
Related
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).
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)
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)
I want to calculate the distance between two points in two different datasets. I don't want to calculate the distance between all points - just to the nearest point of datasetB.
Some examples:
Dataset A - Persons
http://pastebin.com/HbaeqACi
Dataset B - Waterfeatures:
http://pastebin.com/UdDvNtHs
Dataset C - City:
http://pastebin.com/nATnkMRk
So...I want to calculate the distance of each person to the nearest waterfeature point.
I've already tried to work with the rgeos package and after struggling with some projections errors, I've got it to work. But this calculate (at least I assume it) all distances to every point, but, as already said, I've only interested in the distance to the nearest waterfeature point.
# load csv files
persons = read.csv("persons.csv", header = TRUE)
water = read.csv("water.csv", header = TRUE)
# change dataframes to SpatialPointDataFrame and assign a projection
library(sp)
library(rgeos)
coordinates(persons) <- c("POINT_X", "POINT_Y")
proj4string(persons) <- CRS("+proj=utm +datum=WGS84")
coordinates(water) <- c("POINT_X", "POINT_Y")
proj4string(water) <- CRS("+proj=utm +datum=WGS84")
# use rgoes package to calculate the distance
distance <- gDistance(persons, water, byid=TRUE)
# works, but calculates a huge number of distances
Is there any parameter, which I've missed. Or do I need to use another package or function? I've also looked at spatstat, which is able to calculate the distance to the nearest neighbor, but not of two different datasets: http://hosho.ees.hokudai.ac.jp/~kubo/Rdoc/library/spatstat/html/nndist.html
Edit:
The complete R-Script including plotting of the datasets:
library(RgoogleMaps)
library(ggplot2)
library(ggmap)
library(sp)
library(fossil)
#load data
persons = read.csv("person.csv", header = TRUE, stringsAsFactors=FALSE)
water = read.csv("water.csv", header =TRUE, stringsAsFactors=FALSE)
city = read.csv("city.csv", header =TRUE)
# plot data
persons_ggplot2 <- persons
city_ggplot2 <- city
water_ggplot2 <- water
gc <- geocode('new york, usa')
center <- as.numeric(gc)
G <- ggmap(get_googlemap(center = center, color = 'bw', scale = 1, zoom = 11, maptype = "terrain", frame=T), extent="device")
G1 <- G + geom_point(aes(x=POINT_X, y=POINT_Y ),data=city, shape = 22, color="black", fill = "yellow", size = 4) + geom_point(aes(x=POINT_X, y=POINT_Y ),data=persons, shape = 8, color="red", size=2.5) + geom_point(aes(x=POINT_X, y=POINT_Y ),data=water_ggplot2, color="blue", size=1)
plot(G1)
#### calculate distance
# Generate unique coordinates dataframe
UniqueCoordinates <- data.frame(unique(persons[,4:5]))
UniqueCoordinates$Id <- formatC((1:nrow(UniqueCoordinates)), width=3,flag=0)
# Generate a function that looks for the closest waterfeature for each id coordinates
NearestW <- function(id){
tmp <- UniqueCoordinates[UniqueCoordinates$Id==id, 1:2]
WaterFeatures <- rbind(tmp,water[,2:3])
tmp1 <- earth.dist(WaterFeatures, dist=TRUE)[1:(nrow(WaterFeatures)-1)]
tmp1 <- which.min(tmp1)
tmp1 <- water[tmp1,1]
tmp1 <- data.frame(tmp1, WaterFeature=tmp)
return(tmp1)
}
#apply to each id and the merge
CoordinatesWaterFeature <- ldply(UniqueCoordinates$Id, NearestW)
persons <- merge(persons, CoordinatesWaterFeature, by.x=c(4,5), by.y=c(2,3))
What about writing a function that looks for the nearest waterfeature for every person?
#requires function earth.dist from "fossil" package
require(fossil)
#load data
persons = read.csv("person.csv", header = TRUE, stringsAsFactors=FALSE)
water = read.csv("water.csv", header =TRUE, stringsAsFactors=FALSE)
#Generate unique coordinates dataframe
UniqueCoordinates <- data.frame(unique(persons[,4:5]))
UniqueCoordinates$Id <- formatC((1:nrow(UniqueCoordinates)), width=3,flag=0)
#Generate a function that looks for the closest waterfeature for each id coordinates
NearestW <- function(id){
tmp <- UniqueCoordinates[UniqueCoordinates$Id==id, 1:2]
WaterFeatures <- rbind(tmp,water[,2:3])
tmp1 <- earth.dist(WaterFeatures, dist=TRUE)[1:(nrow(WaterFeatures)-1)]
tmp1 <- min(tmp1)
tmp1 <- data.frame(tmp1, WaterFeature=tmp)
return(tmp1)
}
#apply to each id and the merge
CoordinatesWaterFeature <- ldply(UniqueCoordinates$Id, NearestW)
persons <- merge(persons, CoordinatesWaterFeature, by.x=c(4,5), by.y=c(2,3))
NOTE: I've added a stringsAsFactors parameter to the original read.csv , it make the merging easier at the end
NOTE:Column tmp1 notes the number of METERS to the nearest water feature
Maybe I'm a little too late, but you can use spatstat to compute distances between two different datasets. The command is nncross. The arguments you have to use are two objects of type ppp, which you can create using the as.ppp() function.
I am using the example here for discussion:
ggplot map with l
library(rgdal)
library(ggplot2)
library(maptools)
# Data from http://thematicmapping.org/downloads/world_borders.php.
# Direct link: http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip
# Unpack and put the files in a dir 'data'
gpclibPermit()
world.map <- readOGR(dsn="data", layer="TM_WORLD_BORDERS_SIMPL-0.3")
world.ggmap <- fortify(world.map, region = "NAME")
n <- length(unique(world.ggmap$id))
df <- data.frame(id = unique(world.ggmap$id),
growth = 4*runif(n),
category = factor(sample(1:5, n, replace=T)))
## noise
df[c(sample(1:100,40)),c("growth", "category")] <- NA
ggplot(df, aes(map_id = id)) +
geom_map(aes(fill = growth, color = category), map =world.ggmap) +
expand_limits(x = world.ggmap$long, y = world.ggmap$lat) +
scale_fill_gradient(low = "red", high = "blue", guide = "colorbar")
Gives the following results:
I would like to map one variable to the left "half" of a country and a different variable to the right "half" of the country. I put "half" in quotes because it's not clearly defined (or at least I'm not clearly defining it). The answer by Ian Fellows might help (which gives an easy way to get the centroid). I'm hoping for something so that I can do aes(left_half_color = growth, right_half_color = category) in the example. I'm also interested in top half and bottom half if that is different.
If possible, I would also like to map the individual centroids of the halves to something.
This is a solution without ggplot that relies on the plot function instead. It also requires the rgeos package in addition to the code in the OP:
EDIT Now with 10% less visual pain
EDIT 2 Now with centroids for east and west halves
library(rgeos)
library(RColorBrewer)
# Get centroids of countries
theCents <- coordinates(world.map)
# extract the polygons objects
pl <- slot(world.map, "polygons")
# Create square polygons that cover the east (left) half of each country's bbox
lpolys <- lapply(seq_along(pl), function(x) {
lbox <- bbox(pl[[x]])
lbox[1, 2] <- theCents[x, 1]
Polygon(expand.grid(lbox[1,], lbox[2,])[c(1,3,4,2,1),])
})
# Slightly different data handling
wmRN <- row.names(world.map)
n <- nrow(world.map#data)
world.map#data[, c("growth", "category")] <- list(growth = 4*runif(n),
category = factor(sample(1:5, n, replace=TRUE)))
# Determine the intersection of each country with the respective "left polygon"
lPolys <- lapply(seq_along(lpolys), function(x) {
curLPol <- SpatialPolygons(list(Polygons(lpolys[x], wmRN[x])),
proj4string=CRS(proj4string(world.map)))
curPl <- SpatialPolygons(pl[x], proj4string=CRS(proj4string(world.map)))
theInt <- gIntersection(curLPol, curPl, id = wmRN[x])
theInt
})
# Create a SpatialPolygonDataFrame of the intersections
lSPDF <- SpatialPolygonsDataFrame(SpatialPolygons(unlist(lapply(lPolys,
slot, "polygons")), proj4string = CRS(proj4string(world.map))),
world.map#data)
##########
## EDIT ##
##########
# Create a slightly less harsh color set
s_growth <- scale(world.map#data$growth,
center = min(world.map#data$growth), scale = max(world.map#data$growth))
growthRGB <- colorRamp(c("red", "blue"))(s_growth)
growthCols <- apply(growthRGB, 1, function(x) rgb(x[1], x[2], x[3],
maxColorValue = 255))
catCols <- brewer.pal(nlevels(lSPDF#data$category), "Pastel2")
# and plot
plot(world.map, col = growthCols, bg = "grey90")
plot(lSPDF, col = catCols[lSPDF#data$category], add = TRUE)
Perhaps someone can come up with a good solution using ggplot2. However, based on this answer to a question about multiple fill scales for a single graph ("You can't"), a ggplot2 solution seems unlikely without faceting (which might be a good approach, as suggested in the comments above).
EDIT re: mapping centroids of the halves to something: The centroids for the east ("left") halves can be obtained by
coordinates(lSPDF)
Those for the west ("right") halves can be obtained by creating an rSPDF object in a similar way:
# Create square polygons that cover west (right) half of each country's bbox
rpolys <- lapply(seq_along(pl), function(x) {
rbox <- bbox(pl[[x]])
rbox[1, 1] <- theCents[x, 1]
Polygon(expand.grid(rbox[1,], rbox[2,])[c(1,3,4,2,1),])
})
# Determine the intersection of each country with the respective "right polygon"
rPolys <- lapply(seq_along(rpolys), function(x) {
curRPol <- SpatialPolygons(list(Polygons(rpolys[x], wmRN[x])),
proj4string=CRS(proj4string(world.map)))
curPl <- SpatialPolygons(pl[x], proj4string=CRS(proj4string(world.map)))
theInt <- gIntersection(curRPol, curPl, id = wmRN[x])
theInt
})
# Create a SpatialPolygonDataFrame of the western (right) intersections
rSPDF <- SpatialPolygonsDataFrame(SpatialPolygons(unlist(lapply(rPolys,
slot, "polygons")), proj4string = CRS(proj4string(world.map))),
world.map#data)
Then information could be plotted on the map according to the centroids of lSPDF or rSPDF:
points(coordinates(rSPDF), col = factor(rSPDF#data$REGION))
# or
text(coordinates(lSPDF), labels = lSPDF#data$FIPS, cex = .7)