diff --git a/.gitignore b/.gitignore index 0b36450..304d118 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,5 @@ !res_dat_dif_rosali.csv !res_dat_dif_resali.csv *.dcf +*.pdf +*.png diff --git a/RProject/Scripts/Analysis/aggregation.R b/RProject/Scripts/Analysis/aggregation.R index 9890421..52688e4 100644 --- a/RProject/Scripts/Analysis/aggregation.R +++ b/RProject/Scripts/Analysis/aggregation.R @@ -17,7 +17,7 @@ lastChar <- function(str){ substr(str, nchar(str), nchar(str)) } -source(paste0(getwd(),"/functions/resali.R")) +source(paste0(getwd(),"/Scripts/Analysis/functions/resali.R")) ############################################################################## #----------------------------------------------------------------------------# @@ -147,20 +147,19 @@ replicate_pcm_analysis<- function(df=NULL,treatment='TT',irtmodel='PCM2',method= #### 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')))) +results <- c(sapply(c(2,4),function(x) paste0(x,c('A','B','C'))),sapply(c(6,8),function(x) paste0(x,c('A','B','C','D','E')))) -results2 <- c(sapply(10:20,function(x) paste0(x,c('A','B','C','D','E','F','G')))) +results2 <- c(sapply(seq(10,20,2),function(x) paste0(x,c('A','B','C','D','E')))) -results <- c(sapply(c(50,100,200,300),function(x) paste0(results,'_',x))) +results <- c(sapply(c(50,100,300),function(x) paste0(results,'_',x))) -results2 <- c(sapply(c(50,100,200,300),function(x) paste0(results2,'_',x))) - -results <- sort(results) - -results2 <- sort(results2) +results2 <- c(sapply(c(50,100,300),function(x) paste0(results2,'_',x))) results <- c(results,results2) +results <- c(sapply(1:16,function(x) c(results[x],results[x+16],results[x+32])), + sapply(1:30,function(x) c(results[x+48],results[x+30+48],results[x+60+48])) + ) #### Compiler function compile_simulation <- function(scenario) { @@ -241,33 +240,29 @@ compile_simulation <- function(scenario) { #### Compiled results -res.dat <- compile_simulation('1A_100') +res.dat <- compile_simulation('2A_50') for (x in results[seq(2,length(results))]) { y <- compile_simulation(x) res.dat <- bind_rows(res.dat,y) } + res.dat[res.dat$scenario.type=='A','dif.size'] <- -res.dat[res.dat$scenario.type=='A','dif.size'] res.dat[is.na(res.dat$dif.size),'dif.size'] <- 0 -res.dat[193:417,'nb.dif'] <- 2 -res.dat[417:528,'nb.dif'] <- 3 +res.dat[res.dat$scenario=="10B",]$dif.size <- 0.3 +res.dat[substr(res.dat$scenario,1,1)%in%c("6","8"),'nb.dif'] <- 1 +res.dat[substr(res.dat$scenario,1,2)%in%seq(10,16,2),'nb.dif'] <- 2 +res.dat[substr(res.dat$scenario,1,2)%in%seq(18,20,2),'nb.dif'] <- 3 +res.dat[res.dat$N==50,"dif.size"] <- res.dat[which(res.dat$N==50)+1,"dif.size"] res.dat[res.dat$scenario.type=="B",]$eff.size <- 0.2 res.dat[res.dat$scenario.type=="C" & res.dat$dif.size==0,]$eff.size <- 0.4 res.dat[res.dat$scenario.type=="C" & res.dat$dif.size!=0,]$eff.size <- 0.2 -res.dat[res.dat$scenario.type=="D" & res.dat$dif.size==0,]$eff.size <- -0.2 res.dat[res.dat$scenario.type=="D" & res.dat$dif.size!=0,]$eff.size <- 0.4 -res.dat[res.dat$scenario.type=="E" & res.dat$dif.size==0,]$eff.size <- -0.4 res.dat[res.dat$scenario.type=="E" & res.dat$dif.size!=0,]$eff.size <- 0.4 -res.dat[res.dat$scenario.type=="F",]$eff.size <- -0.2 -res.dat[res.dat$scenario.type=="G",]$eff.size <- -0.4 -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 -is.nan.data.frame <- function(x) +is.nan.data.frame <- function(x) { do.call(cbind, lapply(x, is.nan)) +} res.dat[is.nan(res.dat)] <- NA @@ -282,19 +277,21 @@ res.dat$bias <- res.dat$eff.size-res.dat$m.beta #### 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')))) +results <- c(sapply(c(2,4),function(x) paste0(x,c('A','B','C'))),sapply(c(6,8),function(x) paste0(x,c('A','B','C','D','E')))) -results2 <- c(sapply(10:20,function(x) paste0(x,c('A','B','C','D','E','F','G')))) +results2 <- c(sapply(seq(10,20,2),function(x) paste0(x,c('A','B','C','D','E')))) -results <- c(sapply(c(50,100,200,300),function(x) paste0(results,'_',x))) +results <- c(sapply(c(50,100,300),function(x) paste0(results,'_',x))) -results2 <- c(sapply(c(50,100,200,300),function(x) paste0(results2,'_',x))) +results2 <- c(sapply(c(50,100,300),function(x) paste0(results2,'_',x))) -results <- sort(results) +results <- c(results,results2) -results2 <- sort(results2) +results <- c(sapply(1:16,function(x) c(results[x],results[x+16],results[x+32])), + sapply(1:30,function(x) c(results[x+48],results[x+30+48],results[x+60+48])) +) -results <- c(results,results2)[81:528] +results <- results[19:length(results)] #### Compiler function @@ -376,14 +373,23 @@ compile_simulation2 <- function(scenario) { #### Compiled results -res.dat.dif <- compile_simulation2('5A_100') +res.dat.dif <- compile_simulation2('6A_50') for (x in results[seq(2,length(results))]) { y <- compile_simulation2(x) res.dat.dif <- bind_rows(res.dat.dif,y) } -res.dat$bias <- res.dat$eff.size-res.dat$m.beta +res.dat.dif[is.na(res.dat.dif$dif.size),'dif.size'] <- 0 +res.dat.dif[substr(res.dat.dif$scenario,1,1)%in%c("6","8"),'nb.dif'] <- 1 +res.dat.dif[substr(res.dat.dif$scenario,1,2)%in%seq(10,16,2),'nb.dif'] <- 2 +res.dat.dif[substr(res.dat.dif$scenario,1,2)%in%seq(18,20,2),'nb.dif'] <- 3 +res.dat.dif[res.dat.dif$N==50,"dif.size"] <- res.dat.dif[which(res.dat.dif$N==50)+1,"dif.size"] +res.dat.dif[res.dat.dif$scenario.type=="B",]$eff.size <- 0.2 +res.dat.dif[res.dat.dif$scenario.type=="C" & res.dat.dif$dif.size!=0,]$eff.size <- 0.2 +res.dat.dif[res.dat.dif$scenario.type=="D" & res.dat.dif$dif.size!=0,]$eff.size <- 0.4 +res.dat.dif[res.dat.dif$scenario.type=="E" & res.dat.dif$dif.size!=0,]$eff.size <- 0.4 +res.dat.dif[res.dat.dif$scenario=="10B",]$dif.size <- 0.3 res.dat.dif$bias <- res.dat.dif$eff.size-res.dat.dif$m.beta ############################################################################## @@ -394,20 +400,19 @@ res.dat.dif$bias <- res.dat.dif$eff.size-res.dat.dif$m.beta #### 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(2,4),function(x) paste0(x,c('A','B','C'))),sapply(c(6,8),function(x) paste0(x,c('A','B','C','D','E')))) -results <- c(sapply(c(50,100,200,300),function(x) paste0(results,'_',x))) +results2 <- c(sapply(seq(10,20,2),function(x) paste0(x,c('A','B','C','D','E')))) -results2 <- c(sapply(c(50,100,200,300),function(x) paste0(results2,'_',x))) +results <- c(sapply(c(50,100,300),function(x) paste0(results,'_',x))) -results <- sort(results) - -results2 <- sort(results2) +results2 <- c(sapply(c(50,100,300),function(x) paste0(results2,'_',x))) results <- c(results,results2) +results <- c(sapply(1:16,function(x) c(results[x],results[x+16],results[x+32])), + sapply(1:30,function(x) c(results[x+48],results[x+30+48],results[x+60+48])) +) #### Compiler function @@ -650,13 +655,33 @@ compile_simulation2_rosali <- function(scenario) { #### Compiled results -res.dat.dif.rosali <- compile_simulation2_rosali('1A_100') +res.dat.dif.rosali <- compile_simulation2_rosali('2A_50') for (x in results[seq(2,length(results))]) { y <- compile_simulation2_rosali(x) res.dat.dif.rosali <- bind_rows(res.dat.dif.rosali,y) } +res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=='A','dif.size'] <- -res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=='A','dif.size'] +res.dat.dif.rosali[is.na(res.dat.dif.rosali$dif.size),'dif.size'] <- 0 +res.dat.dif.rosali[substr(res.dat.dif.rosali$scenario,1,1)%in%c("6","8"),'nb.dif'] <- 1 +res.dat.dif.rosali[substr(res.dat.dif.rosali$scenario,1,2)%in%seq(10,16,2),'nb.dif'] <- 2 +res.dat.dif.rosali[substr(res.dat.dif.rosali$scenario,1,2)%in%seq(18,20,2),'nb.dif'] <- 3 +res.dat.dif.rosali[res.dat.dif.rosali$N==50,"dif.size"] <- res.dat.dif.rosali[which(res.dat.dif.rosali$N==50)+1,"dif.size"] +res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=="B",]$eff.size <- 0.2 +res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=="C" & res.dat.dif.rosali$dif.size==0,]$eff.size <- 0.4 +res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=="C" & res.dat.dif.rosali$dif.size!=0,]$eff.size <- 0.2 +res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=="D" & res.dat.dif.rosali$dif.size!=0,]$eff.size <- 0.4 +res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=="E" & res.dat.dif.rosali$dif.size!=0,]$eff.size <- 0.4 +res.dat.dif.rosali[res.dat.dif.rosali$scenario=="10B",]$dif.size <- 0.3 + +is.nan.data.frame <- function(x) { + do.call(cbind, lapply(x, is.nan)) +} + + +res.dat.dif.rosali[is.nan(res.dat.dif.rosali)] <- NA + res.dat.dif.rosali$bias <- res.dat.dif.rosali$eff.size-res.dat.dif.rosali$m.beta @@ -668,20 +693,21 @@ res.dat.dif.rosali$bias <- res.dat.dif.rosali$eff.size-res.dat.dif.rosali$m.beta #### 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(2,4),function(x) paste0(x,c('A','B','C'))),sapply(c(6,8),function(x) paste0(x,c('A','B','C','D','E')))) -results <- c(sapply(c(50,100,200,300),function(x) paste0(results,'_',x))) +results2 <- c(sapply(seq(10,20,2),function(x) paste0(x,c('A','B','C','D','E')))) -results2 <- c(sapply(c(50,100,200,300),function(x) paste0(results2,'_',x))) +results <- c(sapply(c(50,100,300),function(x) paste0(results,'_',x))) -results <- sort(results) - -results2 <- sort(results2) +results2 <- c(sapply(c(50,100,300),function(x) paste0(results2,'_',x))) results <- c(results,results2) +results <- c(sapply(1:16,function(x) c(results[x],results[x+16],results[x+32])), + sapply(1:30,function(x) c(results[x+48],results[x+30+48],results[x+60+48])) +) + #### Compiler function @@ -920,13 +946,33 @@ compile_simulation2_resali <- function(scenario) { #### Compiled results -res.dat.dif.resali <- compile_simulation2_resali('1A_100') +res.dat.dif.resali <- compile_simulation2_resali('2A_50') for (x in results[seq(2,length(results))]) { y <- compile_simulation2_resali(x) res.dat.dif.resali <- bind_rows(res.dat.dif.resali,y) } +res.dat.dif.resali[res.dat.dif.resali$scenario.type=='A','dif.size'] <- -res.dat.dif.resali[res.dat.dif.resali$scenario.type=='A','dif.size'] +res.dat.dif.resali[is.na(res.dat.dif.resali$dif.size),'dif.size'] <- 0 +res.dat.dif.resali[substr(res.dat.dif.resali$scenario,1,1)%in%c("6","8"),'nb.dif'] <- 1 +res.dat.dif.resali[substr(res.dat.dif.resali$scenario,1,2)%in%seq(10,16,2),'nb.dif'] <- 2 +res.dat.dif.resali[substr(res.dat.dif.resali$scenario,1,2)%in%seq(18,20,2),'nb.dif'] <- 3 +res.dat.dif.resali[res.dat.dif.resali$N==50,"dif.size"] <- res.dat.dif.resali[which(res.dat.dif.resali$N==50)+1,"dif.size"] +res.dat.dif.resali[res.dat.dif.resali$scenario.type=="B",]$eff.size <- 0.2 +res.dat.dif.resali[res.dat.dif.resali$scenario.type=="C" & res.dat.dif.resali$dif.size==0,]$eff.size <- 0.4 +res.dat.dif.resali[res.dat.dif.resali$scenario.type=="C" & res.dat.dif.resali$dif.size!=0,]$eff.size <- 0.2 +res.dat.dif.resali[res.dat.dif.resali$scenario.type=="D" & res.dat.dif.resali$dif.size!=0,]$eff.size <- 0.4 +res.dat.dif.resali[res.dat.dif.resali$scenario.type=="E" & res.dat.dif.resali$dif.size!=0,]$eff.size <- 0.4 +res.dat.dif.resali[res.dat.dif.resali$scenario=="10B",]$dif.size <- 0.3 + +is.nan.data.frame <- function(x) { + do.call(cbind, lapply(x, is.nan)) +} + + +res.dat.dif.resali[is.nan(res.dat.dif.resali)] <- NA + res.dat.dif.resali$bias <- res.dat.dif.resali$eff.size-res.dat.dif.resali$m.beta @@ -943,20 +989,6 @@ res.dat$theoretical.power <- 0 ### Scénarios N=100 -## Scénarios J=4 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'A') & res.dat$N==100,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'B') & res.dat$N==100,]$theoretical.power <- 0.1543 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'C') & res.dat$N==100,]$theoretical.power <- 0.1543 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'D') & res.dat$N==100,]$theoretical.power <- 0.4627 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'E') & res.dat$N==100,]$theoretical.power <- 0.4627 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'F') & res.dat$N==100,]$theoretical.power <- 0.1543 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'G') & res.dat$N==100,]$theoretical.power <- 0.4627 - -res.dat[res.dat$scenario %in% paste0(1,'C') & res.dat$N==100,]$theoretical.power <- 0.4627 -res.dat[res.dat$scenario %in% paste0(1,'D') & res.dat$N==100,]$theoretical.power <- 0.1543 -res.dat[res.dat$scenario %in% paste0(1,'E') & res.dat$N==100,]$theoretical.power <- 0.4627 - ## Scénarios J=4 / M=4 res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'A') & res.dat$N==100,]$theoretical.power <- 0.05 @@ -964,26 +996,8 @@ res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'B') & res.dat$N==100,]$theo res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'C') & res.dat$N==100,]$theoretical.power <- 0.2177 res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'D') & res.dat$N==100,]$theoretical.power <- 0.6586 res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'E') & res.dat$N==100,]$theoretical.power <- 0.6586 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'F') & res.dat$N==100,]$theoretical.power <- 0.2177 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'G') & res.dat$N==100,]$theoretical.power <- 0.6586 res.dat[res.dat$scenario %in% paste0(2,'C') & res.dat$N==100,]$theoretical.power <- 0.6586 -res.dat[res.dat$scenario %in% paste0(2,'D') & res.dat$N==100,]$theoretical.power <- 0.2177 -res.dat[res.dat$scenario %in% paste0(2,'E') & res.dat$N==100,]$theoretical.power <- 0.6586 - -## Scénarios J=7 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'A') & res.dat$N==100,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'B') & res.dat$N==100,]$theoretical.power <- 0.1870 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'C') & res.dat$N==100,]$theoretical.power <- 0.1870 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'D') & res.dat$N==100,]$theoretical.power <- 0.5666 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'E') & res.dat$N==100,]$theoretical.power <- 0.5666 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'F') & res.dat$N==100,]$theoretical.power <- 0.1870 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'G') & res.dat$N==100,]$theoretical.power <- 0.5666 - -res.dat[res.dat$scenario %in% paste0(3,'C') & res.dat$N==100,]$theoretical.power <- 0.5666 -res.dat[res.dat$scenario %in% paste0(3,'D') & res.dat$N==100,]$theoretical.power <- 0.1870 -res.dat[res.dat$scenario %in% paste0(3,'E') & res.dat$N==100,]$theoretical.power <- 0.5666 ## Scénarios J=7 / M=4 @@ -992,91 +1006,13 @@ res.dat[res.dat$scenario %in% paste0(c(4,14,16,18,20),'B') & res.dat$N==100,]$th res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'C') & res.dat$N==100,]$theoretical.power <- 0.2450 res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'D') & res.dat$N==100,]$theoretical.power <- 0.7136 res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'E') & res.dat$N==100,]$theoretical.power <- 0.7136 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'F') & res.dat$N==100,]$theoretical.power <- 0.2450 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'G') & res.dat$N==100,]$theoretical.power <- 0.7136 res.dat[res.dat$scenario %in% paste0(4,'C') & res.dat$N==100,]$theoretical.power <- 0.7136 -res.dat[res.dat$scenario %in% paste0(4,'D') & res.dat$N==100,]$theoretical.power <- 0.2450 -res.dat[res.dat$scenario %in% paste0(4,'E') & res.dat$N==100,]$theoretical.power <- 0.7136 - - -### Scénarios N=200 - -## Scénarios J=4 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'A') & res.dat$N==200,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'B') & res.dat$N==200,]$theoretical.power <- 0.2618 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'C') & res.dat$N==200,]$theoretical.power <- 0.2618 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'D') & res.dat$N==200,]$theoretical.power <- 0.7507 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'E') & res.dat$N==200,]$theoretical.power <- 0.7507 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'F') & res.dat$N==200,]$theoretical.power <- 0.2618 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'G') & res.dat$N==200,]$theoretical.power <- 0.7507 - -res.dat[res.dat$scenario %in% paste0(1,'C') & res.dat$N==200,]$theoretical.power <- 0.7507 -res.dat[res.dat$scenario %in% paste0(1,'D') & res.dat$N==200,]$theoretical.power <- 0.2618 -res.dat[res.dat$scenario %in% paste0(1,'E') & res.dat$N==200,]$theoretical.power <- 0.7507 - -## Scénarios J=4 / M=4 - -res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'A') & res.dat$N==200,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'B') & res.dat$N==200,]$theoretical.power <- 0.3875 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'C') & res.dat$N==200,]$theoretical.power <- 0.3875 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'D') & res.dat$N==200,]$theoretical.power <- 0.9161 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'E') & res.dat$N==200,]$theoretical.power <- 0.9161 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'F') & res.dat$N==200,]$theoretical.power <- 0.3875 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'G') & res.dat$N==200,]$theoretical.power <- 0.9161 - -res.dat[res.dat$scenario %in% paste0(2,'C') & res.dat$N==200,]$theoretical.power <- 0.9161 -res.dat[res.dat$scenario %in% paste0(2,'D') & res.dat$N==200,]$theoretical.power <- 0.3875 -res.dat[res.dat$scenario %in% paste0(2,'E') & res.dat$N==200,]$theoretical.power <- 0.9161 - -## Scénarios J=7 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'A') & res.dat$N==200,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'B') & res.dat$N==200,]$theoretical.power <- 0.3258 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'C') & res.dat$N==200,]$theoretical.power <- 0.3258 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'D') & res.dat$N==200,]$theoretical.power <- 0.8538 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'E') & res.dat$N==200,]$theoretical.power <- 0.8538 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'F') & res.dat$N==200,]$theoretical.power <- 0.3258 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'G') & res.dat$N==200,]$theoretical.power <- 0.8538 - -res.dat[res.dat$scenario %in% paste0(3,'C') & res.dat$N==200,]$theoretical.power <- 0.8538 -res.dat[res.dat$scenario %in% paste0(3,'D') & res.dat$N==200,]$theoretical.power <- 0.3258 -res.dat[res.dat$scenario %in% paste0(3,'E') & res.dat$N==200,]$theoretical.power <- 0.8538 - -## Scénarios J=7 / M=4 - -res.dat[res.dat$scenario %in% paste0(c(4,14,16,18,20),'A') & res.dat$N==200,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(4,14,16,18,20),'B') & res.dat$N==200,]$theoretical.power <- 0.4321 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'C') & res.dat$N==200,]$theoretical.power <- 0.4321 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'D') & res.dat$N==200,]$theoretical.power <- 0.9471 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'E') & res.dat$N==200,]$theoretical.power <- 0.9471 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'F') & res.dat$N==200,]$theoretical.power <- 0.4321 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'G') & res.dat$N==200,]$theoretical.power <- 0.9471 - -res.dat[res.dat$scenario %in% paste0(4,'C') & res.dat$N==200,]$theoretical.power <- 0.9471 -res.dat[res.dat$scenario %in% paste0(4,'D') & res.dat$N==200,]$theoretical.power <- 0.4321 -res.dat[res.dat$scenario %in% paste0(4,'E') & res.dat$N==200,]$theoretical.power <- 0.9471 - ### Scénarios N=300 -## Scénarios J=4 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'A') & res.dat$N==300,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'B') & res.dat$N==300,]$theoretical.power <- 0.3660 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'C') & res.dat$N==300,]$theoretical.power <- 0.3660 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'D') & res.dat$N==300,]$theoretical.power <- 0.8981 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'E') & res.dat$N==300,]$theoretical.power <- 0.8981 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'F') & res.dat$N==300,]$theoretical.power <- 0.3660 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'G') & res.dat$N==300,]$theoretical.power <- 0.8981 - -res.dat[res.dat$scenario %in% paste0(1,'C') & res.dat$N==300,]$theoretical.power <- 0.8981 -res.dat[res.dat$scenario %in% paste0(1,'D') & res.dat$N==300,]$theoretical.power <- 0.3660 -res.dat[res.dat$scenario %in% paste0(1,'E') & res.dat$N==300,]$theoretical.power <- 0.8981 - ## Scénarios J=4 / M=4 res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'A') & res.dat$N==300,]$theoretical.power <- 0.05 @@ -1084,26 +1020,8 @@ res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'B') & res.dat$N==300,]$theo res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'C') & res.dat$N==300,]$theoretical.power <- 0.5373 res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'D') & res.dat$N==300,]$theoretical.power <- 0.9834 res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'E') & res.dat$N==300,]$theoretical.power <- 0.9834 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'F') & res.dat$N==300,]$theoretical.power <- 0.5373 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'G') & res.dat$N==300,]$theoretical.power <- 0.9834 res.dat[res.dat$scenario %in% paste0(2,'C') & res.dat$N==300,]$theoretical.power <- 0.9834 -res.dat[res.dat$scenario %in% paste0(2,'D') & res.dat$N==300,]$theoretical.power <- 0.5373 -res.dat[res.dat$scenario %in% paste0(2,'E') & res.dat$N==300,]$theoretical.power <- 0.9834 - -## Scénarios J=7 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'A') & res.dat$N==300,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'B') & res.dat$N==300,]$theoretical.power <- 0.4550 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'C') & res.dat$N==300,]$theoretical.power <- 0.4550 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'D') & res.dat$N==300,]$theoretical.power <- 0.9584 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'E') & res.dat$N==300,]$theoretical.power <- 0.9584 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'F') & res.dat$N==300,]$theoretical.power <- 0.4550 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'G') & res.dat$N==300,]$theoretical.power <- 0.9584 - -res.dat[res.dat$scenario %in% paste0(3,'C') & res.dat$N==300,]$theoretical.power <- 0.9584 -res.dat[res.dat$scenario %in% paste0(3,'D') & res.dat$N==300,]$theoretical.power <- 0.4550 -res.dat[res.dat$scenario %in% paste0(3,'E') & res.dat$N==300,]$theoretical.power <- 0.9584 ## Scénarios J=7 / M=4 @@ -1112,30 +1030,12 @@ res.dat[res.dat$scenario %in% paste0(c(4,14,16,18,20),'B') & res.dat$N==300,]$th res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'C') & res.dat$N==300,]$theoretical.power <- 0.5907 res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'D') & res.dat$N==300,]$theoretical.power <- 0.9919 res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'E') & res.dat$N==300,]$theoretical.power <- 0.9919 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'F') & res.dat$N==300,]$theoretical.power <- 0.5907 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'G') & res.dat$N==300,]$theoretical.power <- 0.9919 res.dat[res.dat$scenario %in% paste0(4,'C') & res.dat$N==300,]$theoretical.power <- 0.9919 -res.dat[res.dat$scenario %in% paste0(4,'D') & res.dat$N==300,]$theoretical.power <- 0.5907 -res.dat[res.dat$scenario %in% paste0(4,'E') & res.dat$N==300,]$theoretical.power <- 0.9919 ### Scénarios N=50 -## Scénarios J=4 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'A') & res.dat$N==50,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(1,5,7,9,11),'B') & res.dat$N==50,]$theoretical.power <- 0.1013 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'C') & res.dat$N==50,]$theoretical.power <- 0.1013 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'D') & res.dat$N==50,]$theoretical.power <- 0.2615 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'E') & res.dat$N==50,]$theoretical.power <- 0.2615 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'F') & res.dat$N==50,]$theoretical.power <- 0.1013 -res.dat[res.dat$scenario %in% paste0(c(5,7,9,11),'G') & res.dat$N==50,]$theoretical.power <- 0.2615 - -res.dat[res.dat$scenario %in% paste0(1,'C') & res.dat$N==50,]$theoretical.power <- 0.2615 -res.dat[res.dat$scenario %in% paste0(1,'D') & res.dat$N==50,]$theoretical.power <- 0.1013 -res.dat[res.dat$scenario %in% paste0(1,'E') & res.dat$N==50,]$theoretical.power <- 0.2615 - ## Scénarios J=4 / M=4 res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'A') & res.dat$N==50,]$theoretical.power <- 0.05 @@ -1143,26 +1043,8 @@ res.dat[res.dat$scenario %in% paste0(c(2,6,8,10,12),'B') & res.dat$N==50,]$theor res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'C') & res.dat$N==50,]$theoretical.power <- 0.1339 res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'D') & res.dat$N==50,]$theoretical.power <- 0.3863 res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'E') & res.dat$N==50,]$theoretical.power <- 0.3863 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'F') & res.dat$N==50,]$theoretical.power <- 0.1339 -res.dat[res.dat$scenario %in% paste0(c(6,8,10,12),'G') & res.dat$N==50,]$theoretical.power <- 0.3863 res.dat[res.dat$scenario %in% paste0(2,'C') & res.dat$N==50,]$theoretical.power <- 0.3863 -res.dat[res.dat$scenario %in% paste0(2,'D') & res.dat$N==50,]$theoretical.power <- 0.1339 -res.dat[res.dat$scenario %in% paste0(2,'E') & res.dat$N==50,]$theoretical.power <- 0.3863 - -## Scénarios J=7 / M=2 - -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'A') & res.dat$N==50,]$theoretical.power <- 0.05 -res.dat[res.dat$scenario %in% paste0(c(3,13,15,17,19),'B') & res.dat$N==50,]$theoretical.power <- 0.1171 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'C') & res.dat$N==50,]$theoretical.power <- 0.1171 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'D') & res.dat$N==50,]$theoretical.power <- 0.3236 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'E') & res.dat$N==50,]$theoretical.power <- 0.3236 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'F') & res.dat$N==50,]$theoretical.power <- 0.1171 -res.dat[res.dat$scenario %in% paste0(c(13,15,17,19),'G') & res.dat$N==50,]$theoretical.power <- 0.3236 - -res.dat[res.dat$scenario %in% paste0(3,'C') & res.dat$N==50,]$theoretical.power <- 0.3236 -res.dat[res.dat$scenario %in% paste0(3,'D') & res.dat$N==50,]$theoretical.power <- 0.1171 -res.dat[res.dat$scenario %in% paste0(3,'E') & res.dat$N==50,]$theoretical.power <- 0.3236 ## Scénarios J=7 / M=4 @@ -1171,17 +1053,12 @@ res.dat[res.dat$scenario %in% paste0(c(4,14,16,18,20),'B') & res.dat$N==50,]$the res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'C') & res.dat$N==50,]$theoretical.power <- 0.1448 res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'D') & res.dat$N==50,]$theoretical.power <- 0.4328 res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'E') & res.dat$N==50,]$theoretical.power <- 0.4328 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'F') & res.dat$N==50,]$theoretical.power <- 0.1448 -res.dat[res.dat$scenario %in% paste0(c(14,16,18,20),'G') & res.dat$N==50,]$theoretical.power <- 0.4328 res.dat[res.dat$scenario %in% paste0(4,'C') & res.dat$N==50,]$theoretical.power <- 0.4328 -res.dat[res.dat$scenario %in% paste0(4,'D') & res.dat$N==50,]$theoretical.power <- 0.1448 -res.dat[res.dat$scenario %in% paste0(4,'E') & res.dat$N==50,]$theoretical.power <- 0.4328 - ### DIF scenarios -res.dat.dif$theoretical.power <- res.dat[81:nrow(res.dat),]$theoretical.power +res.dat.dif$theoretical.power <- res.dat[res.dat$dif.size!=0,]$theoretical.power res.dat.dif.rosali$theoretical.power <- res.dat$theoretical.power res.dat.dif.resali$theoretical.power <- res.dat$theoretical.power @@ -1200,37 +1077,178 @@ res.dat.dif.rosali$method <- "ROSALI" res.dat.dif.resali$method <- "RESIDUS" -# Correction of N=50 scenarios - -res.dat[res.dat$N==50,]$dif.size <- sapply(which(res.dat$N==50),function(k) res.dat[k-1,]$dif.size) -res.dat.dif[res.dat.dif$N==50,]$dif.size <- sapply(which(res.dat.dif$N==50),function(k) res.dat.dif[k-1,]$dif.size) -res.dat.dif.rosali[res.dat.dif.rosali$N==50,]$dif.size <- sapply(which(res.dat.dif.rosali$N==50),function(k) res.dat.dif.rosali[k-1,]$dif.size) -res.dat.dif.resali[res.dat.dif.resali$N==50,]$dif.size <- sapply(which(res.dat.dif.resali$N==50),function(k) res.dat.dif.resali[k-1,]$dif.size) -res.dat[res.dat$dif.size!=0 & res.dat$nb.dif==0,]$nb.dif <- 1 -res.dat.dif <- res.dat.dif %>% - relocate(method, .after = theoretical.power) -res.dat[res.dat$scenario=="10B",]$dif.size <- 0.3 -res.dat.dif[res.dat.dif$scenario=="10B",]$dif.size <- 0.3 -res.dat.dif.rosali[res.dat.dif.rosali$scenario=="10B",]$dif.size <- 0.3 -res.dat.dif.resali[res.dat.dif.resali$scenario=="10B",]$dif.size <- 0.3 -res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0,]$eff.size <- rep(c(0,0.2,0.2,0.4,0.4,-0.2,-0.4),16) -res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0 & res.dat.dif$scenario.type=="C",]$bias <- res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0 & res.dat.dif$scenario.type=="C",]$bias -0.2 -res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0 & res.dat.dif$scenario.type=="D",]$bias <- res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0 & res.dat.dif$scenario.type=="D",]$bias +0.6 -res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0 & res.dat.dif$scenario.type=="E",]$bias <- res.dat.dif[res.dat.dif$N=="50" & res.dat.dif$nb.dif>0 & res.dat.dif$scenario.type=="E",]$bias +0.8 - -res.dat[res.dat$N=="50" & res.dat$nb.dif>0,]$eff.size <- rep(c(0,0.2,0.2,0.4,0.4,-0.2,-0.4),16) -res.dat[res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$scenario.type=="C",]$bias <- res.dat[res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$scenario.type=="C",]$bias -0.2 -res.dat[res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$scenario.type=="D",]$bias <- res.dat[res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$scenario.type=="D",]$bias +0.6 -res.dat[res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$scenario.type=="E",]$bias <- res.dat[res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$scenario.type=="E",]$bias +0.8 - -res.dat.dicho <- res.dat[res.dat$M==2,] -res.dat.dicho <- rbind(res.dat.dicho,res.dat.dif[res.dat.dif$M==2,]) -res.dat.dicho <- rbind.fill(res.dat.dicho,res.dat.dif.rosali[res.dat.dif.rosali$M==2,]) -res.dat.dicho <- rbind.fill(res.dat.dicho,res.dat.dif.resali[res.dat.dif.resali$M==2,]) - # Items polytomiques -res.dat.poly <- res.dat[res.dat$M==4,] -res.dat.poly <- rbind(res.dat.poly,res.dat.dif[res.dat.dif$M==4,]) -res.dat.poly <- rbind.fill(res.dat.poly,res.dat.dif.rosali[res.dat.dif.rosali$M==4,]) -res.dat.poly <- rbind.fill(res.dat.poly,res.dat.dif.resali[res.dat.dif.resali$M==4,]) +res.dat.full <- res.dat[res.dat$M==4,] +res.dat.full <- rbind(res.dat.full,res.dat.dif[res.dat.dif$M==4,]) +res.dat.full <- rbind.fill(res.dat.full,res.dat.dif.rosali[res.dat.dif.rosali$M==4,]) +res.dat.full <- rbind.fill(res.dat.full,res.dat.dif.resali[res.dat.dif.resali$M==4,]) + +############################################################################## +#----------------------------------------------------------------------------# +############################ ARTICLE TABLE OUTPUT ############################ +#----------------------------------------------------------------------------# +############################################################################## + +# STRATEGY 1 - IGNORE DIF + +res.dat.article <- res.dat[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article)[3] <- "true.beta" +colnames(res.dat.article)[5] <- "true.gamma" +colnames(res.dat.article)[6] <- "betahat" +colnames(res.dat.article)[8] <- "coverage" +colnames(res.dat.article)[9] <- "power" +res.dat.article[,6:10] <- round(res.dat.article[,6:10],2) +res.dat.article[res.dat.article$true.beta==0,"typeIerror"] <- res.dat.article[res.dat.article$true.beta==0,"power"] +res.dat.article[res.dat.article$true.beta==0,"power"] <- NA +res.dat.article <- res.dat.article[,c(1:7,11,9:10,8)] +res.dat.article[res.dat.article$nb.dif==0,"true.gamma"] <- NA +res.dat.article[is.na(res.dat.article)] <- " " +res.dat.article$bias <- -1*res.dat.article$bias +res.dat.article.ignore <- reshape(res.dat.article[res.dat.article$nb.dif>0,], + direction = "wide", idvar = c("J","true.beta","nb.dif",'true.gamma'),timevar = "N" ) +write.csv(res.dat.article.ignore,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_ignoreDIF.csv") +res.dat.article.nodif.long <- res.dat.article[res.dat.article$nb.dif==0,] +res.dat.article.nodif <- reshape(res.dat.article[res.dat.article$nb.dif==0,], + direction = "wide", idvar = c("J","true.beta","nb.dif",'true.gamma'),timevar = "N" ) +write.csv(res.dat.article.nodif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_noDIF.csv") +res.dat.article <- reshape(res.dat.article[res.dat.article$nb.dif==0,], + direction = "wide", idvar = c("J","true.beta","nb.dif",'true.gamma'),timevar = "N" ) +write.csv(res.dat.article.nodif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_noDIF.csv") + + + +res.dat.article.2 <- res.dat[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.2)[3] <- "true.beta" +colnames(res.dat.article.2)[5] <- "true.gamma" +colnames(res.dat.article.2)[6] <- "betahat" +colnames(res.dat.article.2)[8] <- "coverage" +colnames(res.dat.article.2)[9] <- "power" +res.dat.article.2[,6:10] <- round(res.dat.article.2[,6:10],2) +res.dat.article.2[res.dat.article.2$true.beta==0,"typeIerror"] <- res.dat.article.2[res.dat.article.2$true.beta==0,"power"] +res.dat.article.2[res.dat.article.2$true.beta==0,"power"] <- NA +res.dat.article.2 <- res.dat.article.2[,c(1:7,11,9:10,8)] +res.dat.article.2[res.dat.article.2$nb.dif==0,"true.gamma"] <- NA +res.dat.article.2[is.na(res.dat.article.2)] <- " " +res.dat.article.2$bias <- -1*res.dat.article.2$bias +res.dat.article.nodif.2 <- res.dat.article.2[res.dat.article.2$nb.dif==0,] + +# STRATEGY 2 - ROSALI + +res.dat.article.rosali <- res.dat.dif.rosali[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.rosali)[3] <- "true.beta" +colnames(res.dat.article.rosali)[5] <- "true.gamma" +colnames(res.dat.article.rosali)[6] <- "betahat" +colnames(res.dat.article.rosali)[8] <- "coverage" +colnames(res.dat.article.rosali)[9] <- "power" +res.dat.article.rosali[res.dat.article.rosali$true.beta==0,"typeIerror"] <- res.dat.article.rosali[res.dat.article.rosali$true.beta==0,"power"] +res.dat.article.rosali[res.dat.article.rosali$true.beta==0,"power"] <- NA +res.dat.article.rosali <- res.dat.article.rosali[,c(1:7,11,9:10,8)] +res.dat.article.rosali[res.dat.article.rosali$nb.dif==0,"true.gamma"] <- NA +res.dat.article.rosali[is.na(res.dat.article.rosali)] <- " " +res.dat.article.rosali$bias <- -1*res.dat.article.rosali$bias +res.dat.article.rosali <- reshape(res.dat.article.rosali, + direction = "wide", idvar = c("J","true.beta","nb.dif",'true.gamma'),timevar = "N" ) +res.dat.article.rosali.dif <- res.dat.article.rosali[res.dat.article.rosali$nb.dif>0,] +write.csv(res.dat.article.rosali.dif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_ROSALI_DIF.csv") +res.dat.article.rosali.nodif <- res.dat.article.rosali[res.dat.article.rosali$nb.dif==0,] +write.csv(res.dat.article.rosali.nodif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_ROSALI_noDIF.csv") + + +res.dat.article.rosali.2 <- res.dat.dif.rosali[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.rosali.2)[3] <- "true.beta" +colnames(res.dat.article.rosali.2)[5] <- "true.gamma" +colnames(res.dat.article.rosali.2)[6] <- "betahat" +colnames(res.dat.article.rosali.2)[8] <- "coverage" +colnames(res.dat.article.rosali.2)[9] <- "power" +res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta==0,"typeIerror"] <- res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta==0,"power"] +res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta==0,"power"] <- NA +res.dat.article.rosali.2 <- res.dat.article.rosali.2[,c(1:7,11,9:10,8)] +res.dat.article.rosali.2[res.dat.article.rosali.2$nb.dif==0,"true.gamma"] <- NA +res.dat.article.rosali.2[is.na(res.dat.article.rosali.2)] <- " " +res.dat.article.rosali.2$bias <- -1*res.dat.article.rosali.2$bias +res.dat.article.rosali.2.nodif <- res.dat.article.rosali.2[res.dat.article.rosali.2$nb.dif==0,] + +# STRATEGY 3 - RESIDIF + +res.dat.article.residif <- res.dat.dif.resali[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.residif)[3] <- "true.beta" +colnames(res.dat.article.residif)[5] <- "true.gamma" +colnames(res.dat.article.residif)[6] <- "betahat" +colnames(res.dat.article.residif)[8] <- "coverage" +colnames(res.dat.article.residif)[9] <- "power" +res.dat.article.residif[res.dat.article.residif$true.beta==0,"typeIerror"] <- res.dat.article.residif[res.dat.article.residif$true.beta==0,"power"] +res.dat.article.residif[res.dat.article.residif$true.beta==0,"power"] <- NA +res.dat.article.residif <- res.dat.article.residif[,c(1:7,11,9:10,8)] +res.dat.article.residif[res.dat.article.residif$nb.dif==0,"true.gamma"] <- NA +res.dat.article.residif[is.na(res.dat.article.residif)] <- " " +res.dat.article.residif$bias <- -1*res.dat.article.residif$bias +res.dat.article.residif <- reshape(res.dat.article.residif, + direction = "wide", idvar = c("J","true.beta","nb.dif",'true.gamma'),timevar = "N" ) +res.dat.article.residif.dif <- res.dat.article.residif[res.dat.article.residif$nb.dif>0,] +write.csv(res.dat.article.residif.dif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_RESIDIF_DIF.csv") +res.dat.article.residif.nodif <- res.dat.article.residif[res.dat.article.residif$nb.dif==0,] +write.csv(res.dat.article.residif.nodif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_RESIDIF_noDIF.csv") + +res.dat.article.residif.2 <- res.dat.dif.resali[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.residif.2)[3] <- "true.beta" +colnames(res.dat.article.residif.2)[5] <- "true.gamma" +colnames(res.dat.article.residif.2)[6] <- "betahat" +colnames(res.dat.article.residif.2)[8] <- "coverage" +colnames(res.dat.article.residif.2)[9] <- "power" +res.dat.article.residif.2[res.dat.article.residif.2$true.beta==0,"typeIerror"] <- res.dat.article.residif.2[res.dat.article.residif.2$true.beta==0,"power"] +res.dat.article.residif.2[res.dat.article.residif.2$true.beta==0,"power"] <- NA +res.dat.article.residif.2 <- res.dat.article.residif.2[,c(1:7,11,9:10,8)] +res.dat.article.residif.2[res.dat.article.residif.2$nb.dif==0,"true.gamma"] <- NA +res.dat.article.residif.2[is.na(res.dat.article.residif.2)] <- " " +res.dat.article.residif.2$bias <- -1*res.dat.article.residif.2$bias +res.dat.article.residif.2.nodif <- res.dat.article.residif.2[res.dat.article.residif.2$nb.dif==0,] + +# STRATEGY 4 - PERFECT-DIF + +res.dat.article.dif <- res.dat.dif[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.dif)[3] <- "true.beta" +colnames(res.dat.article.dif)[5] <- "true.gamma" +colnames(res.dat.article.dif)[6] <- "betahat" +colnames(res.dat.article.dif)[8] <- "coverage" +colnames(res.dat.article.dif)[9] <- "power" +res.dat.article.dif[res.dat.article.dif$true.beta==0,"typeIerror"] <- res.dat.article.dif[res.dat.article.dif$true.beta==0,"power"] +res.dat.article.dif[res.dat.article.dif$true.beta==0,"power"] <- NA +res.dat.article.dif <- res.dat.article.dif[,c(1:7,11,9:10,8)] +res.dat.article.dif[res.dat.article.dif$nb.dif==0,"true.gamma"] <- NA +res.dat.article.dif[is.na(res.dat.article.dif)] <- " " +res.dat.article.dif$bias <- -1*res.dat.article.dif$bias +write.csv(res.dat.article.dif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_perfect.csv") +res.dat.article.dif <- reshape(res.dat.article.dif, + direction = "wide", idvar = c("J","true.beta","nb.dif",'true.gamma'),timevar = "N" ) +write.csv(res.dat.article.dif,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/res_perfect.csv") + + +res.dat.article.dif.2 <- res.dat.dif[,c("N","J","eff.size","nb.dif","dif.size", + "m.beta","bias","true.value.in.ci.p","h0.rejected.p", + "theoretical.power")] +colnames(res.dat.article.dif.2)[3] <- "true.beta" +colnames(res.dat.article.dif.2)[5] <- "true.gamma" +colnames(res.dat.article.dif.2)[6] <- "betahat" +colnames(res.dat.article.dif.2)[8] <- "coverage" +colnames(res.dat.article.dif.2)[9] <- "power" +res.dat.article.dif.2[res.dat.article.dif.2$true.beta==0,"typeIerror"] <- res.dat.article.dif.2[res.dat.article.dif.2$true.beta==0,"power"] +res.dat.article.dif.2[res.dat.article.dif.2$true.beta==0,"power"] <- NA +res.dat.article.dif.2 <- res.dat.article.dif.2[,c(1:7,11,9:10,8)] +res.dat.article.dif.2[res.dat.article.dif.2$nb.dif==0,"true.gamma"] <- NA +res.dat.article.dif.2[is.na(res.dat.article.dif.2)] <- " " +res.dat.article.dif.2$bias <- -1*res.dat.article.dif.2$bias diff --git a/RProject/Scripts/Analysis/article.R b/RProject/Scripts/Analysis/article.R index 94c1e34..cb82c1c 100644 --- a/RProject/Scripts/Analysis/article.R +++ b/RProject/Scripts/Analysis/article.R @@ -1,74 +1,10 @@ source(paste0(getwd(),"/functions/resali.R")) -########################## -# IGNORING DIF -########################## - -########### Power - -# Prepare -res.dat$dif.agrees.tt <- ifelse(res.dat$eff.size!=0 & res.dat$dif.size!=0, res.dat$dif.size/res.dat$eff.size<0,NA) -res.dat[res.dat$scenario.type!="A" & res.dat$nb.dif>0 - & res.dat$dif.agrees.tt,"dif.power"] <- res.dat[res.dat$scenario.type!="A" - & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,]$h0.rejected.p-res.dat[res.dat$scenario.type!="A" - & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,]$theoretical.power -res.dat[res.dat$scenario.type!="A" & res.dat$nb.dif>0 - & !res.dat$dif.agrees.tt,"dif.power"] <- res.dat[res.dat$scenario.type!="A" - & res.dat$nb.dif>0 & !res.dat$dif.agrees.tt,]$h0.rejected.p-res.dat[res.dat$scenario.type!="A" - & res.dat$nb.dif>0 & !res.dat$dif.agrees.tt,]$theoretical.power - - - -# Histo coloré par typo -par(mfrow=c(2,1)) -hist(res.dat[abs(res.dat$dif.size)==0.3 & !res.dat$dif.agrees.tt,]$dif.power,breaks = seq(-0.7,0.6,0.05),freq=F,xlim = c(-0.7,0.7),ylim=c(0,4),col=rgb(1,0,0,1/4), - main="real power - theoretical power in scenarios with DIF size 0.3",xlab="Real power - theoretical power (raw % difference)") -hist(res.dat[abs(res.dat$dif.size)==0.3 & res.dat$dif.agrees.tt,]$dif.power,breaks = seq(-0.7,0.6,0.05),freq=F,xlim = c(-0.7,0.7),ylim=c(0,4),col=rgb(0,0,1,1/4),add=T) -abline(v=0,lty=2,col="black",lwd=2) - -hist(res.dat[abs(res.dat$dif.size)==0.5 & !res.dat$dif.agrees.tt,]$dif.power,breaks = seq(-0.7,0.6,0.05),freq=F,xlim = c(-0.7,0.7),ylim=c(0,4),col=rgb(1,0,0,1/4), - main="real power - theoretical power in scenarios with DIF size 0.5",xlab="Real power - theoretical power (raw % difference)") -hist(res.dat[abs(res.dat$dif.size)==0.5 & res.dat$dif.agrees.tt,]$dif.power,breaks = seq(-0.7,0.6,0.05),freq=F,xlim = c(-0.7,0.7),ylim=c(0,4),col=rgb(0,0,1,1/4),add=T) -abline(v=0,lty=2,col="black",lwd=2) - -par(xpd=NA) -legend(x = -0.825,y=6.25,fill = c(rgb(1,0,0,1/4),rgb(0,0,1,1/4)),c('DIF effect contradicts treatment effect',"DIF effect concurs with treatment effect"),ncol=2) - -par(mfrow=c(1,1)) - -# DIF and treatment opposite signs -summary(res.dat[res.dat$scenario.type!="A" & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,c("dif.power")]) - -# DIF and treatment same signs -summary(res.dat[res.dat$scenario.type!="A" & res.dat$nb.dif>0 & 1-res.dat$dif.agrees.tt,c("dif.power")]) - -# N=50 vs 300 -summary(res.dat[res.dat$scenario.type!="A" & res.dat$N=="50" & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,c("dif.power")]) -summary(res.dat[res.dat$scenario.type!="A" & res.dat$N==100 & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,c("dif.power")]) -summary(res.dat[res.dat$scenario.type!="A" & res.dat$N==200 & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,c("dif.power")]) -summary(res.dat[res.dat$scenario.type!="A" & res.dat$N==300 & res.dat$nb.dif>0 & res.dat$dif.agrees.tt,c("dif.power")]) - -########### Treatment effect estimation sign - -# Overall -summary(res.dat[res.dat$scenario.type!="A" & res.dat$nb.dif>0,c("beta.same.sign.truebeta.p")]) - -# Worst case scenario -summary(res.dat[res.dat$scenario.type!="A" & res.dat$nb.dif>0 & res.dat$dif.agrees.tt==FALSE & abs(res.dat$dif.size)>0.3 & abs(res.dat$eff.size)==0.2,c("beta.same.sign.truebeta.signif.p")]) - -########### Bias - -summary(res.dat[res.dat$nb.dif>0,c("bias")]) - -########### true value in CI - -summary(abs(res.dat[res.dat$nb.dif>0,c("true.value.in.ci.p")])) -summary(abs(res.dat[res.dat$N=="50" & res.dat$nb.dif>0,c("true.value.in.ci.p")])) - - - - +# A la place faire un boxplot par sample size avec une boite par méthode +boxplot(as.numeric(res.dat.article$typeIerror)~as.numeric(res.dat.article$N), + ylim=c(0,1),xlab="N",ylab="Type-I error",col="#ff7777",pch=3) +abline(h=0.05,col="red",lty=2,lwd=2) ########################## # DETECTION @@ -106,116 +42,6 @@ summary(res.dat.dif.resali[res.dat.dif.resali$nb.dif==0,"true.value.in.ci.p"]) summary(res.dat.dif.rosali[res.dat.dif.rosali$nb.dif==0,"true.value.in.ci.p"]) -########################## -# TABLES NO DIF RECOVERY -########################## -res.dat$dif.dir <- sign(res.dat$dif.size) -res.dat.dif$dif.dir <- sign(res.dat.dif$dif.size) - -tabs1 <- res.dat[res.dat$dif.size==0, - c("scenario","N","J","M","eff.size", - "h0.rejected.p","theoretical.power","true.value.in.ci.p","beta.same.sign.truebeta.p","beta.same.sign.truebeta.signif.p","bias" - )] -tabs1 <-reshape(data = tabs1,direction = "wide", idvar = c("scenario","J","M","eff.size"),timevar = "N") -write.csv(tabs1,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/tabs1.csv") - - -tabs2 <- res.dat[res.dat$dif.size!=0, - c("scenario","N","J","M","eff.size","dif.size","dif.dir","nb.dif", - "h0.rejected.p","theoretical.power","true.value.in.ci.p","beta.same.sign.truebeta.p","beta.same.sign.truebeta.signif.p","bias" - )] -tabs2 <-reshape(data = tabs2,direction = "wide", idvar = c("scenario","J","M","eff.size","dif.size","dif.dir","nb.dif"),timevar = "N") -tabs2$dif.size <- abs(tabs2$dif.size) -write.csv(tabs2,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/tabs2.csv") - -########################## -# TABLES PERF DIF RECOVERY -########################## -tabs3 <- res.dat.dif[res.dat.dif$dif.size!=0, - c("scenario","N","J","M","eff.size","dif.size","dif.dir","nb.dif", - "h0.rejected.p","theoretical.power","true.value.in.ci.p","beta.same.sign.truebeta.p","beta.same.sign.truebeta.signif.p","bias" - )] -tabs3 <-reshape(data = tabs3,direction = "wide", idvar = c("scenario","J","M","eff.size","dif.size","dif.dir","nb.dif"),timevar = "N") -tabs3$dif.size <- abs(tabs3$dif.size) -write.csv(tabs3,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/tabs3.csv") - - - - - - - - -########################## -# TABLES DETECT -########################## - -# false dif detection - -tab3.resali <- res.dat.dif.resali[res.dat.dif.resali$dif.size==0, - c("scenario","N", - "dif.detected" - )] -tab3.resali <-reshape(data = tab3.resali,direction = "wide", idvar = c("scenario"),timevar = "N") -tab3.rosali <- res.dat.dif.rosali[res.dat.dif.rosali$dif.size==0, - c("scenario","N","J","M","eff.size", - "dif.detected" - )] -tab3.rosali <-reshape(data = tab3.rosali,direction = "wide", idvar = c("scenario","J","M","eff.size"),timevar = "N") -tab3 <- merge(tab3.rosali,tab3.resali,by="scenario",suffixes = c(".rosali",".residuals")) -write.csv(tab3,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/tab3.csv") - - -# dif detection - -res.dat.dif.rosali$dif.agrees.tt <- ifelse(res.dat.dif.rosali$eff.size!=0 & res.dat.dif.rosali$dif.size!=0, res.dat.dif.rosali$dif.size/res.dat.dif.rosali$eff.size<0,NA) -res.dat.dif.resali$dif.agrees.tt <- ifelse(res.dat.dif.resali$eff.size!=0 & res.dat.dif.resali$dif.size!=0, res.dat.dif.resali$dif.size/res.dat.dif.resali$eff.size<0,NA) -res.dat.dif.rosali$dif.dir <- sign(res.dat.dif.rosali$dif.size) -res.dat.dif.resali$dif.dir <- sign(res.dat.dif.resali$dif.size) - -tabs4.resali <- res.dat.dif.resali[res.dat.dif.resali$dif.size!=0, - c("scenario","N", - "dif.detected","prop.perfect","flexible.detect","moreflexible.detect" - )] -tabs4.resali <-reshape(data = tabs4.resali,direction = "wide", idvar = c("scenario"),timevar = "N") -tabs4.rosali <- res.dat.dif.rosali[res.dat.dif.rosali$dif.size!=0, - c("scenario","N","J","M","eff.size","dif.size","dif.dir","nb.dif", - "dif.detected","prop.perfect","flexible.detect","moreflexible.detect" - )] -tabs4.rosali <-reshape(data = tabs4.rosali,direction = "wide", idvar = c("scenario","J","M","eff.size","dif.size","dif.dir","nb.dif"),timevar = "N") -tabs4 <- merge(tabs4.rosali,tabs4.resali,by="scenario",suffixes = c(".rosali",".residuals")) -tabs4 <- rbind(tabs4[78:112,],tabs4[1:77,]) -tabs4$dif.size <- abs(tabs4$dif.size) -write.csv(tabs4,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/tabs4.csv") - -########################## -# TABLES CAUSAL -########################## -res.dat.dif.rosali$dif.power <- res.dat.dif.rosali$h0.rejected.p-res.dat.dif.rosali$theoretical.power -res.dat.dif.resali$dif.power <- res.dat.dif.resali$h0.rejected.p-res.dat.dif.resali$theoretical.power - -res.dat.dif.rosali$typeI.error <- ifelse(res.dat.dif.rosali$scenario.type=="A",res.dat.dif.rosali$h0.rejected.p,NA) -res.dat.dif.rosali$diff.power <- ifelse(res.dat.dif.rosali$scenario.type!="A",res.dat.dif.rosali$dif.power,NA) -res.dat.dif.resali$typeI.error <- ifelse(res.dat.dif.resali$scenario.type=="A",res.dat.dif.resali$h0.rejected.p,NA) -res.dat.dif.resali$diff.power <- ifelse(res.dat.dif.resali$scenario.type!="A",res.dat.dif.resali$dif.power,NA) - -tabs5.resali <- res.dat.dif.resali[res.dat.dif.resali$dif.size!=0, - c("scenario","N", - "h0.rejected.p","theoretical.power","true.value.in.ci.p","beta.same.sign.truebeta.p","beta.same.sign.truebeta.signif.p","bias" - )] -tabs5.resali <-reshape(data = tabs5.resali,direction = "wide", idvar = c("scenario"),timevar = "N") -tabs5.rosali <- res.dat.dif.rosali[res.dat.dif.rosali$dif.size!=0, - c("scenario","N","J","M","eff.size","dif.size","dif.dir","nb.dif", - "h0.rejected.p","theoretical.power","true.value.in.ci.p","beta.same.sign.truebeta.p","beta.same.sign.truebeta.signif.p","bias" - )] -tabs5.rosali <-reshape(data = tabs5.rosali,direction = "wide", idvar = c("scenario","J","M","eff.size","dif.size","dif.dir","nb.dif"),timevar = "N") -tabs5 <- merge(tabs5.rosali,tabs5.resali,by="scenario",suffixes = c(".rosali",".residuals")) -tabs5 <- rbind(tabs5[78:112,],tabs5[1:77,]) -tabs5$dif.size <- abs(tabs5$dif.size) -write.csv(tabs5,"/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/tabs5.csv") - - - ########################## @@ -302,129 +128,3648 @@ summary(res.dat.dif.resali[res.dat.dif.resali$nb.dif>0 & + +########################## +# ICC / CCC BASE +########################## + +plot.tam.2 <- function(x, items=1:x$nitems, type="expected", + low=-3, high=3, ngroups=6, groups_by_item=FALSE, + wle=NULL, export=TRUE, export.type="png", + export.args=list(), observed=TRUE, overlay=FALSE, + ask=FALSE, package="lattice", + fix.devices=TRUE, nnodes=100, ...) +{ + require_namespace_msg("grDevices") + if ( package=="lattice"){ + require_namespace_msg("lattice") + } + + # device.Option <- getOption("device") + + time1 <- NULL + pall <- c('#200c23', '#62403d', '#a87b5e', '#e9bf98' + ) + if ( fix.devices ){ + old.opt.dev <- getOption("device") + old.opt.err <- c( getOption("show.error.messages")) + old.par.ask <- graphics::par("ask") + # remember new pars' values + old.par.xpd <- graphics::par("xpd") + old.par.mar <- graphics::par("mar") + on.exit( options("device"=old.opt.dev)) + on.exit( options("show.error.messages"=old.opt.err), add=TRUE) + on.exit( graphics::par("ask"=old.par.ask), add=TRUE) + # restore new pars' values + on.exit( graphics::par("xpd"=old.par.xpd), add=TRUE) + on.exit( graphics::par("mar"=old.par.mar), add=TRUE) + } + + tamobj <- x + ndim <- tamobj$ndim + tammodel <- "mml" + if(is.null(ndim)) { + ndim <- 1 + tammodel <- "jml" + } + if (ndim > 1 ) { + if ( type=="expected"){ + stop ("Expected scores curves are only available for uni-dimensional models") + } + } + + nitems <- tamobj$nitems + + if (ndim==1 ){ + theta <- matrix(seq(low, high, length=nnodes), nrow=nnodes, ncol=ndim) + } else { + nodes <- seq(low, high, length=nnodes) + theta <- as.matrix( expand.grid( as.data.frame( matrix( rep(nodes, ndim), ncol=ndim ) ) ) ) + nnodes <- nrow(theta) + B <- tamobj$B + } + + iIndex <- 1:nitems + A <- tamobj$A + B <- tamobj$B + if (tammodel=="mml") { + xsi <- tamobj$xsi$xsi + } else { + xsi <- tamobj$xsi + } + maxK <- tamobj$maxK + resp <- tamobj$resp + resp.ind <- tamobj$resp.ind + resp[resp.ind==0] <- NA + AXsi <- matrix(0,nrow=nitems,ncol=maxK ) + res <- tam_mml_calc_prob(iIndex=iIndex, A=A, AXsi=AXsi, B=B, xsi=xsi, theta=theta, + nnodes=nnodes, maxK=maxK, recalc=TRUE ) + rprobs <- res[["rprobs"]] + AXsi <- res[["AXsi"]] + cat <- 1:maxK - 1 + + #@@@ define initial empty objects + expScore <- obScore <- wle_intervals <- NULL + theta2 <- NULL + + #**** type='expected' + if ( type=="expected" ){ + expScore <- sapply(1:nitems, function(i) colSums(cat*rprobs[i,,], na.rm=TRUE)) + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + wle_intervals <- res$wle_intervals + #-- compute observed scores + obScore <- apply(d2,2, function(x){ + stats::aggregate(x, list(groupnumber), mean, na.rm=TRUE) + } ) + } + + #---------------------------------------------------- + # adds observed score for type="items" + if (type=="items") { + require_namespace_msg("plyr") + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + + obScore <- lapply(d2, function(item) { + comp_case=stats::complete.cases(item) + item=item[comp_case] + uniq_cats=sort(unique(item)) + plyr::ldply(split(item, groupnumber[comp_case]), .id="group", + function (group) { + ngroup=length(group) + cat_freq=list() + for (catt in uniq_cats) { + cat_freq[[paste0("cat_", catt)]]=sum(group==catt)/ngroup + } + data.frame(cat_freq) + }) + }) + } + + #************************************************* + # begin plot function + probs_plot <- as.list(1:nitems) + names(probs_plot) <- items + + for (i in (1:nitems)[items]) { + #*********************************************************** + #** expected item response curves + if ( type=="expected"){ + if (i==1 || !overlay) { + ylim2 <- c(0,max( tamobj$resp[,i], na.rm=TRUE ) ) + graphics::plot(theta, expScore[,i],,col=12, type="l", lwd=3, las=1, ylab="Score", xlab="Ability", + main=paste("Expected Scores Curve - Item ", colnames(tamobj$resp)[i] ) , + ylim=ylim2, ... ) + } else { + graphics::lines(theta, expScore[,i],type="l", col=i, lwd=3, pch=1) + } + if (observed){ + theta2_i <- theta2 + obScore_i <- obScore[[i]]$x + if (groups_by_item){ + ind_i <- ! is.na(resp[,i]) + resp_i <- resp[ind_i, i, drop=FALSE] + wle_i <- wle[ ind_i ] + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle_i, ngroups=ngroups, resp=resp_i ) + theta2_i <- res$theta2 + groupnumber_i <- res$groupnumber + aggr <- stats::aggregate(resp_i, list(groupnumber_i), mean, na.rm=TRUE ) + obScore_i <- aggr[,2] + } + graphics::lines(theta2_i, obScore_i, type="o", lwd=2, pch=1) + } + } + #*********************************************************** + + if ( ndim==1 ){ theta0 <- theta } + + if ( type=="items"){ + rprobs.ii <- rprobs[i,,] + rprobs.ii <- rprobs.ii[ rowMeans( is.na(rprobs.ii) ) < 1, ] + K <- nrow(rprobs.ii) + dat2 <- NULL + #************ + if ( ndim > 1 ){ + B.ii <- B[i,,] + ind.ii <- which( colSums( B.ii ) > 0 )[1] + rprobs0.ii <- rprobs.ii + rprobs0.ii <- stats::aggregate( t(rprobs0.ii), list( theta[,ind.ii] ), mean ) + theta0 <- rprobs0.ii[,1,drop=FALSE] + rprobs.ii <- t( rprobs0.ii[,-1] ) + } + probs_plot[[i]] <- rprobs.ii + #************** + for (kk in 1:K){ + dat2a <- data.frame( "Theta"=theta0[,1], "cat"=kk, "P"=rprobs.ii[kk,] ) + dat2 <- rbind(dat2, dat2a) + } + auto.key <- NULL + simple.key <- paste0("Cat", 1:K - 1) + auto.key <- simple.key + dat2$time <- dat2$cat + dat2$time1 <- paste0("Cat", dat2$time ) + + simple.key <- FALSE + Kpercol <- K + # package graphics + if ( package=="graphics" ){ + kk <- 1 + dfr <- dat2 + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::plot( dfr1a$Theta, dfr1a$P, ylim=c(-.1,1.1), + xlab=expression(theta), + col=pall[kk], type="l", xpd=TRUE,axes=F, ... + ) + axis(1) + axis(2) + grid(nx = NA, + ny = NULL, + lty = 3, col = "lightgray", lwd = 1) + graphics::lines( dfr1a$Theta, dfr1a$P, + col=pall[kk], type="l", ... + ) + for (kk in seq(2,K) ){ + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::lines( dfr1a$Theta, dfr1a$P, col=pall[kk] ) + # graphics::points( dfr1a$Theta, dfr1a$P, pch=kk, col=kk+1 ) + + } + } + + + #*************************************** + + } + #*************** + graphics::par(ask=ask) + } # end item ii + #************************************************* + +} + +# get all the function names of the given package "mypack" +r <- unclass(lsf.str(envir = asNamespace("TAM"), all = T)) + +# create functions in the Global Env. with the same name +for(name in r) eval(parse(text=paste0(name, '<-TAM:::', name))) + +#### CCC + +zaz <- read.csv("/home/corentin/Documents/These/Recherche/Simulations/Data/NoDIF/N100/scenario_2A_100.csv") +zaz <- zaz[zaz$replication==1,] +zaza <- tam.mml(resp = zaz[,paste0("item",1:4)]) + + +CurlyBraces <- function(x0, x1, y0, y1, pos = 1, direction = 1, depth = 1) { + + a=c(1,2,3,48,50) # set flexion point for spline + b=c(0,.2,.28,.7,.8) # set depth for spline flexion point + + curve = spline(a, b, n = 50, method = "natural")$y * depth + + curve = c(curve,rev(curve)) + + if (pos == 1){ + a_sequence = seq(x0,x1,length=100) + b_sequence = seq(y0,y1,length=100) + } + if (pos == 2){ + b_sequence = seq(x0,x1,length=100) + a_sequence = seq(y0,y1,length=100) + } + + # direction + if(direction==1) + a_sequence = a_sequence+curve + if(direction==2) + a_sequence = a_sequence-curve + + # pos + if(pos==1) + lines(a_sequence,b_sequence, lwd=1.5, xpd=NA) # vertical + if(pos==2) + lines(b_sequence,a_sequence, lwd=1.5, xpd=NA) # horizontal + +} + + + +# CCC de base +pdf(file = '/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_base.pdf') +par(xpd=F,mar=c(6.1,5.1,7.6,2.1)) +plot.tam.2(zaza,type = "items",export=F,ylab="Probability of response",main=NULL,package = "graphics",items = 3) +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[7,]$xsi,y0=0,y1=1.1,lty=3) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[8,]$xsi,y0=0,y1=1.1,lty=3) +segments(x0=zaza$xsi[9,]$xsi,x1=zaza$xsi[9,]$xsi,y0=0,y1=1.1,lty=3) + +text(x=-2.5,y=0.85,"0",col="#200c23") +text(x=-0.65,y=0.55,"1",col="#62403d") +text(x=0.95,y=0.55,"2",col="#a87b5e") +text(x=2.5,y=0.85,"3",col="#e9bf98") +par(xpd=T,mar=c(5.1,4.1,4.1,2.1)) +segments(x0=-3,x1=zaza$xsi[7,]$xsi,y0=1.1,y1=1.1,col="#200c23",lwd=2) +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[8,]$xsi,y0=1.1,y1=1.1,col="#62403d",lwd=2) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[9,]$xsi,y0=1.1,y1=1.1,col="#a87b5e",lwd=2) +segments(x0=zaza$xsi[9,]$xsi,x1=3,y0=1.1,y1=1.1,col="#e9bf98",lwd=2) + +points(x = zaza$xsi[7,]$xsi, y=1.1,pch=9,cex=1) +points(x = zaza$xsi[8,]$xsi, y=1.1,pch=9,cex=1) +points(x = zaza$xsi[9,]$xsi, y=1.1,pch=9,cex=1) + + +text( x=mean(c(-3,zaza$xsi[7,]$xsi)), y=1.2,"0",col="#200c23" ) +text( x=mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)), y=1.2,"1",col="#62403d" ) +text( x=mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)), y=1.2,"2",col="#a87b5e" ) +text( x=mean(c(zaza$xsi[9,]$xsi,3)), y=1.2,"3",col="#e9bf98" ) +text( x=mean(c(-3,zaza$xsi[7,]$xsi)),cex=0.7, y=1.15,"Much less than usual",col="#200c23" ) +text( x=mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)),cex=0.7, y=1.15,"Less so than usual",col="#62403d" ) +text( x=mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)),cex=0.7, y=1.15,"As much as usual",col="#a87b5e" ) +text( x=mean(c(zaza$xsi[9,]$xsi,3)),cex=0.7, y=1.15,"More so than usual",col="#e9bf98" ) + +text(x=zaza$xsi[7,]$xsi,y=1.15,expression(delta["j,1"])) +text(x=zaza$xsi[8,]$xsi,y=1.15,expression(delta["j,2"])) +text(x=zaza$xsi[9,]$xsi,y=1.15,expression(delta["j,3"])) + +text(x = 0,y=1.3,"Most probable response catgory") +CurlyBraces(x0=-2.5, x1=2.5, y0=1.225, y1=1.225, pos = 2, direction = 1, depth=0.05) +arrows(x0=-2.65,x1=-3,y0=-0.35,length = 0.15,lwd = 2) +arrows(x0=2.65,x1=3,y0=-0.35,length = 0.15,lwd = 2) +text(x=-2.55,y=-0.35,"Worse\nmental\nhealth",adj=0) +text(x=2.5,y=-0.35,"Better\nmental\nhealth",adj=1) +rect(xleft = 3,xright=5,ybottom = 0,ytop=1.1,col = "white",border = "white") + +lines(x=c(zaza$xsi[7,]$xsi,zaza$xsi[7,]$xsi),y=c(0,-0.15),lty=3) +lines(x=c(zaza$xsi[8,]$xsi,zaza$xsi[8,]$xsi),y=c(0,-0.15),lty=3) +lines(x=c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(0,-0.15),lty=3) +title(main='Example item: \n "Have you been able to enjoy your normal daily activities?" ', font.main=2) +par(xpd=F) +dev.off() + +########################## +# ICC / CCC DIF +########################## + +plot.tam.dif <- function(x, items=1:x$nitems, type="expected", + low=-3, high=3, ngroups=6, groups_by_item=FALSE, + wle=NULL, export=TRUE, export.type="png", + export.args=list(), observed=TRUE, overlay=FALSE, + ask=FALSE, package="lattice", + fix.devices=TRUE, nnodes=100, ...) +{ + require_namespace_msg("grDevices") + if ( package=="lattice"){ + require_namespace_msg("lattice") + } + + # device.Option <- getOption("device") + pall <- c('#200c23', '#62403d', '#a87b5e', '#e9bf98' + ) + low <- low-2 + high <- high+2 + time1 <- NULL + if ( fix.devices ){ + old.opt.dev <- getOption("device") + old.opt.err <- c( getOption("show.error.messages")) + old.par.ask <- graphics::par("ask") + # remember new pars' values + old.par.xpd <- graphics::par("xpd") + old.par.mar <- graphics::par("mar") + on.exit( options("device"=old.opt.dev)) + on.exit( options("show.error.messages"=old.opt.err), add=TRUE) + on.exit( graphics::par("ask"=old.par.ask), add=TRUE) + # restore new pars' values + on.exit( graphics::par("xpd"=old.par.xpd), add=TRUE) + on.exit( graphics::par("mar"=old.par.mar), add=TRUE) + } + + tamobj <- x + ndim <- tamobj$ndim + tammodel <- "mml" + if(is.null(ndim)) { + ndim <- 1 + tammodel <- "jml" + } + if (ndim > 1 ) { + if ( type=="expected"){ + stop ("Expected scores curves are only available for uni-dimensional models") + } + } + + nitems <- tamobj$nitems + + if (ndim==1 ){ + theta <- matrix(seq(low, high, length=nnodes), nrow=nnodes, ncol=ndim) + } else { + nodes <- seq(low, high, length=nnodes) + theta <- as.matrix( expand.grid( as.data.frame( matrix( rep(nodes, ndim), ncol=ndim ) ) ) ) + nnodes <- nrow(theta) + B <- tamobj$B + } + + iIndex <- 1:nitems + A <- tamobj$A + B <- tamobj$B + if (tammodel=="mml") { + xsi <- tamobj$xsi$xsi + } else { + xsi <- tamobj$xsi + } + maxK <- tamobj$maxK + resp <- tamobj$resp + resp.ind <- tamobj$resp.ind + resp[resp.ind==0] <- NA + AXsi <- matrix(0,nrow=nitems,ncol=maxK ) + res <- tam_mml_calc_prob(iIndex=iIndex, A=A, AXsi=AXsi, B=B, xsi=xsi, theta=theta, + nnodes=nnodes, maxK=maxK, recalc=TRUE ) + rprobs <- res[["rprobs"]] + AXsi <- res[["AXsi"]] + cat <- 1:maxK - 1 + + #@@@ define initial empty objects + expScore <- obScore <- wle_intervals <- NULL + theta2 <- NULL + + #**** type='expected' + if ( type=="expected" ){ + expScore <- sapply(1:nitems, function(i) colSums(cat*rprobs[i,,], na.rm=TRUE)) + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + wle_intervals <- res$wle_intervals + #-- compute observed scores + obScore <- apply(d2,2, function(x){ + stats::aggregate(x, list(groupnumber), mean, na.rm=TRUE) + } ) + } + + #---------------------------------------------------- + # adds observed score for type="items" + if (type=="items") { + require_namespace_msg("plyr") + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + + obScore <- lapply(d2, function(item) { + comp_case=stats::complete.cases(item) + item=item[comp_case] + uniq_cats=sort(unique(item)) + plyr::ldply(split(item, groupnumber[comp_case]), .id="group", + function (group) { + ngroup=length(group) + cat_freq=list() + for (catt in uniq_cats) { + cat_freq[[paste0("cat_", catt)]]=sum(group==catt)/ngroup + } + data.frame(cat_freq) + }) + }) + } + + #************************************************* + # begin plot function + probs_plot <- as.list(1:nitems) + names(probs_plot) <- items + + for (i in (1:nitems)[items]) { + #*********************************************************** + #** expected item response curves + if ( type=="expected"){ + if (i==1 || !overlay) { + ylim2 <- c(0,max( tamobj$resp[,i], na.rm=TRUE ) ) + graphics::plot(theta, expScore[,i],,col=12, type="l", lwd=3, las=1, ylab="Score", xlab="Ability", + main=paste("Expected Scores Curve - Item ", colnames(tamobj$resp)[i] ) , + ylim=ylim2, ... ) + } else { + graphics::lines(theta, expScore[,i],type="l", col=i, lwd=3, pch=1) + } + if (observed){ + theta2_i <- theta2 + obScore_i <- obScore[[i]]$x + if (groups_by_item){ + ind_i <- ! is.na(resp[,i]) + resp_i <- resp[ind_i, i, drop=FALSE] + wle_i <- wle[ ind_i ] + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle_i, ngroups=ngroups, resp=resp_i ) + theta2_i <- res$theta2 + groupnumber_i <- res$groupnumber + aggr <- stats::aggregate(resp_i, list(groupnumber_i), mean, na.rm=TRUE ) + obScore_i <- aggr[,2] + } + graphics::lines(theta2_i, obScore_i, type="o", lwd=2, pch=1) + } + } + #*********************************************************** + + if ( ndim==1 ){ theta0 <- theta } + + if ( type=="items"){ + rprobs.ii <- rprobs[i,,] + rprobs.ii <- rprobs.ii[ rowMeans( is.na(rprobs.ii) ) < 1, ] + K <- nrow(rprobs.ii) + dat2 <- NULL + #************ + if ( ndim > 1 ){ + B.ii <- B[i,,] + ind.ii <- which( colSums( B.ii ) > 0 )[1] + rprobs0.ii <- rprobs.ii + rprobs0.ii <- stats::aggregate( t(rprobs0.ii), list( theta[,ind.ii] ), mean ) + theta0 <- rprobs0.ii[,1,drop=FALSE] + rprobs.ii <- t( rprobs0.ii[,-1] ) + } + probs_plot[[i]] <- rprobs.ii + #************** + for (kk in 1:K){ + dat2a <- data.frame( "Theta"=theta0[,1], "cat"=kk, "P"=rprobs.ii[kk,] ) + dat2 <- rbind(dat2, dat2a) + } + auto.key <- NULL + simple.key <- paste0("Cat", 1:K - 1) + auto.key <- simple.key + dat2$time <- dat2$cat + dat2$time1 <- paste0("Cat", dat2$time ) + + simple.key <- FALSE + Kpercol <- K + # package graphics + if ( package=="graphics" ){ + kk <- 1 + dfr <- dat2 + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::plot( ifelse(dfr1a$Theta+0.5>-3,dfr1a$Theta+0.5,NA), dfr1a$P, ylim=c(-.1,1.1),xlim=c(-3,3), + xlab=expression(theta), + col=pall[kk], type="l", xpd=TRUE,axes=F, ... + ) + axis(1) + axis(2) + grid(nx = NA, + ny = NULL, + lty = 3, col = "lightgray", lwd = 1) + graphics::lines( ifelse(dfr1a$Theta+0.5>-3,dfr1a$Theta+0.5,NA), dfr1a$P,xlim=c(-3,3), + col=pall[kk], type="l", ... + ) + for (kk in seq(2,K) ){ + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::lines( ifelse(dfr1a$Theta+0.5>-3,dfr1a$Theta+0.5,NA), dfr1a$P, col=pall[kk] ) + # graphics::points( dfr1a$Theta, dfr1a$P, pch=kk, col=kk+1 ) + + } + } + + + #*************************************** + + } + #*************** + graphics::par(ask=ask) + } # end item ii + #************************************************* + +} + + +#### CCC + +zaz <- read.csv("/home/corentin/Documents/These/Recherche/Simulations/Data/NoDIF/N100/scenario_2A_100.csv") +zaz <- zaz[zaz$replication==1,] +zaza <- tam.mml(resp = zaz[,paste0("item",1:4)]) + + + + + +# CCC DIF + +# base + +pdf(file = '/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_dif_1.pdf') +par(xpd=F,mar=c(6.1,5.1,7.6,2.1)) +plot.tam.2(zaza,type = "items",export=F,ylab="Probability of response",main=NULL,package = "graphics",items = 3) +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[7,]$xsi,y0=0,y1=1.1,lty=3) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[8,]$xsi,y0=0,y1=1.1,lty=3) +segments(x0=zaza$xsi[9,]$xsi,x1=zaza$xsi[9,]$xsi,y0=0,y1=1.1,lty=3) + +text(x=-2.5,y=0.85,"0",col="#200c23") +text(x=-0.65,y=0.55,"1",col="#62403d") +text(x=0.95,y=0.55,"2",col="#a87b5e") +text(x=2.5,y=0.85,"3",col="#e9bf98") +par(xpd=T,mar=c(5.1,4.1,4.1,2.1)) +segments(x0=-3,x1=zaza$xsi[7,]$xsi,y0=1.1,y1=1.1,col="#200c23",lwd=2) +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[8,]$xsi,y0=1.1,y1=1.1,col="#62403d",lwd=2) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[9,]$xsi,y0=1.1,y1=1.1,col="#a87b5e",lwd=2) +segments(x0=zaza$xsi[9,]$xsi,x1=3,y0=1.1,y1=1.1,col="#e9bf98",lwd=2) + +points(x = zaza$xsi[7,]$xsi, y=1.1,pch=9,cex=1) +points(x = zaza$xsi[8,]$xsi, y=1.1,pch=9,cex=1) +points(x = zaza$xsi[9,]$xsi, y=1.1,pch=9,cex=1) + + +text( x=mean(c(-3,zaza$xsi[7,]$xsi)), y=1.2,"0",col="#200c23" ) +text( x=mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)), y=1.2,"1",col="#62403d" ) +text( x=mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)), y=1.2,"2",col="#a87b5e" ) +text( x=mean(c(zaza$xsi[9,]$xsi,3)), y=1.2,"3",col="#e9bf98" ) +text( x=mean(c(-3,zaza$xsi[7,]$xsi)),cex=0.7, y=1.15,"Much less than usual",col="#200c23" ) +text( x=mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)),cex=0.7, y=1.15,"Less so than usual",col="#62403d" ) +text( x=mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)),cex=0.7, y=1.15,"As much as usual",col="#a87b5e" ) +text( x=mean(c(zaza$xsi[9,]$xsi,3)),cex=0.7, y=1.15,"More so than usual",col="#e9bf98" ) + +text(x=zaza$xsi[7,]$xsi,y=1.15,expression(delta["j,1"])) +text(x=zaza$xsi[8,]$xsi,y=1.15,expression(delta["j,2"])) +text(x=zaza$xsi[9,]$xsi,y=1.15,expression(delta["j,3"])) + +text(x = 0,y=1.3,"Most probable response catgory") +CurlyBraces(x0=-2.5, x1=2.5, y0=1.225, y1=1.225, pos = 2, direction = 1, depth=0.05) +arrows(x0=-2.65,x1=-3,y0=-0.35,length = 0.15,lwd = 2) +arrows(x0=2.65,x1=3,y0=-0.35,length = 0.15,lwd = 2) +text(x=-2.55,y=-0.35,"Worse\nmental\nhealth",adj=0) +text(x=2.5,y=-0.35,"Better\nmental\nhealth",adj=1) +rect(xleft = 3,xright=5,ybottom = 0,ytop=1.1,col = "white",border = "white") + +lines(x=c(zaza$xsi[7,]$xsi,zaza$xsi[7,]$xsi),y=c(0,-0.6),lty=3) +lines(x=c(zaza$xsi[8,]$xsi,zaza$xsi[8,]$xsi),y=c(0,-0.6),lty=3) +lines(x=c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(0,-0.6),lty=3) +title(main='Example item: \n "Have you been able to enjoy your normal daily activities?" ', font.main=2) +par(xpd=F) +dev.off() + +# DIF homogène + + +pdf(file = '/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_dif_2.pdf') +par(xpd=F,mar=c(12.6,5.1,1.1,2.1)) +plot.tam.dif(zaza,type = "items",export=F,ylab="Probability of response",main=NULL,package = "graphics",items = 3) + + +text(x=-2,y=0.85,"0",col="#200c23") +text(x=-.05,y=0.55,"1",col="#62403d") +text(x=1.45,y=0.55,"2",col="#a87b5e") +text(x=2.5,y=0.7,"3",col="#e9bf98") +par(xpd=T,mar=c(5.1,4.1,4.1,2.1)) +segments(x0=-3,x1=.5+zaza$xsi[7,]$xsi,y0=-0.5,col="#200c23",lwd=2) +segments(x0=.5+zaza$xsi[7,]$xsi,x1=.5+zaza$xsi[8,]$xsi,y0=-0.5,col="#62403d",lwd=2) +segments(x0=.5+zaza$xsi[8,]$xsi,x1=.5+zaza$xsi[9,]$xsi,y0=-0.5,col="#a87b5e",lwd=2) +segments(x0=.5+zaza$xsi[9,]$xsi,x1=3,y0=-0.5,col="#e9bf98",lwd=2) + +points(x =.5 + zaza$xsi[7,]$xsi, y=-0.5,pch=9,cex=1) +points(x =.5 + zaza$xsi[8,]$xsi, y=-0.5,pch=9,cex=1) +points(x =.5 + zaza$xsi[9,]$xsi, y=-0.5,pch=9,cex=1) + + +text( x=mean(c(-2.5,zaza$xsi[7,]$xsi)), y=-0.65,"0",col="#200c23" ) +text( x=0.5+mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)), y=-0.65,"1",col="#62403d" ) +text( x=0.5+mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)), y=-0.65,"2",col="#a87b5e" ) +text( x=0.5+mean(c(zaza$xsi[9,]$xsi,2.5)), y=-0.65,"3",col="#e9bf98" ) +text( x=mean(c(-2.5,zaza$xsi[7,]$xsi)),cex=0.7, y=-0.6,"Much less than usual",col="#200c23" ) +text( x=.5+mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)),cex=0.7, y=-0.6,"Less so than usual",col="#62403d" ) +text( x=.5+mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)),cex=0.7, y=-0.6,"As much as usual",col="#a87b5e" ) +text( x=.5+mean(c(zaza$xsi[9,]$xsi,2.5)),cex=0.7, y=-0.6,"More so than usual",col="#e9bf98" ) + +text(x=0.5+zaza$xsi[7,]$xsi,y=-0.55,expression(delta["j,1"])) +text(x=0.5+zaza$xsi[8,]$xsi,y=-0.55,expression(delta["j,2"])) +text(x=0.5+zaza$xsi[9,]$xsi,y=-0.55,expression(delta["j,3"])) + +arrows(x0=zaza$xsi[7,]$xsi+0.05,x1=zaza$xsi[7,]$xsi+0.5-0.05,y0=0.625,length = 0.1, lwd = 2) +arrows(x0=zaza$xsi[8,]$xsi+0.05,x1=zaza$xsi[8,]$xsi+0.5-0.05,y0=0.625,length = 0.1, lwd = 2) +arrows(x0=zaza$xsi[9,]$xsi+0.05,x1=zaza$xsi[9,]$xsi+0.5-0.05,y0=0.625,length = 0.1, lwd = 2) +text(x=0.25+zaza$xsi[7,]$xsi,y=0.675,expression(gamma["j,1"])) +text(x=0.25+zaza$xsi[8,]$xsi,y=0.675,expression(gamma["j,2"])) +text(x=0.25+zaza$xsi[9,]$xsi,y=0.675,expression(gamma["j,3"])) + +text(x = 0.25,y=-0.75,"Most probable response catgory") +CurlyBraces(x0=-2.25, x1=2.75, y0=-0.675, y1=-0.675, pos = 2, direction = 2, depth=0.05) +arrows(x0=-2.65,x1=-3,y0=-0.35,length = 0.15,lwd = 2) +arrows(x0=2.65,x1=3,y0=-0.35,length = 0.15,lwd = 2) +text(x=-2.55,y=-0.35,"Worse\nmental\nhealth",adj=0) +text(x=2.5,y=-0.35,"Better\nmental\nhealth",adj=1) + +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[7,]$xsi,y0=0.6,y1=1.6,lty=3) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[8,]$xsi,y0=0.6,y1=1.6,lty=3) +segments(x0=zaza$xsi[9,]$xsi,x1=zaza$xsi[9,]$xsi,y0=0.6,y1=1.6,lty=3) +rect(xleft = 3,xright=5,ybottom = -.1,ytop=1.1,col = "white",border = "white") + + +lines(x=.5+c(zaza$xsi[7,]$xsi,zaza$xsi[7,]$xsi),y=c(0.65,-0.5),lty=3) +lines(x=.5+c(zaza$xsi[8,]$xsi,zaza$xsi[8,]$xsi),y=c(0.65,-0.5),lty=3) +lines(x=.5+c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(0.65,-0.25),lty=3) +lines(x=.5+c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(-0.45,-0.5),lty=3) +par(xpd=F) +dev.off() + + + + + + + + + + + +# CCC DIF HETEROGENE 1 + +plot.tam.difhet1 <- function(x, items=1:x$nitems, type="expected", + low=-3, high=3, ngroups=6, groups_by_item=FALSE, + wle=NULL, export=TRUE, export.type="png", + export.args=list(), observed=TRUE, overlay=FALSE, + ask=FALSE, package="lattice", + fix.devices=TRUE, nnodes=100, ...) +{ + require_namespace_msg("grDevices") + if ( package=="lattice"){ + require_namespace_msg("lattice") + } + low <- low-2 + high <- high+2 + # device.Option <- getOption("device") + pall <- c('#200c23', '#62403d', '#a87b5e', '#e9bf98' + ) + time1 <- NULL + if ( fix.devices ){ + old.opt.dev <- getOption("device") + old.opt.err <- c( getOption("show.error.messages")) + old.par.ask <- graphics::par("ask") + # remember new pars' values + old.par.xpd <- graphics::par("xpd") + old.par.mar <- graphics::par("mar") + on.exit( options("device"=old.opt.dev)) + on.exit( options("show.error.messages"=old.opt.err), add=TRUE) + on.exit( graphics::par("ask"=old.par.ask), add=TRUE) + # restore new pars' values + on.exit( graphics::par("xpd"=old.par.xpd), add=TRUE) + on.exit( graphics::par("mar"=old.par.mar), add=TRUE) + } + + tamobj <- x + ndim <- tamobj$ndim + tammodel <- "mml" + if(is.null(ndim)) { + ndim <- 1 + tammodel <- "jml" + } + if (ndim > 1 ) { + if ( type=="expected"){ + stop ("Expected scores curves are only available for uni-dimensional models") + } + } + + nitems <- tamobj$nitems + + if (ndim==1 ){ + theta <- matrix(seq(low, high, length=nnodes), nrow=nnodes, ncol=ndim) + } else { + nodes <- seq(low, high, length=nnodes) + theta <- as.matrix( expand.grid( as.data.frame( matrix( rep(nodes, ndim), ncol=ndim ) ) ) ) + nnodes <- nrow(theta) + B <- tamobj$B + } + + iIndex <- 1:nitems + A <- tamobj$A + B <- tamobj$B + if (tammodel=="mml") { + xsi <- tamobj$xsi$xsi + } else { + xsi <- tamobj$xsi + } + maxK <- tamobj$maxK + resp <- tamobj$resp + resp.ind <- tamobj$resp.ind + resp[resp.ind==0] <- NA + AXsi <- matrix(0,nrow=nitems,ncol=maxK ) + res <- tam_mml_calc_prob(iIndex=iIndex, A=A, AXsi=AXsi, B=B, xsi=xsi, theta=theta, + nnodes=nnodes, maxK=maxK, recalc=TRUE ) + rprobs <- res[["rprobs"]] + AXsi <- res[["AXsi"]] + cat <- 1:maxK - 1 + + #@@@ define initial empty objects + expScore <- obScore <- wle_intervals <- NULL + theta2 <- NULL + + #**** type='expected' + if ( type=="expected" ){ + expScore <- sapply(1:nitems, function(i) colSums(cat*rprobs[i,,], na.rm=TRUE)) + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + wle_intervals <- res$wle_intervals + #-- compute observed scores + obScore <- apply(d2,2, function(x){ + stats::aggregate(x, list(groupnumber), mean, na.rm=TRUE) + } ) + } + + #---------------------------------------------------- + # adds observed score for type="items" + if (type=="items") { + require_namespace_msg("plyr") + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + + obScore <- lapply(d2, function(item) { + comp_case=stats::complete.cases(item) + item=item[comp_case] + uniq_cats=sort(unique(item)) + plyr::ldply(split(item, groupnumber[comp_case]), .id="group", + function (group) { + ngroup=length(group) + cat_freq=list() + for (catt in uniq_cats) { + cat_freq[[paste0("cat_", catt)]]=sum(group==catt)/ngroup + } + data.frame(cat_freq) + }) + }) + } + + #************************************************* + # begin plot function + probs_plot <- as.list(1:nitems) + names(probs_plot) <- items + + for (i in (1:nitems)[items]) { + #*********************************************************** + #** expected item response curves + if ( type=="expected"){ + if (i==1 || !overlay) { + ylim2 <- c(0,max( tamobj$resp[,i], na.rm=TRUE ) ) + graphics::plot(theta, expScore[,i],,col=12, type="l", lwd=3, las=1, ylab="Score", xlab="Ability", + main=paste("Expected Scores Curve - Item ", colnames(tamobj$resp)[i] ) , + ylim=ylim2, ... ) + } else { + graphics::lines(theta, expScore[,i],type="l", col=i, lwd=3, pch=1) + } + if (observed){ + theta2_i <- theta2 + obScore_i <- obScore[[i]]$x + if (groups_by_item){ + ind_i <- ! is.na(resp[,i]) + resp_i <- resp[ind_i, i, drop=FALSE] + wle_i <- wle[ ind_i ] + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle_i, ngroups=ngroups, resp=resp_i ) + theta2_i <- res$theta2 + groupnumber_i <- res$groupnumber + aggr <- stats::aggregate(resp_i, list(groupnumber_i), mean, na.rm=TRUE ) + obScore_i <- aggr[,2] + } + graphics::lines(theta2_i, obScore_i, type="o", lwd=2, pch=1) + } + } + #*********************************************************** + + if ( ndim==1 ){ theta0 <- theta } + + if ( type=="items"){ + rprobs.ii <- rprobs[i,,] + rprobs.ii <- rprobs.ii[ rowMeans( is.na(rprobs.ii) ) < 1, ] + K <- nrow(rprobs.ii) + dat2 <- NULL + #************ + if ( ndim > 1 ){ + B.ii <- B[i,,] + ind.ii <- which( colSums( B.ii ) > 0 )[1] + rprobs0.ii <- rprobs.ii + rprobs0.ii <- stats::aggregate( t(rprobs0.ii), list( theta[,ind.ii] ), mean ) + theta0 <- rprobs0.ii[,1,drop=FALSE] + rprobs.ii <- t( rprobs0.ii[,-1] ) + } + probs_plot[[i]] <- rprobs.ii + #************** + for (kk in 1:K){ + dat2a <- data.frame( "Theta"=theta0[,1], "cat"=kk, "P"=rprobs.ii[kk,] ) + dat2 <- rbind(dat2, dat2a) + } + auto.key <- NULL + simple.key <- paste0("Cat", 1:K - 1) + auto.key <- simple.key + dat2$time <- dat2$cat + dat2$time1 <- paste0("Cat", dat2$time ) + + simple.key <- FALSE + Kpercol <- K + # package graphics + if ( package=="graphics" ){ + kk <- 1 + dfr <- dat2 + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::plot( ifelse(dfr1a$Theta+0.5>-3 & dfr1a$Theta+0.5<3, dfr1a$Theta+0.5, NA), dfr1a$P, ylim=c(-.1,1.1),xlim=c(-3,3), + xlab=expression(theta), + col=pall[kk], type="l", xpd=TRUE,axes=F, ... + ) + axis(1) + axis(2) + grid(nx = NA, + ny = NULL, + lty = 3, col = "lightgray", lwd = 1) + graphics::lines( ifelse(dfr1a$Theta+0.5>-3 & dfr1a$Theta+0.5<3, dfr1a$Theta+0.5, NA), dfr1a$P,xlim=c(-3,3), + col=pall[kk], type="l", ... + ) + for (kk in seq(2,K) ){ + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::lines(ifelse(dfr1a$Theta+ifelse(kk==3,1,ifelse(kk==4,0.35,0.5))>-3 & dfr1a$Theta+ifelse(kk==3,1,ifelse(kk==4,0.35,0.5))<3, dfr1a$Theta, NA)+ifelse(kk==3,1,ifelse(kk==4,0.35,0.5)), dfr1a$P, col=pall[kk] ) + # graphics::points( dfr1a$Theta, dfr1a$P, pch=kk, col=kk+1 ) + + } + } + + + #*************************************** + + } + #*************** + graphics::par(ask=ask) + } # end item ii + #************************************************* + +} + + +# DIF heterogene convergent + + +pdf(file = '/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_dif_het1.pdf') +par(xpd=F,mar=c(12.6,5.1,1.1,2.1)) +plot.tam.difhet1(zaza,type = "items",export=F,ylab="Probability of response",main=NULL,package = "graphics",items = 3) + + +text(x=-2,y=0.85,"0",col="#200c23") +text(x=-0.15,y=0.55,"1",col="#62403d") +text(x=1.45+0.475,y=0.55,"2",col="#a87b5e") +text(x=2.5,y=0.7,"3",col="#e9bf98") +par(xpd=T,mar=c(5.1,4.1,4.1,2.1)) +segments(x0=-3,x1=.5+zaza$xsi[7,]$xsi,y0=-0.5,col="#200c23",lwd=2) +segments(x0=.5+zaza$xsi[7,]$xsi,x1=.5+zaza$xsi[8,]$xsi+0.25,y0=-0.5,col="#62403d",lwd=2) +segments(x0=.5+zaza$xsi[8,]$xsi+0.25,x1=.5+zaza$xsi[9,]$xsi,y0=-0.5,col="#a87b5e",lwd=2) +segments(x0=.5+zaza$xsi[9,]$xsi,x1=3,y0=-0.5,col="#e9bf98",lwd=2) + +points(x =.5 + zaza$xsi[7,]$xsi, y=-0.5,pch=9,cex=1) +points(x =.5 + zaza$xsi[8,]$xsi+0.25, y=-0.5,pch=9,cex=1) +points(x =.5 + zaza$xsi[9,]$xsi, y=-0.5,pch=9,cex=1) +rect(xleft = 3,xright=5,ybottom = 0,ytop=1.1,col = "white",border = "white") + +text( x=mean(c(-2.5,zaza$xsi[7,]$xsi)), y=-0.65,"0",col="#200c23" ) +text( x=0.125+0.5+mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)), y=-0.65,"1",col="#62403d" ) +text( x=0.5+0.125+mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)), y=-0.65,"2",col="#a87b5e" ) +text( x=0.5+mean(c(zaza$xsi[9,]$xsi,2.5)), y=-0.65,"3",col="#e9bf98" ) +text( x=mean(c(-2.5,zaza$xsi[7,]$xsi)),cex=0.7, y=-0.6,"Much less than usual",col="#200c23" ) +text( x=0.125+.5+mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)),cex=0.7, y=-0.6,"Less so than usual",col="#62403d" ) +text( x=.125+.5+mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)),cex=0.7, y=-0.6,"As much as usual",col="#a87b5e" ) +text( x=.5+mean(c(zaza$xsi[9,]$xsi,2.5)),cex=0.7, y=-0.6,"More so than usual",col="#e9bf98" ) + +text(x=0.5+zaza$xsi[7,]$xsi,y=-0.55,expression(delta["j,1"])) +text(x=0.5+zaza$xsi[8,]$xsi+0.25,y=-0.55,expression(delta["j,2"])) +text(x=0.5+zaza$xsi[9,]$xsi,y=-0.55,expression(delta["j,3"])) + +arrows(x0=zaza$xsi[7,]$xsi+0.05,x1=zaza$xsi[7,]$xsi+0.5-0.05,y0=0.625,length = 0.1, lwd = 2) +arrows(x0=zaza$xsi[8,]$xsi+0.05,x1=zaza$xsi[8,]$xsi+0.75-0.05,y0=0.625,length = 0.1, lwd = 2,col="darkred") +arrows(x0=zaza$xsi[9,]$xsi+0.05,x1=zaza$xsi[9,]$xsi+0.5-0.05,y0=0.625,length = 0.1, lwd = 2) +text(x=0.25+zaza$xsi[7,]$xsi,y=0.675,expression(gamma["j,1"])) +text(x=0.25+zaza$xsi[8,]$xsi+0.125,y=0.675,expression(gamma["j,2"]),col="darkred") +text(x=0.25+zaza$xsi[9,]$xsi,y=0.675,expression(gamma["j,3"])) + +text(x = 0.25,y=-0.75,"Most probable response catgory") +CurlyBraces(x0=-2.25, x1=2.75, y0=-0.675, y1=-0.675, pos = 2, direction = 2, depth=0.05) +arrows(x0=-2.65,x1=-3,y0=-0.35,length = 0.15,lwd = 2) +arrows(x0=2.65,x1=3,y0=-0.35,length = 0.15,lwd = 2) +text(x=-2.55,y=-0.35,"Worse\nmental\nhealth",adj=0) +text(x=2.5,y=-0.35,"Better\nmental\nhealth",adj=1) + +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[7,]$xsi,y0=0.6,y1=1.6,lty=3) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[8,]$xsi,y0=0.6,y1=1.6,lty=3) +segments(x0=zaza$xsi[9,]$xsi,x1=zaza$xsi[9,]$xsi,y0=0.6,y1=1.6,lty=3) +rect(xleft = 3,xright=5,ybottom = -.1,ytop=1.1,col = "white",border = "white") + + +lines(x=.5+c(zaza$xsi[7,]$xsi,zaza$xsi[7,]$xsi),y=c(0.65,-0.5),lty=3) +lines(x=.5+c(zaza$xsi[8,]$xsi+0.25,zaza$xsi[8,]$xsi+0.25),y=c(0.65,-0.5),lty=3) +lines(x=.5+c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(0.65,-0.25),lty=3) +lines(x=.5+c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(-0.45,-0.5),lty=3) +par(xpd=F) +dev.off() + + + + + +# CCC DIF HETEROGENE 2 + +plot.tam.difhet2 <- function(x, items=1:x$nitems, type="expected", + low=-3, high=3, ngroups=6, groups_by_item=FALSE, + wle=NULL, export=TRUE, export.type="png", + export.args=list(), observed=TRUE, overlay=FALSE, + ask=FALSE, package="lattice", + fix.devices=TRUE, nnodes=100, ...) +{ + require_namespace_msg("grDevices") + if ( package=="lattice"){ + require_namespace_msg("lattice") + } + low <- low-2 + high <- high+2 + # device.Option <- getOption("device") + pall <- c('#200c23', '#62403d', '#a87b5e', '#e9bf98' + ) + time1 <- NULL + if ( fix.devices ){ + old.opt.dev <- getOption("device") + old.opt.err <- c( getOption("show.error.messages")) + old.par.ask <- graphics::par("ask") + # remember new pars' values + old.par.xpd <- graphics::par("xpd") + old.par.mar <- graphics::par("mar") + on.exit( options("device"=old.opt.dev)) + on.exit( options("show.error.messages"=old.opt.err), add=TRUE) + on.exit( graphics::par("ask"=old.par.ask), add=TRUE) + # restore new pars' values + on.exit( graphics::par("xpd"=old.par.xpd), add=TRUE) + on.exit( graphics::par("mar"=old.par.mar), add=TRUE) + } + + tamobj <- x + ndim <- tamobj$ndim + tammodel <- "mml" + if(is.null(ndim)) { + ndim <- 1 + tammodel <- "jml" + } + if (ndim > 1 ) { + if ( type=="expected"){ + stop ("Expected scores curves are only available for uni-dimensional models") + } + } + + nitems <- tamobj$nitems + + if (ndim==1 ){ + theta <- matrix(seq(low, high, length=nnodes), nrow=nnodes, ncol=ndim) + } else { + nodes <- seq(low, high, length=nnodes) + theta <- as.matrix( expand.grid( as.data.frame( matrix( rep(nodes, ndim), ncol=ndim ) ) ) ) + nnodes <- nrow(theta) + B <- tamobj$B + } + + iIndex <- 1:nitems + A <- tamobj$A + B <- tamobj$B + if (tammodel=="mml") { + xsi <- tamobj$xsi$xsi + } else { + xsi <- tamobj$xsi + } + maxK <- tamobj$maxK + resp <- tamobj$resp + resp.ind <- tamobj$resp.ind + resp[resp.ind==0] <- NA + AXsi <- matrix(0,nrow=nitems,ncol=maxK ) + res <- tam_mml_calc_prob(iIndex=iIndex, A=A, AXsi=AXsi, B=B, xsi=xsi, theta=theta, + nnodes=nnodes, maxK=maxK, recalc=TRUE ) + rprobs <- res[["rprobs"]] + AXsi <- res[["AXsi"]] + cat <- 1:maxK - 1 + + #@@@ define initial empty objects + expScore <- obScore <- wle_intervals <- NULL + theta2 <- NULL + + #**** type='expected' + if ( type=="expected" ){ + expScore <- sapply(1:nitems, function(i) colSums(cat*rprobs[i,,], na.rm=TRUE)) + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + wle_intervals <- res$wle_intervals + #-- compute observed scores + obScore <- apply(d2,2, function(x){ + stats::aggregate(x, list(groupnumber), mean, na.rm=TRUE) + } ) + } + + #---------------------------------------------------- + # adds observed score for type="items" + if (type=="items") { + require_namespace_msg("plyr") + #-- compute WLE score groups + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle, ngroups=ngroups, resp=resp ) + wle <- res$wle + theta2 <- res$theta2 + d <- res$d + d1 <- res$d1 + d2 <- res$d2 + groupnumber <- res$groupnumber + ngroups <- res$ngroups + + obScore <- lapply(d2, function(item) { + comp_case=stats::complete.cases(item) + item=item[comp_case] + uniq_cats=sort(unique(item)) + plyr::ldply(split(item, groupnumber[comp_case]), .id="group", + function (group) { + ngroup=length(group) + cat_freq=list() + for (catt in uniq_cats) { + cat_freq[[paste0("cat_", catt)]]=sum(group==catt)/ngroup + } + data.frame(cat_freq) + }) + }) + } + + #************************************************* + # begin plot function + probs_plot <- as.list(1:nitems) + names(probs_plot) <- items + + for (i in (1:nitems)[items]) { + #*********************************************************** + #** expected item response curves + if ( type=="expected"){ + if (i==1 || !overlay) { + ylim2 <- c(0,max( tamobj$resp[,i], na.rm=TRUE ) ) + graphics::plot(theta, expScore[,i],,col=12, type="l", lwd=3, las=1, ylab="Score", xlab="Ability", + main=paste("Expected Scores Curve - Item ", colnames(tamobj$resp)[i] ) , + ylim=ylim2, ... ) + } else { + graphics::lines(theta, expScore[,i],type="l", col=i, lwd=3, pch=1) + } + if (observed){ + theta2_i <- theta2 + obScore_i <- obScore[[i]]$x + if (groups_by_item){ + ind_i <- ! is.na(resp[,i]) + resp_i <- resp[ind_i, i, drop=FALSE] + wle_i <- wle[ ind_i ] + res <- plot_tam_grouped_wle( tamobj=tamobj, tammodel=tammodel, + wle=wle_i, ngroups=ngroups, resp=resp_i ) + theta2_i <- res$theta2 + groupnumber_i <- res$groupnumber + aggr <- stats::aggregate(resp_i, list(groupnumber_i), mean, na.rm=TRUE ) + obScore_i <- aggr[,2] + } + graphics::lines(theta2_i, obScore_i, type="o", lwd=2, pch=1) + } + } + #*********************************************************** + + if ( ndim==1 ){ theta0 <- theta } + + if ( type=="items"){ + rprobs.ii <- rprobs[i,,] + rprobs.ii <- rprobs.ii[ rowMeans( is.na(rprobs.ii) ) < 1, ] + K <- nrow(rprobs.ii) + dat2 <- NULL + #************ + if ( ndim > 1 ){ + B.ii <- B[i,,] + ind.ii <- which( colSums( B.ii ) > 0 )[1] + rprobs0.ii <- rprobs.ii + rprobs0.ii <- stats::aggregate( t(rprobs0.ii), list( theta[,ind.ii] ), mean ) + theta0 <- rprobs0.ii[,1,drop=FALSE] + rprobs.ii <- t( rprobs0.ii[,-1] ) + } + probs_plot[[i]] <- rprobs.ii + #************** + for (kk in 1:K){ + dat2a <- data.frame( "Theta"=theta0[,1], "cat"=kk, "P"=rprobs.ii[kk,] ) + dat2 <- rbind(dat2, dat2a) + } + auto.key <- NULL + simple.key <- paste0("Cat", 1:K - 1) + auto.key <- simple.key + dat2$time <- dat2$cat + dat2$time1 <- paste0("Cat", dat2$time ) + + simple.key <- FALSE + Kpercol <- K + # package graphics + if ( package=="graphics" ){ + kk <- 1 + dfr <- dat2 + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::plot(ifelse(dfr1a$Theta-1.125>-3,dfr1a$Theta-1.125,NA) , dfr1a$P, ylim=c(-.1,1.1),xlim=c(-3,3), + xlab=expression(theta), + col=pall[kk], type="l", xpd=TRUE,axes=F, ... + ) + axis(1) + axis(2) + grid(nx = NA, + ny = NULL, + lty = 3, col = "lightgray", lwd = 1) + graphics::lines( ifelse(dfr1a$Theta-1.125>-3,dfr1a$Theta-1.125,NA), dfr1a$P,xlim=c(-3,3), + col=pall[kk], type="l", xlim=c(-3,3), ... + ) + for (kk in seq(2,K) ){ + dfr1a <- dfr[ dfr$cat==kk, ] + graphics::lines( ifelse(dfr1a$Theta+ifelse(kk==3,1,ifelse(kk==4,0.35,0.5))>-3,dfr1a$Theta,NA)+ifelse(kk==3,1,ifelse(kk==4,0.35,0.5)), dfr1a$P, col=pall[kk] , xlim=c(-3,3)) + # graphics::points( dfr1a$Theta, dfr1a$P, pch=kk, col=kk+1 ) + + } + } + + + #*************************************** + + } + #*************** + graphics::par(ask=ask) + } # end item ii + #************************************************* + +} + + +# DIF heterogene divergent + + +pdf(file = '/home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_dif_het2.pdf') +par(xpd=F,mar=c(12.6,5.1,1.1,2.1)) +plot.tam.difhet2(zaza,type = "items",export=F,ylab="Probability of response",main=NULL,package = "graphics",items = 3) + + +text(x=-2.5,y=0.6,"0",col="#200c23") +text(x=-0.15,y=0.55,"1",col="#62403d") +text(x=1.45+0.475,y=0.55,"2",col="#a87b5e") +text(x=2.5,y=0.7,"3",col="#e9bf98") +par(xpd=T,mar=c(5.1,4.1,4.1,2.1)) +segments(x0=-3,x1=-.5+zaza$xsi[7,]$xsi,y0=-0.5,col="#200c23",lwd=2) +segments(x0=-.5+zaza$xsi[7,]$xsi,x1=.5+zaza$xsi[8,]$xsi+0.25,y0=-0.5,col="#62403d",lwd=2) +segments(x0=.5+zaza$xsi[8,]$xsi+0.25,x1=.5+zaza$xsi[9,]$xsi,y0=-0.5,col="#a87b5e",lwd=2) +segments(x0=.5+zaza$xsi[9,]$xsi,x1=3,y0=-0.5,col="#e9bf98",lwd=2) + +points(x =.5 + zaza$xsi[7,]$xsi-1, y=-0.5,pch=9,cex=1) +points(x =.5 + zaza$xsi[8,]$xsi+0.25, y=-0.5,pch=9,cex=1) +points(x =.5 + zaza$xsi[9,]$xsi, y=-0.5,pch=9,cex=1) +rect(xleft = 3,xright=5,ybottom = 0,ytop=1.1,col = "white",border = "white") + + +text( x=-0.25+mean(c(-3,zaza$xsi[7,]$xsi)), y=-0.65,"0",col="#200c23" ) +text( x=-0.5+0.125+0.5+mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)), y=-0.65,"1",col="#62403d" ) +text( x=0.5+0.125+mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)), y=-0.65,"2",col="#a87b5e" ) +text( x=0.5+mean(c(zaza$xsi[9,]$xsi,2.5)), y=-0.65,"3",col="#e9bf98" ) +text( x=-0.25+mean(c(-3,zaza$xsi[7,]$xsi)),cex=0.7, y=-0.6,"Much less than usual",col="#200c23" ) +text( x=-0.5+0.125+.5+mean(c(zaza$xsi[7,]$xsi,zaza$xsi[8,]$xsi)),cex=0.7, y=-0.6,"Less so than usual",col="#62403d" ) +text( x=.125+.5+mean(c(zaza$xsi[8,]$xsi,zaza$xsi[9,]$xsi)),cex=0.7, y=-0.6,"As much as usual",col="#a87b5e" ) +text( x=.5+mean(c(zaza$xsi[9,]$xsi,2.5)),cex=0.7, y=-0.6,"More so than usual",col="#e9bf98" ) + +text(x=-0.5+zaza$xsi[7,]$xsi,y=-0.55,expression(delta["j,1"])) +text(x=0.5+zaza$xsi[8,]$xsi+0.25,y=-0.55,expression(delta["j,2"])) +text(x=0.5+zaza$xsi[9,]$xsi,y=-0.55,expression(delta["j,3"])) + +arrows(x0=zaza$xsi[7,]$xsi-0.05,x1=zaza$xsi[7,]$xsi-0.5+0.05,y0=0.625,length = 0.1, lwd = 2,col="darkred") +arrows(x0=zaza$xsi[8,]$xsi+0.05,x1=zaza$xsi[8,]$xsi+0.75-0.05,y0=0.625,length = 0.1, lwd = 2,col="darkred") +arrows(x0=zaza$xsi[9,]$xsi+0.05,x1=zaza$xsi[9,]$xsi+0.5-0.05,y0=0.625,length = 0.1, lwd = 2) +text(x=-0.25+zaza$xsi[7,]$xsi,y=0.675,expression(gamma["j,1"]),col="darkred") +text(x=0.25+zaza$xsi[8,]$xsi+0.125,y=0.675,expression(gamma["j,2"]),col="darkred") +text(x=0.25+zaza$xsi[9,]$xsi,y=0.675,expression(gamma["j,3"])) + +text(x = 0.25,y=-0.75,"Most probable response catgory") +CurlyBraces(x0=-2.75, x1=2.75, y0=-0.675, y1=-0.675, pos = 2, direction = 2, depth=0.05) +arrows(x0=-2.65,x1=-3,y0=-0.35,length = 0.15,lwd = 2) +arrows(x0=2.65,x1=3,y0=-0.35,length = 0.15,lwd = 2) +text(x=-2.55,y=-0.35,"Worse\nmental\nhealth",adj=0) +text(x=2.5,y=-0.35,"Better\nmental\nhealth",adj=1) +rect(xleft = 3,xright=5,ybottom = -.1,ytop=1.1,col = "white",border = "white") + +segments(x0=zaza$xsi[7,]$xsi,x1=zaza$xsi[7,]$xsi,y0=0.6,y1=1.6,lty=3) +segments(x0=zaza$xsi[8,]$xsi,x1=zaza$xsi[8,]$xsi,y0=0.6,y1=1.6,lty=3) +segments(x0=zaza$xsi[9,]$xsi,x1=zaza$xsi[9,]$xsi,y0=0.6,y1=1.6,lty=3) + + +lines(x=-.25+c(zaza$xsi[7,]$xsi,zaza$xsi[7,]$xsi)-.25,y=c(0.65,-0.325),lty=3) +lines(x=-.25+c(zaza$xsi[7,]$xsi,zaza$xsi[7,]$xsi)-.25,y=c(-0.375,-0.5),lty=3) +lines(x=.5+c(zaza$xsi[8,]$xsi+0.25,zaza$xsi[8,]$xsi+0.25),y=c(0.65,-0.5),lty=3) +lines(x=.5+c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(0.65,-0.25),lty=3) +lines(x=.5+c(zaza$xsi[9,]$xsi,zaza$xsi[9,]$xsi),y=c(-0.45,-0.5),lty=3) +par(xpd=F) +dev.off() + + + + +########################## +# LM FACTEURS IGNORE DIF +########################## + + +####### SCENARIOS SANS TE + +res.dat.article.ignore.h0 <- res.dat.article.ignore[res.dat.article.ignore$true.beta==0,] +res.dat.article.ignore.h0$prop.dif <- res.dat.article.ignore.h0$nb.dif/res.dat.article.ignore.h0$J + +res.dat.article.ignore.h0.long <- reshape(res.dat.article.ignore.h0,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.ignore.h0.long) <- NULL +colnames(res.dat.article.ignore.h0.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.ignore.h0.long$prop.dif <- as.numeric(res.dat.article.ignore.h0.long$prop.dif) +res.dat.article.ignore.h0.long$N <- as.numeric(res.dat.article.ignore.h0.long$N) +res.dat.article.ignore.h0.long$true.gamma <- as.numeric(res.dat.article.ignore.h0.long$true.gamma) +res.dat.article.ignore.h0.long$J <- as.numeric(res.dat.article.ignore.h0.long$J) + +res.dat.article.ignore.h0$true.gamma <- as.numeric(res.dat.article.ignore.h0$true.gamma) + +# bias +res.dat.article.ignore.h0.long$abs.bias <- abs(res.dat.article.ignore.h0.long$bias) +summary(lm(abs.bias~true.gamma+prop.dif+N+J,data = res.dat.article.ignore.h0.long)) +summary(lm(abs.bias~true.gamma+prop.dif,data = res.dat.article.ignore.h0.long)) +summary(res.dat.article.ignore.h1.long[res.dat.article.ignore.h1.long$abs.gamma==0.5,"abs.bias"]) +summary(res.dat.article.ignore.h1.long[res.dat.article.ignore.h1.long$abs.gamma==0.3 & res.dat.article.ignore.h1.long$prop.dif<0.3,"abs.bias"]) + +# type I +summary(lm(typeIerror~J+true.gamma+prop.dif+N,data = res.dat.article.ignore.h0.long)) +summary(lm(typeIerror~true.gamma+prop.dif+N,data = res.dat.article.ignore.h0.long)) +res.dat.article.ignore.h0.long$abs.gamma <- abs(res.dat.article.ignore.h0.long$true.gamma) +summary(lm(typeIerror~abs.gamma+prop.dif+N,data = res.dat.article.ignore.h0.long)) + +res.dat.article.ignore.h0[res.dat.article.ignore.h0$true.gamma==-0.5 & + res.dat.article.ignore.h0$prop.dif>0.3,]$typeIerror.300 +res.dat.article.ignore.h0[res.dat.article.ignore.h0$true.gamma==-0.3 & + res.dat.article.ignore.h0$prop.dif<0.3,]$typeIerror.50 + +# coverage +summary(lm(coverage~abs.gamma+prop.dif+N,data = res.dat.article.ignore.h0.long)) + + +####### SCENARIOS AVEC TE + +res.dat.article.ignore.h1 <- res.dat.article.ignore[res.dat.article.ignore$true.beta!=0,] +res.dat.article.ignore.h1$prop.dif <- res.dat.article.ignore.h1$nb.dif/res.dat.article.ignore.h1$J + +res.dat.article.ignore.h1.long <- reshape(res.dat.article.ignore.h1,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.ignore.h1.long) <- NULL +colnames(res.dat.article.ignore.h1.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.ignore.h1.long$prop.dif <- as.numeric(res.dat.article.ignore.h1.long$prop.dif) +res.dat.article.ignore.h1.long$N <- as.numeric(res.dat.article.ignore.h1.long$N) +res.dat.article.ignore.h1.long$true.gamma <- as.numeric(res.dat.article.ignore.h1.long$true.gamma) +res.dat.article.ignore.h1.long$J <- as.numeric(res.dat.article.ignore.h1.long$J) + +res.dat.article.ignore.h1$true.gamma <- as.numeric(res.dat.article.ignore.h1$true.gamma) + +# bias +res.dat.article.ignore.h1.long$abs.bias <- abs(res.dat.article.ignore.h1.long$bias) +res.dat.article.ignore.h1.long$abs.gamma <- abs(res.dat.article.ignore.h1.long$true.gamma) +res.dat.article.ignore.h1.long$sign.gamma <- sign(res.dat.article.ignore.h1.long$true.gamma) +summary(lm(abs.bias~abs.gamma+sign.gamma+prop.dif+true.beta+N,data = res.dat.article.ignore.h1.long)) +summary(lm(abs.bias~abs.gamma+prop.dif,data = res.dat.article.ignore.h1.long)) +summary(res.dat.article.ignore.h1.long$abs.bias) + + +# coverage +res.dat.article.ignore.h1.long$masks <- res.dat.article.ignore.h1.long$true.beta/res.dat.article.ignore.h1.long$true.gamma>0 +res.dat.article.ignore.h1.long$masks <- 1*res.dat.article.ignore.h1.long$masks +summary(lm(coverage~abs.gamma+prop.dif+true.beta+N+masks,data = res.dat.article.ignore.h1.long)) +summary(lm(coverage~abs.gamma+prop.dif+N+masks,data = res.dat.article.ignore.h1.long)) +summary(lm(coverage~abs.gamma+prop.dif+N,data = res.dat.article.ignore.h1.long)) + +summary(res.dat.article.ignore.h1.long$coverage) + + +# power +res.dat.article.ignore.h1.long$powerdif <- as.numeric(res.dat.article.ignore.h1.long$power)-as.numeric(res.dat.article.ignore.h1.long$theoretical.power) +summary(lm(powerdif~masks*prop.dif+true.beta+N+masks*abs.gamma,data = res.dat.article.ignore.h1.long)) +summary(res.dat.article.ignore.h1.long[res.dat.article.ignore.h1.long$masks==0,]$powerdif) +summary(res.dat.article.ignore.h1.long[res.dat.article.ignore.h1.long$masks==1,]$powerdif) + +# bias +- +summary(lm(bias~abs.gamma+prop.dif+true.beta+N+masks,data = res.dat.article.ignore.h1.long)) +summary(lm(bias~masks,data = res.dat.article.ignore.h1.long)) +summary(res.dat.article.ignore.h1.long[res.dat.article.ignore.h1.long$masks==1,]$bias) +summary(res.dat.article.ignore.h1.long[res.dat.article.ignore.h1.long$masks==0,]$bias) + +########################## +# DESCRIPTION PCM-DIF +########################## + +####### SCENARIOS SANS TE + +res.dat.article.dif.h0 <- res.dat.article.dif[res.dat.article.dif$true.beta==0,] +res.dat.article.dif.h0$prop.dif <- res.dat.article.dif.h0$nb.dif/res.dat.article.dif.h0$J + +res.dat.article.dif.h0.long <- reshape(res.dat.article.dif.h0,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.dif.h0.long) <- NULL +colnames(res.dat.article.dif.h0.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.dif.h0.long$prop.dif <- as.numeric(res.dat.article.dif.h0.long$prop.dif) +res.dat.article.dif.h0.long$N <- as.numeric(res.dat.article.dif.h0.long$N) +res.dat.article.dif.h0.long$true.gamma <- as.numeric(res.dat.article.dif.h0.long$true.gamma) +res.dat.article.dif.h0.long$J <- as.numeric(res.dat.article.dif.h0.long$J) + +res.dat.article.dif.h0$true.gamma <- as.numeric(res.dat.article.dif.h0$true.gamma) + +# typeI +summary(as.numeric(res.dat.article.dif.h0.long$typeIerror)) +# bias +summary(abs(as.numeric(res.dat.article.dif.h0.long$bias))) +# coverage +summary(as.numeric(res.dat.article.dif.h0.long$coverage)) + +####### SCENARIOS AVEC TE + +res.dat.article.dif.h1 <- res.dat.article.dif[res.dat.article.dif$true.beta!=0,] +res.dat.article.dif.h1$prop.dif <- res.dat.article.dif.h1$nb.dif/res.dat.article.dif.h1$J + +res.dat.article.dif.h1.long <- reshape(res.dat.article.dif.h1,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.dif.h1.long) <- NULL +colnames(res.dat.article.dif.h1.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.dif.h1.long$prop.dif <- as.numeric(res.dat.article.dif.h1.long$prop.dif) +res.dat.article.dif.h1.long$N <- as.numeric(res.dat.article.dif.h1.long$N) +res.dat.article.dif.h1.long$true.gamma <- as.numeric(res.dat.article.dif.h1.long$true.gamma) +res.dat.article.dif.h1.long$J <- as.numeric(res.dat.article.dif.h1.long$J) + +res.dat.article.dif.h1$true.gamma <- as.numeric(res.dat.article.dif.h1$true.gamma) +res.dat.article.dif.h1.long$powerdif <- as.numeric(res.dat.article.dif.h1.long$power)-as.numeric(res.dat.article.dif.h1.long$theoretical.power) + +# powerdif +summary(as.numeric(res.dat.article.dif.h1.long$powerdif)) +summary(lm(powerdif~1,data=res.dat.article.dif.h1.long)) +# bias +summary(abs(as.numeric(res.dat.article.dif.h1.long$bias))) +# coverage +summary(as.numeric(res.dat.article.dif.h1.long$coverage)) + +########################## +# LM FACTEURS ROSALI +########################## + + +####### SCENARIOS SANS TE + +res.dat.article.rosali.dif.h0 <- res.dat.article.rosali.dif[res.dat.article.rosali.dif$true.beta==0,] +res.dat.article.rosali.dif.h0$prop.dif <- res.dat.article.rosali.dif.h0$nb.dif/res.dat.article.rosali.dif.h0$J + +res.dat.article.rosali.dif.h0.long <- reshape(res.dat.article.rosali.dif.h0,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.rosali.dif.h0.long) <- NULL +colnames(res.dat.article.rosali.dif.h0.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.rosali.dif.h0.long$prop.dif <- as.numeric(res.dat.article.rosali.dif.h0.long$prop.dif) +res.dat.article.rosali.dif.h0.long$N <- as.numeric(res.dat.article.rosali.dif.h0.long$N) +res.dat.article.rosali.dif.h0.long$true.gamma <- as.numeric(res.dat.article.rosali.dif.h0.long$true.gamma) +res.dat.article.rosali.dif.h0.long$J <- as.numeric(res.dat.article.rosali.dif.h0.long$J) + +res.dat.article.rosali.dif.h0$true.gamma <- as.numeric(res.dat.article.rosali.dif.h0$true.gamma) + +# bias +res.dat.article.rosali.dif.h0.long$abs.gamma <- abs(res.dat.article.rosali.dif.h0.long$true.gamma) +res.dat.article.rosali.dif.h0.long$abs.bias <- abs(res.dat.article.rosali.dif.h0.long$bias) +summary(lm(abs.bias~abs.gamma+prop.dif+N+J,data = res.dat.article.rosali.dif.h0.long)) +summary(lm(abs.bias~abs.gamma+prop.dif+N,data = res.dat.article.rosali.dif.h0.long)) +summary(res.dat.article.rosali.dif.h0.long$abs.bias) + +# type I +summary(lm(typeIerror~abs.gamma+prop.dif+N+J,data = res.dat.article.rosali.dif.h0.long)) +summary(lm(typeIerror~abs.gamma+prop.dif+N,data = res.dat.article.rosali.dif.h0.long)) +summary(as.numeric(res.dat.article.rosali.dif.h0.long$typeIerror)) + + +# coverage +summary(lm(coverage~abs.gamma+prop.dif+N,data = res.dat.article.ignore.h0.long)) + + +####### SCENARIOS AVEC TE + +res.dat.article.rosali.dif.h1 <- res.dat.article.rosali.dif[res.dat.article.rosali.dif$true.beta!=0,] +res.dat.article.rosali.dif.h1$prop.dif <- res.dat.article.rosali.dif.h1$nb.dif/res.dat.article.rosali.dif.h1$J + +res.dat.article.rosali.dif.h1.long <- reshape(res.dat.article.rosali.dif.h1,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.rosali.dif.h1.long) <- NULL +colnames(res.dat.article.rosali.dif.h1.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.rosali.dif.h1.long$prop.dif <- as.numeric(res.dat.article.rosali.dif.h1.long$prop.dif) +res.dat.article.rosali.dif.h1.long$N <- as.numeric(res.dat.article.rosali.dif.h1.long$N) +res.dat.article.rosali.dif.h1.long$true.gamma <- as.numeric(res.dat.article.rosali.dif.h1.long$true.gamma) +res.dat.article.rosali.dif.h1.long$J <- as.numeric(res.dat.article.rosali.dif.h1.long$J) + +res.dat.article.rosali.dif.h1$true.gamma <- as.numeric(res.dat.article.rosali.dif.h1$true.gamma) + +# bias +res.dat.article.rosali.dif.h1.long$abs.bias <- abs(res.dat.article.rosali.dif.h1.long$bias) +res.dat.article.rosali.dif.h1.long$abs.gamma <- abs(res.dat.article.rosali.dif.h1.long$true.gamma) +res.dat.article.rosali.dif.h1.long$sign.gamma <- sign(res.dat.article.rosali.dif.h1.long$true.gamma) +summary(lm(abs.bias~abs.gamma+sign.gamma+prop.dif+true.beta+N+J,data = res.dat.article.rosali.dif.h1.long)) +summary(lm(abs.bias~abs.gamma+prop.dif+N,data = res.dat.article.rosali.dif.h1.long)) +summary(res.dat.article.rosali.dif.h1.long$abs.bias) + + +# coverage +res.dat.article.rosali.dif.h1.long$masks <- res.dat.article.rosali.dif.h1.long$true.beta/res.dat.article.rosali.dif.h1.long$true.gamma>0 +res.dat.article.rosali.dif.h1.long$masks <- 1*res.dat.article.rosali.dif.h1.long$masks +summary(lm(coverage~abs.gamma+prop.dif+true.beta+N+masks+J,data = res.dat.article.rosali.dif.h1.long)) +summary(lm(coverage~abs.gamma+prop.dif+N,data = res.dat.article.rosali.dif.h1.long)) + +summary(res.dat.article.rosali.dif.h1.long$coverage) + + +# power +res.dat.article.rosali.dif.h1.long$powerdif <- as.numeric(res.dat.article.rosali.dif.h1.long$power)-as.numeric(res.dat.article.rosali.dif.h1.long$theoretical.power) +summary(lm(powerdif~masks+true.beta+N,data = res.dat.article.rosali.dif.h1.long)) +summary(lm(abs(powerdif)~N+prop.dif,data = res.dat.article.rosali.dif.h1.long)) + +summary(res.dat.article.rosali.dif.h1.long[res.dat.article.rosali.dif.h1.long$masks==0,]$powerdif) +summary(res.dat.article.rosali.dif.h1.long[res.dat.article.rosali.dif.h1.long$masks==1,]$powerdif) + +# bias +- +summary(lm(bias~abs.gamma+prop.dif+true.beta+N+masks,data = res.dat.article.rosali.dif.h1.long)) +summary(lm(bias~masks,data = res.dat.article.rosali.dif.h1.long)) +summary(res.dat.article.rosali.dif.h1.long[res.dat.article.rosali.dif.h1.long$masks==1,]$bias) +summary(res.dat.article.rosali.dif.h1.long[res.dat.article.rosali.dif.h1.long$masks==0,]$bias) + + +########################## +# Plots ROSALI vs ignore +########################## + +par(mfrow=c(2,2)) + +plot(res.dat.article.ignore.h0.long$typeIerror,res.dat.article.rosali.dif.h0.long$typeIerror, + pch=3,col="#CD5E35",xlim=c(0,1),ylim=c(0,1),cex=1.5, + xlab = "Type-I error when ignoring DIF",ylab="Type-I error after ROSALI DIF detection", + main="Type-I error",axes = F) +segments(x0=0,y0=0,x1=1,y1=1,lty=2) +axis(1) +axis(2) + +plot(c(res.dat.article.ignore.h0.long$abs.bias,res.dat.article.ignore.h1.long$abs.bias), + c(res.dat.article.rosali.dif.h0.long$abs.bias,res.dat.article.rosali.dif.h1.long$abs.bias), + pch=3,col="#CD5E35",xlim=c(0,0.4),ylim=c(0,0.4),cex=1.5, + xlab = "Absolute bias when ignoring DIF",ylab="Absolute bias after ROSALI DIF detection", + main="Absolute bias",axes = F) +segments(x0=0,y0=0,x1=0.4,y1=0.4,lty=2) +axis(1) +axis(2) + +plot(c(res.dat.article.ignore.h0.long$coverage,res.dat.article.ignore.h1.long$coverage), + c(res.dat.article.rosali.dif.h0.long$coverage,res.dat.article.rosali.dif.h1.long$coverage), + pch=3,col="#CD5E35",xlim=c(0,1),ylim=c(0,1),cex=1.5, + xlab = "Coverage when ignoring DIF",ylab="Coverage after ROSALI DIF detection", + main="Coverage",axes = F) +segments(x0=0,y0=0,x1=1,y1=1,lty=2) +axis(1) +axis(2) + +plot(c(res.dat.article.ignore.h0.long$powerdif,res.dat.article.ignore.h1.long$powerdif), + c(res.dat.article.rosali.dif.h0.long$powerdif,res.dat.article.rosali.dif.h1.long$powerdif), + pch=3,col="#CD5E35",xlim=c(-1,1),ylim=c(-1,1),cex=1.5, + xlab = "Power difference when ignoring DIF",ylab="Power difference after ROSALI DIF detection", + main="Difference between expected and observed power",axes = F) +segments(x0=-1,y0=-1,x1=1,y1=1,lty=2) +axis(1) +axis(2) + +par(mfrow=c(1,1)) + +which.typeI <- which(as.numeric(res.dat.article.rosali.dif.h0.long$typeIerror)-as.numeric(res.dat.article.ignore.h0.long$typeIerror)<=-0.1) +res.dat.article.ignore.h0.long[which.typeI,] + +df_temp_rosali <- rbind(res.dat.article.rosali.dif.h0.long[,c(1:6,13)],res.dat.article.rosali.dif.h1.long[,c(1:6,13)]) +df_temp_ignore <- rbind(res.dat.article.ignore.h0.long[,c(1:6,13)],res.dat.article.ignore.h1.long[,c(1:6,13)]) +which.bias <- which(as.numeric(df_temp_rosali$abs.bias)-as.numeric(df_temp_ignore$abs.bias)<=-0.05) +df_temp_rosali[which.bias,] + +df_temp_rosali <- rbind(res.dat.article.rosali.dif.h0.long[,c(1:6,12)],res.dat.article.rosali.dif.h1.long[,c(1:6,12)]) +df_temp_ignore <- rbind(res.dat.article.ignore.h0.long[,c(1:6,12)],res.dat.article.ignore.h1.long[,c(1:6,12)]) +which.coverage <- which(as.numeric(df_temp_rosali$coverage)-as.numeric(df_temp_ignore$coverage)>=0.1) +df_temp_rosali[which.coverage,] + +df_temp_rosali <- rbind(res.dat.article.rosali.dif.h1.long) +df_temp_ignore <- rbind(res.dat.article.ignore.h1.long) +which.power <- which(abs(as.numeric(df_temp_rosali$powerdif))-abs(as.numeric(df_temp_ignore$powerdif))<=-0.1) +df_temp_rosali[which.power,] + +########################## +# LM FACTEURS RESIDIF +########################## + + +####### SCENARIOS SANS TE + +res.dat.article.residif.dif.h0 <- res.dat.article.residif.dif[res.dat.article.residif.dif$true.beta==0,] +res.dat.article.residif.dif.h0$prop.dif <- res.dat.article.residif.dif.h0$nb.dif/res.dat.article.residif.dif.h0$J + +res.dat.article.residif.dif.h0.long <- reshape(res.dat.article.residif.dif.h0,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.residif.dif.h0.long) <- NULL +colnames(res.dat.article.residif.dif.h0.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.residif.dif.h0.long$prop.dif <- as.numeric(res.dat.article.residif.dif.h0.long$prop.dif) +res.dat.article.residif.dif.h0.long$N <- as.numeric(res.dat.article.residif.dif.h0.long$N) +res.dat.article.residif.dif.h0.long$true.gamma <- as.numeric(res.dat.article.residif.dif.h0.long$true.gamma) +res.dat.article.residif.dif.h0.long$J <- as.numeric(res.dat.article.residif.dif.h0.long$J) + +res.dat.article.residif.dif.h0$true.gamma <- as.numeric(res.dat.article.residif.dif.h0$true.gamma) + +# bias +res.dat.article.residif.dif.h0.long$abs.gamma <- abs(res.dat.article.residif.dif.h0.long$true.gamma) +res.dat.article.residif.dif.h0.long$abs.bias <- abs(res.dat.article.residif.dif.h0.long$bias) +summary(lm(abs.bias~abs.gamma+prop.dif+N+J,data = res.dat.article.residif.dif.h0.long)) +summary(lm(abs.bias~abs.gamma+prop.dif+N,data = res.dat.article.residif.dif.h0.long)) +summary(res.dat.article.residif.dif.h0.long$abs.bias) + +# type I +summary(lm(typeIerror~abs.gamma+prop.dif+N+J,data = res.dat.article.residif.dif.h0.long)) +summary(lm(typeIerror~abs.gamma+prop.dif+N,data = res.dat.article.residif.dif.h0.long)) +summary(as.numeric(res.dat.article.residif.dif.h0.long$typeIerror)) + + +# coverage +summary(lm(coverage~abs.gamma+prop.dif+N,data = res.dat.article.ignore.h0.long)) + + +####### SCENARIOS AVEC TE + +res.dat.article.residif.dif.h1 <- res.dat.article.residif.dif[res.dat.article.residif.dif$true.beta!=0,] +res.dat.article.residif.dif.h1$prop.dif <- res.dat.article.residif.dif.h1$nb.dif/res.dat.article.residif.dif.h1$J + +res.dat.article.residif.dif.h1.long <- reshape(res.dat.article.residif.dif.h1,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.residif.dif.h1.long) <- NULL +colnames(res.dat.article.residif.dif.h1.long)[7:12] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.residif.dif.h1.long$prop.dif <- as.numeric(res.dat.article.residif.dif.h1.long$prop.dif) +res.dat.article.residif.dif.h1.long$N <- as.numeric(res.dat.article.residif.dif.h1.long$N) +res.dat.article.residif.dif.h1.long$true.gamma <- as.numeric(res.dat.article.residif.dif.h1.long$true.gamma) +res.dat.article.residif.dif.h1.long$J <- as.numeric(res.dat.article.residif.dif.h1.long$J) + +res.dat.article.residif.dif.h1$true.gamma <- as.numeric(res.dat.article.residif.dif.h1$true.gamma) + +# bias +res.dat.article.residif.dif.h1.long$abs.bias <- abs(res.dat.article.residif.dif.h1.long$bias) +res.dat.article.residif.dif.h1.long$abs.gamma <- abs(res.dat.article.residif.dif.h1.long$true.gamma) +res.dat.article.residif.dif.h1.long$sign.gamma <- sign(res.dat.article.residif.dif.h1.long$true.gamma) +res.dat.article.residif.dif.h1.long$masks <- res.dat.article.residif.dif.h1.long$true.beta/res.dat.article.residif.dif.h1.long$true.gamma>0 +res.dat.article.residif.dif.h1.long$masks <- 1*res.dat.article.residif.dif.h1.long$masks +summary(lm(abs.bias~abs.gamma+masks+prop.dif+true.beta+N+J,data = res.dat.article.residif.dif.h1.long)) +summary(lm(abs.bias~abs.gamma+masks+prop.dif+N,data = res.dat.article.residif.dif.h1.long)) +summary(res.dat.article.residif.dif.h1.long$abs.bias) + +summary(res.dat.article.residif.dif.h1.long[res.dat.article.residif.dif.h1.long$masks==1,]$abs.bias) +summary(res.dat.article.residif.dif.h1.long[res.dat.article.residif.dif.h1.long$masks==0,]$abs.bias) + +res.dat.article.rosali.dif.h1.long$masks <- 1*(res.dat.article.rosali.dif.h1.long$true.gamma>0) +res.dat.article.rosali.dif.h1.long$abs.bias <- abs(as.numeric(res.dat.article.rosali.dif.h1.long$bias)) +summary(res.dat.article.rosali.dif.h1.long[res.dat.article.rosali.dif.h1.long$masks==1,]$abs.bias) +summary(res.dat.article.rosali.dif.h1.long[res.dat.article.rosali.dif.h1.long$masks==0,]$abs.bias) + + +# coverage + +summary(lm(coverage~abs.gamma+prop.dif+true.beta+N+masks+J,data = res.dat.article.residif.dif.h1.long)) +summary(lm(coverage~abs.gamma+prop.dif+N+masks,data = res.dat.article.residif.dif.h1.long)) + +summary(res.dat.article.residif.dif.h1.long$coverage) + + +# power +res.dat.article.residif.dif.h1.long$powerdif <- as.numeric(res.dat.article.residif.dif.h1.long$power)-as.numeric(res.dat.article.residif.dif.h1.long$theoretical.power) +summary(lm(powerdif~masks+true.beta+N+abs.gamma+prop.dif+J,data = res.dat.article.residif.dif.h1.long)) +summary(lm(powerdif~masks+true.beta+N,data = res.dat.article.residif.dif.h1.long)) + +summary(res.dat.article.residif.dif.h1.long[res.dat.article.residif.dif.h1.long$masks==0,]$powerdif) +summary(res.dat.article.residif.dif.h1.long[res.dat.article.residif.dif.h1.long$masks==1,]$powerdif) + +# bias +- +summary(lm(bias~abs.gamma+prop.dif+true.beta+N+masks,data = res.dat.article.residif.dif.h1.long)) +summary(lm(bias~masks,data = res.dat.article.residif.dif.h1.long)) +summary(res.dat.article.residif.dif.h1.long[res.dat.article.residif.dif.h1.long$masks==1,]$bias) +summary(res.dat.article.residif.dif.h1.long[res.dat.article.residif.dif.h1.long$masks==0,]$bias) + + +########################## +# Plots RESIDIF vs ignore +########################## + +par(mfrow=c(2,2)) + +plot(res.dat.article.ignore.h0.long$typeIerror,res.dat.article.residif.dif.h0.long$typeIerror, + pch=3,col="#CD5E35",xlim=c(0,1),ylim=c(0,1),cex=1.5, + xlab = "Type-I error when ignoring DIF",ylab="Type-I error after RESIDIF DIF detection", + main="Type-I error",axes = F) +segments(x0=0,y0=0,x1=1,y1=1,lty=2) +axis(1) +axis(2) + +plot(c(res.dat.article.ignore.h0.long$abs.bias,res.dat.article.ignore.h1.long$abs.bias), + c(res.dat.article.residif.dif.h0.long$abs.bias,res.dat.article.residif.dif.h1.long$abs.bias), + pch=3,col="#CD5E35",xlim=c(0,0.4),ylim=c(0,0.4),cex=1.5, + xlab = "Absolute bias when ignoring DIF",ylab="Absolute bias after RESIDIF DIF detection", + main="Absolute bias",axes = F) +segments(x0=0,y0=0,x1=0.4,y1=0.4,lty=2) +axis(1) +axis(2) + +plot(c(res.dat.article.ignore.h0.long$coverage,res.dat.article.ignore.h1.long$coverage), + c(res.dat.article.residif.dif.h0.long$coverage,res.dat.article.residif.dif.h1.long$coverage), + pch=3,col="#CD5E35",xlim=c(0,1),ylim=c(0,1),cex=1.5, + xlab = "Coverage when ignoring DIF",ylab="Coverage after RESIDIF DIF detection", + main="Coverage",axes = F) +segments(x0=0,y0=0,x1=1,y1=1,lty=2) +axis(1) +axis(2) + +plot(c(res.dat.article.ignore.h0.long$powerdif,res.dat.article.ignore.h1.long$powerdif), + c(res.dat.article.residif.dif.h0.long$powerdif,res.dat.article.residif.dif.h1.long$powerdif), + pch=3,col="#CD5E35",xlim=c(-1,1),ylim=c(-1,1),cex=1.5, + xlab = "Power difference when ignoring DIF",ylab="Power difference after RESIDIF DIF detection", + main="Difference between expected and observed power",axes = F) +segments(x0=-1,y0=-1,x1=1,y1=1,lty=2) +axis(1) +axis(2) + +par(mfrow=c(1,1)) + +which.typeI <- which(as.numeric(res.dat.article.residif.dif.h0.long$typeIerror)-as.numeric(res.dat.article.ignore.h0.long$typeIerror)<=-0.1) +res.dat.article.ignore.h0.long[which.typeI,] + +res.dat.article.residif.dif.h0.long$masks <- NA +res.dat.article.ignore.h0.long$masks <- NA + +df_temp_residif <- rbind(res.dat.article.residif.dif.h0.long[,c(1:6,14:15)],res.dat.article.residif.dif.h1.long[,c(1:6,13,16)]) +df_temp_ignore <- rbind(res.dat.article.ignore.h0.long[,c(1:6,13,15)],res.dat.article.ignore.h1.long[,c(1:6,13,16)]) +which.bias <- which(as.numeric(df_temp_residif$abs.bias)-as.numeric(df_temp_ignore$abs.bias)<=-0.05) +df_temp_residif[which.bias,] +table(df_temp_residif[which.bias,]$masks) +which.bias <- which(as.numeric(df_temp_residif$abs.bias)-as.numeric(df_temp_ignore$abs.bias)>0.05) +df_temp_residif[which.bias,] + +df_temp_residif <- rbind(res.dat.article.residif.dif.h0.long[,c(1:6,12,15)],res.dat.article.residif.dif.h1.long[,c(1:6,12,16)]) +df_temp_ignore <- rbind(res.dat.article.ignore.h0.long[,c(1:6,12,15)],res.dat.article.ignore.h1.long[,c(1:6,12,16)]) +which.bias <- which(as.numeric(df_temp_residif$coverage)-as.numeric(df_temp_ignore$coverage)<=-0.1) +df_temp_residif[which.coverage,] +table(df_temp_residif[which.coverage,]$masks) + +df_temp_residif <- rbind(res.dat.article.residif.dif.h1.long) +df_temp_ignore <- rbind(res.dat.article.ignore.h1.long) +which.power <- which(abs(as.numeric(df_temp_residif$powerdif))-abs(as.numeric(df_temp_ignore$powerdif))<=-0.1) +df_temp_residif[which.power,] +table(df_temp_residif[which.power,]$masks) + + + + + + + +########################## +# BOXPLOT PERF VS NODIF +########################## + +par(mfrow=c(2,2)) +par(bg = "white") + +res.dat.article.nodif <- res.dat.article[res.dat$nb.dif==0,] + +### Type I error +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",120), + rep("ROSALI",120), + rep("RESIDIF",120), + rep("PCM-DIF",120) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab="Analysis strategy",pch=3,main="Type-I error rate (TE = 0)", + ylab="RCT type-I error",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + +### BIAS +bp.dat.bias.ignore <- as.numeric(res.dat.article[res.dat.article$nb.dif!=0,"bias"]) + +bp.dat.bias.nodif <- as.numeric(res.dat.article.nodif[,"bias"]) + +bp.dat.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$nb.dif!=0,"bias"]) + +bp.dat.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$nb.dif!=0,"bias"]) + +bp.dat.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$nb.dif!=0,"bias"]) + +bp.dat.bias <- data.frame(bias=c(bp.dat.bias.nodif,bp.dat.bias.ignore,bp.dat.bias.rosali,bp.dat.bias.residif, + bp.dat.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",120), + rep("ROSALI",120), + rep("RESIDIF",120), + rep("PCM-DIF",120) ) ) +bp.dat.bias$method <- factor(bp.dat.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) +bp.dat.bias$bias <- abs(bp.dat.bias$bias) + +boxplot(bp.dat.bias$bias~bp.dat.bias$method,xlab="Analysis strategy",pch=3,main="Absolute bias", + ylab="Absolute bias",ylim=c(0,.5),yaxt="n", + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850"), + cex.lab=1.45,cex.main=1.5,cex.axis=1.45) +axis(2,seq(-.5,.5,0.25),cex.axis=1.45) +abline(h=0,lty=2,col='#777777',lwd=2) + + +### COVERAGE +bp.dat.coverage.ignore <- as.numeric(res.dat.article[res.dat.article$nb.dif!=0,"coverage"]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",120), + rep("ROSALI",120), + rep("RESIDIF",120), + rep("PCM-DIF",120) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab="Analysis strategy",pch=3,main="Coverage", + ylab="Coverage",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(-1,1,0.25),cex=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + +### POWER + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article[res.dat.article$true.gamma>0 & res.dat.article$true.beta>0 & res.dat.article$nb.dif!=0,"power"])-as.numeric(res.dat.article[res.dat.article$true.gamma>0 & res.dat.article$true.beta>0 & res.dat.article$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article[res.dat.article$true.gamma<0 & res.dat.article$true.beta>0 & res.dat.article$nb.dif!=0,"power"])-as.numeric(res.dat.article[res.dat.article$true.gamma<0 & res.dat.article$true.beta>0 & res.dat.article$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif[res.dat.article.nodif$true.beta>0,"power"])-as.numeric(res.dat.article.nodif[res.dat.article.nodif$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",48),rep("AMPLIFY1",48), + rep("MASK2",48),rep("AMPLIFY2",48), + rep("MASK3",48),rep("AMPLIFY3",48), + rep("MASK4",48),rep("AMPLIFY4",48) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="Power (TE ≠ 0)", + ylab="RCT power - expected power",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) +title(cex.lab=1.45,xlab="Analysis strategy") +# legend("topright",fill = c("#798A5D","#D4E8B5"),c('DIF masks treatment effect','DIF amplifies treatment effect')) + + + + +par(mfrow=c(1,1)) +par(bg = "white") + + + ########################## -# PLOTS CAUSAL +# DESCRIPTION NO DIF ########################## +####### SCENARIOS SANS TE + +res.dat.article.nodif.long.h0 <- res.dat.article.nodif.long[res.dat.article.nodif.long$true.beta==0,] +res.dat.article.nodif.long.h0$prop.dif <- res.dat.article.nodif.long.h0$nb.dif/res.dat.article.nodif.long.h0$J + +res.dat.article.nodif.long.h0$prop.dif <- as.numeric(res.dat.article.nodif.long.h0$prop.dif) +res.dat.article.nodif.long.h0$N <- as.numeric(res.dat.article.nodif.long.h0$N) +res.dat.article.nodif.long.h0$true.gamma <- as.numeric(res.dat.article.nodif.long.h0$true.gamma) +res.dat.article.nodif.long.h0$J <- as.numeric(res.dat.article.nodif.long.h0$J) + +res.dat.article.nodif.long.h0$true.gamma <- as.numeric(res.dat.article.nodif.long.h0$true.gamma) + +# typeI +summary(as.numeric(res.dat.article.dif.h0.long$typeIerror)) + +####### SCENARIOS AVEC TE + +res.dat.article.nodif.long.h1 <- res.dat.article.nodif.long[res.dat.article.nodif.long$true.beta!=0,] +res.dat.article.nodif.long.h1$prop.dif <- res.dat.article.nodif.long.h1$nb.dif/res.dat.article.nodif.long.h1$J +res.dat.article.nodif.long.h1$prop.dif <- as.numeric(res.dat.article.nodif.long.h1$prop.dif) +res.dat.article.nodif.long.h1$N <- as.numeric(res.dat.article.nodif.long.h1$N) +res.dat.article.nodif.long.h1$true.gamma <- as.numeric(res.dat.article.nodif.long.h1$true.gamma) +res.dat.article.nodif.long.h1$J <- as.numeric(res.dat.article.nodif.long.h1$J) -### +res.dat.article.nodif.long.h1$true.gamma <- as.numeric(res.dat.article.nodif.long.h1$true.gamma) +res.dat.article.nodif.long.h1$powerdif <- as.numeric(res.dat.article.nodif.long.h1$power)-as.numeric(res.dat.article.nodif.long.h1$theoretical.power) -# Plot bias vs perf detect +# powerdif +summary(as.numeric(res.dat.article.nodif.long.h1$powerdif)) -plot(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.rosali[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$bias),na.rm = T)), - type="l",ylim=c(0,0.2),lwd=2,col="red",xaxs = "i",yaxs="i",xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.resali[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$bias),na.rm = T)), - type="l",lwd=2,col="blue",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") -#title("Average absolute value bias in scenarios at given perfect detection rate") +####### Overall -# Plot true bias vs perf detect +#coverage +res.dat.article.nodif.long$bias <- as.numeric(res.dat.article.nodif.long$bias) +res.dat.article.nodif.long$abs.bias <- abs(res.dat.article.nodif.long$bias) +summary(res.dat.article.nodif.long$abs.bias) -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$bias),na.rm = T)), - type="l",ylim=c(0,0.2),lwd=2,col="pink",xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$bias),na.rm = T)), - type="l",lwd=2,col="#8193f1",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") -legend(x=0.535,y=0.195,legend=c('ROSALI - accounting for DIF','Residuals - accounting for DIF', - 'ROSALI - not accounting for DIF','Residuals - not accounting for DIF'), - col=c("red","blue","pink","#8193f1"),lty=c(1,2,1,2),lwd=c(2,2,2,2)) -### +#coverage +summary(res.dat.article.nodif.long$coverage) +####### ROSALI -### +# SCENARIOS SANS TE -# Plot alpha vs. perfect +# typeI -plot(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.rosali[res.dat.dif.rosali$scenario.type=="A" & res.dat.dif.rosali$prop.perfect>=x-0.1 & res.dat.dif.rosali$prop.perfect<=x+0.1,]$h0.rejected.p),na.rm = T)), - type="l",ylim=c(0,1),lwd=2,col="red",xaxs = "i",yaxs="i",xlab = "Perfect detection rate",ylab="Type-I error rate") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.resali[res.dat.dif.resali$scenario.type=="A" & res.dat.dif.resali$prop.perfect>=x-0.1 & res.dat.dif.resali$prop.perfect<=x+0.1,]$h0.rejected.p),na.rm = T)), - type="l",lwd=2,col="blue",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.rosali$scenario.type=="A" & res.dat.dif.rosali$prop.perfect>=x-0.1 & res.dat.dif.rosali$prop.perfect<=x+0.1,]$h0.rejected.p),na.rm = T)), - type="l",ylim=c(0,1),lwd=2,col="pink",xlab = "Perfect detection rate",ylab="Type-I error rate") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.resali$scenario.type=="A" & res.dat.dif.resali$prop.perfect>=x-0.1 & res.dat.dif.resali$prop.perfect<=x+0.1,]$h0.rejected.p),na.rm = T)), - type="l",lwd=2,col="#8193f1",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") -#title("Average type-I error rate in scenarios at given perfect detection rate") -legend(x=0.535,y=0.98,legend=c('ROSALI - accounting for DIF','Residuals - accounting for DIF', - 'ROSALI - not accounting for DIF','Residuals - not accounting for DIF'), - col=c("red","blue","pink","#8193f1"),lty=c(1,2,1,2),lwd=c(2,2,2,2)) -abline(h=0.05,lty=3) -### +summary(as.numeric(res.dat.article.rosali.2.nodif$typeIerror)) +res.dat.article.rosali.2.nodif$typeIerror <- as.numeric(res.dat.article.rosali.2.nodif$typeIerror) +res.dat.article.rosali.2.nodif$N <- as.numeric(res.dat.article.rosali.2.nodif$N) +summary(lm(typeIerror~N+J,data = res.dat.article.rosali.2.nodif)) +# bias +res.dat.article.rosali.2.nodif$abs.bias <- abs(as.numeric(res.dat.article.rosali.2.nodif$bias)) +summary(as.numeric(res.dat.article.rosali.2.nodif[res.dat.article.rosali.2.nodif$true.beta==0,]$abs.bias)) -### +# SCENARIOS AVEC TE -# Plot truevalueinci vs. perfect +# bias +summary(as.numeric(res.dat.article.rosali.2.nodif[res.dat.article.rosali.2.nodif$true.beta!=0,]$abs.bias)) -plot(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.rosali[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$true.value.in.ci.p),na.rm = T)), - type="l",ylim=c(0.5,1),lwd=2,col="red",xaxs = "i",yaxs="i",xlab = "Perfect detection rate",ylab="Average proportion of true effect in estimate CI") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.resali[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$true.value.in.ci.p),na.rm = T)), - type="l",lwd=2,col="blue",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$true.value.in.ci.p),na.rm = T)), - type="l",ylim=c(0,0.2),lwd=2,col="pink",xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$true.value.in.ci.p),na.rm = T)), - type="l",lwd=2,col="#8193f1",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") +# coverage +res.dat.article.rosali.2.nodif$coverage <- as.numeric(res.dat.article.rosali.2.nodif$coverage) +summary(as.numeric(res.dat.article.rosali.2.nodif[res.dat.article.rosali.2.nodif$true.beta!=0,]$coverage)) -#title("Average proportion of true effect in estimate CI in scenarios at given perfect detection rate") -legend(x=0.535,y=0.6,legend=c('ROSALI - accounting for DIF','Residuals - accounting for DIF', - 'ROSALI - not accounting for DIF','Residuals - not accounting for DIF'), - col=c("red","blue","pink","#8193f1"),lty=c(1,2,1,2),lwd=c(2,2,2,2)) -### +# power +res.dat.article.rosali.2.nodif$powerdif <- as.numeric(res.dat.article.rosali.2.nodif$power)-as.numeric(res.dat.article.rosali.2.nodif$theoretical.power) +summary(as.numeric(res.dat.article.rosali.2.nodif[res.dat.article.rosali.2.nodif$true.beta!=0,]$powerdif)) -### +####### RESIDIF -# Plot powerdif vs. perfect +# SCENARIOS SANS TE + +# typeI + +summary(as.numeric(res.dat.article.residif.2.nodif$typeIerror)) + +res.dat.article.residif.2.nodif$typeIerror <- as.numeric(res.dat.article.residif.2.nodif$typeIerror) +res.dat.article.residif.2.nodif$N <- as.numeric(res.dat.article.residif.2.nodif$N) +summary(lm(typeIerror~N+J,data = res.dat.article.residif.2.nodif)) + +# bias +res.dat.article.residif.2.nodif$abs.bias <- abs(as.numeric(res.dat.article.residif.2.nodif$bias)) +summary(as.numeric(res.dat.article.residif.2.nodif[res.dat.article.residif.2.nodif$true.beta==0,]$abs.bias)) + +# SCENARIOS AVEC TE + +# bias +summary(as.numeric(res.dat.article.residif.2.nodif[res.dat.article.residif.2.nodif$true.beta!=0,]$abs.bias)) + +# coverage +res.dat.article.residif.2.nodif$coverage <- as.numeric(res.dat.article.residif.2.nodif$coverage) +summary(as.numeric(res.dat.article.residif.2.nodif[res.dat.article.residif.2.nodif$true.beta!=0,]$coverage)) + +# power +res.dat.article.residif.2.nodif$powerdif <- as.numeric(res.dat.article.residif.2.nodif$power)-as.numeric(res.dat.article.residif.2.nodif$theoretical.power) +summary(as.numeric(res.dat.article.residif.2.nodif[res.dat.article.residif.2.nodif$true.beta!=0,]$powerdif)) + + + +# Scenarios avec + perf +res.dat.article.ignore.long <- reshape(res.dat.article.ignore,idvar=c("J",'true.beta',"true.gamma","nb.dif","prop.dif"),v.names=c('betahat','bias','typeIerror','power',"coverage")) +rownames(res.dat.article.ignore.long) <- NULL +colnames(res.dat.article.ignore.long)[6:11] <- c("betahat","bias","typeIerror",'power','theoretical.power','coverage') +res.dat.article.ignore.long$abs.bias <- abs(res.dat.article.ignore.long$bias) +res.dat.article.residif.2$abs.bias <- abs(res.dat.article.residif.2$bias) +res.dat.article.residif.2.dif <- res.dat.article.residif.2[res.dat.article.residif.2$nb.dif>0,] +res.dat.article.rosali.2$abs.bias <- abs(res.dat.article.rosali.2$bias) +res.dat.article.rosali.2.dif <- res.dat.article.rosali.2[res.dat.article.rosali.2$nb.dif>0,] +res.dat.article.ignore.long.dif <- res.dat.article.ignore.long[res.dat.article.ignore.long$nb.dif>0,] +summary(res.dat.article.residif.2.dif[res.dat.article.residif.2.dif$abs.bias-res.dat.article.ignore.long.dif$abs.bias<=-0.1,]$abs.bias) +summary(res.dat.article.ignore.long.dif[res.dat.article.residif.2.dif$abs.bias-res.dat.article.ignore.long.dif$abs.bias<=-0.1,]$abs.bias) + +summary(res.dat.article.rosali.2.dif[res.dat.article.rosali.2.dif$abs.bias-res.dat.article.ignore.long.dif$abs.bias<=-0.1,]$abs.bias) +summary(res.dat.article.ignore.long.dif[res.dat.article.rosali.2.dif$abs.bias-res.dat.article.ignore.long.dif$abs.bias<=-0.1,]$abs.bias) + + +########################## +# BOXPLOT PERF VS NODIF FACET TYPE1 +########################## -plot(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(res.dat.dif.rosali[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$diff.power,na.rm = T)), - type="l",col="red",xaxs = "i",yaxs="i",lwd=2,ylim=c(-0.5,0.5),xlab = "Perfect detection rate",ylab="Observed power - theoretical power (average)") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(res.dat.dif.resali[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$diff.power,na.rm = T)), - type="l",col="blue",lwd=2,lty=2,ylim=c(-0.2,0),xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(res.dat[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$dif.power,na.rm = T)), - type="l",col="pink",lwd=2,ylim=c(-0.2,0.1),xlab = "Perfect detection rate",ylab="Observed power - theoretical power (average)") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(res.dat[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$dif.power,na.rm = T)), - type="l",col="#8193f1",lwd=2,lty=2,ylim=c(-0.2,0),xlab = "Perfect detection rate",ylab="Average absolute value bias") -#title("Average difference with theoretical power in scenarios at given perfect detection rate") -legend(x=0.54,y=0.48,legend=c('ROSALI - accounting for DIF','Residuals - accounting for DIF', - 'ROSALI - not accounting for DIF','Residuals - not accounting for DIF'), - col=c("red","blue","pink","#8193f1"),lty=c(1,2,1,2),lwd=c(2,2,2,2)) -### - - -### - -# Plot betasame vs. perfect - -plot(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.rosali[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$beta.same.sign.truebeta.p),na.rm = T)), - type="l",ylim=c(0.5,1),lwd=2,col="red",xaxs = "i",yaxs="i",xlab = "Perfect detection rate",ylab="Average proportion of true effect of same sign as estimate") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat.dif.resali[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$beta.same.sign.truebeta.p),na.rm = T)), - type="l",lwd=2,col="blue",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.rosali$prop.perfect>=x-0.05 & res.dat.dif.rosali$prop.perfect<=x+0.05,]$beta.same.sign.truebeta.p),na.rm = T)), - type="l",ylim=c(0,0.2),lwd=2,col="pink",xlab = "Perfect detection rate",ylab="Average absolute value bias") -lines(seq(0,0.85,0.001),sapply(seq(0,0.85,0.001), - function(x) mean(abs(res.dat[res.dat.dif.resali$prop.perfect>=x-0.05 & res.dat.dif.resali$prop.perfect<=x+0.05,]$beta.same.sign.truebeta.p),na.rm = T)), - type="l",lwd=2,col="#8193f1",lty=2,xlab = "Perfect detection rate",ylab="Average absolute value bias") - -#title("Average proportion of true effect in estimate CI in scenarios at given perfect detection rate") -legend(x=0.535,y=0.6,legend=c('ROSALI - accounting for DIF','Residuals - accounting for DIF', - 'ROSALI - not accounting for DIF','Residuals - not accounting for DIF'), - col=c("red","blue","pink","#8193f1"),lty=c(1,2,1,2),lwd=c(2,2,2,2)) -### +par(mfrow=c(3,4)) +par(bg = "white") + +res.dat.article.2$abs.gamma <- abs(as.numeric(res.dat.article.2$true.gamma)) +res.dat.article.rosali.2$abs.gamma <- abs(as.numeric(res.dat.article.rosali.2$true.gamma)) +res.dat.article.residif.2$abs.gamma <- abs(as.numeric(res.dat.article.residif.2$true.gamma)) +res.dat.article.dif.2$abs.gamma <- abs(as.numeric(res.dat.article.dif.2$true.gamma)) +res.dat.article.2$prop.dif <- res.dat.article.2$nb.dif/res.dat.article.2$J +res.dat.article.rosali.2$prop.dif <- res.dat.article.rosali.2$nb.dif/res.dat.article.rosali.2$J +res.dat.article.residif.2$prop.dif <- res.dat.article.residif.2$nb.dif/res.dat.article.residif.2$J +res.dat.article.dif.2$prop.dif <- res.dat.article.dif.2$nb.dif/res.dat.article.dif.2$J + +############# Type I error + +# N50 +## DIF 03 25% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="Weak DIF - 25% of items", + ylab="Type-I error rate",ylim=c(0,1),yaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + +## DIF 03 50% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="Weak DIF - 50% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + +## DIF 05 25% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="Medium DIF - 25% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + + +## DIF 05 50% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="Medium DIF - 50% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + +# N100 +## DIF 03 25% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab="Type-I error rate",ylim=c(0,1),yaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + +## DIF 03 50% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + +## DIF 05 25% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + + +## DIF 05 50% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + + +# N300 +## DIF 03 25% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab="Type-I error rate",ylim=c(0,1),yaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + +## DIF 03 50% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + +## DIF 05 25% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + + +## DIF 05 50% + +bp.dat.typeIerror.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("typeIerror")]) + +bp.dat.typeIerror.nodif <- as.numeric(res.dat.article.nodif.2[,"typeIerror"]) + +bp.dat.typeIerror.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"typeIerror"]) + +bp.dat.typeIerror <- data.frame(typeIerror=c(bp.dat.typeIerror.nodif,bp.dat.typeIerror.ignore,bp.dat.typeIerror.rosali,bp.dat.typeIerror.residif, + bp.dat.typeIerror.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.typeIerror$method <- factor(bp.dat.typeIerror$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.typeIerror$typeIerror~bp.dat.typeIerror$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.05,lty=2,col='#777777',lwd=2) + + + + + + + +########################## +# BOXPLOT PERF VS NODIF FACET BIAS +########################## + +par(mfrow=c(3,4)) +par(bg = "white") + +res.dat.article.2$abs.gamma <- abs(as.numeric(res.dat.article.2$true.gamma)) +res.dat.article.rosali.2$abs.gamma <- abs(as.numeric(res.dat.article.rosali.2$true.gamma)) +res.dat.article.residif.2$abs.gamma <- abs(as.numeric(res.dat.article.residif.2$true.gamma)) +res.dat.article.dif.2$abs.gamma <- abs(as.numeric(res.dat.article.dif.2$true.gamma)) +res.dat.article.2$prop.dif <- res.dat.article.2$nb.dif/res.dat.article.2$J +res.dat.article.rosali.2$prop.dif <- res.dat.article.rosali.2$nb.dif/res.dat.article.rosali.2$J +res.dat.article.residif.2$prop.dif <- res.dat.article.residif.2$nb.dif/res.dat.article.residif.2$J +res.dat.article.dif.2$prop.dif <- res.dat.article.dif.2$nb.dif/res.dat.article.dif.2$J +res.dat.article.2$abs.bias <- abs(as.numeric(res.dat.article.2$bias)) +res.dat.article.rosali.2$abs.bias <- abs(as.numeric(res.dat.article.rosali.2$bias)) +res.dat.article.residif.2$abs.bias <- abs(as.numeric(res.dat.article.residif.2$bias)) +res.dat.article.dif.2$abs.bias <- abs(as.numeric(res.dat.article.dif.2$bias)) +res.dat.article.nodif.2$abs.bias <- abs(as.numeric(res.dat.article.nodif.2$bias)) + +############# Bias + +# N50 +## DIF 03 25% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="Weak DIF - 25% of items", + ylab="Absolute bias",ylim=c(0,0.5),yaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + +## DIF 03 50% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="Weak DIF - 50% of items", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + +## DIF 05 25% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="Medium DIF - 25% of items", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + + + +## DIF 05 50% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="Medium DIF - 50% of items", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + + +# N100 +## DIF 03 25% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab="Absolute bias",ylim=c(0,0.5),yaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + +## DIF 03 50% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + +## DIF 05 25% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + + + +## DIF 05 50% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + + + +# N300 +## DIF 03 25% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab="Absolute bias",ylim=c(0,0.5),yaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + +## DIF 03 50% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + +## DIF 05 25% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + + + +## DIF 05 50% + +bp.dat.abs.bias.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("abs.bias")]) + +bp.dat.abs.bias.nodif <- as.numeric(res.dat.article.nodif.2[,"abs.bias"]) + +bp.dat.abs.bias.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"abs.bias"]) + +bp.dat.abs.bias <- data.frame(abs.bias=c(bp.dat.abs.bias.nodif,bp.dat.abs.bias.ignore,bp.dat.abs.bias.rosali,bp.dat.abs.bias.residif, + bp.dat.abs.bias.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.abs.bias$method <- factor(bp.dat.abs.bias$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.abs.bias$abs.bias~bp.dat.abs.bias$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,0.5),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) + + + +########################## +# BOXPLOT PERF VS NODIF FACET COVERAGE +########################## + +par(mfrow=c(3,4)) +par(bg = "white") + +res.dat.article.2$abs.gamma <- abs(as.numeric(res.dat.article.2$true.gamma)) +res.dat.article.rosali.2$abs.gamma <- abs(as.numeric(res.dat.article.rosali.2$true.gamma)) +res.dat.article.residif.2$abs.gamma <- abs(as.numeric(res.dat.article.residif.2$true.gamma)) +res.dat.article.dif.2$abs.gamma <- abs(as.numeric(res.dat.article.dif.2$true.gamma)) +res.dat.article.2$prop.dif <- res.dat.article.2$nb.dif/res.dat.article.2$J +res.dat.article.rosali.2$prop.dif <- res.dat.article.rosali.2$nb.dif/res.dat.article.rosali.2$J +res.dat.article.residif.2$prop.dif <- res.dat.article.residif.2$nb.dif/res.dat.article.residif.2$J +res.dat.article.dif.2$prop.dif <- res.dat.article.dif.2$nb.dif/res.dat.article.dif.2$J + +############# Bias + +# N50 +## DIF 03 25% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="Weak DIF - 25% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) +title(ylab="Coverage",cex.lab=1.6) + + +## DIF 03 50% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="Weak DIF - 50% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + +## DIF 05 25% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="Medium DIF - 25% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + + +## DIF 05 50% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="Medium DIF - 50% of items", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + +# N100 +## DIF 03 25% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab="",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) +title(ylab="Coverage",cex.lab=1.6) + +## DIF 03 50% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + +## DIF 05 25% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + + +## DIF 05 50% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + + +# N300 +## DIF 03 25% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) +title(ylab="Coverage",cex.lab=1.6) + + +## DIF 03 50% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + +## DIF 05 25% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + + +## DIF 05 50% + +bp.dat.coverage.ignore <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif>0.3 & res.dat.article.2$nb.dif!=0,c("coverage")]) + +bp.dat.coverage.nodif <- as.numeric(res.dat.article.nodif.2[,"coverage"]) + +bp.dat.coverage.rosali <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif>0.3 & res.dat.article.rosali.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.residif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif>0.3 & res.dat.article.residif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage.dif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif>0.3 & res.dat.article.dif.2$nb.dif!=0,"coverage"]) + +bp.dat.coverage <- data.frame(coverage=c(bp.dat.coverage.nodif,bp.dat.coverage.ignore,bp.dat.coverage.rosali,bp.dat.coverage.residif, + bp.dat.coverage.dif),method=c(rep("NO DIF",18), + rep("IGNORE-DIF",10), + rep("ROSALI",10), + rep("RESIDIF",10), + rep("PCM-DIF",10) ) ) +bp.dat.coverage$method <- factor(bp.dat.coverage$method,levels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF")) + +boxplot(bp.dat.coverage$coverage~bp.dat.coverage$method,xlab=" ",pch=3,main="", + ylab=" ",ylim=c(0,1),yaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.45, + col=c("#e69875","#a7c080","#a7c080","#a7c080","#a7c080") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850")) +axis(2,seq(0,1,0.1),cex.axis=1.45) +abline(h=0.95,lty=2,col='#777777',lwd=2) + + + + + + +########################## +# BOXPLOT PERF VS NODIF FACET POWER +########################## + +par(mfrow=c(3,4)) +par(bg = "white") + +res.dat.article.2$abs.gamma <- abs(as.numeric(res.dat.article.2$true.gamma)) +res.dat.article.rosali.2$abs.gamma <- abs(as.numeric(res.dat.article.rosali.2$true.gamma)) +res.dat.article.residif.2$abs.gamma <- abs(as.numeric(res.dat.article.residif.2$true.gamma)) +res.dat.article.dif.2$abs.gamma <- abs(as.numeric(res.dat.article.dif.2$true.gamma)) +res.dat.article.2$prop.dif <- res.dat.article.2$nb.dif/res.dat.article.2$J +res.dat.article.rosali.2$prop.dif <- res.dat.article.rosali.2$nb.dif/res.dat.article.rosali.2$J +res.dat.article.residif.2$prop.dif <- res.dat.article.residif.2$nb.dif/res.dat.article.residif.2$J +res.dat.article.dif.2$prop.dif <- res.dat.article.dif.2$nb.dif/res.dat.article.dif.2$J + + +# N50 +## DIF 03 25% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="Weak DIF - 25% of items", + ylab="RCT power - expected power",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 03 50% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="Weak DIF - 50% of items", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 05 25% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="Medium DIF - 25% of items", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 05 50% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==50 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==50 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==50 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==50 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="Medium DIF - 50% of items", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + + + + + +# N100 +## DIF 03 25% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="RCT power - expected power",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 03 50% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 05 25% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 05 50% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==100 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==100 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==100 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==100 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + + + + +# N300 +## DIF 03 25% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="RCT power - expected power",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.6,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 03 50% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.3 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.3 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.3 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.3 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 05 25% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +## DIF 05 50% + +bp.dat.power.ignore.mask <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma>0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.ignore.magnif <- as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.2[res.dat.article.2$N==300 & res.dat.article.2$abs.gamma==0.5 & res.dat.article.2$prop.dif<0.3 & res.dat.article.2$true.gamma<0 & res.dat.article.2$true.beta>0 & res.dat.article.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.nodif <- as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"power"])-as.numeric(res.dat.article.nodif.2[res.dat.article.nodif.2$true.beta>0,"theoretical.power"]) + +bp.dat.power.rosali.mask <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma>0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.rosali.magnif <- as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.rosali.2[res.dat.article.rosali.2$N==300 & res.dat.article.rosali.2$abs.gamma==0.5 & res.dat.article.rosali.2$prop.dif<0.3 & res.dat.article.rosali.2$true.beta>0 & res.dat.article.rosali.2$true.gamma<0 & res.dat.article.rosali.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.residif.mask <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma>0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.residif.magnif <- as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.residif.2[res.dat.article.residif.2$N==300 & res.dat.article.residif.2$abs.gamma==0.5 & res.dat.article.residif.2$prop.dif<0.3 & res.dat.article.residif.2$true.beta>0 & res.dat.article.residif.2$true.gamma<0 & res.dat.article.residif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power.dif.mask <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma>0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) +bp.dat.power.dif.magnif <- as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"power"])-as.numeric(res.dat.article.dif.2[res.dat.article.dif.2$N==300 & res.dat.article.dif.2$abs.gamma==0.5 & res.dat.article.dif.2$prop.dif<0.3 & res.dat.article.dif.2$true.beta>0 & res.dat.article.dif.2$true.gamma<0 & res.dat.article.dif.2$nb.dif!=0,"theoretical.power"]) + +bp.dat.power <- data.frame(power=c(bp.dat.power.nodif,bp.dat.power.ignore.mask,bp.dat.power.ignore.magnif,bp.dat.power.rosali.mask,bp.dat.power.rosali.magnif,bp.dat.power.residif.mask,bp.dat.power.residif.magnif, + bp.dat.power.dif.mask,bp.dat.power.dif.magnif), + method=c(rep("NO DIF",12), + rep("MASK1",4),rep("AMPLIFY1",4), + rep("MASK2",4),rep("AMPLIFY2",4), + rep("MASK3",4),rep("AMPLIFY3",4), + rep("MASK4",4),rep("AMPLIFY4",4) )) +bp.dat.power$method <- factor(bp.dat.power$method,levels=c("NO DIF","MASK1","AMPLIFY1","MASK2","AMPLIFY2","MASK3","AMPLIFY3","MASK4","AMPLIFY4")) + + +boxplot(bp.dat.power$power~bp.dat.power$method,xlab="",pch=3,main="", + ylab="",ylim=c(-1,1),yaxt="n",xaxt="n", + cex.lab=1.45,cex.main=1.5,cex.axis=1.15, + col=c("#e69875","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5","#798A5D","#D4E8B5") + ,border=c("#CD5E35","#697850","#697850","#697850","#697850","#697850","#697850","#697850","#697850"), + width=c(0.8,0.4,0.4,0.4,0.4,0.4,0.4,0.4,0.4), + at=c(1,2,2.5,3.25,3.75,4.5,5,5.75,6.25)) +axis(2,seq(-1,1,0.25),cex.axis=1.45) +axis(1,c(1,2.25,3.5,4.75,6),labels=c("NO DIF","IGNORE-DIF","ROSALI","RESIDIF","PCM-DIF"),cex.axis=1.45) +abline(h=0,lty=2,col='#595959',lwd=2) + + +par(mfrow=c(1,1))