r - 如何在不重复预定义三元组中特定元素的情况下将向量随机化？

我从一个简单的设置开始，结果变得非常具有挑战性:

假设我们有一个盛有W = 60个白球，B = 10个蓝球，G = 10个绿球和Y = 10个黄球的碗。
现在，我开始从该碗中取出三元组并将其存储起来，直到碗空了。
但是，有一个规则:

规则:

完成后，我对分别具有0、1、2和3个非白色球的三元组的比例感兴趣。

为了解决这个问题，我从绘制和拒绝样本的想法开始，直到有一个样本，它填补了上面的规则。

我尝试了此(希望可复制)的代码:

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)

不幸的是，我遇到了两个问题:

循环重复了太多次!似乎该规则经常被违反，这使得以这种方式进行采样可能不可行。

尽管我尝试调用效率最高的函数，但是当有多种方法到达那里时(例如.subset2调用)，我有种感觉，这段代码在解决此问题方面效率很低。

接下来，我尝试了两阶段采样(更具体的是mstage软件包中的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)

虽然这也没有解决，但我也觉得这种方法不太适合我的问题!

总的来说，在我看来，我好像是用大锤砸开螺母的，而且我觉得有一个更有效的方法来解决这个问题(尤其是因为我以后要进行一些蒙特卡洛模拟)。

我将不胜感激!
提前致谢!

最佳答案

这是一种毫无疑问可以改进的替代方法，但我认为这在某种意义上是统计意义上的(在三个样本中具有特定的颜色可以减少在同一三个样本中使用另一种颜色的可能性)。

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)

关于r - 如何在不重复预定义三元组中特定元素的情况下将向量随机化？，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/34590669/