voronoi tessellations的層次結構

Question

我正在使用voronoi tessellations。我有不同的多邊形代表曲面細分中的區域。

以下幾點用於繪製圖中的曲面細分。

tessdata 
    [,1]  [,2] 
1 -0.4960583 -0.3529047 
2 -2.4986929 0.8897895 
3 3.6514561 -1.3533369 
4 -1.7263101 -5.5341202 
5 2.2140143 0.3883696 
6 -2.5208933 -1.4881461 
7 -3.2556913 4.4535629 
8 0.6423109 -2.8350062 
9 -0.4160715 1.2676151 
10 4.4059361 4.5641771 

使用tessdata作爲輸入來繪製鑲嵌如下：

library(deldir) 
dd<-deldir(tessdata[,1], tessdata[,2]) 
plot(dd,wlines="tess") 

的Sammon座標如下。

 [,1]  [,2] 
1 3.14162704 -1.45728604 
2 2.35422623 2.46437927 
3 -0.85051049 2.71503294 
4 1.94310458 -0.45936958 
5 0.08737757 3.74324701 
6 1.23007799 1.34443842 
7 0.01571924 2.19322032 
8 1.43320754 2.64818631 
9 -0.05463431 0.66980876 
10 1.51344967 5.03351176 

我想要構造輸入座標點座標點的曲面細分。使用這些點的曲面細分應位於所示圖中的一個區域內，因此，上述點應該縮放，或者我們可以在上圖中的某個區域內限制曲面細分的繪圖。

希望我已經涵蓋了所有必要的數據。

P.S：

sammon的投影出現在「MASS」包中。 「deldir」包中的voronoi tessellations。

deldir函數輸出的dirsgs參數將給出構成曲面細分中線條的點的座標。

包圖形的段函數可以用來連接座標從dirsgs中提取出來的2個點。

Answer 1

如果你想限制第二套點 到鑲嵌， 可以使用tile.list的瓷磚之一，有每個圖塊的描述， 然後檢查哪些點在這種瓷磚 （有有很多功能可以這樣做： 在下面的例子中，我用secr::pointsInPolygon）。

# Sample data 
x <- matrix(rnorm(20), nc = 2) 
y <- matrix(rnorm(1000), nc=2) 

# Tessellation 
library(deldir) 
d <- deldir(x[,1], x[,2]) 
plot(d, wlines="tess") 

# Pick a cell at random 
cell <- sample(tile.list(d), 1)[[1]] 
points(cell$pt[1], cell$pt[2], pch=16) 
polygon(cell$x, cell$y, lwd=3) 

# Select the points inside that cell 
library(secr) 
i <- pointsInPolygon(
    y, 
    cbind( 
    c(cell$x,cell$x[1]), 
    c(cell$y,cell$y[1]) 
) 
) 
points(y[!i,], pch=".") 
points(y[i,], pch="+") 

# Compute a tessellation of those points 
dd <- deldir(y[i,1], y[i,2]) 
plot(dd, wlines="tess", add=TRUE) 

相反，如果你想翻譯和重新調整的點 放到合適的瓷磚，這是棘手。

我們需要以某種方式估算如何遠離瓷磚的要點是： 爲此，讓我們從一個點定義幾個若干輔助功能來計算， 第一的距離段， 然後從距離指向多邊形的點。

distance_to_segment <- function(M, A, B) { 
    norm <- function(u) sqrt(sum(u^2)) 
    lambda <- sum((B-A) * (M-A))/norm(B-A)^2 
    if(lambda <= 0) { 
    norm(M-A) 
    } else if(lambda >= 1) { 
    norm(M-B) 
    } else { 
    N <- A + lambda * (B-A) 
    norm(M-N) 
    } 
} 
A <- c(-.5,0) 
B <- c(.5,.5) 
x <- seq(-1,1,length=100) 
y <- seq(-1,1,length=100) 
z <- apply(
    expand.grid(x,y), 
    1, 
    function(u) distance_to_segment(u, A, B) 
) 
par(las=1) 
image(x, y, matrix(z,nr=length(x))) 
box() 
segments(A[1],A[2],B[1],B[2],lwd=3) 

library(secr) 
distance_to_polygon <- function(x, poly) { 
    closed_polygon <- rbind(poly, poly[1,]) 
    if(pointsInPolygon(t(x), closed_polygon)) 
    return(0) 
    d <- rep(Inf, nrow(poly)) 
    for(i in 1:nrow(poly)) { 
    A <- closed_polygon[i,] 
    B <- closed_polygon[i+1,] 
    d[i] <- distance_to_segment(x,A,B) 
    } 
    min(d) 
} 
x <- matrix(rnorm(20),nc=2) 
poly <- x[chull(x),] 
x <- seq(-5,5,length=100) 
y <- seq(-5,5,length=100) 
z <- apply(
    expand.grid(x,y), 
    1, 
    function(u) distance_to_polygon(u, poly) 
) 
par(las=1) 
image(x, y, matrix(z,nr=length(x))) 
box() 
polygon(poly, lwd=3) 

現在，我們可以尋找形式

x --> lambda * x + a 
y --> lambda * y + b 

的改造最小化的（平方的總和）距離多邊形。 這實際上是不夠的：我們很可能最終得到比例因子 lambda等於（或接近）零。 爲了避免這種情況，我們可以添加一個懲罰，如果lambda小。

# Sample data 
x <- matrix(rnorm(20),nc=2) 
x <- x[chull(x),] 
y <- matrix(c(1,2) + 5*rnorm(20), nc=2) 
plot(y, axes=FALSE, xlab="", ylab="") 
polygon(x) 

# Function to minimize: 
# either the sum of the squares of the distances to the polygon, 
# if at least one point is outside, 
# or minus the square of the scaling factor. 
# It is not continuous, but (surprisingly) that does not seem to be a problem. 
f <- function(p) { 
    lambda <- log(1 + exp(p[1])) 
    a <- p[2:3] 
    y0 <- colMeans(y) 
    transformed_points <- t(lambda * (t(y)-y0) + a) 
    distances <- apply(
    transformed_points, 
    1, 
    function(u) distance_to_polygon(u, x) 
) 
    if(all(distances == 0)) - lambda^2 
    else      sum(distances^2) 
} 
# Minimize this function 
p <- optim(c(1,0,0), f)$par 
# Compute the optimal parameters 
lambda <- log(1 + exp(p[1])) 
a <- p[2:3] 
y0 <- colMeans(y) 
# Compute the new coordinates 
transformed_points <- t(lambda * (t(y)-y0) + a) 
# Plot them 
segments(y[,1], y[,2], transformed_points[,1], transformed_points[,2], lty=3) 
points(transformed_points, pch=3) 
library(deldir) 
plot( 
    deldir(transformed_points[,1], transformed_points[,2]), 
    wlines="tess", add=TRUE 
)