Calibration of a group
From Opasnet
Moderator:Jouni (see all) |
This page is a stub. You may improve it into a full page. Citation of this page: |
Upload data
|
Contents
Scope
What is the calibration of a group according to answers to an open assessment quiz?
Definition
Data
Obs | Parameter | Person | P0.5 | P0.6 | P0.7 | P0.8 | P0.9 | P1.0 |
---|---|---|---|---|---|---|---|---|
1 | Number of questions | Person 1 | 4 | 4 | 4 | 4 | 4 | 4 |
2 | Number of questions | Person 2 | 4 | 4 | 4 | 4 | 4 | 4 |
3 | Number of questions | Person 3 | 4 | 4 | 4 | 4 | 4 | 4 |
4 | Number of questions | Person 4 | 4 | 4 | 4 | 4 | 4 | 4 |
5 | Number of questions | Person 5 | 4 | 4 | 4 | 4 | 4 | 4 |
6 | Number of questions | Person 6 | 4 | 4 | 4 | 4 | 4 | 4 |
7 | Number of questions | Person 7 | 4 | 4 | 4 | 4 | 4 | 4 |
8 | Number of questions | Person 8 | 4 | 4 | 4 | 4 | 4 | 4 |
9 | Number of questions | Person 9 | 4 | 4 | 4 | 4 | 4 | 4 |
10 | Number of questions | Person 10 | 4 | 4 | 4 | 4 | 4 | 4 |
11 | Number of questions | Person 11 | 4 | 4 | 4 | 4 | 4 | 4 |
12 | Number of questions | Person 12 | 4 | 4 | 4 | 4 | 4 | 4 |
13 | Number of questions | Person 13 | 4 | 4 | 4 | 4 | 4 | 4 |
14 | Number of questions | Person 14 | 4 | 4 | 4 | 4 | 4 | 4 |
15 | Number of questions | Person 15 | 4 | 4 | 4 | 4 | 4 | 4 |
16 | Number of questions | Person 16 | 4 | 4 | 4 | 4 | 4 | 4 |
17 | Number of questions | Person 17 | 4 | 4 | 4 | 4 | 4 | 4 |
18 | Number of questions | Person 18 | 4 | 4 | 4 | 4 | 4 | 4 |
19 | Number of questions | Person 19 | 4 | 4 | 4 | 4 | 4 | 4 |
20 | Number of questions | Person 20 | 4 | 4 | 4 | 4 | 4 | 4 |
21 | Number correct | Person 1 | 2 | 3 | 3 | 3 | 4 | 4 |
22 | Number correct | Person 2 | 2 | 2 | 3 | 3 | 3 | 4 |
23 | Number correct | Person 3 | 2 | 2 | 3 | 3 | 4 | 4 |
24 | Number correct | Person 4 | 2 | 3 | 2 | 4 | 3 | 4 |
25 | Number correct | Person 5 | 2 | 2 | 3 | 3 | 4 | 4 |
26 | Number correct | Person 6 | 2 | 3 | 3 | 3 | 3 | 4 |
27 | Number correct | Person 7 | 2 | 2 | 3 | 3 | 4 | 4 |
28 | Number correct | Person 8 | 2 | 3 | 2 | 4 | 3 | 4 |
29 | Number correct | Person 9 | 2 | 2 | 3 | 3 | 4 | 4 |
30 | Number correct | Person 10 | 2 | 3 | 3 | 3 | 4 | 4 |
31 | Number correct | Person 11 | 2 | 2 | 3 | 3 | 4 | 4 |
32 | Number correct | Person 12 | 2 | 3 | 2 | 4 | 4 | 4 |
33 | Number correct | Person 13 | 2 | 2 | 3 | 3 | 3 | 4 |
34 | Number correct | Person 14 | 2 | 3 | 3 | 3 | 4 | 4 |
35 | Number correct | Person 15 | 2 | 2 | 3 | 3 | 3 | 4 |
36 | Number correct | Person 16 | 2 | 2 | 2 | 4 | 4 | 4 |
37 | Number correct | Person 17 | 2 | 2 | 3 | 3 | 3 | 4 |
38 | Number correct | Person 18 | 2 | 3 | 3 | 3 | 4 | 4 |
39 | Number correct | Person 19 | 2 | 2 | 3 | 3 | 3 | 4 |
40 | Number 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
See also
Keywords
Calibration, informativeness, expert elicitation
References
Related files
<mfanonymousfilelist></mfanonymousfilelist>