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

Posted 2023-03-14

【中文标题】如何在不重复预定义三元组中的特定元素的情况下随机化向量？

【英文标题】：How to randomize a vector without repeating specific elements in predefined triples?

【发布时间】：2016-04-08 00:53:40

【问题描述】：

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

说，我们有一个碗，里面有 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 调用），我有一种感觉，这段代码在解决这个问题方面效率很低。

接下来我尝试了两阶段采样（更具体的是 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)

虽然这也没有成功，但我也觉得这种方法不太适合我的问题！

总而言之，在我看来，这有点像我在用大锤敲碎坚果，我觉得有一种更有效的方法来解决这个问题（特别是因为我想运行一些蒙特卡罗模拟之后）。

如果有任何帮助，我将不胜感激！ 提前致谢！

【问题讨论】：

在 Rcpp 中实现你的功能。

【参考方案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)

【讨论】：

谢谢，@Henry！这真的解决了我的主要问题。现在，我能够基于您的代码构建 MC 模拟，同时包括一些 Rcpp（如 @Roland 建议的）和其他有效的编码方法以使其更快。我现在正在努力解决的唯一问题是，当相应的值为零时，“结果”表不会显示零，而是简单地删除该值，这会导致错误，当我尝试总结输出时经过大量的迭代。

@freeconomist：我不知道你说的删除值是什么意思。如果你尝试coloursinsamples(6,1,1,1) 或coloursinsamples(3,3,3,3) 几次而不设置种子，你每次应该得到四个值，其中一些是0。

例如，当我使用 coloursinsamples(150,15,15,15) 尝试您的代码并将种子设置为 (3) 时，“结果”表会忽略第三个值（而不是返回“0”）。

尝试set.seed(3); res <- coloursinsamples(150,15,15,15); res; length(res) 我得到了24 37 4 0 的结果和4 的向量长度，正如我所料。零实际上在那里，因为它是由我的代码中的if(! "3" %in% names(result)) result <- c(result, "3"=0) 行插入的

确实！我的错！我更改了一些代码，尝试重复函数并将输出存储到全局环境中的向量中。不幸的是，我将结果存储在错误的位置，代码末尾的最终 if 语句没有机会触发。非常感谢您的帮助！