Lấy mẫu bằng r mà không có các chữ số giống nhau liên tiếp

Question

Tôi khá mới đối với R, nhưng tôi đã thực hiện rất nhiều tìm kiếm và chưa tìm thấy câu trả lời cho câu hỏi của mình.

Tôi có một vector với nhiều lần lặp lại của 8 chữ số:

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

Bây giờ tôi muốn để có một hoán vị của việc này (có lẽ sử dụng sample(allNum, 420, replace=FALSE)), nhưng tôi không muốn bất kỳ chữ số giống hệt nhau liên tiếp - ví dụ : 1 2 2 8

Có cách nào đơn giản để thực hiện việc này không?

Answer 1

Vay từ a previous answer, một phương pháp là hiệu quả và tiếp tục lấy mẫu cho đến khi bạn có được hoán vị với các đặc tính mong muốn.

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

Tuy nhiên, lệnh sau đây mất nhiều thời gian vì các chữ số liên tiếp giống hệt nhau rất phổ biến trong ví dụ bạn trình bày. Vì vậy, cách tiếp cận này sẽ không khả thi trong tình huống cụ thể của bạn.

nonconsec.permute(allNum,420) 

Answer 2

Bạn gặp vấn đề khi có khả năng chọn yếu tố ngẫu nhiên so với giới hạn về lựa chọn của bạn. Cụ thể, nếu số lượng phần tử bạn phải chọn là hơn $ 2n-1 $ trong đó $ n $ là số lần phần tử thường gặp nhất xảy ra, bạn có thể chọn một phần tử ngẫu nhiên (phù hợp với các ràng buộc trước đó). Tuy nhiên, nếu những con số này bằng nhau, thì giá trị thường xuyên nhất phải ở vị trí khác cho phần còn lại của chuỗi (và các giá trị giữa có thể được gán ngẫu nhiên). Việc nhận biết ràng buộc này cho phép một lượt đi qua (không có lựa chọn ngẫu nhiên nào hơn là có các phần tử trong vector ban đầu).

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 
} 

Điều này sẽ thất bại nếu không thể sắp xếp: length(x) < 2 * max(table(x)) - 1, nhưng kiểm tra ban đầu có thể được thêm nếu muốn.

Answer 3

Dưới đây là một thuật toán đơn giản cho rằng:

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