简体   繁体   中英

Sample draw in sapply without replacement

How does one draw a sample within a sapply function without replacement? Consider the following MWE below. What I am trying to achieve is for a number in idDRAW to receive a letter from chrSMPL (given the sample size of chrSMPL ). Whether a number from idDRAW receives a letter is determined by the respective probabilities, risk factors and categories. This is calculated in the sapply function and stored in tmp .

The issue is sample replacement, leading to a number being named with a letter more than once. How can one avoid replacement whilst still using the sapply function? I have tried to adjust the code from this question ( Alternative for sample ) to suit my needs, but no luck. Thanks in advance.

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 

I managed with an alternative solution using a for loop as seen below. If anyone can offer suggestions on how the desired result can be achieved without using a for loop it would be greatly appreciated.

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]

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM