R,spatstat包中的分割链包装?

时间:2016-02-25 18:29:29

标签: r ggplot2 voronoi spatstat dirichlet

我正在尝试创建聚集点的漂亮数字。是否有一个包将在点的镶嵌之间创建分界线?理想情况下,它适合在ggplot中进行绘图。

以下是一些示例代码:

#DivideLineExample
library(spatstat)

W=owin(c(0,1),c(0,1))          # Set up the Window
p<-runifpoint(42, win=W)       # Get random points

ll=cbind(p$x,p$y)              # get lat/long for each point
zclust=kmeans(ll,centers=4)    # Cluster the points spatially into 4 clusters

K<-pp<-D<-list()
plot(W,main="Clustered Points")
for (i in 1:4){                   # this breaks up the points into separate ppp objects for each cluster
  K[[i]]=ll[zclust$cluster==i,]   
  pp[[i]]=as.ppp(K[[i]],W)
  plot(pp[[i]],col=i,add=TRUE,cex=1.5,pch=16)
  D[[i]]=dirichlet(pp[[i]])       # This performs the Dirichlet Tessellation and plots
  plot(D[[i]],col=i,add=TRUE)
}

这样输出: http://imgur.com/CCXeOEB

Clusters of points without divisions

我正在寻找的是: http://imgur.com/7nmtXjo

Clusters of points with divide chains

我知道算法exists

任何想法/替代品?

2 个答案:

答案 0 :(得分:0)

您可以尝试点多边形测试,例如像kirkpatrick数据结构。更容易的是将多边形划分为水平或垂直。来源:http://www.personal.kent.edu/~rmuhamma/Compgeometry/MyCG/Voronoi/DivConqVor/divConqVor.htm

答案 1 :(得分:0)

我写了一个我认为会做你想做的功能:

divchain <- function (X) {
    stopifnot(is.ppp(X))
    if(!is.multitype(X)) {
        whinge <- paste(deparse(substitute(X)),
                        "must be a marked pattern with",
                        "factor valued marks.\n")
        stop(whinge)
    }
    X <- unique(X, rule = "deldir", warn = TRUE)
    w <- Window(X)
    require(deldir)
    dd <- deldir(X,z=marks(X),rw=c(w$xrange,w$yrange))
    if (is.null(dd)) 
        return(NULL)
    ddd <- dd$dirsgs
    sss <- dd$summary
    z   <- sss[["z"]]
    rslt <- list()
    nsgs <- nrow(ddd)
    K <- 0
    for (i in 1:nsgs) {
         i1 <- ddd[i,5]
         i2 <- ddd[i,6]
         c1 <- z[i1]
         c2 <- z[i2]
         if(c1 != c2) {
             K <- K+1
             rslt[[K]] <- unlist(ddd[i,1:4])
         }
    }
    class(rslt) <- "divchain"
    attr(rslt,"rw") <- dd$rw
    rslt
}

我还为“divchain”课写了一个情节方法:

plot.divchain <- function(x,add=FALSE,...){
    if(!add) {
        rw <- attr(x,"rw")
        plot(0,0,type="n",ann=FALSE,axes=FALSE,xlim=rw[1:2],ylim=rw[3:4])
        bty <- list(...)$bty
        box(bty=bty)
    }
    lapply(x,function(u){segments(u[1],u[2],u[3],u[4],...)})
    invisible()

}

E.g:

require(spatstat)
set.seed(42)
X <- runifpoint(50)
z <- factor(kmeans(with(X,cbind(x,y)),centers=4)$cluster)
marks(X) <- z
dcX <- divchain(X)
plot(dirichlet(X),border="brown",main="")
plot(X,chars=20,cols=1:4,add=TRUE)
plot(dcX,add=TRUE,lwd=3)

Dividing chain

让我知道这是否令人满意。抱歉,我无法帮助你解决ggplot的问题。我不做ggplot。