使用Spatstat生成六边形网格

Question

我正在分析某些粒子的生长模式，并希望将点模式与具有相同强度的完美六边形网格的点模式进行比较（每单位面积的点数相同）。我已经编写了一个函数来执行此操作，但它有一个固有的错误，我不确定它的来源。基本上，在函数运行之后，它会产生一个完美的六边形点图案，它没有正确数量的粒子 - 它通常偏差约1-4％。如果将以下代码复制并粘贴到R中，您将看到 - 对于此特定示例，误差为11.25％ - 原始点图案具有71个粒子，并且生成的完美六边形点图案具有80个粒子。这看起来很奇怪，因为您将看到，代码旨在将粒子彼此放置一个特定的距离，从而创建一个与具有相同粒子数的原始粒子相同大小的窗口。

以下是我为生成六边形网格而编写的函数的代码。

library(spatstat)

data(swedishpines)

swedishpines.df <- as.data.frame(swedishpines)

MaxXValue <- max(swedishpines.df[1])
MaxYValue <- max(swedishpines.df[2])
#The above two lines dictate the window size
NumberOfParticles <- nrow(swedishpines.df[1])
#Number of entries = number of particles

#calculate delta
intensity <- NumberOfParticles / (MaxXValue*MaxYValue)
#Intensity ---> particles / unit^2
    #Area = ( sqrt(3) / 2 ) * delta^2
    #Now - in substituting intensity in for area, it is key to recognize 
    #that there are 3 particles associated with each hexagonal tile.
    #This is because each particle on the border of the tile is really 1/3 of a 
    #a particle due to it being associated with 3 different hexagonal tiles.  
    #Since intensity = 3 Particles / Area, 
delta <- sqrt(2/(intensity*(sqrt(3))))
#This is derived from the equation for the area of a regular hexagon. 

#xcoords and ycoords represent the x and y coordintes of all of the generated points.  The 'x' and 'y' are temporary holders for the x and y coordinates of a single horizontal line of points (they are appended to xcoords and ycoords at the end of each while loop).  

xcoords <- c()
ycoords <- c()

#The following large while loop calculates the coordinates of the first set of points that are vertically aligned with one another. (alternating horizontal lines of particles)  This is shown in the image below.

y_shift <- 0
while (y_shift < MaxYValue) {

    x <- c(0)
    x_shift <- 0 + delta
    count <- 0

    while (x_shift < MaxXValue) {
        x <- append(x, x_shift)
        x_shift <- x_shift + delta
        count <- count + 1
    }

    y <- c(y_shift)

    for (i in seq(0,(count-1))) {
        y <- append(y, y_shift)
    }

    y_shift <- y_shift + sqrt(3)*delta
    xcoords <- append(xcoords,x)
    ycoords <- append(ycoords,y)

}

#The following large while loop calculates the coordinates of the second set of points that are vertically aligned with one another. This is shown in the image below. 

y_shift <- 0 + (delta*(sqrt(3)))/2
while (y_shift < MaxYValue) {

    x <- c(0 + (1/2)*delta)
    x_shift <- 0 + (1/2)*delta + delta
    count <- 0

    while (x_shift < MaxXValue) {
        x <- append(x, x_shift)
        x_shift <- x_shift + delta
        count <- count + 1
    }

    y <- c(y_shift)

    for (i in seq(0,(count-1))) {
        y <- append(y, y_shift)
    }

    y_shift <- y_shift + sqrt(3)*delta
    xcoords <- append(xcoords,x)
    ycoords <- append(ycoords,y)

}

hexplot <- ppp(xcoords, ycoords, window=owin(c(0,MaxXValue),c(0,MaxYValue)))

现在，我对R来说相对较新，因此在代码中某处导致此错误的语法错误很可能就是这样。或者，可能是我在这个过程中的思路上有些错误。但是，我认为这不太可能，因为我的结果与我一直在努力的结果非常接近（大多数时候只有1-4％的错误是相当不错的）。

总之，我想要帮助的是如何采用点模式并创建具有相同数量的粒子的相同窗口大小的另一个点模式，但是具有完美的六边形点模式。

如果你觉得某些事情不清楚，请不要犹豫让我说清楚。

谢谢！

Answer 1

如果我错了，请原谅我，但我相信你要做的事情是不可能的（在一般情况下），考虑到你在示例中显示的限制。简而言之，您能想到一种在与窗口高度和宽度相同的页面上以六边形图案绘制71个点的方法吗？我认为这种模式不存在。

要进一步解释，请考虑代码中的最后一行：

hexplot <- ppp(xcoords, ycoords, window=owin(c(0,MaxXValue),c(0,MaxYValue)))

现在，由于您的窗口与原始数据大小相同，为了获得相同的强度，您需要完全相同的点数（71）。在六边形排列的点中，您有x行，每行包含y个点。但是没有整数x和y乘以71.

话虽如此，如果你“拉伸”窗口宽度一点，那么你的一半行将包含一个点。这是一个稍微宽松的约束，但不能保证在一般情况下会有一个解决方案。

因此，要获得完全相同的点强度，您需要能够更改相对窗口大小。您需要将其拉伸以添加一些空白区域并获得较低的点强度。在一般情况下，这仍然可能不起作用......但它可能，我还没有解决。最简单的方法是从纯网格开始，然后将代码扩展为六边形。

---

查看代码时，我注意到您在使用while函数时正在使用seq循环。例如，如果您希望生成从0到x的所有MaxXValue点，增加sqrt(3)*delta，只需执行以下操作：

x<-seq(0,MaxXValue,by=delta)

而不是那个大while。这里可能存在一些错误，但我认为您可以将整个代码减少到：

library(spatstat)
data(swedishpines)
swedishpines.df <- as.data.frame(swedishpines)
MaxXValue <- max(swedishpines.df[1])
MaxYValue <- max(swedishpines.df[2])
NumberOfParticles <- nrow(swedishpines.df)
intensity <- NumberOfParticles / (MaxXValue*MaxYValue)
delta <- sqrt(2/(intensity*(sqrt(3))))
x<-seq(0,MaxXValue,by=delta)
y<-seq(0,MaxYValue,by=sqrt(3)*delta)
first.coords=merge(x,y) # Find every combo of x and y
x=seq(delta/2,MaxXValue,by=delta)
y=delta*sqrt(3)/2 + (delta*sqrt(3)*seq(0,length(x)/2))
second.coords=merge(x,y)
coords=rbind(first.coords,second.coords)
ppp(coords$x, coords$y, window=owin(c(0,MaxXValue),c(0,MaxYValue)))

最后，我在您的评论中注意到您提到六边形区域为( sqrt(3) / 2 ) * delta^2，但不是(3*sqrt(3)/2) * delta^2？ `

---

我对Josh O'Brien的评论感兴趣，并决定实施旋转功能以获得所需的确切点数。这是代码：

# Include all above code
rotate=function(deg) {
    r=matrix(c(cos(deg),-sin(deg),sin(deg),cos(deg)),byrow=T,nrow=2)
    rotated.coords=data.frame(t(r %*% t(as.matrix(coords))))
    names(rotated.coords)=c('x','y')
    rotated.coords
}

rotate.optim=function(deg) {
    rotated.coords=rotate(deg)
    abs(NumberOfParticles-length(suppressWarnings(ppp(rotated.coords$x, rotated.coords$y, window=owin(c(0,MaxXValue),c(0,MaxYValue)))$x)))
}

o=optim(0,rotate.optim,lower=0,upper=2*pi,method='Brent')
rotated.coords=rotate(o$par)
rotated.coords.window=rotated.coords[rotated.coords$x >= 0 & rotated.coords$y >= 0 & rotated.coords$x <= MaxXValue & rotated.coords$y <= MaxYValue,]
final=ppp(rotated.coords.window$x,rotated.coords.window$y,window=owin(c(0,MaxXValue),c(0,MaxYValue)))
plot(final)

Answer 2

为了完整起见，我将补充说spatstat现在有一个函数hexgrid来生成六边形网格，然后可以应用rotate.ppp来旋转模式。