Jak dobrać losowo wektor bez powtarzania określonych elementów w predefiniowanych trójkach?

Question

Zacząłem rzekomo prostej konfiguracji, która okazała się dość trudne:

Say, mamy miskę zawierającą W = 60 białe kule, B = 10 niebieskie kule, G = 10 zielone kulki i Y = 10 żółtych kulek. Teraz zaczynam rysować trójki z tej miski i przechowywać je, dopóki miska nie będzie pusta. Jednak jest jedna zasada:

Reguła:

Każde potrójne nie może zawierać więcej niż jeden non-białą piłkę w tym samym kolorze!

Po zakończeniu jestem zainteresowany stosunkiem trójek z 0, 1, 2 i 3 nie-białymi kulkami, odpowiednio.

Aby rozwiązać ten problem, zacząłem od pomysłu rysowania i odrzucania próbek, dopóki nie pojawi się próbka spełniająca powyższą REGUŁĘ.

Próbowałem z tym (mam nadzieję) powtarzalnego kodu:

W = rep(0, times = 60) 
BGY = c(rep(1, times = 10),rep(2, times = 10),rep(3, times = 10)) 
sumup = matrix(c(rep(1,times=3)),byrow=FALSE) 
OUTPUT = c(0,0,0,0) 

getBALLS = function(W,BGY){ 
    k = 0 
    while (k == 0){ 
    POT = c(W, BGY) 
    STEPS = (length(W) + length(BGY))/3 
    randPOT <<- sample(POT, STEPS*3, replace=FALSE) 
    for(j in 1:STEPS){ 
     if (.subset2(randPOT,3*j-2)!=.subset2(randPOT,3*j-1) && 
      .subset2(randPOT,3*j-2)!= .subset2(randPOT,3*j) && 
      .subset2(randPOT,3*j-1)!=.subset2(randPOT,3*j)){ 
     next 
     } 
     else getBALLS(W, BGY) 
    } 
    k = 1 
    } 
    TABLES = matrix(randPOT, nrow=3, byrow=FALSE) 
    Bdistr = t(TABLES) %*% sumup 
    for(i in 1:STEPS){ 
    if (.subset2(Bdistr,i)==1) OUTPUT[1] <<- .subset2(OUTPUT,1)+1 
    else if (.subset2(Bdistr,i)==0) OUTPUT[4] <<- .subset2(OUTPUT,4)+1 
    else if (.subset2(Bdistr,i)==2) OUTPUT[2] <<- .subset2(OUTPUT,2)+1 
    else OUTPUT[3] <<- .subset2(OUTPUT,3)+1 
    } 
    rOUTPUT = OUTPUT/ STEPS 
    return(rOUTPUT) 
}  

set.seed(1) 
getBALLS(W,BGY) 

Niestety natknąłem się dwa problemy:

1. pętli iteracje zbyt wiele razy! Wygląda na to, że zasada jest często naruszana, co sprawia, że ​​pobieranie próbek w ten sposób prawdopodobnie nie jest możliwe.
2. Chociaż starałem się wywoływać najbardziej wydajne funkcje, gdy istnieje więcej niż jeden sposób dotarcia do nich (na przykład wywołanie .subset2), mam wrażenie, że ten kod jest dość nieskuteczny w rozwiązaniu tego problemu.

Następny Próbowałem z próbek dwustopniowym (bardziej konkretnym funkcja mstage z pakietu sampling):

Stage1 = c(rep(0,12), rep(1,3), rep(2,3)) 
Stage2 = c(rep(0,12), rep(1,3), rep(2,3)) 
b = data.frame(Stage1, Stage2) 
probs = list(list((1/12) , (1/3), (1/3)), list(rep(1/12,12),rep(1/3,3),rep(1/3,3))) 
m = mstage(b, stage = list("cluster","cluster"), varnames = list("Stage1","Stage2"), 
      size = list(3,c(1,1,1)), method = "systematic", pik = probs) 

Chociaż nie wyszło też, ja też czułem się jak to podejście nie robi” t tak dobrze pasuje do mojego problemu!

Wszystko wskazywało na to, że użyłem młota do złamania nakrętki i mam wrażenie, że jest o wiele skuteczniejszy sposób rozwiązania tego problemu (zwłaszcza, że ​​chciałbym uruchomić trochę Monte Carlo następnie symulacje).

Doceniam każdą pomoc! Z góry dziękuję!

Answer 1

Oto alternatywne podejście, które bez wątpienia mogłoby zostać ulepszone, ale które według mnie ma jakiś sens statystyczny (posiadanie określonego koloru w próbie trzech sprawia, że ​​mniej prawdopodobne jest, że inny kolor znajduje się w tej samej próbce trzech) .

coloursinsamples <- function (W,B,G,Y){ 
    WBGY <- c(W,B,G,Y) 
    if(sum(WBGY) %% 3 != 0){ warning("cannot take exact full sample") } 
    numbersamples <- sum(WBGY)/3 
    if(max(WBGY[2:4]) > numbersamples){ warning("too many of a colour") } 

    weights <- rep(3,numbersamples) 
    sampleB <- sample(numbersamples, size=WBGY[2], prob=weights) 
    weights[sampleB] <- weights[sampleB]-1 
    sampleG <- sample(numbersamples, size=WBGY[3], prob=weights) 
    weights[sampleG] <- weights[sampleG]-1 
    sampleY <- sample(numbersamples, size=WBGY[4], prob=weights) 
    weights[sampleY] <- weights[sampleY]-1 

    numbercolours <- table(table(c(sampleB,sampleG,sampleY))) 
    result <- c("0" = numbersamples - sum(numbercolours), numbercolours) 
    if(! "1" %in% names(result)){ result <- c(result, "1"=0) } 
    if(! "2" %in% names(result)){ result <- c(result, "2"=0) } 
    if(! "3" %in% names(result)){ result <- c(result, "3"=0) } 
    result[as.character(0:3)] 
    } 

set.seed(1) 
coloursinsamples(6,1,1,1) 
coloursinsamples(60,10,10,10) 
coloursinsamples(600,100,100,100) 
coloursinsamples(6000,1000,1000,1000)