R: comment échantillonner sans remplacement ET sans mêmes valeurs consécutives

J'ai passé plus d'une journée à essayer d'accomplir ce qui semble être une chose très simple. Je dois créer 300 séquences «aléatoires» dans lesquelles les nombres 1, 2, 3 et 4 apparaissent tous exactement 12 fois, mais le même nombre n'est jamais utilisé deux fois de suite / consécutivement.

Mes meilleures tentatives (je suppose) ont été:

1. avoir R échantillon 48 éléments sans remplacement, tester s'il existe des valeurs consécutives avec rle, puis utiliser uniquement les séquences qui ne contiennent pas de valeurs consécutives. Problème: il n'y a presque pas de séquences aléatoires qui répondent à ce critère, donc cela prend une éternité.

2. avoir R créer des séquences sans valeurs consécutives (voir 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)]
  }

Problème: cela crée des séquences avec des nombres variables de chaque valeur. J'ai ensuite essayé d'utiliser uniquement ces séquences avec exactement 12 de chaque valeur, mais cela ne m'a ramené qu'au problème 1: prend une éternité.

Il doit y avoir un moyen facile de le faire, non? Toute aide est grandement appréciée!

Peut-être que l'utilisation replicate()avec une repeatboucle est plus rapide. ici un exemple avec des 3séquences. On dirait que cela prendrait environ. 1490 secondes avec 300(non testé).

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

Une autre option consiste à utiliser une méthode Markov Chain Monte-Carlo pour échanger 2 nombres au hasard et passer au nouvel échantillon uniquement lorsque 1) nous n'échangeons pas le même nombre et 2) pas 2 nombres identiques sont adjacents. Pour traiter les échantillons corrélés, nous pouvons générer un grand nombre d'échantillons, puis en sélectionner au hasard 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

Vous pouvez retirer des valeurs consécutives et les placer là où elles ne sont pas consécutives.

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