在R {spatstat}中尋找點之間的歐幾里德距離，由不規則的多邊形窗口限制

Question

我試圖找到兩點間的歐幾里得距離，由不規則的多邊形限制。 （即距離必須被計算爲通過給窗口的路線）

下面是一個可重複的例子：

library(spatstat) 

#Simple example of a polygon and points. 
ex.poly <- data.frame(x=c(0,5,5,2.5,0), y=c(0,0,5,2.5,5)) 
points <- data.frame(x=c(0.5, 2.5, 4.5), y=c(4,1,4)) 

bound <- owin(poly=data.frame(x=ex.poly$x, y=ex.poly$y)) 

test.ppp <- ppp(x=points$x, y=points$y, window=bound) 

pairdist.ppp(test.ppp)#distance between every point 
#The distance result from this function between point 1 and point 3, is given as 4.0 

但是我們知道剛剛從繪製點

plot(test.ppp) 

路線限制在多邊形的距離應該更大（在這種情況下，5.00）。

是否有另一個功能，我不知道{spatstat}會這樣做？還是有人有其他建議可以做到這一點的另一個包？

我試圖找到水體中兩點之間的距離，所以我的實際數據中的不規則多邊形更加複雜。

任何幫助，非常感謝！

乾杯

Answer 1

OK，這裏的gdistance爲基礎的方法，我在昨天的評論中提到。這並不完美，因爲它計算的路徑段都被限制在棋盤上的16個方向之一上發生（國王的移動加上騎士的移動）。也就是說，在你的例子中，對於三個成對距離中的每一個，它都在正確值的2％以內（總是略微高估）。

library(maptools) ## To convert spatstat objects to sp objects 
library(gdistance) ## Loads raster and provides cost-surface functions 

## Convert *.ppp points to SpatialPoints object 
Pts <- as(test.ppp, "SpatialPoints") 

## Convert the lake's boundary to a raster, with values of 1 for 
## cells within the lake and values of 0 for cells on land 
Poly <- as(bound, "SpatialPolygons")   ## 1st to SpatialPolygons-object 
R <- raster(extent(Poly), nrow=100, ncol=100) ## 2nd to RasterLayer ... 
RR <- rasterize(Poly, R)      ## ... 
RR[is.na(RR)]<-0        ## Set cells on land to "0" 

## gdistance requires that you 1st prepare a sparse "transition matrix" 
## whose values give the "conductance" of movement between pairs of 
## adjacent and next-to-adjacent cells (when using directions=16) 
tr1 <- transition(RR, transitionFunction=mean, directions=16) 
tr1 <- geoCorrection(tr1,type="c") 

## Compute a matrix of pairwise distances between points 
## (These should be 5.00 and 3.605; all are within 2% of actual value). 
costDistance(tr1, Pts) 
##   1  2 
## 2 3.650282   
## 3 5.005259 3.650282 

## View the selected paths 
plot(RR) 
plot(Pts, pch=16, col="gold", cex=1.5, add=TRUE) 
SL12 <- shortestPath(tr1, Pts[1,], Pts[2,], output="SpatialLines") 
SL13 <- shortestPath(tr1, Pts[1,], Pts[3,], output="SpatialLines") 
SL23 <- shortestPath(tr1, Pts[2,], Pts[3,], output="SpatialLines") 
lapply(list(SL12, SL13, SL23), function(X) plot(X, col="red", add=TRUE, lwd=2))