# For further details see http://jutze.com/research/2016-schult-sparfeldt-pirls-timss # MC vs CR: a nice study of test information functions # AUC for theta = -2 to +2 # # compiled by Johannes Schult (jutze@jutze.com) # last updated: 2014-06-26 # In plotIRT, the actual R function adds CR and MC item curves up; you just have to specify a, b, ax, b1, b2 etc. library(zoo) # I modified the original PlotIRT commands in order to obtain the inverse of the test information function # NB: Run PlotIRTA.R before continuing! source("W:/PlotIRTA.R") mylinewidth <- 3 # # # # # # IGLU # # # # # # ### half 1 # half 1 items 3pl - MC only iglu2006 <- read.table("W:/IGLU2006/iglu2006half1itemsmc.csv") half1mca <- iglu2006$V1 half1mcb <- iglu2006$V2 half1mcc <- iglu2006$V3 mylinetype <- 1 mc <- PlotIRTA(a=half1mca,b=half1mcb,c=half1mcc,TestI=T,width=6,normalmetric=T,testcol="brown") id <- order(mc$Theta) id <- id[11:50] AUC <- sum(diff(mc$Theta[id])*rollmean(mc$toPlot[id],2)) AUCmc <- AUC # normalmetric=T - see http://timss.bc.edu/methods/pdf/TP11_Scaling_Methodology.pdf (page 1) # half 1 - CR only # items 3pl (2 categories) iglu2006 <- read.table("W:/IGLU2006/iglu2006half1items3plcr.csv") half1cra <- iglu2006$V1 half1crb <- iglu2006$V2 half1crc <- iglu2006$V3 iglu2006items3cat <- read.table("W:/IGLU2006/iglu2006half1items3catcr.csv") iglu2006items4cat <- read.table("W:/IGLU2006/iglu2006half1items4catcr.csv") half1craj <- c(iglu2006items3cat$V1,iglu2006items4cat$V1) items3cat <- length(iglu2006items3cat[,1]) items4cat <- length(iglu2006items4cat[,1]) b3 <- vector("list", length=items3cat) z <- 0 while(z < items3cat) { z <- z + 1 b3[[z]] <- c(iglu2006items3cat[z,2],iglu2006items3cat[z,3]) print(z) } b4 <- vector("list", length=(items4cat)) z <- 0 while(z < (items4cat)) { z <- z + 1 b4[[z]] <- c(iglu2006items4cat[z,2],iglu2006items4cat[z,3],iglu2006items4cat[z,4]) print(z) } half1crbj <- append(b3,b4) mylinetype <- 2 cr <- PlotIRTA(a=half1cra,b=half1crb,c=half1crc,aj=half1craj,bj=half1crbj,TestI=T,width=6,normalmetric=T,testcol="brown") AUC <- sum(diff(cr$Theta[id])*rollmean(cr$toPlot[id],2)) AUCcr <- AUC diff1 <- mc$toPlot/cr$toPlot plot(cr$Theta, diff1, type="l", xlab = "Theta", ylab = "Relative Efficiency (MC vs CR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = "brown", lty = 2, lwd = 1, add = TRUE) ### half 2 # half 2 items 3pl - MC only iglu2006 <- read.table("W:/IGLU2006/iglu2006half2itemsmc.csv") half2mca <- iglu2006$V1 half2mcb <- iglu2006$V2 half2mcc <- iglu2006$V3 #mylinetype <- 1 #thecol <- "black" #PlotIRTA(a=half2mca,b=half2mcb,c=half2mcc,TestI=T,width=6,szaxis=1.1,szlabel=1.1,ymax=1.01,normalmetric=T) # half 2 - CR only # items 3pl (2 categories) iglu2006 <- read.table("W:/IGLU2006/iglu2006half2items3plcr.csv") half2cra <- iglu2006$V1 half2crb <- iglu2006$V2 half2crc <- iglu2006$V3 iglu2006items3cat <- read.table("W:/IGLU2006/iglu2006half2items3catcr.csv") iglu2006items4cat <- read.table("W:/IGLU2006/iglu2006half2items4catcr.csv") half2craj <- c(iglu2006items3cat$V1,iglu2006items4cat$V1) items3cat <- length(iglu2006items3cat[,1]) items4cat <- length(iglu2006items4cat[,1]) b3 <- vector("list", length=items3cat) z <- 0 while(z < items3cat) { z <- z + 1 b3[[z]] <- c(iglu2006items3cat[z,2],iglu2006items3cat[z,3]) print(z) } b4 <- vector("list", length=(items4cat)) z <- 0 while(z < (items4cat)) { z <- z + 1 b4[[z]] <- c(iglu2006items4cat[z,2],iglu2006items4cat[z,3],iglu2006items4cat[z,4]) print(z) } half2crbj <- append(b3,b4) #mylinetype <- 1 #thecol <- "black" ### mc + mc # create half1mc+half2mc scale curve half1mcahalf2mca <- c(half1mca,half2mca) half1mcbhalf2mcb <- c(half1mcb,half2mcb) half1mcchalf2mcc <- c(half1mcc,half2mcc) mylinetype <- 1 mcmc <- PlotIRTA(a=half1mcahalf2mca,b=half1mcbhalf2mcb,c=half1mcchalf2mcc,TestI=T,width=6,normalmetric=T,testcol="black") AUC <- sum(diff(mcmc$Theta[id])*rollmean(mcmc$toPlot[id],2)) AUCmcmc <- AUC ### cr + cr half1crahalf2cra <- c(half1cra,half2cra) half1crbhalf2crb <- c(half1crb,half2crb) half1crchalf2crc <- c(half1crc,half2crc) half1crajhalf2craj <- c(half1craj,half2craj) half1crbjhalf2crbj <- append(half1crbj,half2crbj) mylinetype <- 2 crcr <- PlotIRTA(a=half1crahalf2cra,b=half1crbhalf2crb,c=half1crchalf2crc,aj=half1crajhalf2craj,bj=half1crbjhalf2crbj,TestI=T,width=6,normalmetric=T,testcol="black") AUC <- sum(diff(crcr$Theta[id])*rollmean(crcr$toPlot[id],2)) AUCcrcr <- AUC #mcvscr <- data.frame(mc,cr) diff2 <- mcmc$toPlot/crcr$toPlot plot(cr$Theta, diff2, type="l", xlab = "Theta", ylab = "Relative Efficiency (MCMC vs CRCR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = 3, lty = 2, lwd = 1, add = TRUE) ### mc + cr half1mcahalf2cra <- c(half1mca,half2cra) half1mcbhalf2crb <- c(half1mcb,half2crb) half1mcchalf2crc <- c(half1mcc,half2crc) mylinetype <- 3 mccr <- PlotIRTA(a=half1mcahalf2cra,b=half1mcbhalf2crb,c=half1mcchalf2crc,aj=half2craj,bj=half2crbj,TestI=T,width=6,normalmetric=T,testcol="red") AUC <- sum(diff(mccr$Theta[id])*rollmean(mccr$toPlot[id],2)) AUCmccr <- AUC diff3 <- mcmc$toPlot/mccr$toPlot plot(cr$Theta, diff3, type="l", xlab = "Theta", ylab = "Relative Efficiency (MCMC vs MCCR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = 3, lty = 2, lwd = 1, add = TRUE) ### cr + mc half1crahalf2mca <- c(half1cra,half2mca) half1crbhalf2mcb <- c(half1crb,half2mcb) half1crchalf2mcc <- c(half1crc,half2mcc) mylinetype <- 3 crmc <- PlotIRTA(a=half1crahalf2mca,b=half1crbhalf2mcb,c=half1crchalf2mcc,aj=half1craj,bj=half1crbj,TestI=T,width=6,normalmetric=T,testcol="violet") AUC <- sum(diff(crmc$Theta[id])*rollmean(crmc$toPlot[id],2)) AUCcrmc <- AUC diff4 <- crmc$toPlot/crcr$toPlot plot(cr$Theta, diff4, type="l", xlab = "Theta", ylab = "Relative Efficiency (CRMC vs CRCR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = 3, lty = 2, lwd = 1, add = TRUE) #AUCmc #AUCcr AUCmcmc AUCmccr AUCcrmc AUCcrcr ###################### # Table 2, Column 3) # ###################### round(AUCmcmc/AUCcrcr, digits = 2) round(AUCmcmc/AUCmccr, digits = 2) round(AUCcrmc/AUCcrcr, digits = 2) #AUCcrcr/AUCcrmc # # # # # # TIMSS # # # # # # ### half 1 # half 1 items 3pl - MC only timss2007 <- read.table("W:/TIMSS2007/timss2007half1itemsmc.csv") #head(timss2007) half1mca <- timss2007$V1 half1mcb <- timss2007$V2 half1mcc <- timss2007$V3 mylinetype <- 1 mc <- PlotIRTA(a=half1mca,b=half1mcb,c=half1mcc,TestI=T,width=6,normalmetric=T,testcol="brown") # normalmetric=T - see http://timss.bc.edu/methods/pdf/TP11_Scaling_Methodology.pdf (page 1) id <- order(mc$Theta) id <- id[11:50] AUC <- sum(diff(mc$Theta[id])*rollmean(mc$toPlot[id],2)) AUCmc <- AUC # half 1 - CR only # items 3pl (2 categories) timss2007 <- read.table("W:/TIMSS2007/timss2007half1items3plcr.csv") half1cra <- timss2007$V1 half1crb <- timss2007$V2 half1crc <- timss2007$V3 timss2007items3cat <- read.table("W:/TIMSS2007/timss2007half1items3catcr.csv") half1craj <- timss2007items3cat$V1 items3cat <- length(timss2007items3cat[,1]) b3 <- vector("list", length=items3cat) z <- 0 while(z < items3cat) { z <- z + 1 b3[[z]] <- c(timss2007items3cat[z,2],timss2007items3cat[z,3]) print(z) } half1crbj <- b3 mylinetype <- 2 cr <- PlotIRTA(a=half1cra,b=half1crb,c=half1crc,aj=half1craj,bj=half1crbj,TestI=T,width=6,normalmetric=T,testcol="brown") AUC <- sum(diff(cr$Theta[id])*rollmean(cr$toPlot[id],2)) AUCcr <- AUC diff1 <- mc$toPlot/cr$toPlot plot(cr$Theta, diff1, type="l", xlab = "Theta", ylab = "Relative Efficiency (MC vs CR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = "brown", lty = 2, lwd = 1, add = TRUE) ### half 2 # half 2 items 3pl - MC only timss2007 <- read.table("W:/TIMSS2007/timss2007half2itemsmc.csv") half2mca <- timss2007$V1 half2mcb <- timss2007$V2 half2mcc <- timss2007$V3 #mylinetype <- 1 #thecol <- "black" #PlotIRTA(a=half2mca,b=half2mcb,c=half2mcc,TestI=T,width=6,normalmetric=T) # half 2 - CR only # items 3pl (2 categories) timss2007 <- read.table("W:/TIMSS2007/timss2007half2items3plcr.csv") half2cra <- timss2007$V1 half2crb <- timss2007$V2 half2crc <- timss2007$V3 timss2007items3cat <- read.table("W:/TIMSS2007/timss2007half2items3catcr.csv") half2craj <- timss2007items3cat$V1 items3cat <- length(timss2007items3cat[,1]) b3 <- vector("list", length=items3cat) z <- 0 while(z < items3cat) { z <- z + 1 b3[[z]] <- c(timss2007items3cat[z,2],timss2007items3cat[z,3]) print(z) } half2crbj <- b3 #mylinetype <- 1 #thecol <- "black" ### mc + mc # create half1mc+half2mc scale curve half1mcahalf2mca <- c(half1mca,half2mca) half1mcbhalf2mcb <- c(half1mcb,half2mcb) half1mcchalf2mcc <- c(half1mcc,half2mcc) mylinetype <- 1 mcmc <- PlotIRTA(a=half1mcahalf2mca,b=half1mcbhalf2mcb,c=half1mcchalf2mcc,TestI=T,width=6,normalmetric=T,testcol="black") AUC <- sum(diff(mcmc$Theta[id])*rollmean(mcmc$toPlot[id],2)) AUCmcmc <- AUC ### cr + cr half1crahalf2cra <- c(half1cra,half2cra) half1crbhalf2crb <- c(half1crb,half2crb) half1crchalf2crc <- c(half1crc,half2crc) half1crajhalf2craj <- c(half1craj,half2craj) half1crbjhalf2crbj <- append(half1crbj,half2crbj) mylinetype <- 2 crcr <- PlotIRTA(a=half1crahalf2cra,b=half1crbhalf2crb,c=half1crchalf2crc,aj=half1crajhalf2craj,bj=half1crbjhalf2crbj,TestI=T,width=6,normalmetric=T,testcol="black") AUC <- sum(diff(crcr$Theta[id])*rollmean(crcr$toPlot[id],2)) AUCcrcr <- AUC diff2 <- mcmc$toPlot/crcr$toPlot plot(cr$Theta, diff2, type="l", xlab = "Theta", ylab = "Relative Efficiency (MCMC vs CRCR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = 3, lty = 2, lwd = 1, add = TRUE) ### mc + cr half1mcahalf2cra <- c(half1mca,half2cra) half1mcbhalf2crb <- c(half1mcb,half2crb) half1mcchalf2crc <- c(half1mcc,half2crc) mylinetype <- 3 mccr <- PlotIRTA(a=half1mcahalf2cra,b=half1mcbhalf2crb,c=half1mcchalf2crc,aj=half2craj,bj=half2crbj,TestI=T,width=6,normalmetric=T,testcol="red") AUC <- sum(diff(mccr$Theta[id])*rollmean(mccr$toPlot[id],2)) AUCmccr <- AUC diff3 <- mcmc$toPlot/mccr$toPlot plot(cr$Theta, diff3, type="l", xlab = "Theta", ylab = "Relative Efficiency (MCMC vs MCCR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = 3, lty = 2, lwd = 1, add = TRUE) ### cr + mc half1crahalf2mca <- c(half1cra,half2mca) half1crbhalf2mcb <- c(half1crb,half2mcb) half1crchalf2mcc <- c(half1crc,half2mcc) mylinetype <- 3 crmc <- PlotIRTA(a=half1crahalf2mca,b=half1crbhalf2mcb,c=half1crchalf2mcc,aj=half1craj,bj=half1crbj,TestI=T,width=6,normalmetric=T,testcol="violet") AUC <- sum(diff(crmc$Theta[id])*rollmean(crmc$toPlot[id],2)) AUCcrmc <- AUC diff4 <- crmc$toPlot/crcr$toPlot plot(cr$Theta, diff4, type="l", xlab = "Theta", ylab = "Relative Efficiency (CRMC vs CRCR)") curve(dnorm(x, mean = 0.13, sd = 0.75), col = 3, lty = 2, lwd = 1, add = TRUE) #AUCmc #AUCcr AUCmcmc AUCmccr AUCcrmc AUCcrcr ###################### # Table 2, Column 5) # ###################### round(AUCmcmc/AUCcrcr, digits = 2) round(AUCmcmc/AUCmccr, digits = 2) round(AUCcrmc/AUCcrcr, digits = 2) #AUCcrcr/AUCcrmc # SO FAR, SO GOOD