R: cara mengambil sampel tanpa penggantian DAN tanpa nilai yang sama berturut-turut

Saya telah menghabiskan lebih dari satu hari mencoba untuk mencapai apa yang tampaknya menjadi hal yang sangat sederhana. Saya harus membuat 300 urutan 'acak' di mana angka 1,2,3 dan 4 semuanya muncul tepat 12 kali, tetapi angka yang sama tidak pernah digunakan dua kali 'berturut-turut' / berturut-turut.

Upaya terbaik saya (saya kira) adalah:

1. memiliki sampel R 48 item tanpa penggantian, uji apakah ada nilai berturut-turut dengan rle, kemudian gunakan hanya urutan yang tidak mengandung nilai berturut-turut. Masalah: hampir tidak ada urutan acak yang memenuhi kriteria ini, sehingga dibutuhkan selamanya.

2. minta R membuat urutan tanpa nilai berturut-turut (lihat kode).

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)]
  }

Masalah: ini menciptakan urutan dengan angka yang berbeda dari setiap nilai. Saya kemudian mencoba menggunakan hanya sekuens tersebut dengan tepat 12 dari setiap nilai, tetapi itu hanya membawa saya kembali ke masalah 1: membutuhkan selamanya.

Pasti ada cara mudah untuk melakukan ini, kan? Setiap bantuan sangat dihargai!

Mungkin menggunakan replicate()dengan repeatloop lebih cepat. di sini contoh dengan 3urutan. Sepertinya ini akan membutuhkan sekitar. 1490 detik dengan 300(tidak diuji).

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

Pilihan lain adalah dengan menggunakan metode Markov Chain Monte-Carlo untuk bertukar 2 angka secara acak dan pindah ke sampel baru hanya ketika 1) kita tidak bertukar nomor yang sama dan 2) tidak ada 2 angka yang identik berdekatan. Untuk mengatasi sampel yang berkorelasi, kami dapat menghasilkan banyak sampel dan kemudian secara acak memilih 300 di antaranya:

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

Anda dapat mengambil nilai berturut-turut dan menempatkannya di tempat yang tidak berurutan.

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