R: Wie man ohne Ersatz UND ohne aufeinanderfolgende gleiche Werte probiert

Ich habe über einen Tag lang versucht, etwas zu erreichen, das sehr einfach zu sein scheint. Ich muss 300 'zufällige' Sequenzen erstellen, in denen die Zahlen 1,2,3 und 4 alle genau 12 Mal vorkommen, aber die gleiche Zahl wird nie zweimal 'hintereinander' / nacheinander verwendet.

Meine besten Versuche (ich denke) waren:

1. Lassen Sie R 48 Elemente ersatzlos testen, testen Sie, ob es mit rle aufeinanderfolgende Werte gibt, und verwenden Sie dann nur die Sequenzen, die keine aufeinanderfolgenden Werte enthalten. Problem: Es gibt fast keine zufälligen Sequenzen, die dieses Kriterium erfüllen, daher dauert es ewig.

2. Lassen Sie R Sequenzen ohne aufeinanderfolgende Werte erstellen (siehe Code).

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

Problem: Dadurch werden Sequenzen mit unterschiedlichen Nummern für jeden Wert erstellt. Ich habe dann versucht, nur diese Sequenzen mit genau 12 von jedem Wert zu verwenden, aber das brachte mich nur zu Problem 1 zurück: dauert ewig.

Es muss einen einfachen Weg geben, das zu tun, oder? Jede Hilfe wird sehr geschätzt!

Vielleicht ist die Verwendung replicate()mit einer repeatSchleife schneller. hier ein Beispiel mit 3Sequenzen. Sieht so aus, als würde das ca. dauern. 1490 Sekunden mit 300(nicht getestet).

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

Eine andere Möglichkeit besteht darin, eine Markov-Ketten-Monte-Carlo-Methode zu verwenden, um 2 Zahlen zufällig auszutauschen und nur dann zur neuen Stichprobe zu wechseln, wenn 1) nicht dieselbe Zahl ausgetauscht wird und 2) keine 2 identischen Zahlen benachbart sind. Um korrelierte Stichproben zu adressieren, können wir viele Stichproben generieren und dann 300 davon zufällig auswählen:

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

Sie können aufeinanderfolgende Werte herausnehmen und dort platzieren, wo sie nicht aufeinander folgen.

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