Calibration of a group

From Opasnet
Jump to: navigation, search



Scope

What is the calibration of a group according to answers to an open assessment quiz?

Definition

Data

Calibration of a group(#)
ObsParameterPersonP0.5P0.6P0.7P0.8P0.9P1.0
1Number of questions Person 1 4 4 4 4 4 4
2Number of questions Person 2 4 4 4 4 4 4
3Number of questions Person 3 4 4 4 4 4 4
4Number of questions Person 4 4 4 4 4 4 4
5Number of questions Person 5 4 4 4 4 4 4
6Number of questions Person 6 4 4 4 4 4 4
7Number of questions Person 7 4 4 4 4 4 4
8Number of questions Person 8 4 4 4 4 4 4
9Number of questions Person 9 4 4 4 4 4 4
10Number of questions Person 10 4 4 4 4 4 4
11Number of questions Person 11 4 4 4 4 4 4
12Number of questions Person 12 4 4 4 4 4 4
13Number of questions Person 13 4 4 4 4 4 4
14Number of questions Person 14 4 4 4 4 4 4
15Number of questions Person 15 4 4 4 4 4 4
16Number of questions Person 16 4 4 4 4 4 4
17Number of questions Person 17 4 4 4 4 4 4
18Number of questions Person 18 4 4 4 4 4 4
19Number of questions Person 19 4 4 4 4 4 4
20Number of questions Person 20 4 4 4 4 4 4
21Number correct Person 1 2 3 3 3 4 4
22Number correct Person 2 2 2 3 3 3 4
23Number correct Person 3 2 2 3 3 4 4
24Number correct Person 4 2 3 2 4 3 4
25Number correct Person 5 2 2 3 3 4 4
26Number correct Person 6 2 3 3 3 3 4
27Number correct Person 7 2 2 3 3 4 4
28Number correct Person 8 2 3 2 4 3 4
29Number correct Person 9 2 2 3 3 4 4
30Number correct Person 10 2 3 3 3 4 4
31Number correct Person 11 2 2 3 3 4 4
32Number correct Person 12 2 3 2 4 4 4
33Number correct Person 13 2 2 3 3 3 4
34Number correct Person 14 2 3 3 3 4 4
35Number correct Person 15 2 2 3 3 3 4
36Number correct Person 16 2 2 2 4 4 4
37Number correct Person 17 2 2 3 3 3 4
38Number correct Person 18 2 3 3 3 4 4
39Number correct Person 19 2 2 3 3 3 4
40Number correct Person 20 2 2 3 3 4 4

Unit

-

Formula

<rcode graphics="1">
#Code for transforming a .csv of the form above (i.e. copy pasted to excel and exported as .csv) to database uploadable form
QRes <- read.table("M:/R/Calibration ex.csv", sep = ";", dec = ",", header = TRUE)
QRes <- reshape(QRes, idvar = c("Parameter", "Person"), times = colnames(QRes)[3:ncol(QRes)], timevar = "Assessed probability", 
varying = list(colnames(QRes)[3:ncol(QRes)]), direction = "long")
colnames(QRes)[ncol(QRes)] <- "Result"
#Code for downloading current result from the base and forming a summary
library(OpasnetBaseUtils)
QRes <- op_baseGetData("opasnet_base", "Op_en5018")#"heande_base", "Erac3117") 
Summaryf <- function(Margin, CI) {
Summary <- data.frame(Number_of_questions = Margin[2,], Assessed_probability = as.numeric(gsub("P", "", dimnames(Margin)[[2]])), 
Actual_probability = Margin[1,]/Margin[2,], 
CI_lower_bound = 0, CI_upper_bound = 1)
for (i in 1:nrow(Summary)) {
	Summary[i,"CI_lower_bound"] <- qbinom((1 - CI)/2, Summary[i,"Number_of_questions"], Summary[i,"Assessed_probability"])/
		Summary[i,"Number_of_questions"]
	Summary[i,"CI_upper_bound"] <- qbinom(CI + (1 - CI)/2, Summary[i,"Number_of_questions"], Summary[i,"Assessed_probability"])/
		Summary[i,"Number_of_questions"]
}
return(Summary)
}
QRSummary <- Summaryf(tapply(QRes[,"Result"], QRes[,c("Parameter","Assessed_probability")], sum), 0.9)
QRSummary
#Plot above summary
library(ggplot2)
plot1 <- ggplot(QRSummary, aes(x = Assessed_probability, y = Actual_probability)) + geom_line() + geom_line(aes(y = CI_lower_bound), 
colour = "blue") + geom_line(aes(y = CI_upper_bound), colour = "red")
plot1
#Calibration score
RInf <- function(s, p) {
	s*log(s/p) + (1-s)*log((1-s)/(1-p))
}
1 - pchisq(sum(2*QRSummary[,"Number_of_questions"]*RInf(QRSummary[,"Actual_probability"], QRSummary[,"Assessed_probability"]), na.rm = TRUE), 
	nrow(QRSummary))
#Individual/subgroup assessment
Names <- paste("Person", c(1,2,3,4,5,6)) #paste("Person", c(1,2,...)) returns "Person 1", "Person 2", ...
MRows <- QRes[,"Person"]%in%Names #matching rows of QRes
PQRS <- Summaryf(tapply(QRes[MRows,"Result"], QRes[MRows,c("Parameter","Assessed_probability")], sum), 0.9)
PQRS
plot2 <- ggplot(PQRS, aes(x = Assessed_probability, y = Actual_probability)) + geom_line() + geom_line(aes(y = CI_lower_bound), 
colour = "blue") + geom_line(aes(y = CI_upper_bound), colour = "red")
plot2
1 - pchisq(sum(2*PQRS[,"Number_of_questions"]*RInf(PQRS[,"Actual_probability"], PQRS[,"Assessed_probability"]), na.rm = TRUE), nrow(PQRS))
</rcode>

Result

Show results


See also

Keywords

Calibration, informativeness, expert elicitation

References


Related files

<mfanonymousfilelist></mfanonymousfilelist>