R:如何在不替换且没有连续相同值的情况下进行采样


10

我花了整整一天的时间来完成似乎很简单的事情。我必须创建300个“随机”序列,其中数字1,2、3和4都恰好出现12次,但是同一数字永远不会“连续”使用两次。

我最好的尝试是:

  1. 有R个样本,其中48个项目没有替换,请使用rle测试是否存在连续值,然后仅使用不包含连续值的序列。问题:几乎没有符合此标准的随机序列,因此要花很长时间。

  2. 具有R个创建序列而没有连续值(请参见代码)。

pop<-rep(1:4,12)
y=c()
while(length(y)!=48)
  {
  y= c(y,sample(pop,48-length(y),replace=F))
  y=y[!c(FALSE, diff(y) == 0)]
  }

问题:这将创建每个值具有不同数量的序列。然后,我尝试仅使用每个值正好为12的那些序列,但这仅使我回到问题1:花了很长时间。

必须有一些简单的方法来执行此操作,对吗?任何帮助是极大的赞赏!

Answers:


3

也许replicate()repeat循环一起使用会更快。这是一个带有3序列的例子。看起来这大约需要花费时间。1490秒300(未测试)。

set.seed(42)
seqc <- rep(1:4, each=12)  # starting sequence

system.time(
  res <- replicate(3, {
    repeat {
      seqcs <- sample(seqc, 48, replace=FALSE) 
      if (!any(diff(seqcs) == 0)) break
    }
    seqcs
  })
)
#  user  system elapsed 
# 14.88    0.00   14.90 

res[1:10, ]
#       [,1] [,2] [,3]
#  [1,]    4    2    3
#  [2,]    1    1    4
#  [3,]    3    2    1
#  [4,]    1    1    4
#  [5,]    2    3    1
#  [6,]    4    1    2
#  [7,]    3    4    4
#  [8,]    2    1    1
#  [9,]    3    4    4
# [10,]    4    3    2

1
非常感谢!创建100个序列需要800秒,在这种情况下,这是完全可以接受的。解决了我的问题!
CookieMons

1

另一种选择是使用马尔可夫链蒙特卡罗方法随机交换2个数字,并且仅在以下情况下移动到新样本中:1)我们不交换相同的数字并且2)没有2个相同的数字相邻。为了处理相关样本,我们可以生成很多样本,然后随机选择其中的300个:

v <- rep(1:4, 12)
l <- 48
nr <- 3e5
m <- matrix(0, nrow=nr, ncol=l)
count <- 0
while(count < nr) {
    i <- sample(l, 2)
    if (i[1L] != i[2L]) {
        v[i] = v[i[2:1]]
        if (!any(diff(v)==0)) {
            count <- count + 1
            m[count, ] <- v
        } else {
            v[i] = v[i[2:1]]
        }
    }
}
a <- m[sample(nr, 300),]
a

1

您可以取出连续的值并将其放置在不连续的位置。

unConsecutive  <- function(x) {
    repeat{
        tt <- c(FALSE, diff(x)==0)
        if(any(tt)) {
            y <- x[which(tt)]
            x <- x[which(!tt)]
            i <- x != y[1]
            i  <- which(c(c(TRUE, diff(i)==0) & i,FALSE)
                        | c(FALSE, c(diff(i)==0, TRUE) & i))
            if(length(i) > 0) {
                i <- i[1]-1
                x <- c(x[seq_len(i)], y, x[i+seq_len(length(x)-i)])
            } else {
                x  <- c(x, y)
                break
            }
        } else {break}
    }
    x
}

unConsecutive(c(1,1,2))
#[1] 1 2 1
unConsecutive(c(1,1,1))
#[1] 1 1 1

set.seed(7)
system.time(
    res <- replicate(300, unConsecutive(sample(rep(1:4,12))))
)
#   user  system elapsed 
#  0.058   0.011   0.069 
all(apply(res, 2, table) == 12)
#[1] TRUE
all(apply(res, 2, diff) != 0)
#[1] TRUE
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.