arrays - 从 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 - 根据 denis 的评论回答最后一个问题

使用更多的采样程序 (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 次尝试的直方图: