पूर्वनिर्धारित ट्रिपल में विशिष्ट तत्वों को दोहराए बिना वेक्टर को यादृच्छिक कैसे करें?

Question

मैं एक कथित तौर पर साधारण सेटअप है, जो निकला काफी चुनौतीपूर्ण बनने के लिए के साथ शुरू किया:

कहो, हम एक कटोरा जो डब्ल्यू = 60 सफेद गेंदों होता है, बी = 10 नीले रंग की गेंदों, जी = 10 हरे रंग की गेंदों और वाई है = 10 पीले रंग की गेंदें। अब मैं उस कटोरे से ट्रिपल खींचना शुरू करता हूं और उन्हें स्टोर करता हूं, जब तक कि कटोरा खाली न हो जाए। हालांकि, वहाँ एक नियम है:

नियम:

प्रत्येक ट्रिपल एक ही रंग के एक से अधिक गैर-सफेद गेंद शामिल नहीं हो सकता!

जब किया गया तो मुझे क्रमश: 0, 1, 2 और 3 गैर-सफेद गेंदों के साथ ट्रिपल के अनुपात में रूचि है।

इस समस्या को हल करने के लिए मैंने नमूनों को चित्रित करने और अस्वीकार करने के विचार से शुरुआत की, जब तक कोई नमूना न हो, जो उपरोक्त नियम को पूरा करता है।

मैं इस (उम्मीद प्रतिलिपि प्रस्तुत करने योग्य) कोड के साथ करने की कोशिश की:

1. पाश दोहराता कई बार:

   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) 
   

   दुर्भाग्य से मैं दो समस्याओं का सामना करना पड़ा! ऐसा लगता है कि नियम अक्सर उल्लंघन किया जाता है, जो इस तरह से सैंपलिंग को संभवतः व्यवहार्य नहीं बनाता है।

2. हालांकि मैंने सबसे कुशल कार्यों को कॉल करने का प्रयास किया, हालांकि वहां वहां जाने के एक से अधिक तरीके (उदा। सब्ससेट 2 कॉल), मुझे एहसास है कि यह समस्या इस समस्या को हल करने में काफी अक्षम है।

अगला मैं दो चरणों नमूना (अधिक विशिष्ट sampling पैकेज से mstage समारोह) के साथ करने की कोशिश की:

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) 

हालांकि यह या तो बाहर काम नहीं किया, मैं यह भी महसूस किया इस दृष्टिकोण की तरह 'नहीं करता है मेरी समस्या ठीक से फिट नहीं है!

सभी ने मुझे बताया कि यह मुझे थोड़ा लगता है जैसे मैं एक अखरोट को तोड़ने के लिए एक स्लेजहैमर का उपयोग कर रहा था और मुझे लगता है कि इस समस्या से निपटने में एक और अधिक प्रभावी तरीका है (विशेष रूप से जब से मैं कुछ मोंटे कार्लो चलाने के लिए चाहता हूं बाद में सिमुलेशन)।

मैं किसी भी मदद की सराहना करता हूं! अग्रिम धन्यवाद!

Answer 1

यहां एक वैकल्पिक दृष्टिकोण है जिसमें कोई संदेह नहीं किया जा सकता है, लेकिन जो मुझे लगता है कि किसी प्रकार की सांख्यिकीय समझ (तीन के नमूने में एक विशेष रंग होने से यह एक और रंग तीन के समान नमूने में कम हो जाता है) ।

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)