找到坐标子集

Question

我有一个问题，我希望在R中用下面的示例数据解决。我知道这肯定已经解决过很多次但是我找不到一个适合我的解决方案。

我想要做的核心是找到如何将一组2D坐标转换为最适合另一个更大的2D坐标集。想象一下，例如在夜晚出现一小片星空的宝丽来照片，你想要把它举起来，以便它们与星星的当前位置相匹配。

以下是如何生成类似于我的真实问题的数据：

# create reference points (the "starry sky")
set.seed(99)
ref_coords = data.frame(x = runif(50,0,100), y = runif(50,0,100))

# generate points take subset of coordinates to serve as points we 
# are looking for ("the Polaroid")
my_coords_final = ref_coords[c(5,12,15,24,31,34,48,49),]

# add a little bit of variation as compared to reference points 
# (data should very similar, but have a little bit of noise)
set.seed(100)
my_coords_final$x = my_coords_final$x+rnorm(8,0,.1)
set.seed(101)
my_coords_final$y = my_coords_final$y+rnorm(8,0,.1)

# create "start values" by, e.g., translating the points we are 
# looking for to start at (0,0)  
my_coords_start =apply(my_coords_final,2,function(x) x-min(x))

# Plot of example data, goal is to find the dotted vector that 
# corresponds to the translation needed
plot(ref_coords, cex = 1.2) # "Starry sky"
points(my_coords_start,pch=20, col = "red") # start position of "Polaroid"
points(my_coords_final,pch=20, col = "blue") # corrected position of "Polaroid"
segments(my_coords_start[1,1],my_coords_start[1,2],
my_coords_final[1,1],my_coords_final[1,2],lty="dotted")

如上绘制数据应该产生：

我想要的结果基本上是上图中的虚线所代表的，即x和y的增量，我可以应用于起始坐标，将它们移动到参考网格中的正确位置。

有关实际数据的详细信息

我的点和参考点之间应该几乎没有旋转或缩放差异。

我的真实数据大约是1000个参考点，最多可以搜索几百个点（如果效率更高，则可以使用更少的点）

我希望必须搜索大约10到20组参考点才能找到我的匹配，因为许多参考集都不包含我的分数。

感谢您的时间，我真的很感激任何意见！

编辑：为了澄清，右图表示参考数据。左图表示我想要在参考数据中翻译的点，以便找到它们与参考最匹配的位置。在这种情况下，该位置由上图中的蓝点表示。

最后，任何工作策略都不得使用my_coords_final中的数据，而是使用my_coords_start从ref_coords开始重现这组坐标。

Answer 1

因此，我使用optim()发布的前一种方法（参见编辑历史记录）最小化点之间的距离总和仅适用于作为参考数据的点分布位于中间的有限环境中点场。满足该问题并且似乎仍然可用于几千个点的解决方案将是一个蛮力增量和比较算法，它计算场中每个点与参考数据的单个点之间的差异，然后确定如何其余参考数据中的许多都在最小阈值范围内（需要考虑数据中的噪声）：

##  A brute-force approach where min_dist can be used to 
##    ameliorate some random noise:
min_dist <- 5 
win_thresh <- 0
win_thresh_old <- 0
for(i in 1:nrow(ref_coords)) {
  x2 <- my_coords_start[,1]
  y2 <- my_coords_start[,2]
  x1 <- ref_coords[,1] + (x2[1] - ref_coords[i,1])
  y1 <- ref_coords[,2] + (y2[1] - ref_coords[i,2])

  ##  Calculate all pairwise distances between reference and field data:
  dists <- dist( cbind( c(x1, x2), c(y1, y2) ), "euclidean")

  ##  Only take distances for the sampled data:
  dists <- as.matrix(dists)[-1*1:length(x1),]

  ##  Calculate the number of distances within the minimum
  ##    distance threshold minus the diagonal portion:
  win_thresh <- sum(rowSums(dists < min_dist) > 1)  

  ##  If we have more "matches" than our best then calculate a new
  ##    dx and dy:
  if (win_thresh > win_thresh_old) {
    win_thresh_old <- win_thresh
    dx <- (x2[1] - ref_coords[i,1])
    dy <- (y2[1] - ref_coords[i,2])
  }
}

##  Plot estimated correction (your delta x and delta y) calculated
##    from the brute force calculation of shifts:
points(
  x=ref_coords[,1] + dx, 
  y=ref_coords[,2] + dy,
  cex=1.5, col = "red"
)

我非常有兴趣知道是否有人能够以更有效的方式解决测试数据中的点数问题，可能使用统计或优化算法。