I am trying to solve the following problem in R :
I have a polygon object defined by a list l with two components x and y. The order defines the edges of the polygon.
For instance :
l=list(
x=c(-1.93400738955091,0.511747161547164,1.85047596846401,-1.4963460488281,-1.31613255558929,-0.0803828876660542,1.721752044722,-0.724002506376074,-2.08847609804132,2.13366860069641),
y=c(-1.02967154136169,1.53216851658359,-1.39564869249673,-1.21266011692921,1.6419616619241,-1.87141898897228,0.946605074767527,1.49557080147009,0.324443917837958,-0.517303529772633)
)
plot(l,type="b",pch=16)
points(l$x[c(10,1)],l$y[c(10,1)],type="b",pch=16)
Now what I am interested in is to keep only the outer boundary (but not the convex hull) of this polygon. The following picture highlights the point I'd like to keep
points(
x=c(-1.13927707377209,-1.31613255249992,-1.3598262571216,0.511747159281619,0.264900107013767,0.671727215417383,-0.724002505140328,-1.93400738893304,-1.4811931364624,-1.45298543105533,-2.08847609804132,-1.40787406113029,-1.3598262571216,0.278826441754518,1.85047596733123,1.48615105742673,1.48615105742673,2.13366860069641,1.38016944537233,1.38016944537233,1.17232981688283,1.17232981688283,1.72175204307433,0.671727215417383,-1.496346, -0.08038289, -0.2824999),
y=c(1.13914087952916,1.64196166071069,0.949843643913108,1.53216851597378,1.27360509238768,1.18229006681548,1.49557080106148,-1.02967154055378,-0.972634663817139,-0.525818314106921,0.324443915423533,0.188755761926866,0.949843643913108,-1.30971824545964,-1.3956486896768,-0.59886540309968,-0.59886540309968,-0.517303527559411,-0.367082245352325,-0.367082245352325,0.0874657083966551,0.0874657083966551,0.94660507315481,1.18229006681548,-1.21266,-1.871419,-1.281255),
pch=16,
col="red",
cex=0.75
)
I am really clueless about whether there are tools to easily do that. The closest I have found is the polysimplify function in the polyclip package, which identifies all the points I need, but also outputs some points I do not need (inner points where segments intersect).
I actually found a solution (below). The following function does what I want but I am unsure why it works (and whether it may fail).
Actually the function below correctly identifies the point I want but outputs them in the wrong order, so it is still useless to me...
polygon.clean<-function(poly){
require(polyclip)
poly.cleaned=polysimplify(poly)
x=unlist(sapply(poly.cleaned,function(x)x$x))
y=unlist(sapply(poly.cleaned,function(x)x$y))
x.src=x[!x%in%x[duplicated(x)]]
y.src=y[!y%in%y[duplicated(y)]]
poly.cleaned=poly.cleaned[sapply(poly.cleaned,function(poly.sub,x,y){
any(poly.sub$x%in%x&poly.sub$y%in%y)
},x=x.src,y=y.src)]
x=unlist(sapply(poly.cleaned,function(x){
res=x$x
if(length(res)==4){
res=vector()
}
res
}))
y=unlist(sapply(poly.cleaned,function(x){
res=x$y
if(length(res)==4){
res=vector()
}
res
}))
x=c(x,x.src)
y=c(y,y.src)
tester=duplicated(x)&duplicated(y)
x=x[!tester]
y=y[!tester]
list(x=x,y=y)
}
plot(l,type="b",pch=16)
points(l$x[c(10,1)],l$y[c(10,1)],type="b",pch=16)
points(polygon.clean(l),pch=16,cex=0.75,col="red")
Using rgeos routines, you first "node" your linestring to create all the intersections, then "polygonize" it, then "union" it to dissolve its insides.
First make a SpatialLines version of your data with duplicated first/last point:
library(sp)
library(rgeos)
coords = cbind(l$x, l$y); coords=rbind(coords,coords[1,])
s = SpatialLines(list(Lines(list(Line(coords)),ID=1)))
Then:
s_outer = gUnaryUnion(gPolygonize(gNode(s)))
Plot it thus:
plot(s,lwd=5)
plot(s_outer, lwd=2,border="red",add=TRUE)
If you want the coordinates of the surrounding polygon they are in the returned object and can be extracted with:
s_outer#polygons[[1]]#Polygons[[1]]#coords
# x y
# [1,] 0.27882644 -1.30971825
# [2,] -0.08038289 -1.87141899
# [3,] -0.28886517 -1.27867953
Assuming there's only one polygon, which might not be the case - suppose your line traces a figure-of-eight - then you'll get two polygons touching at a point. We don't know how free your jaggly line is to do things like that...
Related
I want to know the fastest algorithms for obtaining the cartesian distances between each point in a SpatialPointsDataFrame (X) and either (a) the closest point in a second SpatialPointsDataFrame (Y), or (b) the closest line segment in a SpatialLinesDataFrame (Y). So this is basically 2 questions, with perhaps the same answer.
For the lines, I know I can use dist2Line(X,Y, distfun=distGeo) but this is insanely slow. I also tried using nncross, after converting both X and Y to ppp objects, as below. This is did NOT work; heat mapping the new distance measure showed that it does not radiate from Y.
X_ppp <- as(X, "ppp")
Y_psp <- as(Y, "psp")
distR <- nncross(X_ppp,Y_ppp,what="dist",k=1)
X$dist2road <- distR
For lines, I also tried using gDistance(X,Y) but was met with the error, for i=1,2: Spatial object i is not projected; GEOS expects planar coordinates. I think this is because I'm using lat-lon, and it needs a true projection. But all the files i'm working with are lat-lon, and I'm not sure how to choose and specify a projection (for tanzania) w/out coping it from another file.
For points, again using the nncross approach resulted in definitely wrong distances. (In each the point and line case, is this because the output vector is not ordered in the same way that the points within X are? If so, I see now way of outputting an ID for the point within X.)
Also for points, this knn code below did work. But it's clearly not in cartesian distance, and so I'd like to convert it or find some other algorithm that provides cartesian distance.
knn.results = knn(data=coordinates(market.shp),
query=coordinates(tzprice.shp), k=1)
knn.results <- data.frame(knn.results)
tzprice.shp$dist2market <- knn.results[,2]
Basically, my hope is to find the fastest algorithm for each purpose (distance to nearest point, distance to nearest line), with output either in cartesian distance or convertible to cartesian distance. Thanks!
Somebody pointed me towards one possible answer for finding the cartesian distance between each point in a SpatialPointsDataFrame (X) and the closest point in a second SpatialPointsDataFrame (let's call it Y). So that's the first half of my question... perhaps there's a faster method out there, but this way is quite fast, and it DOES return answers in Km, at least if proj=longlat.
tree <- createTree(coordinates(Y))
inds <- knnLookup(tree, newdat=coordinates(X), k=1)
distkm <- sapply(seq_len(nrow(inds)), function(i) spDists(X[i, ], Y[inds[i, ],]))
Still looking for an algorithm that (quickly) finds meters/km from each point in X to the nearest line in a SpatialLinesDataFrame.
I have a set of coordinates X and Y for my points and used the deldir to create determine and plot the Voronoi Polygons. (I've used this tutorial here)
This is my plot: (sorry that its so small, but you get the idea).
I need to determine the area of each polygon. How can I do that?
I looked up in the deldirpackage page and couldnt find anything related to the Voronoi polygons, only about other
Based on the reference manual (https://cran.r-project.org/web/packages/deldir/index.html), the output of the deldir function is a list. One of the list element, summary, is a data frame, which contains a column called dir.area. This is the the area of the Dirichlet tile surrounding the point, which could be what you are looking for.
Below I am using the example from the reference manual. Use $ to access the summary data frame.
library(deldir)
x <- c(2.3,3.0,7.0,1.0,3.0,8.0)
y <- c(2.3,3.0,2.0,5.0,8.0,9.0)
dxy1 <- deldir(x,y)
dxy1$summary
I have an alphahull::ashape() result that I need to convert with spatstat::owin() for subsequent spatial analyses. Is there an elegant solution how to order the points from the concave hull and convert the shape to an owin object or any Spatial* object? With ordered points in a hypothetical matrix coords the polygon is defined as:
geo.owin=try(owin(poly=list(x=coords[,1],y=coords[,2])),silent=T)
if(class(geo.owin)=="try-error") geo.owin=owin(poly=list(x=rev(coords[,1]),y=rev(coords[,2])))
This is not possible. The ashape()$edges matrix contains coordinates of points that can be drawn to look like a polygon and the matrix is provided here. However, the points are not ordered as demonstrated with different plotting colors and directions of arrows.
# data
okraj = matrix(c(23.8808, 18.0106, 23.8808, 1.8265, 1.8266, 1.8265, 18.0106, 39.5352, 39.5352, 39.5352, 13.5519, 27.9675, 3.8102, 4.8269, 8.8236, 52.7248, 45.3385, 52.7248, 50.9600, 50.9600, 50.9600, 45.3385, 39.9042, 39.9042, 39.9042, 49.1204, 41.8421, 47.1450, 44.9423, 46.0246, 13.5519, 27.9675, 32.1116, 1.8266, 4.5644, 3.8102, 17.5557, 39.5840, 32.1116, 29.2158, 4.5644, 29.2158, 4.8269, 8.8236, 17.5557, 49.1204, 41.8421, 41.3710, 50.9600, 49.8638, 47.1450, 45.5063, 39.8987, 41.3710, 40.0750, 49.8638), ncol=4, dimnames=list(NULL,c("x1","y1","x2","y2")))
# draw polygon from arrows
farby=colorRampPalette(c("lightblue","black"))(nrow(okraj))
plot(0,type="n",xlim=range(okraj[,c(1,3)]),ylim=range(okraj[,c(2,4)]),xlab="",ylab="")
for(i in 1:nrow(okraj)){
arrows(okraj[i,"x1"],okraj[i,"y1"],okraj[i,"x2"],okraj[i,"y2"],col=farby[i],length=.1,lwd=2)
}
The search through other questions returned solutions for ordered points, convex not concave shapes, solutions in C, python and Lua languages. My current code searches for connected points across the matrix and uses if() conditions for every problem I ran into in interpreting the alpha shape edge coordinates (pardon the naive coding).
# function finding a row, which contains the connecting data
find.connection=function(bod, temp){
# test whether a connection exists in the first set of point coordinates
riadok1=ifelse(length(which(temp[,1]==bod[1]))==0,NA,which(temp[,1]==bod[1]))
riadok2=ifelse(length(which(temp[,2]==bod[2]))==0,NA,which(temp[,2]==bod[2]))
# test for a connection in the second set of coordinates
if(is.na(riadok1)){
riadok1=ifelse(length(which(temp[,3]==bod[1]))==0,NA,which(temp[,3]==bod[1]))
riadok2=ifelse(length(which(temp[,4]==bod[2]))==0,NA,which(temp[,4]==bod[2]))
}
# check multiple values in x or y coordinates and select a row where both occur
if(riadok1==riadok2){
riadok=riadok1
} else {
riadky1=ifelse(length(which(temp[,3]==bod[1]))==0,NA,which(temp[,3]==bod[1]))
riadky2=ifelse(length(which(temp[,4]==bod[2]))==0,NA,which(temp[,4]==bod[2]))
riadok=intersect(riadky1,riadky2)
}
return(riadok)
}
# setting up the variable with ordered points
coords=c(okraj[1,c("x2","y2")])
coords=rbind(coords,c(okraj[1,c("x1","y1")]))
# current working point and a matrix subset, in which to search for a connection
bod=okraj[1,1:2]
temp=okraj[-1,]
# consecutively search for connecting points
for(j in 1:nrow(okraj)){
if(any(is.na(match(bod,temp)))){
message(paste("Problem with: ", bod,", row: ",j ))
next
}
bod2=NA # next ordered point
smer=0 # controls the set of coordinates to use for a connection
for(x in 1:2){
riadok=find.connection(bod=bod,temp=temp)
# my solution to the current crash point can be implemented here
if(is.na(riadok)) bod2=NA
# select correct value for the connecting point from the two sets of coordinates
else bod2=temp[riadok,c(x+smer,x+smer+1)]
if(all(bod==bod2)) bod2=temp[riadok,c(x+2,x+3)]
if(any(is.na(bod2))){
smer=1
next
} else { break }
}
# store the connecting point and move to the next
coords=rbind(coords,bod2)
bod=bod2
# caveats for the last row in the matrix
if(!is.null(dim(temp))) temp = temp[-riadok,]
if(is.null(dim(temp))){
if(all(coords[1,]==coords[nrow(coords),])){
break
}
if(which(temp==bod[1])==1){
coords=rbind(coords,temp[3:4])
break
} else {
coords=rbind(coords,temp[1:2])
break
}
}
}
It works for some datasets. Here, the sample dataset contains an endpoint okraj[8,3:4] that does not connect to anything else in the matrix and the code crashes. My solution would be to skip the row and try again with previous point.
if(is.na(riadok)){
bod2=NA
temp=temp[-riadok,]
bod=coords[nrow(coords),]
next
}
However, the solution requires dropping a row of data, which is wrong. Your help with a systematic solution to converting an alpha shape to a mapped object would be very appreciated.
Edit:
A question about removing holes from polygons received an answer from #Spacedman using rgeos routines. How could it help to resolve my problem with unordered points from the example herein?
When I use the alphahull library for determining whether a point belongs to a alpha-convex hull or not (inahull), I'm getting a FALSE for points that are clearly inside the alpha convex hull. I've tried different ways of handling the data but it seems that inahull doesn't work properly (or I don't know how to use it ;) )
library(alphahull)
data<-read.table("f2",h=T)
plot(x=x$alpha,y=x$beta, log="y")
Now, I select a set of points for creating a subspace in the plot
sp<-locator(30, type='p', pch=20)
sp
$x
[1] 16.91776 24.41393 36.14421 46.46116 43.34893 27.61219 16.99911
$y
[1] 31.74403 55.32414 68.87334 30.98970 15.31316 11.20075 15.14894
hull<-ahull(sp,alpha=1000)
Now, I add them to the plot just to check:
plot(hull, add=T)
(So far it looks good)
Now, if I check that these points are inside the shape (which are clearly inside):
inahull(hull, c(30,40))
FALSE
The data that I'm using can be found in this link:
https://drive.google.com/file/d/0B8gPXQL4u-b_c2RxNHNGcE5TOVk/edit?usp=sharing
A problem using alphahull was also reported here:
Row ordering for polygons
Thanks for your time and help!
I would like to identify linear features, such as roads and rivers, on raster maps and convert them to a linear spatial object (SpatialLines class) using R.
The raster and sp packages can be used to convert features from rasters to polygon vector objects (SpatialPolygons class). rasterToPolygons() will extract cells of a certain value from a raster and return a polygon object. The product can be simplified using the dissolve=TRUE option, which calls routines in the rgeos package to do this.
This all works just fine, but I would prefer it to be a SpatialLines object. How can I do this?
Consider this example:
## Produce a sinuous linear feature on a raster as an example
library(raster)
r <- raster(nrow=400, ncol=400, xmn=0, ymn=0, xmx=400, ymx=400)
r[] <- NA
x <-seq(1, 100, by=0.01)
r[cellFromRowCol(r, round((sin(0.2*x) + cos(0.06*x)+2)*100), round(x*4))] <- 1
## Quick trick to make it three cells wide
r[edge(r, type="outer")] <- 1
## Plot
plot(r, legend=FALSE, axes=FALSE)
## Convert linear feature to a SpatialPolygons object
library(rgeos)
rPoly <- rasterToPolygons(r, fun=function(x) x==1, dissolve=TRUE)
plot(rPoly)
Would the best approach be to find a centre line through the polygon?
Or is there existing code available to do this?
EDIT: Thanks to #mdsumner for pointing out that this is called skeletonization.
Here's my effort. The plan is:
densify the lines
compute a delaunay triangulation
take the midpoints, and take those points that are in the polygon
build a distance-weighted minimum spanning tree
find its graph diameter path
The densifying code for starters:
densify <- function(xy,n=5){
## densify a 2-col matrix
cbind(dens(xy[,1],n=n),dens(xy[,2],n=n))
}
dens <- function(x,n=5){
## densify a vector
out = rep(NA,1+(length(x)-1)*(n+1))
ss = seq(1,length(out),by=(n+1))
out[ss]=x
for(s in 1:(length(x)-1)){
out[(1+ss[s]):(ss[s+1]-1)]=seq(x[s],x[s+1],len=(n+2))[-c(1,n+2)]
}
out
}
And now the main course:
simplecentre <- function(xyP,dense){
require(deldir)
require(splancs)
require(igraph)
require(rgeos)
### optionally add extra points
if(!missing(dense)){
xy = densify(xyP,dense)
} else {
xy = xyP
}
### compute triangulation
d=deldir(xy[,1],xy[,2])
### find midpoints of triangle sides
mids=cbind((d$delsgs[,'x1']+d$delsgs[,'x2'])/2,
(d$delsgs[,'y1']+d$delsgs[,'y2'])/2)
### get points that are inside the polygon
sr = SpatialPolygons(list(Polygons(list(Polygon(xyP)),ID=1)))
ins = over(SpatialPoints(mids),sr)
### select the points
pts = mids[!is.na(ins),]
dPoly = gDistance(as(sr,"SpatialLines"),SpatialPoints(pts),byid=TRUE)
pts = pts[dPoly > max(dPoly/1.5),]
### now build a minimum spanning tree weighted on the distance
G = graph.adjacency(as.matrix(dist(pts)),weighted=TRUE,mode="upper")
T = minimum.spanning.tree(G,weighted=TRUE)
### get a diameter
path = get.diameter(T)
if(length(path)!=vcount(T)){
stop("Path not linear - try increasing dens parameter")
}
### path should be the sequence of points in order
list(pts=pts[path+1,],tree=T)
}
Instead of the buffering of the earlier version I compute the distance from each midpoint to the line of the polygon, and only take points that are a) inside, and b) further from the edge than 1.5 of the distance of the inside point that is furthest from the edge.
Problems can arise if the polygon kinks back on itself, with long segments, and no densification. In this case the graph is a tree and the code reports it.
As a test, I digitized a line (s, SpatialLines object), buffered it (p), then computed the centreline and superimposed them:
s = capture()
p = gBuffer(s,width=0.2)
plot(p,col="#cdeaff")
plot(s,add=TRUE,lwd=3,col="red")
scp = simplecentre(onering(p))
lines(scp$pts,col="white")
The 'onering' function just gets the coordinates of one ring from a SpatialPolygons thing that should only be one ring:
onering=function(p){p#polygons[[1]]#Polygons[[1]]#coords}
Capture spatial lines features with the 'capture' function:
capture = function(){p=locator(type="l")
SpatialLines(list(Lines(list(Line(cbind(p$x,p$y))),ID=1)))}
Thanks to #klewis at gis.stackexchange.com for linking to this elegant algorithm for finding the centre line (in response to a related question I asked there).
The process requires finding the coordinates on the edge of a polygon describing the linear feature and performing a Voronoi tessellation of those points. The coordinates of the Voronoi tiles that fall within the polygon of the linear feature fall on the centre line. Turn these points into a line.
Voronoi tessellation is done really efficiently in R using the deldir package, and intersections of polygons and points with the rgeos package.
## Find points on boundary of rPoly (see question)
rPolyPts <- coordinates(as(as(rPoly, "SpatialLinesDataFrame"),
"SpatialPointsDataFrame"))
## Perform Voronoi tessellation of those points and extract coordinates of tiles
library(deldir)
rVoronoi <- tile.list(deldir(rPolyPts[, 1], rPolyPts[,2]))
rVoronoiPts <- SpatialPoints(do.call(rbind,
lapply(rVoronoi, function(x) cbind(x$x, x$y))))
## Find the points on the Voronoi tiles that fall inside
## the linear feature polygon
## N.B. That the width parameter may need to be adjusted if coordinate
## system is fractional (i.e. if longlat), but must be negative, and less
## than the dimension of a cell on the original raster.
library(rgeos)
rLinePts <- gIntersection(gBuffer(rPoly, width=-1), rVoronoiPts)
## Create SpatialLines object
rLine <- SpatialLines(list(Lines(Line(rLinePts), ID="1")))
The resulting SpatialLines object:
You can get the boundary of that polygon as SpatialLines by direct coercion:
rLines <- as(rPoly, "SpatialLinesDataFrame")
Summarizing the coordinates down to a single "centre line" would be possible, but nothing immediate that I know of. I think that process is generally called "skeletonization":
http://en.wikipedia.org/wiki/Topological_skeleton
I think ideal solution would be to build such negative buffer which dynamically reach the minimum width and doesn't break when value is too large; keeps continued object and eventually, draws a line if the value is reached. But unfortunately, this may be very compute demanding because this would be done probably in steps and checks if the value for particular point is enough to have a point (of our middle line). Possible it's ne need to have infinitive number of steps, or at least, some parametrized value.
I don't know how to implement this for now.