确保相邻点之间的最小距离

Question

确保相邻点之间的最小距离

4

我有一个包含15-25个数据点的列表/框架。它们都在0到100之间，并且有一些簇（例如大约在72左右）。当显示这些数据时，我想增加每对点之间的距离，使其至少为2（例如69.4和71.4将成为两个相邻的点）。

但是，我需要确保保留整体顺序并尽可能地使每个点保持原来的位置。

我的点列表只是

scores <- c(13.343, 17.998, 25.413, 27.721, 33.361, 47.263, 52.298, 55.981,
            57.851, 72.038, 72.204, 72.296, 73.472, 75.925, 80.748, 85.998)

我希望增加点簇之间的距离。在72.038 - 72.296这个范围内的点将会向下移动，以确保更加均匀的分布。

spacedScores <- c(13.343, 17.998, 25.413, 27.721, 33.361, 47.263, 52.298,
                  55.981, 57.851, 67.925, 69.925, 71.925, 73.925, 75.925,
                  80.748, 85.998)

有没有关于如何在R中最干净地完成这个任务的建议？

澄清一下：我不一定要求数学上最优解，只需要一个相当好的解决方案。我也想象大部分时间一些点需要向上移动，一些点需要向下移动 - 这是可以接受的。

- chmullig

2个回答

2

我想出了一个巧妙的暴力破解方法，它会迭代几次，直到数据集中的每个差异都大于2，并且所需的最小修改量也被实现：

scores <- c(13.343, 17.998, 25.413, 27.721, 33.361, 47.263, 52.298, 55.981, 57.851, 72.038, 72.204, 72.296, 73.472, 75.925, 80.748, 85.998)

done <- 0
while (any(diff(scores)<2)) {
diffs <- diff(scores)
closevals <- which(diffs < 2)
first <- closevals[which.min(diffs[closevals])]
if (which.min(diff(scores[(first-1):(first+1)])) == 1) {
    scores[1:(first-1)] <- scores[1:(first-1)] - (2 - (scores[first] - scores[first-1]))
    } else {
        scores[(first+1):length(scores)] <- scores[(first+1):length(scores)] + (2 - (scores[first+1] - scores[first]))
    }
}
> scores
 [1] 13.343 17.998 25.413 27.721 33.361 47.263 52.298 55.981 57.981 72.168
[11] 74.168 76.168 78.168 80.621 85.444 90.694

编辑：我刚刚看到有人给出了一个更好、更简单的答案（结果完全相同）。我没有删除我的复杂答案的唯一原因是我的循环还检查如果在两个数字之间加一个小数是否会比总是从较小的值中减去2-diff()更好。

我希望我的解决方案在实际数据中能更好地运行 :)

- daroczig

谢谢，无论如何都给你一个赞的好回答。 - chmullig

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- nico · Accepted Answer

你可以使用diff(scores)来找出点之间的距离（我假设值是已排序的）。

然后使用which(diff(scores) < 2)来识别“不良点”，并将它们移回以使间距=2。

问题是，纠正一个距离可能会使前一个或下一个距离变为<2，因此您需要多次重复此过程。

这里有一个示例，我“强制”解决了问题。你可能想引入计数器以避免无限循环。

scores <- c(13.343, 17.998, 25.413, 27.721, 33.361, 47.263,
    52.298, 55.981, 57.851, 72.038, 72.204, 72.296, 73.472, 
    75.925, 80.748, 85.998)
spacedScores <- c(13.343, 17.998, 25.413, 27.721, 33.361, 
    47.263, 52.298, 55.981, 57.851, 67.925, 69.925, 71.925, 
    73.925, 75.925, 80.748, 85.998)

plot(scores, pch=20)
points(spacedScores, pch='x', col="red")

badPoints <- which(diff(scores) < 2)

while (length(badPoints) > 0)
  {
  scores[badPoints] <- scores[badPoints] - (2 - diff(scores)[badPoints])
  badPoints <- which(diff(scores) < 2)
  }

points(scores, pch='o', col="green")

这是结果：黑色表示原始点，绿色表示修改后的点，红色表示您提供的间隔点。示例图