R：共识投票的模拟研究

Question

在这项研究中，我要求nRaters 对不同的响应选项进行投票（他们对不同选项的响应概率由ProbabilityDist 定义，如下所示）。对于每个item.i，投票在两种情况下停止（以先到者为准）：

1. “投票”数超过AgreementThreshold（即同意某项的人数百分比。
2. 回答问题的评分者的最大数量（由MaxNRaters 定义）

例如，如果 Rater1 和 Rater2 响应“A”，则投票停止，但如果 R​​ater1 响应“A”但 Rater2 响应“B”，则投票继续（在这种情况下，如果 Rater3 响应“A”，则应返回“A”，因为更多已达到 50% 以上。但是，如果 Rater3 响应“C”-“H”，则应返回“NoAgreement”，因为未达到 AgreementThreshold）。

我已经启动了下面的代码，但我一直在思考如何创建一个有条件停止的循环或函数。我也想重复这个，这样我就可以像d.out中的示例输出一样返回输出。

ResponseChoices= LETTERS[1:8]
ProbabilityDist= c(0.6, 0.2, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03)
MaxNRaters=3
AgreementThreshold = .5 
    #Obtain consensus answer when greater than 50% of raters agree 
    #e.g., if votes for Item.i = "A" "H" "A" return "A"

### Some kind of conditional loop here ###
### Note: the loop should iterate through multiple items using the stop rules described above

VotesForItem.i <- sample(ResponseChoices, nRaters, replace=TRUE, prob=ProbabilityDist)

##########################################


# return(votes)

#Sample of desired output
items=c(1:5)
VotedResponses=c("A","A","B","NoAgreement","A")
d.out=cbind(items,VotedResponses)

Answer 1

按照您的要求执行，尽管对于较大的 MaxNRaters 值确实很慢。

items <- 3    
responses <- c(8, 5, 4) # number of responses for each item
ResponseChoices <- lapply(1:items, function(i) paste0(LETTERS[1:responses[i]], i))
ProbabilityDist <- lapply(1:items, function(i)rmultinom(1, 100, prob = 1:responses[i])/100)

MaxNRaters=3
AgreementThreshold = .5
simResults=NULL
for(j in 1:items){
    i <- 1
    VotedResponses <- c()
    Rater <- c()
    decision <- c()
    while(i<=MaxNRaters){
        Rater <- c(Rater, i)

        resp <- sample(ResponseChoices[[j]], 1 , replace=TRUE, prob=ProbabilityDist[[j]])
        VotedResponses <- c(VotedResponses, resp)
        if(any(table(VotedResponses) > i*AgreementThreshold)&i>1) {
            decision <- c(decision, resp)
            break
        }
        else{
            decision <- c(decision, "No Agreement")
            i <- i+1
        }
    }
    nraters=length(decision)
    decision=decision[nraters]

    simResults.i=cbind(j, nraters,decision)

    simResults=rbind(simResults, simResults.i)
}

或接近你想要的输出的东西

library(dplyr)
data_frame(responses=sample(ResponseChoices, 5, replace=TRUE, prob=ProbabilityDist))%>%
    group_by(responses) %>% mutate(counts=1:n()) %>% ungroup %>% 
    mutate(d= floor(row_number()*AgreementThreshold))%>%  
    mutate(decision=ifelse( cummax(counts) > d, responses, "NoAgreement"))%>% 
    select(-counts, -d)

#   responses    decision
#1         B           B
#2         A NoAgreement
#3         A           A
#4         A           A
#5         A           A

投票在非NoAgreement 决定的第一个实例中停止。在上面的示例中，它在 3 处停止。