无偿地抽签样品

Question

[如何在不替换的情况下在sapply函数中抽取样本？考虑下面的以下MWE。我要达到的目的是让idDRAW中的数字接收到chrSMPL的字母（给定chrSMPL的样本大小）。 idDRAW中的数字是否接收到字母取决于相应的概率，风险因素和类别。这是在sapply函数中计算并存储在tmp中。

问题在于样品更换，导致一个数字多次用字母命名。在仍然使用sapply功能的同时如何避免更换？我已尝试根据此问题（Alternative for sample）调整代码以适合我的需要，但是没有运气。预先感谢。

set.seed(3)
chr<- LETTERS[1:8]
chrSMPL<- sample(chr, size = 30, replace = TRUE) 
idDRAW<- sort(sample(1:100, size = 70, replace = FALSE)) 
p_mat<- matrix(runif(16, min = 0, max = 0.15), ncol = 2); rownames(p_mat) <- chr  ## probability matrix
r_mat <- matrix(rep(c(0.8, 1.2), each = length(chr)), ncol = 2); rownames(r_mat) <- chr ## risk factor matrix
r_cat<- sample(1:2, 70, replace = TRUE) ## risk categories

# find number from `idDRAW` to be named a letter:
Out<- sapply(chrSMPL, function(x){
  tmp<- p_mat[x, 1] * r_mat[x, r_cat]
  sample(idDRAW, 1, prob = tmp)
})

> sort(Out)[1:3]
G B B 
5 5 5 

Answer 1

我使用了一个for循环的替代解决方案，如下所示。如果有人可以在不使用for循环的情况下提供有关如何实现所需结果的建议，将不胜感激。

set.seed(3)
Out <- c()
for(i in 1:length(chrSMPL)){
  tmp <- p_mat[chrSMPL[i], 1] * r_mat[chrSMPL[i], r_cat]
  Out <- c(Out, sample(idDRAW, 1, prob = tmp))
  rm <- which(idDRAW == Out[i])
  idDRAW <- idDRAW[-rm]
  r_cat <- r_cat[-rm]
}

names(Out) <- chrSMPL
sort(Out)[1:3]