我正在使用voronoi镶嵌。我有不同的多边形，代表着镶嵌中的区域。
下面的点用于在图中绘制镶嵌。
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
我想构造输入sammon坐标点的镶嵌。使用这些点的镶嵌细分应位于所示图中的一个区域内，为此，应缩放上述点，否则我们可以将镶嵌细分的图限制在上图中的一个区域内。
希望我已经涵盖了所有必要的数据。
附言：
sammon的投影采用“ MASS”包装。
来自“ deldir”包的voronoi镶嵌。
deldir函数输出的dirsgs参数将给出镶嵌中形成直线的点的坐标。
封装图形的线段功能可用于连接从dirsgs中提取其坐标的2个点。
最佳答案
如果要限制第二组积分
到镶嵌的其中一块，
您可以使用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
)