diff --git a/RProject/.RData b/RProject/.RData index cb9f20e..5faaf71 100644 Binary files a/RProject/.RData and b/RProject/.RData differ diff --git a/RProject/.Rhistory b/RProject/.Rhistory index 8d80ce6..7d87e1c 100644 --- a/RProject/.Rhistory +++ b/RProject/.Rhistory @@ -1,512 +1,512 @@ -returndat$se.beta <- 1.413612*sapply(seq(1,max(df[,sequence])),function(k) tam.se(tam1[[k]])$beta$se.Dim1[2] ) -returndat$low.ci.beta <- returndat$beta-1.96*returndat$se.beta -returndat$high.ci.beta <- returndat$beta+1.96*returndat$se.beta -returndat$true.value.in.ci <- 1*(truebeta>returndat$low.ci.beta & truebetareturndat$low.ci.beta & 04) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N100/scenario_',scenario,'_nodif.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="200" & name<=4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N200/scenario_',scenario,'.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="200" & name>4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N200/scenario_',scenario,'_nodif.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="300" & name<=4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N300/scenario_',scenario,'.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="300" & name>4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N300/scenario_',scenario,'_nodif.csv')) +} +if (unique(s$J)==4) { +if (unique(s$M)==2) { +a <- data.frame(m.item1=mean(s$item1),m.item2=mean(s$item2),m.item3=mean(s$item3),m.item4=mean(s$item4)) } else { -returndat$beta.same.sign.truebeta <- 1*(sign(truebeta)==sign(returndat$beta)) -} -returndat2 <- data.frame(J=rep(nbitems,max(df[,sequence])), -M=1+max(df$item1), -N=nrow(df[df$replication==1,])/2, -eff.size=eff.size, -dif.size= difsize, -nb.dif= nbdif -) -returndat <- cbind(returndat2,returndat) -return(returndat) -} -replicate_pcm_analysis_m2 <- function(df=NULL,treatment='TT',irtmodel='PCM2',method='MML',sequence='replication',truebeta=0,eff.size=0,difsize=NA,nbdif=0) { -nbitems <- sum(sapply(1:20,function(x) paste0('item',x)) %in% colnames(df)) -resp <- df[,sapply(seq(1,nbitems),function(x) paste0('item',x))] -if (method=='MML') { -n <- max(df[,sequence]) -print(n) -tam1 <- pbmclapply(seq(1,n), -function(x) pcm_analysis(df=df[df[,sequence]==x,],treatment=treatment,irtmodel=irtmodel) +a <- data.frame(m.item1_1=mean(s$item1_1),m.item1_2=mean(s$item1_2),m.item1_3=mean(s$item1_3), +m.item2_1=mean(s$item2_1),m.item2_2=mean(s$item2_2),m.item2_3=mean(s$item2_3), +m.item3_1=mean(s$item3_1),m.item3_2=mean(s$item3_2),m.item3_3=mean(s$item3_3), +m.item4_1=mean(s$item4_1),m.item4_2=mean(s$item4_2),m.item4_3=mean(s$item4_3) ) } -listitems <- sapply(seq(1,nbitems),function(x) paste0('item',x)) -returndat <- data.frame(matrix(nrow=max(df[,sequence]),ncol=length(listitems))) -colnames(returndat) <- listitems -for (s in seq(1,max(df[,sequence]))) { -for (k in seq(1,nbitems)) { -returndat[s,paste0('item',k)] <- tam1[[s]]$xsi$xsi[k] -} -} -returndat$beta <- sapply(seq(1,max(df[,sequence])),function(k) tam1[[k]]$beta[2]) -returndat$se.beta <- 1.413612*sapply(seq(1,max(df[,sequence])),function(k) tam.se(tam1[[k]])$beta$se.Dim1[2] ) -returndat$low.ci.beta <- returndat$beta-1.96*returndat$se.beta -returndat$high.ci.beta <- returndat$beta+1.96*returndat$se.beta -returndat$true.value.in.ci <- 1*(truebeta>returndat$low.ci.beta & truebetareturndat$low.ci.beta & 0returndat$low.ci.beta & truebetareturndat$low.ci.beta & 0returndat$low.ci.beta & truebetareturndat$low.ci.beta & 04) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N100/scenario_',scenario,'_nodif.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="200" & name<=4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N200/scenario_',scenario,'.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="200" & name>4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N200/scenario_',scenario,'_nodif.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="300" & name<=4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N300/scenario_',scenario,'.csv')) +} +if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="300" & name>4) { +s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N300/scenario_',scenario,'_nodif.csv')) +} +if (unique(s$J)==4) { +if (unique(s$M)==2) { +a <- data.frame(m.item1=mean(s$item1),m.item2=mean(s$item2),m.item3=mean(s$item3),m.item4=mean(s$item4)) } else { -returndat$beta.same.sign.truebeta <- 1*(sign(truebeta)==sign(returndat$beta)) -} -returndat2 <- data.frame(J=rep(nbitems,max(df[,sequence])), -M=1+max(df$item1), -N=nrow(df[df$replication==1,])/2, -eff.size=eff.size, -dif.size= difsize, -nb.dif= nbdif +a <- data.frame(m.item1_1=mean(s$item1_1),m.item1_2=mean(s$item1_2),m.item1_3=mean(s$item1_3), +m.item2_1=mean(s$item2_1),m.item2_2=mean(s$item2_2),m.item2_3=mean(s$item2_3), +m.item3_1=mean(s$item3_1),m.item3_2=mean(s$item3_2),m.item3_3=mean(s$item3_3), +m.item4_1=mean(s$item4_1),m.item4_2=mean(s$item4_2),m.item4_3=mean(s$item4_3) ) -returndat <- cbind(returndat2,returndat) -return(returndat) -} -replicate_pcm_analysis_m4(dat1[dat1$replication==1,]) -######################################## -## LIBRARIES -######################################## -library(TAM) -library(doMC) -library(parallel) -library(pbmcapply) -library(funprog) -lastChar <- function(str){ -substr(str, nchar(str)-2, nchar(str)) -} -####################################### -## ANALYSIS FUNCTIONS -####################################### -pcm_analysis <- function(df=NULL,treatment='TT',irtmodel='PCM2',method='MML') { -nbitems <- sum(sapply(1:20,function(x) paste0('item',x)) %in% colnames(df)) -resp <- df[,sapply(seq(1,nbitems),function(x) paste0('item',x))] -if (method=='MML') { -tam1 <- tam.mml(resp=resp,Y=df[,treatment],irtmodel = irtmodel,est.variance = T,verbose=F) -} -if (method=='JML') { -tam1 <- tam.jml(resp=resp,group=1+df[,treatment]) } -if (method!='MML' & method!='JML') { -stop('Invalid method. Please choose among MML or JML') -} -return(tam1) -} -replicate_pcm_analysis_m4 <- function(df=NULL,treatment='TT',irtmodel='PCM2',method='MML',sequence='replication',truebeta=0,eff.size=0,difsize=NA,nbdif=0) { -nbitems <- sum(sapply(1:20,function(x) paste0('item',x)) %in% colnames(df)) -resp <- df[,sapply(seq(1,nbitems),function(x) paste0('item',x))] -if (method=='MML') { -n <- max(df[,sequence]) -print(n) -tam1 <- pbmclapply(seq(1,n), -function(x) pcm_analysis(df=df[df[,sequence]==x,],treatment=treatment,irtmodel=irtmodel) -) -} -listitems <- c(sapply(c('_1','_2','_3'),function(x) paste0(sapply(seq(1,nbitems),function(x) paste0('item',x)),x))) -returndat <- data.frame(matrix(nrow=max(df[,sequence]),ncol=length(listitems))) -colnames(returndat) <- listitems -for (s in seq(1,max(df[,sequence]))) { -for (k in seq(1,nbitems)) { -returndat[s,paste0('item',k,'_1')] <- tam1[[s]]$item[k,'AXsi_.Cat1'] -returndat[s,paste0('item',k,'_2')] <- tam1[[s]]$item[k,'AXsi_.Cat2']-tam1[[s]]$item[k,'AXsi_.Cat1'] -returndat[s,paste0('item',k,'_3')] <- tam1[[s]]$item[k,'AXsi_.Cat3']-tam1[[s]]$item[k,'AXsi_.Cat2'] -} -} -returndat <- returndat[,sort_by(listitems, lastChar)] -returndat$beta <- sapply(seq(1,max(df[,sequence])),function(k) tam1[[k]]$beta[2]) -returndat$se.beta <- 1.413612*sapply(seq(1,max(df[,sequence])),function(k) tam.se(tam1[[k]])$beta$se.Dim1[2] ) -returndat$low.ci.beta <- returndat$beta-1.96*returndat$se.beta -returndat$high.ci.beta <- returndat$beta+1.96*returndat$se.beta -returndat$true.value.in.ci <- 1*(truebeta>returndat$low.ci.beta & truebetareturndat$low.ci.beta & 0returndat$low.ci.beta & truebetareturndat$low.ci.beta & 0returndat$low.ci.beta & truebetareturndat$low.ci.beta & 0returndat$low.ci.beta & truebetareturndat$high.ci.beta) -if (truebeta==0) { -returndat$beta.same.sign.truebeta <- NA -} else { -returndat$beta.same.sign.truebeta <- 1*(sign(truebeta)==sign(returndat$beta)) -} -returndat2 <- data.frame(J=rep(nbitems,max(df[,sequence])), -M=1+max(df$item1), -N=nrow(df[df$replication==1,])/2, -eff.size=eff.size, -dif.size= difsize, -nb.dif= nbdif -) -returndat <- cbind(returndat2,returndat) -return(returndat) -} -replicate_pcm_analysis_m2 <- function(df=NULL,treatment='TT',irtmodel='PCM2',method='MML',sequence='replication',truebeta=0,eff.size=0,difsize=NA,nbdif=0) { -nbitems <- sum(sapply(1:20,function(x) paste0('item',x)) %in% colnames(df)) -resp <- df[,sapply(seq(1,nbitems),function(x) paste0('item',x))] -if (method=='MML') { -n <- max(df[,sequence]) -print(n) -tam1 <- pbmclapply(seq(1,n), -function(x) pcm_analysis(df=df[df[,sequence]==x,],treatment=treatment,irtmodel=irtmodel) -) -} -listitems <- sapply(seq(1,nbitems),function(x) paste0('item',x)) -returndat <- data.frame(matrix(nrow=max(df[,sequence]),ncol=length(listitems))) -colnames(returndat) <- listitems -for (s in seq(1,max(df[,sequence]))) { -for (k in seq(1,nbitems)) { -returndat[s,paste0('item',k)] <- tam1[[s]]$xsi$xsi[k] -} -} -returndat$beta <- sapply(seq(1,max(df[,sequence])),function(k) tam1[[k]]$beta[2]) -returndat$se.beta <- 1.413612*sapply(seq(1,max(df[,sequence])),function(k) tam.se(tam1[[k]])$beta$se.Dim1[2] ) -returndat$low.ci.beta <- returndat$beta-1.96*returndat$se.beta -returndat$high.ci.beta <- returndat$beta+1.96*returndat$se.beta -returndat$true.value.in.ci <- 1*(truebeta>returndat$low.ci.beta & truebetareturndat$high.ci.beta) -if (truebeta==0) { -returndat$beta.same.sign.truebeta <- NA -} else { -returndat$beta.same.sign.truebeta <- 1*(sign(truebeta)==sign(returndat$beta)) -} -returndat2 <- data.frame(J=rep(nbitems,max(df[,sequence])), -M=1+max(df$item1), -N=nrow(df[df$replication==1,])/2, -eff.size=eff.size, -dif.size= difsize, -nb.dif= nbdif -) -returndat <- cbind(returndat2,returndat) -return(returndat) -} -####################################### -## SCENARIO ANALYSIS -####################################### -registerDoMC(4) -replicate_pcm_analysis_m4(dat1[dat1$replication==1,]) -dat1 <- read.csv(file = '/home/corentin/Documents/These/Recherche/Simulations/Data/NoDIF/N100/scenario_4A_100.csv') -replicate_pcm_analysis_m4(dat1[dat1$replication==1,]) +z <- data.frame(m.beta=mean(s$beta), +m.low.ci.beta=mean(s$low.ci.beta), +m.high.ci.beta=mean(s$high.ci.beta), +true.value.in.ci.p=mean(s$true.value.in.ci), +h0.rejected.p=mean(s$h0.rejected), +beta.same.sign.truebeta.p=mean(s$beta.same.sign.truebeta,na.rm=T)) +d <- cbind(b,a,z) +d$prop. +return(d) +} +res.dat <- compile_simulation('1A_100') +for (x in results[seq(2,length(results))]) { +y <- compile_simulation(x) +res.dat <- bind_rows(res.dat,y) +} +View(res.dat) +res.dat.simple <- res.dat[,c(1:8,13,16:18)] +res.dat.simple$m.beta <- round(res.dat.simple$m.beta,3) +res.dat.simple +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +res.dat[is.na(res.dat$dif.size),'dif.size'] <- 0 +res.dat.simple <- res.dat[,c(1:8,13,16:18)] +res.dat.simple$m.beta <- round(res.dat.simple$m.beta,3) +res.dat.simple +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +plot(h0.rejected.p~dif.size,data=res.null) +boxplot(h0.rejected.p~dif.size,data=res.null)+points(h0.rejected.p~dif.size,data=res.null) +boxplot(h0.rejected.p~dif.size,data=res.null) +points(h0.rejected.p~dif.size,data=res.null) +points(h0.rejected.p~1.dif.size,data=res.null) +points(h0.rejected.p~1+dif.size,data=res.null) +boxplot(h0.rejected.p~dif.size,data=res.null) +points(h0.rejected.p~1+dif.size,data=res.null) +points(y=h0.rejected.p,x=0,data=res.null) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +points(y=h0.rejected.p,x=0,data=res.null) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +points(y=res.null$h0.rejected.p,x=0) +points(y=res.null$h0.rejected.p,x=rep(0,nrow(res.null))) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +points(y=res.null$h0.rejected.p,x=rep(0,nrow(res.null))) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null))) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0))) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0))) +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3))) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3))) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0))) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col=2) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col=3) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0))) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col=2) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col=3) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),'gray') +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray') +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='darkred') +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='darkgreen') +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pty=2) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pty=2) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='darkred',pty=2) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='darkgreen',pty=2) +res.null <- res.dat[res.dat$eff.size==0,] +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pch=3) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='darkred',pch=3) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='darkgreen',pch=3) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3)) +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pch=3) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='#053305',pch=3) +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3),xlab='DIF size',ylab='H0 rejection proportion in target scenario') +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pch=3) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(2,2)) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item') +res.null0 <- res.null[res.null$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pch=3) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='#053305',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items') +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +res.null +par(mfrow=c(2,2)) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item') +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(2,2)) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item') +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF') +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null +res.dat$nb.dif +table(res.dat$scenario) +cumsum(table(res.dat$scenario)) +table(res.dat[1:132]$scenario) +table(res.dat[1:132,]$scenario) +nrow(res.dat) +res.dat[132:300,'nb.dif'] <- 2 +res.dat[300:396,'nb.dif'] <- 3 +View(res.dat) +res.dat.simple <- res.dat[,c(1:8,13,16:18)] +res.dat.simple$m.beta <- round(res.dat.simple$m.beta,3) +res.dat.simple +#### plots +## Proportion of rejected h0 per dif value in h0 scenarios (A) by DIF size +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3),xlab='DIF size',ylab='H0 rejection proportion in target scenario') +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pch=3) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='#053305',pch=3) +## Proportion of rejected h0 per dif value in h0 scenarios (A) by DIF size (1 item) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 3 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==3,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 3 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(1,1)) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(1,1)) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==7,] +nrow(res.null) +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 3 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==3 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 3 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(1,1)) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==7,] +nrow(res.null) +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 3 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==3 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 3 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(1,1)) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(1,1)) +par(mfrow=c(2,2)) +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==7,] +nrow(res.null) +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +# 3 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==3 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', +ylab='H0 rejection proportion in target scenario',main='DIF on 3 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) +par(mfrow=c(1,1)) diff --git a/RProject/pcm.R b/RProject/pcm.R index 7fcd065..079695e 100644 --- a/RProject/pcm.R +++ b/RProject/pcm.R @@ -9,6 +9,7 @@ library(doMC) library(parallel) library(pbmcapply) library(funprog) +library(dplyr) lastChar <- function(str){ substr(str, nchar(str)-2, nchar(str)) @@ -205,13 +206,6 @@ write.csv(res[[2]],'/home/corentin/Documents/These/Recherche/Simulation/Analysis write.csv(res[[3]],'/home/corentin/Documents/These/Recherche/Simulation/Analysis/NoDIF/N300/scenario_1E_300.csv') - - - - - - - ###################################### Scenario 2: J=4 / M=4 #### A: H0 TRUE @@ -2054,12 +2048,223 @@ write.csv(res_nodif[[2]],'/home/corentin/Documents/These/Recherche/Simulation/An write.csv(res_nodif[[3]],'/home/corentin/Documents/These/Recherche/Simulation/Analysis/DIF/N300/scenario_20G_300_nodif.csv') +############################################################################## +#----------------------------------------------------------------------------# +################################# AGGREGATION ################################ +#----------------------------------------------------------------------------# +############################################################################## +#### Create data.frame +results <- c(sapply(1:4,function(x) paste0(x,c('A','B','C','D','E'))),sapply(5:9,function(x) paste0(x,c('A','B','C','D','E','F','G')))) +results2 <- c(sapply(10:20,function(x) paste0(x,c('A','B','C','D','E','F','G')))) +results <- c(sapply(c(100,200,300),function(x) paste0(results,'_',x))) +results2 <- c(sapply(c(100,200,300),function(x) paste0(results2,'_',x))) +results <- sort(results) +results2 <- sort(results2) +results <- c(results,results2) +#### Compiler function + +compile_simulation <- function(scenario) { + name <- as.numeric(gsub("[^0-9.-]", "", substr(scenario,start=0,stop=2))) + if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="100" & name<=4) { + s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N100/scenario_',scenario,'.csv')) + } + if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="100" & name>4) { + s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N100/scenario_',scenario,'_nodif.csv')) + } + if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="200" & name<=4) { + s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N200/scenario_',scenario,'.csv')) + } + if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="200" & name>4) { + s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N200/scenario_',scenario,'_nodif.csv')) + } + if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="300" & name<=4) { + s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N300/scenario_',scenario,'.csv')) + } + if (substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario))=="300" & name>4) { + s <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Analysis/NoDIF/N300/scenario_',scenario,'_nodif.csv')) + } + if (unique(s$J)==4) { + if (unique(s$M)==2) { + a <- data.frame(m.item1=mean(s$item1),m.item2=mean(s$item2),m.item3=mean(s$item3),m.item4=mean(s$item4)) + } else { + a <- data.frame(m.item1_1=mean(s$item1_1),m.item1_2=mean(s$item1_2),m.item1_3=mean(s$item1_3), + m.item2_1=mean(s$item2_1),m.item2_2=mean(s$item2_2),m.item2_3=mean(s$item2_3), + m.item3_1=mean(s$item3_1),m.item3_2=mean(s$item3_2),m.item3_3=mean(s$item3_3), + m.item4_1=mean(s$item4_1),m.item4_2=mean(s$item4_2),m.item4_3=mean(s$item4_3) + ) + } + } else { + if (unique(s$M)==2) { + a <- data.frame(m.item1=mean(s$item1),m.item2=mean(s$item2),m.item3=mean(s$item3),m.item4=mean(s$item4), + m.item5=mean(s$item5),m.item6=mean(s$item6),m.item7=mean(s$item7)) + } else { + a <- data.frame(m.item1_1=mean(s$item1_1),m.item1_2=mean(s$item1_2),m.item1_3=mean(s$item1_3), + m.item2_1=mean(s$item2_1),m.item2_2=mean(s$item2_2),m.item2_3=mean(s$item2_3), + m.item3_1=mean(s$item3_1),m.item3_2=mean(s$item3_2),m.item3_3=mean(s$item3_3), + m.item4_1=mean(s$item4_1),m.item4_2=mean(s$item4_2),m.item4_3=mean(s$item4_3), + m.item5_1=mean(s$item5_1),m.item5_2=mean(s$item5_2),m.item5_3=mean(s$item5_3), + m.item6_1=mean(s$item6_1),m.item6_2=mean(s$item6_2),m.item6_3=mean(s$item6_3), + m.item7_1=mean(s$item7_1),m.item7_2=mean(s$item7_2),m.item7_3=mean(s$item7_3) + ) + } + } + zz <- substr(scenario,start=0,stop=nchar(scenario)-4) + b <- data.frame(scenario=zz, + scenario.type=substr(zz,start=nchar(zz),stop=nchar(zz)), + N=substr(scenario,start=nchar(scenario)-2,stop=nchar(scenario)), + J=unique(s$J), + M=unique(s$M), + eff.size=unique(s$eff.size), + nb.dif=unique(s$nb.dif), + dif.size=unique(s$dif.size) + ) + z <- data.frame(m.beta=mean(s$beta), + m.low.ci.beta=mean(s$low.ci.beta), + m.high.ci.beta=mean(s$high.ci.beta), + true.value.in.ci.p=mean(s$true.value.in.ci), + h0.rejected.p=mean(s$h0.rejected), + beta.same.sign.truebeta.p=mean(s$beta.same.sign.truebeta,na.rm=T)) + d <- cbind(b,a,z) + d$prop. + return(d) +} + +#### Compiled results + +res.dat <- compile_simulation('1A_100') + +for (x in results[seq(2,length(results))]) { + y <- compile_simulation(x) + res.dat <- bind_rows(res.dat,y) +} +res.dat[is.na(res.dat$dif.size),'dif.size'] <- 0 +res.dat[132:300,'nb.dif'] <- 2 +res.dat[300:396,'nb.dif'] <- 3 +View(res.dat) + +res.dat.simple <- res.dat[,c(1:8,13,16:18)] +res.dat.simple$m.beta <- round(res.dat.simple$m.beta,3) +res.dat.simple + +################ Boxplots of Rejected H0 in null scenarios + +## Proportion of rejected h0 per dif value in h0 scenarios (A) by DIF size + +res.null <- res.dat[res.dat$eff.size==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(1,2,3),xlab='DIF size',ylab='H0 rejection proportion in target scenario') +res.null0 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0,] +points(y=res.null0$h0.rejected.p,x=rep(1,nrow(res.null0)),col='gray',pch=3) +res.null3 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(2,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.dat[res.dat$eff.size==0 & res.dat$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(3,nrow(res.null5)),col='#053305',pch=3) + +## Proportion of rejected h0 per dif value in h0 scenarios (A) by DIF size (1 item) + +par(mfrow=c(2,2)) + +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) + +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +# 3 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==3,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 3 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +par(mfrow=c(1,1)) + +## Proportion of rejected h0 per dif value in h0 scenarios (A) by DIF size (1 item) J=4 + +par(mfrow=c(2,2)) + +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) + +# 1 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==1 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 1 item',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==4,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +par(mfrow=c(1,1)) + + +## Proportion of rejected h0 per dif value in h0 scenarios (A) by DIF size (1 item) J=7 + +par(mfrow=c(2,2)) + +# 0 item +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==0 & res.dat$J==7,] +nrow(res.null) +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='No DIF',ylim=c(0,1)) +points(y=res.null$h0.rejected.p,x=rep(1,nrow(res.null)),col='#590b0c',pch=3) + +# 2 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==2 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 2 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +# 3 items +res.null <- res.dat[res.dat$eff.size==0 & res.dat$nb.dif==3 & res.dat$J==7,] +boxplot(h0.rejected.p~dif.size,data=res.null,col=c(2,3),xlab='DIF size', + ylab='H0 rejection proportion in target scenario',main='DIF on 3 items',ylim=c(0,1)) +res.null3 <- res.null[res.null$dif.size==0.3,] +points(y=res.null3$h0.rejected.p,x=rep(1,nrow(res.null3)),col='#590b0c',pch=3) +res.null5 <- res.null[res.null$dif.size==0.5,] +points(y=res.null5$h0.rejected.p,x=rep(2,nrow(res.null5)),col='#053305',pch=3) + +par(mfrow=c(1,1))