在R中选择n个最远的点

Question

给定一组 xy 坐标，我如何选择 n 个点，使这 n 个点彼此相距最远？

一种低效的方法可能不适用于大型数据集，如下所示（从 1000 个点中找出最远的 20 个点）：

xy <- cbind(rnorm(1000),rnorm(1000))

n <- 20
bestavg <- 0
bestSet <- NA
for (i in 1:1000){
    subset <- xy[sample(1:nrow(xy),n),]
    avg <- mean(dist(subset))
    if (avg > bestavg) {
        bestavg <- avg
        bestSet <- subset
    }
}

Answer 1

此代码基于 Pascal 的代码，删除距离矩阵中行和最大的点。

m2 <- function(xy, n){

    subset <- xy

    alldist <- as.matrix(dist(subset))

    while (nrow(subset) > n) {
        cdists = rowSums(alldist)
        closest <- which(cdists == min(cdists))[1]
        subset <- subset[-closest,]
        alldist <- alldist[-closest,-closest]
    }
    return(subset)
}

在高斯云上运行，其中m1 是@pascal 的函数：

> set.seed(310366)
> xy <- cbind(rnorm(1000),rnorm(1000))
> m1s = m1(xy,20)
> m2s = m2(xy,20)

通过查看点间距离的总和来了解谁做得最好：

> sum(dist(m1s))
[1] 646.0357
> sum(dist(m2s))
[1] 811.7975

方法 2 获胜！并与 20 个点的随机样本进行比较：

> sum(dist(xy[sample(1000,20),]))
[1] 349.3905

效果不如预期。

那么发生了什么？让我们绘制：

> plot(xy,asp=1)
> points(m2s,col="blue",pch=19)
> points(m1s,col="red",pch=19,cex=0.8)

方法 1 生成红点，这些红点在空间上均匀分布。方法 2 创建几乎定义周长的蓝点。我怀疑这样做的原因很容易解决（在一个维度上甚至更容易......）。

使用初始点的双峰模式也说明了这一点：

同样，方法 2 产生的总和距离比方法 1 大得多，但两者都比随机抽样好：

> sum(dist(m1s2))
[1] 958.3518
> sum(dist(m2s2))
[1] 1206.439
> sum(dist(xy2[sample(1000,20),]))
[1] 574.34

Answer 2

按照@Spacedman 的建议，我编写了一个函数，该函数从最近的对中删除一个点，直到保留所需的点数。它似乎运作良好，但是随着您的加分，它会很快变慢。

xy <- cbind(rnorm(1000),rnorm(1000))

n <- 20

subset <- xy

alldist <- as.matrix(dist(subset))
diag(alldist) <- NA
alldist[upper.tri(alldist)] <- NA

while (nrow(subset) > n) {
    closest <- which(alldist == min(alldist,na.rm=T),arr.ind=T)
    subset <- subset[-closest[1,1],]
    alldist <- alldist[-closest[1,1],-closest[1,1]]
}