Если вы хотите ограничить второй набор точек к одной из плиток тесселяции, вы можете использовать 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, равным (или близким к нулю). Чтобы избежать этого, мы можем добавить штраф, если лямбда невелика.
# 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
)
И что вы пытаетесь сделать уже? – juba
Возможный дубликат [вывод проекции sammon внутри полигона] (http://stackoverflow.com/questions/14853503/sammon-projection-output-within-a-polygon) – juba
Вы говорите, что знаете, как ограничить тесселяцию, так что ваш вопрос только, как масштабировать точки Саммона в один из полигонов? – Gregor