Pobieranie próbek w r bez następujących po sobie identycznych cyfr

Question

Jestem całkiem nowy dla R, ale wykonałem wiele poszukiwań i nie znalazłem odpowiedzi na moje pytanie.

Mam wektor z wielu powtórzeń 8 cyfr:

allNum <- c(rep(1, 70), rep(2, 70), rep(3, 35), rep(4, 35), 
      rep(5, 70), rep(6, 70), rep(7, 35), rep(8, 35)) 

Teraz chcę zrobić permutacji to (prawdopodobnie za pomocą sample(allNum, 420, replace=FALSE)), ale nie chcę żadnych kolejnych identycznych cyfr - na przykład : 1 2 2 8

Czy istnieje prosty sposób na zrobienie tego?

Answer 1

Pożyczanie od a previous answer, jedną z metod jest brutalna siła i pobieranie próbek, dopóki nie uzyska się permutacji o pożądanych właściwościach.

nonconsec.permute <- function(pop,size) { 
    while(!exists("x",inherits=FALSE) || 0 %in% diff(x)) { 
    x <- sample(pop, size, replace=F) 
    } 
} 

Jednak poniższe polecenie zajmuje dużo czasu, ponieważ identyczne kolejne cyfry są niezwykle częste w przedstawionym przykładzie. Więc takie podejście nie byłoby możliwe w twojej konkretnej sytuacji.

nonconsec.permute(allNum,420) 

Answer 2

Masz problem, w którym istnieje możliwość wyboru elementów losowo w porównaniu do ograniczeń w dokonywanych wyborach. W szczególności, jeśli liczba elementów, które musisz wybrać, wynosi więcej niż 2n-1 $, gdzie $ n $ jest liczbą razy, kiedy występuje najczęstszy element, możesz wybrać element losowy (zgodny z wcześniejszymi ograniczeniami). Jeśli jednak liczby są równe, najczęstsza wartość musi być w każdej innej pozycji przez resztę sekwencji (a wartości między nimi mogą być losowo przypisane). Rozpoznanie tego ograniczenia pozwala na pojedyncze przejście (bez losowych wyborów, niż w oryginalnym wektorze).

permute.nonconsec <- function(allNum) { 
    fully.constrained <- function(x) { 
    2*max(table(x)) - 1 == length(x) 
    } 
    permuted <- numeric(length(allNum)) 
    permuted[1] <- sample(allNum, 1) 
    allNum <- allNum[-min(which(allNum==permuted[1]))] 
    for (i in seq_along(allNum)+1) { 
    if(fully.constrained(allNum)) { 
     # switch to deterministic algorithm 
     # determine which value is the constraining one 
     r <- rle(sort(allNum)) 
     limiter <- r$values[r$lengths==max(r$lengths)] 
     permuted[seq(i, length(permuted), by=2)] <- limiter 
     remaining <- allNum[allNum != limiter] 
     if (length(remaining)>0) { 
     permuted[seq(i+1, length(permuted), by=2)] <- 
      remaining[sample.int(length(remaining))] 
     } 
     break; 
    } 
    available <- allNum[allNum != permuted[i-1]] 
    permuted[i] <- available[sample.int(length(available), 1)] 
    allNum <- allNum[-min(which(allNum==permuted[i]))] 
    } 
    permuted 
} 

To nie powieść, jeśli nie jest możliwe rozmieszczenie: length(x) < 2 * max(table(x)) - 1, ale wstępna kontrola za które mogą być dodawane w razie potrzeby.

Answer 3

Oto prosty algorytm, że:

N = 420 
i = as.integer(runif(1, 1, length(allNum))) 
result = allNum[i] 
allNum = allNum[-i] 
while (N != 1) { 
    N = N - 1 

    # pick a random value that's different from last chosen one 
    last = result[length(result)] 
    i = as.integer(runif(1, 1, sum(allNum != last))) 
    result = c(result, allNum[allNum != last][i]) 

    # remove any (doesn't matter which) element of allNum that's 
    # equal to last choice, to sample without replacement 
    last = result[length(result)] 
    allNum = allNum[-which(allNum == last)[1]] 
}