从R中至少有最小差异的数组中选择随机元素的最佳方法

Question

我想从数组中随机选择一定数量的元素，以使这些元素的相互距离始终受到限制。 例如，有一个向量a <- seq(1,1000)，我怎样才能选择 20 个元素之间的最小距离为 15？

目前，我正在使用一个简单的迭代，只要太靠近任何元素，我都会拒绝选择，但如果要选择的元素数量很多，它会很麻烦并且往往很长。是否有最佳实践/功能？

编辑 - 答案和分析摘要

到目前为止，我有两个可行的答案，我将它们包含在两个特定的函数中。

# dash2 approach
# ---------------
rand_pick_min <- function(ar, min.dist, n.picks){
  stopifnot(is.numeric(min.dist), 
            is.numeric(n.picks), n.picks%%1 == 0)
  if(length(ar)/n.picks < min.dist) 
    stop('The number of picks exceeds the maximum number of divisions that the array allows which is: ', 
         floor(length(ar)/min.dist))
  picked <- array(NA, n.picks)
  copy <- ar
  for (i in 1:n.picks) {
    stopifnot(length(copy) > 0)  
    picked[i] <- sample(copy, 1)
    copy <- copy[ abs(copy - picked[i]) >= min.dist ]
  }
  return(picked)
}

# denis approach
# ---------------
rand_pick_min2 <- function(ar, min.dist, n.picks){
  require(Surrogate)
  stopifnot(is.numeric(min.dist), 
            is.numeric(n.picks), n.picks%%1 == 0)
  if(length(ar)/n.picks < min.dist) 
    stop('The number of picks exceeds the maximum number of divisions that the array allows which is: ', 
         floor(length(ar)/min.dist))
  lar <- length(ar)
  dist <- Surrogate::RandVec(a=min.dist, b=(lar-(n.picks)*min.dist), 
                             s=lar, n=(n.picks+1), m=1, Seed=sample(1:lar, size = 1))$RandVecOutput
  return(cumsum(round(dist))[1:n.picks])
}

使用建议的相同示例，我运行了 3 个测试。一、最低限度的有效有效期

# Libs
require(ggplot2)
require(microbenchmark)

# Inputs
a <- seq(1, 1000)            # test vector
md <- 15                     # min distance
np <- 20                     # number of picks

# Run
dist_vec <- c(sapply(1:500, function(x) c(dist(rand_pick_min(a, md, np)))))   # sol 1
dist_vec2 <- c(sapply(1:500, function(x) c(dist(rand_pick_min2(a, md, np))))) # sol 2

# Tests - break the min
cat('Any distance breaking the min in sol 1?', any(dist_vec < md), '\n')  # FALSE
cat('Any distance breaking the min in sol 2?', any(dist_vec2 < md), '\n') # FALSE

其次，我测试了结果距离的分布，按照解的顺序获得了前两个图（sol1 [A] 是 dash2 的 sol，而 sol2 [B] 是 denis 的一个）。

pa <- ggplot() + theme_classic() +
  geom_density(aes_string(x = dist_vec), fill = 'lightgreen') +
  geom_vline(aes_string(xintercept = mean(dist_vec)), col = 'darkred') + xlab('Distances')
pb <- ggplot() + theme_classic() +
  geom_density(aes_string(x = dist_vec2), fill = 'lightgreen') +
  geom_vline(aes_string(xintercept = mean(dist_vec)), col = 'darkred') + xlab('Distances')
print(pa)
print(pb)

最后，我计算了两种方法所需的计算时间，如下图并得到最后一个数字。

comp_times <- microbenchmark::microbenchmark(
  'solution_1' = rand_pick_min(a, md, np),
  'solution_2' = rand_pick_min2(a, md, np),
  times = 500
)
ggplot2::autoplot(comp_times); ggsave('stckoverflow2.png')

受到结果的启发，我问自己，距离分布是应该预期的还是由于所应用的方法而导致的偏差。

EDIT2 - 根据丹尼斯的评论回答最后一个问题

使用更多的采样程序 (5000)，我生成了结果位置的 pdf，并且确实您的方法包含一些人工制品，使您的解决方案 (B) 偏离了我需要的解决方案。尽管如此，能够强制执行特定的最终职位分配将会很有趣。

Answer 1

如果您想避免命中和未命中方法，则必须将问题转化为距离总和有限制的距离样本。

基本上我如何翻译您想要的内容：您采样的 N 个位置等于 N+1 距离，范围从最小距离到向量的大小 - N*mindist（所有样本都打包在一起的情况）。然后，您需要将距离总和限制为 1000（向量的大小）。

在这种情况下，解决方案将使用 Surrogate 包中的 Surrogate::RandVec（请参阅 Random sampling to give an exact sum），它允许使用固定总和进行采样。

library(Surrogate)
a <- seq(1,1000)
mind <- 15
N <- 20
dist <- Surrogate::RandVec(a=mind, b=(1000-(N)*mind), s=1000, n=(N+1), m=1, Seed=sample(1:1000, size = 1))$RandVecOutput
pos <- cumsum(round(dist))[1:20]
pos

> pos
 [1]  22  59  76 128 204 239 289 340 389 440 489 546 567 607 724 773 808 843 883 927

dist 是距离的采样。您通过计算距离的总和来重建您的位置。它为您提供pos，即您的索引位置的向量。

优点是您可以获得任何值，并且您的采样应该是随机的。对于我不知道的速度部分，您需要与您的大数据案例的方法进行比较。

这是 1000 次尝试的直方图：

Answer 2

我认为最好的解决方案，在某种意义上保证随机性（我不确定是什么意思！）可能是：

1. 随机选择一个元素
2. 删除所有离该元素太近的元素
3. 选择另一个元素
4. 返回 2。

所以：

min_dist <- 15
a <- seq(1, 1000)
picked <- integer(20)
copy <- a
for (i in 1:20) {
  stopifnot(length(copy) > 0)
  picked[i] <- sample(copy, 1)
  copy <- copy[ abs(copy - picked[i]) >= min_dist ]
}

这是否比采样和拒绝更快可能取决于原始向量的特性。此外，正如您所看到的，您不能保证能够获得您想要的所有元素，尽管在您的特定情况下不会有问题，因为 19 个宽度为 30 的间隔永远无法覆盖整个seq(1, 1000)。