source ( paste0 ( getwd ( ) , " /functions/resali.R" ) )
# 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 )
##########################
# 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 ( ' #f7c611' , ' #61b5b7' , ' #ca346d' , ' #204776'
)
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 = " " ,
col = pall [kk ] , type = " l" , xpd = TRUE , axes = F , ...
)
axis ( 1 )
axis ( 2 , las = 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 = " #f7c611" )
text ( x = -0.65 , y = 0.55 , " 1" , col = " #61b5b7" )
text ( x = 0.95 , y = 0.55 , " 2" , col = " #ca346d" )
text ( x = 2.5 , y = 0.85 , " 3" , col = " #204776" )
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 = " #f7c611" , lwd = 2 )
segments ( x0 = zaza $ xsi [7 , ] $ xsi , x1 = zaza $ xsi [8 , ] $ xsi , y0 = 1.1 , y1 = 1.1 , col = " #61b5b7" , lwd = 2 )
segments ( x0 = zaza $ xsi [8 , ] $ xsi , x1 = zaza $ xsi [9 , ] $ xsi , y0 = 1.1 , y1 = 1.1 , col = " #ca346d" , lwd = 2 )
segments ( x0 = zaza $ xsi [9 , ] $ xsi , x1 = 3 , y0 = 1.1 , y1 = 1.1 , col = " #204776" , 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 = " #f7c611" )
text ( x = mean ( c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) ) , y = 1.2 , " 1" , col = " #61b5b7" )
text ( x = mean ( c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) ) , y = 1.2 , " 2" , col = " #ca346d" )
text ( x = mean ( c ( zaza $ xsi [9 , ] $ xsi , 3 ) ) , y = 1.2 , " 3" , col = " #204776" )
text ( x = mean ( c ( -3 , zaza $ xsi [7 , ] $ xsi ) ) , cex = 0.7 , y = 1.15 , " Much less than usual" , col = " #f7c611" )
text ( x = mean ( c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) ) , cex = 0.7 , y = 1.15 , " Less so than usual" , col = " #61b5b7" )
text ( x = mean ( c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) ) , cex = 0.7 , y = 1.15 , " As much as usual" , col = " #ca346d" )
text ( x = mean ( c ( zaza $ xsi [9 , ] $ xsi , 3 ) ) , cex = 0.7 , y = 1.15 , " More so than usual" , col = " #204776" )
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 category" )
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 = ' Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
#### ICC BASE
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/NoDIF/N300/scenario_2A_300.csv" )
zaza <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza2 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
zaza3 <- tam.mml ( resp = zaz [ , paste0 ( " item" , 1 : 4 ) ] )
icc.tam.base <- function ( x , items = 1 : x $ nitems , type = " expected" , TT = F ,
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 ( ' #204776' , ' #204776' , ' #204776' , ' #204776'
)
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 ( -3 , 3 , 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 ) )
if ( TT == 0 ) {
graphics :: plot ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , ylab = " Expected item response" ,
main = NULL , xlab = " " ,
col = " #204776" , ylim = ylim2 , xlim = ... )
} else {
if ( TT == 1 ) {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , col = " #204776" )
} else {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 2 , las = 1 , col = " #204776" , lty = 2 )
}
}
} 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 = " " ,
col = pall [kk ] , type = " l" , xpd = TRUE , axes = F , ...
)
axis ( 1 )
axis ( 2 , las = 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
#*************************************************
}
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/icc_base.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.base ( zaza , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 0 )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
text ( x = -2.55 , y = -0.45 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.45 , " Better\nmental\nhealth" , adj = 1 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
##########################
# CCC DIF
##########################
#### 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_homo.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 in control group (X=0)" , 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 = " #f7c611" )
text ( x = -0.65 , y = 0.55 , " 1" , col = " #61b5b7" )
text ( x = 0.95 , y = 0.55 , " 2" , col = " #ca346d" )
text ( x = 2.5 , y = 0.85 , " 3" , col = " #204776" )
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 = " #f7c611" , lwd = 2 )
segments ( x0 = zaza $ xsi [7 , ] $ xsi , x1 = zaza $ xsi [8 , ] $ xsi , y0 = 1.1 , y1 = 1.1 , col = " #61b5b7" , lwd = 2 )
segments ( x0 = zaza $ xsi [8 , ] $ xsi , x1 = zaza $ xsi [9 , ] $ xsi , y0 = 1.1 , y1 = 1.1 , col = " #ca346d" , lwd = 2 )
segments ( x0 = zaza $ xsi [9 , ] $ xsi , x1 = 3 , y0 = 1.1 , y1 = 1.1 , col = " #204776" , 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.15 , " 0" , col = " #f7c611" )
text ( x = mean ( c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) ) , y = 1.15 , " 1" , col = " #61b5b7" )
text ( x = mean ( c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) ) , y = 1.15 , " 2" , col = " #ca346d" )
text ( x = mean ( c ( zaza $ xsi [9 , ] $ xsi , 3 ) ) , y = 1.15 , " 3" , col = " #204776" )
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.275 , " Most probable response category" )
CurlyBraces ( x0 = -2.5 , x1 = 2.5 , y0 = 1.2 , y1 = 1.2 , 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.275 ) , lty = 3 )
lines ( x = c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [7 , ] $ xsi ) , y = c ( -0.4 , -0.6 ) , lty = 3 )
lines ( x = c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( 0 , -0.275 ) , lty = 3 )
lines ( x = c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( -0.4 , -0.6 ) , lty = 3 )
lines ( x = c ( zaza $ xsi [9 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) , y = c ( 0 , -0.6 ) , lty = 3 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) , line = 1.8 )
title ( main = ' A - Homogeneous DIF' , font.main = 2 )
par ( xpd = F )
dev.off ( )
# DIF homogène
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 ( ' #f7c611' , ' #61b5b7' , ' #ca346d' , ' #204776'
)
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 = " " ,
col = pall [kk ] , type = " l" , xpd = TRUE , axes = F , ...
)
axis ( 1 )
axis ( 2 , las = 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
#*************************************************
}
pdf ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_dif_2_homo.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 in treatment group (X=1)" , main = NULL , package = " graphics" , items = 3 )
text ( x = -2 , y = 0.85 , " 0" , col = " #f7c611" )
text ( x = -.05 , y = 0.55 , " 1" , col = " #61b5b7" )
text ( x = 1.45 , y = 0.55 , " 2" , col = " #ca346d" )
text ( x = 2.5 , y = 0.7 , " 3" , col = " #204776" )
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 = " #f7c611" , lwd = 2 )
segments ( x0 = .5 + zaza $ xsi [7 , ] $ xsi , x1 = .5 + zaza $ xsi [8 , ] $ xsi , y0 = -0.5 , col = " #61b5b7" , lwd = 2 )
segments ( x0 = .5 + zaza $ xsi [8 , ] $ xsi , x1 = .5 + zaza $ xsi [9 , ] $ xsi , y0 = -0.5 , col = " #ca346d" , lwd = 2 )
segments ( x0 = .5 + zaza $ xsi [9 , ] $ xsi , x1 = 3 , y0 = -0.5 , col = " #204776" , 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.55 , " 0" , col = " #f7c611" )
text ( x = 0.5 + mean ( c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) ) , y = -0.55 , " 1" , col = " #61b5b7" )
text ( x = 0.5 + mean ( c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) ) , y = -0.55 , " 2" , col = " #ca346d" )
text ( x = 0.5 + mean ( c ( zaza $ xsi [9 , ] $ xsi , 2.5 ) ) , y = -0.55 , " 3" , col = " #204776" )
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 , " DIF" )
text ( x = 0.25 + zaza $ xsi [8 , ] $ xsi , y = 0.675 , " DIF" )
text ( x = 0.25 + zaza $ xsi [9 , ] $ xsi , y = 0.675 , " DIF" )
text ( x = 0.25 , y = -0.675 , " Most probable response category" )
CurlyBraces ( x0 = -2.25 , x1 = 2.75 , y0 = -0.6 , y1 = -0.6 , 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" )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) , line = -4.3 )
lines ( x = .5 + c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [7 , ] $ xsi ) , y = c ( 0.65 , -0.25 ) , lty = 3 )
lines ( x = .5 + c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( 0.65 , -0.25 ) , 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 [7 , ] $ xsi , zaza $ xsi [7 , ] $ xsi ) , y = c ( -0.45 , -0.5 ) , lty = 3 )
lines ( x = .5 + c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( -0.45 , -0.5 ) , 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 ( ' #f7c611' , ' #61b5b7' , ' #ca346d' , ' #204776'
)
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 = " " ,
col = pall [kk ] , type = " l" , xpd = TRUE , axes = F , ...
)
axis ( 1 )
axis ( 2 , las = 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.5 , ifelse ( kk == 4 , 0.4 , 0.5 ) ) > -3 & dfr1a $ Theta + ifelse ( kk == 3 , 1.5 , ifelse ( kk == 4 , 0.4 , 0.5 ) ) < 3 , dfr1a $ Theta , NA ) + ifelse ( kk == 3 , 1.5 , ifelse ( kk == 4 , 0.4 , 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_2_conv.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 in treatment group (X=1)" , main = NULL , package = " graphics" , items = 3 )
text ( x = -2 , y = 0.85 , " 0" , col = " #f7c611" )
text ( x = -0.15 , y = 0.55 , " 1" , col = " #61b5b7" )
text ( x = 1.45 +1 .,y = 0.55 , " 2" , col = " #ca346d" )
text ( x = 2.5 , y = 0.7 , " 3" , col = " #204776" )
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 = " #f7c611" , lwd = 2 )
segments ( x0 = .5 + zaza $ xsi [7 , ] $ xsi , x1 = .75 + zaza $ xsi [8 , ] $ xsi +0.25 , y0 = -0.5 , col = " #61b5b7" , lwd = 2 )
segments ( x0 = .75 + zaza $ xsi [8 , ] $ xsi +0.25 , x1 = .5 + zaza $ xsi [9 , ] $ xsi , y0 = -0.5 , col = " #ca346d" , lwd = 2 )
segments ( x0 = .5 + zaza $ xsi [9 , ] $ xsi , x1 = 3 , y0 = -0.5 , col = " #204776" , lwd = 2 )
points ( x = .5 + zaza $ xsi [7 , ] $ xsi , y = -0.5 , pch = 9 , cex = 1 )
points ( x = .75 + 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.55 , " 0" , col = " #f7c611" )
text ( x = 0.75 + mean ( c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) ) , y = -0.55 , " 1" , col = " #61b5b7" )
text ( x = 0.75 + mean ( c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) ) , y = -0.55 , " 2" , col = " #ca346d" )
text ( x = 0.5 + mean ( c ( zaza $ xsi [9 , ] $ xsi , 2.5 ) ) , y = -0.55 , " 3" , col = " #204776" )
text ( x = 0.5 + zaza $ xsi [7 , ] $ xsi , y = -0.55 , expression ( delta [ " j,1" ] ) )
text ( x = 0.75 + 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 +1 -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 , " DIF" )
text ( x = 0.25 + zaza $ xsi [8 , ] $ xsi +0.25 , y = 0.675 , " DIF" )
text ( x = 0.25 + zaza $ xsi [9 , ] $ xsi , y = 0.675 , " DIF" )
text ( x = 0.25 , y = -0.675 , " Most probable response category" )
CurlyBraces ( x0 = -2.25 , x1 = 2.75 , y0 = -0.6 , y1 = -0.6 , 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" )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) , line = -4.3 )
lines ( x = .5 + c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [7 , ] $ xsi ) , y = c ( 0.65 , -0.25 ) , lty = 3 )
lines ( x = 1 + c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( 0.65 , -0.25 ) , lty = 3 )
lines ( x = 1 + c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( -0.45 , -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 [7 , ] $ xsi , zaza $ xsi [7 , ] $ xsi ) , y = c ( -0.45 , -0.5 ) , 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 ( ' #f7c611' , ' #61b5b7' , ' #ca346d' , ' #204776'
)
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 = " " ,
col = pall [kk ] , type = " l" , xpd = TRUE , axes = F , ...
)
axis ( 1 )
axis ( 2 , las = 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.5 , ifelse ( kk == 4 , 0.4 , 0.5 ) ) > -3 & dfr1a $ Theta + ifelse ( kk == 3 , 1.5 , ifelse ( kk == 4 , 0.4 , 0.5 ) ) < 3 , dfr1a $ Theta , NA ) + ifelse ( kk == 3 , 1.5 , ifelse ( kk == 4 , 0.4 , 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 divergent
pdf ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/ccc_dif_2_div.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 in treatment group (X=1)" , main = NULL , package = " graphics" , items = 3 )
text ( x = -2.5 , y = 0.6 , " 0" , col = " #f7c611" )
text ( x = -0.15 , y = 0.55 , " 1" , col = " #61b5b7" )
text ( x = 1.45 +0.475 , y = 0.55 , " 2" , col = " #ca346d" )
text ( x = 2.5 , y = 0.7 , " 3" , col = " #204776" )
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 = " #f7c611" , lwd = 2 )
segments ( x0 = -.5 + zaza $ xsi [7 , ] $ xsi , x1 = .75 + zaza $ xsi [8 , ] $ xsi +0.25 , y0 = -0.5 , col = " #61b5b7" , lwd = 2 )
segments ( x0 = .75 + zaza $ xsi [8 , ] $ xsi +0.25 , x1 = .5 + zaza $ xsi [9 , ] $ xsi , y0 = -0.5 , col = " #ca346d" , lwd = 2 )
segments ( x0 = .5 + zaza $ xsi [9 , ] $ xsi , x1 = 3 , y0 = -0.5 , col = " #204776" , lwd = 2 )
points ( x = .5 + zaza $ xsi [7 , ] $ xsi -1 , y = -0.5 , pch = 9 , cex = 1 )
points ( x = .75 + 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.55 , " 0" , col = " #f7c611" )
text ( x = -0.25 +0.125 +0.5 + mean ( c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) ) , y = -0.55 , " 1" , col = " #61b5b7" )
text ( x = 0.5 +0.25 + mean ( c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [9 , ] $ xsi ) ) , y = -0.55 , " 2" , col = " #ca346d" )
text ( x = 0.5 + mean ( c ( zaza $ xsi [9 , ] $ xsi , 2.5 ) ) , y = -0.55 , " 3" , col = " #204776" )
text ( x = -0.5 + zaza $ xsi [7 , ] $ xsi , y = -0.55 , expression ( delta [ " j,1" ] ) )
text ( x = 0.75 + 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 +1 -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 , " DIF" )
text ( x = 0.25 + zaza $ xsi [8 , ] $ xsi +0.25 , y = 0.675 , " DIF" )
text ( x = 0.25 + zaza $ xsi [9 , ] $ xsi , y = 0.675 , " DIF" )
text ( x = 0.25 , y = -0.675 , " Most probable response category" )
CurlyBraces ( x0 = -2.25 , x1 = 2.75 , y0 = -0.6 , y1 = -0.6 , 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" )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) , line = -4.3 )
lines ( x = -.5 + c ( zaza $ xsi [7 , ] $ xsi , zaza $ xsi [7 , ] $ xsi ) , y = c ( 0.65 , -0.5 ) , lty = 3 )
lines ( x = 1 + c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( 0.65 , -0.25 ) , lty = 3 )
lines ( x = 1 + c ( zaza $ xsi [8 , ] $ xsi , zaza $ xsi [8 , ] $ xsi ) , y = c ( -0.45 , -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.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.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 )
res.dat.article.ignore.h0.long $ bias <- abs ( res.dat.article.ignore.h0.long $ bias )
res.dat.article.ignore.h0.long $ betahat <- abs ( res.dat.article.ignore.h0.long $ betahat )
# 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 MASK
res.dat.article.ignore.h1 <- res.dat.article.ignore [res.dat.article.ignore $ true.beta != 0 & res.dat.article.ignore $ true.gamma > 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 ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.ignore.h1.long ) )
# 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 ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.ignore.h1.long ) )
# 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 ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.ignore.h1.long ) )
# 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 )
####### SCENARIOS AVEC TE AMPLIFY
res.dat.article.ignore.h1 <- res.dat.article.ignore [res.dat.article.ignore $ true.beta != 0 & res.dat.article.ignore $ true.gamma < 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 )
res.dat.article.ignore.h1 $ true.beta <- as.numeric ( res.dat.article.ignore.h1 $ true.beta )
# 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 + prop.dif + true.beta + N + J , data = res.dat.article.ignore.h1.long ) )
# 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 + J , data = res.dat.article.ignore.h1.long ) )
# 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 ~ abs.gamma + prop.dif + true.beta + N + J , data = res.dat.article.ignore.h1.long ) )
# 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.long $ abs.gamma <- abs ( res.dat.article.rosali.dif.h0.long $ true.gamma )
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.bias <- abs ( res.dat.article.rosali.dif.h0.long $ bias )
summary ( lm ( abs.bias ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.rosali.dif.h0.long ) )
# 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 MASK
res.dat.article.rosali.dif.h1 <- res.dat.article.rosali.dif [res.dat.article.rosali.dif $ true.beta != 0 & res.dat.article.rosali.dif $ true.gamma > 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 ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.rosali.dif.h1.long ) )
# coverage
summary ( lm ( coverage ~ true.gamma + prop.dif + true.beta + N + J , 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 ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.rosali.dif.h1.long ) )
# 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 )
####### SCENARIOS AVEC TE AMPLIFY
res.dat.article.rosali.dif.h1 <- res.dat.article.rosali.dif [res.dat.article.rosali.dif $ true.beta != 0 & res.dat.article.rosali.dif $ true.gamma < 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 + prop.dif + true.beta + N + J , data = res.dat.article.rosali.dif.h1.long ) )
# coverage
summary ( lm ( coverage ~ abs.gamma + prop.dif + true.beta + N + J , 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 ~ abs.gamma + prop.dif + true.beta + N + J , data = res.dat.article.rosali.dif.h1.long ) )
##########################
# 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.long $ abs.gamma <- as.numeric ( res.dat.article.residif.dif.h0.long $ true.gamma )
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 MASK
res.dat.article.residif.dif.h1 <- res.dat.article.residif.dif [res.dat.article.residif.dif $ true.beta != 0 & res.dat.article.residif.dif $ true.gamma > 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 )
summary ( lm ( abs.bias ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.residif.dif.h1.long ) )
# coverage
summary ( lm ( coverage ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.residif.dif.h1.long ) )
# 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 ~ true.gamma + prop.dif + true.beta + N + J , data = res.dat.article.residif.dif.h1.long ) )
####### SCENARIOS AVEC TE AMPLIFY
res.dat.article.residif.dif.h1 <- res.dat.article.residif.dif [res.dat.article.residif.dif $ true.beta != 0 & res.dat.article.residif.dif $ true.gamma < 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 )
summary ( lm ( bias ~ abs.gamma + prop.dif + true.beta + N + J , data = res.dat.article.residif.dif.h1.long ) )
# coverage
summary ( lm ( coverage ~ abs.gamma + prop.dif + true.beta + N + J , data = res.dat.article.residif.dif.h1.long ) )
# 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 ~ abs.gamma + prop.dif + true.beta + N + J , data = res.dat.article.residif.dif.h1.long ) )
##########################
# 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" )
##########################
# 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 )
# powerdif
summary ( as.numeric ( res.dat.article.nodif.long.h1 $ powerdif ) )
####### Overall
#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 )
#coverage
summary ( res.dat.article.nodif.long $ coverage )
####### ROSALI
# SCENARIOS SANS TE
# typeI
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
# bias
summary ( as.numeric ( res.dat.article.rosali.2.nodif [res.dat.article.rosali.2.nodif $ true.beta != 0 , ] $ abs.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 ) )
# 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
# 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
##########################
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 ) )
##########################
# ICC DIF
##########################
# DIF HOMOGENE
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N300/scenario_XA_300.csv" )
zaza0 <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza1 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
icc.tam.difh <- function ( x , items = 1 : x $ nitems , type = " expected" , TT = F ,
low = -4 , high = 4 , 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 ( ' #f7c611' , ' #61b5b7' , ' #ca346d' , ' #204776'
)
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 ( -3 , 3 , 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 ) )
if ( ! TT ) {
graphics :: plot ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , ylab = " Expected item response" ,
main = NULL ,
col = ' #204776' , ylim = ylim2 , xlim = c ( -4 , 4 ) , xlab = " " , ... )
} else {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , col = ' #ca346d' )
}
} 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
#*************************************************
}
pdf ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/icc_difh.pdf' )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.difh ( zaza0 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = F )
icc.tam.difh ( zaza1 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = T )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' A \n \n ' , font.main = 2 )
arrows ( x0 = -3.65 , x1 = -4 , y0 = -0.55 , length = 0.15 , lwd = 2 )
arrows ( x0 = 3.65 , x1 = 4 , y0 = -0.55 , length = 0.15 , lwd = 2 )
text ( x = -3.55 , y = -0.55 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 3.5 , y = -0.55 , " Better\nmental\nhealth" , adj = 1 )
arrows ( x1 = -.65 , x0 = .15 , y0 = 1.5 , length = 0.15 , lwd = 2 )
arrows ( x1 = -1.7 , x0 = -0.9 , y0 = .75 , length = 0.15 , lwd = 2 )
arrows ( x1 = 0.4 , x0 = 1.2 , y0 = 2.25 , length = 0.15 , lwd = 2 )
legend ( y = 0.5 , x = 1.5 , lty = c ( 1 , 1 ) , lwd = c ( 2 , 2 ) , col = c ( ' #204776' , ' #ca346d' ) , c ( " Control group" , " Treatment group" ) )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
# DIF CONVERGENT
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N300/scenario_YA_300.csv" )
zaza0 <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza1 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
pdf ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/icc_difnh1.pdf' )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.difh ( zaza0 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = F )
icc.tam.difh ( zaza1 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = T )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' B \n \n Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
arrows ( x0 = -3.65 , x1 = -4 , y0 = -0.55 , length = 0.15 , lwd = 2 )
arrows ( x0 = 3.65 , x1 = 4 , y0 = -0.55 , length = 0.15 , lwd = 2 )
text ( x = -3.55 , y = -0.55 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 3.5 , y = -0.55 , " Better\nmental\nhealth" , adj = 1 )
arrows ( x1 = -0.1 , x0 = 1.2 , y0 = 2.25 , length = 0.15 , lwd = 2 )
arrows ( x1 = -.9 , x0 = .15 , y0 = 1.5 , length = 0.15 , lwd = 2 )
arrows ( x1 = -1.65 , x0 = -0.9 , y0 = .75 , length = 0.15 , lwd = 2 )
legend ( y = 0.5 , x = 1.5 , lty = c ( 1 , 1 ) , lwd = c ( 2 , 2 ) , col = c ( ' #204776' , ' #ca346d' ) , c ( " Control group" , " Treatment group" ) )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
# DIF DIVERGENT
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N300/scenario_ZA_300.csv" )
zaza0 <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza1 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
pdf ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PDF/icc_difnh2.pdf' )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.difh ( zaza0 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = F )
icc.tam.difh ( zaza1 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = T )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' C \n \n ' , font.main = 2 )
arrows ( x0 = -3.65 , x1 = -4 , y0 = -0.55 , length = 0.15 , lwd = 2 )
arrows ( x0 = 3.65 , x1 = 4 , y0 = -0.55 , length = 0.15 , lwd = 2 )
text ( x = -3.55 , y = -0.55 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 3.5 , y = -0.55 , " Better\nmental\nhealth" , adj = 1 )
legend ( y = 0.5 , x = 1.5 , lty = c ( 1 , 1 ) , lwd = c ( 2 , 2 ) , col = c ( ' #204776' , ' #ca346d' ) , c ( " Control group" , " Treatment group" ) )
arrows ( x1 = 1.9 , x0 = 1.4 , y0 = 2.25 , length = 0.15 , lwd = 2 )
arrows ( x1 = -1.4 , x0 = -.9 , y0 = 0.75 , length = 0.15 , lwd = 2 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
#### ICC DIF BASE
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N300/scenario_XB_300.csv" )
zaza <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza2 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
zaza3 <- tam.mml ( resp = zaz [ , paste0 ( " item" , 1 : 4 ) ] )
icc.tam <- function ( x , items = 1 : x $ nitems , type = " expected" , TT = F ,
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 ( -3 , 3 , 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 ) )
if ( TT == 0 ) {
graphics :: plot ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , ylab = " Expected item response" ,
main = NULL , xlab = " " ,
col = " #204776" , ylim = ylim2 , xlim = ... )
} else {
if ( TT == 1 ) {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , col = " #ca346d" )
} else {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 2 , las = 1 , col = " #999999" , lty = 2 )
}
}
} 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
#*************************************************
}
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/icc_beta.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam ( zaza , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 0 )
icc.tam ( zaza2 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 1 )
icc.tam ( zaza3 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 2 )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' A - Item Characteristic Curve \n Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
text ( x = -2.55 , y = -0.45 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.45 , " Better\nmental\nhealth" , adj = 1 )
arrows ( x0 = 0.175 , x1 = -0.175 , y0 = 1.5 , length = 0.15 , lwd = 2 , col = " black" )
text ( x = 0.05 , y = 1.575 , " DIF" , col = " black" )
legend ( y = 3 , x = -3 , lty = c ( 1 , 1 , 2 ) , lwd = c ( 2 , 2 , 2 ) , col = c ( ' #204776' , ' #ca346d' , " #999999" ) , c ( " Control group" , " Treatment group" , " True ICC" ) )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
icc.tam.2 <- function ( x , items = 1 : x $ nitems , type = " expected" , TT = F ,
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 ( ' #204776' , ' #ca346d'
)
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 ( -3 , 3 , 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 ) )
if ( TT == 0 ) {
graphics :: plot ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , ylab = " Expected item response" ,
main = NULL , xlab = " " ,
col = " #ca346d" , ylim = ylim2 , xlim = ... )
} else {
if ( TT == 1 ) {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 3 , las = 1 , col = " #204776" )
} else {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 2 , las = 1 , col = " #999999" , lty = 2 )
}
}
} 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
#*************************************************
}
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/icc_beta2.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.2 ( zaza , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 0 )
icc.tam.2 ( zaza2 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 1 )
icc.tam.2 ( zaza3 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 2 )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' A - Item Characteristic Curve \n Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
text ( x = -2.55 , y = -0.45 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.45 , " Better\nmental\nhealth" , adj = 1 )
arrows ( x1 = 0.175 , x0 = -0.175 , y0 = 1.5 , length = 0.15 , lwd = 2 , col = " black" )
text ( x = 0.05 , y = 1.575 , " DIF" , col = " black" )
legend ( y = 3 , x = -3 , lty = c ( 1 , 1 , 2 ) , lwd = c ( 2 , 2 , 2 ) , col = c ( ' #204776' , ' #ca346d' , " #999999" ) , c ( " Control group" , " Treatment group" , " True ICC" ) )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
#### Densité theta beta0
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/densite_theta_null.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
plot ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 0 , sd = 1 ) , type = " l" , lwd = 2 , col = " #204776" , axes = F ,
xlab = " " , ylab = " Probability density" )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' B - true vs. observed latent variable density \n Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 , line = 2.8 )
lines ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 0 , sd = 1 ) , type = " l" , lwd = 0.5 , col = " #ca346d" , lty = 1 )
text ( x = 0 , y = 0.4225 , expression ( beta == 0 ) , adj = 0.5 )
legend ( y = 0.38 , x = -3 , lty = c ( 1 , 1 , 2 , 2 ) , lwd = c ( 2 , 2 , 2 , 2 ) , cex = 1 , col = c ( ' #204776' , ' #ca346d' , ' #204776' , ' #ca346d' ) , c ( " Control group (true)" , " Treatment group (true)" , " Control group (observed)" , " Treatment group (observed)" ) )
lines ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 1 , sd = 1 ) , type = " l" , lwd = 2 , col = " #ca346d" , lty = 2 )
arrows ( x0 = 0 , x1 = 1 , y0 = .4125 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 0.5 , y = 0.425 , expression ( widehat ( beta ) > 0 ) , adj = 0.5 , col = " black" )
segments ( x0 = 0 , x1 = 0 , y0 = 0.4 , y1 = 0.4125 , lty = 3 , col = " black" )
segments ( x0 = 1 , x1 = 1 , y0 = 0.4 , y1 = 0.4125 , lty = 3 , col = " black" )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.05 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.05 , length = 0.15 , lwd = 2 )
text ( x = -2.55 , y = -0.05 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.05 , " Better\nmental\nhealth" , adj = 1 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
#### Densité theta mask
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/densite_theta_masks.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
plot ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 0 , sd = 1 ) , type = " l" , lwd = 2 , col = " #204776" , axes = F ,
xlab = " " , ylab = " Probability density" )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' B - true vs. observed latent variable density \n Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 , line = 3.4 )
lines ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 1 , sd = 1 ) , type = " l" , lwd = 2 , col = " #ca346d" , lty = 1 )
lines ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 0.5 , sd = 1 ) , type = " l" , lwd = 2 , col = " #ca346d" , lty = 2 )
arrows ( x0 = 0 , x1 = 1 , y0 = .4325 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 0.5 , y = 0.4425 , expression ( beta ) , adj = 0.5 )
segments ( x0 = 0 , x1 = 0 , y0 = 0.4 , y1 = 0.4325 , lty = 3 )
segments ( x0 = 1 , x1 = 1 , y0 = 0.4 , y1 = 0.4325 , lty = 3 )
arrows ( x0 = 1 , x1 = 0.51 , y0 = .415 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 0.75 , y = 0.4225 , " DIF" , adj = 0.5 , col = " black" )
segments ( x0 = 0.5 , x1 = 0.5 , y0 = 0.4 , y1 = .415 , lty = 3 , col = " black" )
arrows ( x0 = 0 , x1 = 0.49 , y0 = .405 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 0.25 , y = 0.4175 , expression ( widehat ( beta ) ) , adj = 0.5 , col = " black" )
segments ( x0 = 0 , x1 = 0 , y0 = 0.4 , y1 = .405 , lty = 3 , col = " black" )
segments ( x0 = 0.5 , x1 = 0.5 , y0 = 0.4 , y1 = .405 , lty = 3 , col = " black" )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
legend ( y = 0.38 , x = -3 , lty = c ( 1 , 1 , 2 , 2 ) , lwd = c ( 2 , 2 , 2 , 2 ) , cex = 1 , col = c ( ' #204776' , ' #ca346d' , ' #204776' , ' #ca346d' ) , c ( " Control group (true)" , " Treatment group (true)" , " Control group (observed)" , " Treatment group (observed)" ) )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.05 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.05 , length = 0.15 , lwd = 2 )
text ( x = -2.55 , y = -0.05 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.05 , " Better\nmental\nhealth" , adj = 1 )
par ( xpd = F )
dev.off ( )
#### Densité theta amplify
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/densite_theta_amplify.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
plot ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 0 , sd = 1 ) , type = " l" , lwd = 2 , col = " #204776" , axes = F ,
xlab = " " , ylab = " Probability density" )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' B - true vs. observed latent variable density \n Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 , line = 3.4 )
lines ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 1 , sd = 1 ) , type = " l" , lwd = 2 , col = " #ca346d" , lty = 1 )
lines ( seq ( -3 , 3 , 0.001 ) , dnorm ( seq ( -3 , 3 , 0.001 ) , mean = 1.5 , sd = 1 ) , type = " l" , lwd = 2 , col = " #ca346d" , lty = 2 )
arrows ( x0 = 0 , x1 = 0.98 , y0 = .4325 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 0.5 , y = 0.4425 , expression ( beta ) , adj = 0.5 )
segments ( x0 = 0 , x1 = 0 , y0 = 0.4 , y1 = 0.4325 , lty = 3 )
segments ( x0 = 1 , x1 = 1 , y0 = 0.4 , y1 = 0.4325 , lty = 3 )
arrows ( x0 = 1.02 , x1 = 1.5 , y0 = .4325 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 1.25 , y = 0.4425 , " DIF" , adj = 0.5 , col = " black" )
segments ( x0 = 1.5 , x1 = 1.5 , y0 = 0.4 , y1 = .4325 , lty = 3 , col = " black" )
arrows ( x0 = 0 , x1 = 1.5 , y0 = .41 , length = 0.1 , lwd = 2 , col = " black" )
text ( x = 0.75 , y = 0.4215 , expression ( widehat ( beta ) ) , adj = 0.5 , col = " black" )
segments ( x0 = 0 , x1 = 0 , y0 = 0.4 , y1 = .41 , lty = 3 , col = " black" )
segments ( x0 = 1.5 , x1 = 1.5 , y0 = 0.4 , y1 = .41 , lty = 3 , col = " black" )
legend ( y = 0.38 , x = -3 , lty = c ( 1 , 1 , 2 , 2 ) , lwd = c ( 2 , 2 , 2 , 2 ) , cex = 1 , col = c ( ' #204776' , ' #ca346d' , ' #204776' , ' #ca346d' ) , c ( " Control group (true)" , " Treatment group (true)" , " Control group (observed)" , " Treatment group (observed)" ) )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.05 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.05 , length = 0.15 , lwd = 2 )
text ( x = -2.55 , y = -0.05 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.05 , " Better\nmental\nhealth" , adj = 1 )
par ( xpd = F )
dev.off ( )
#### ICC DIF SUPPL RESIDIF 1
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N300/scenario_XB_300.csv" )
zaza <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza2 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
zaza3 <- tam.mml ( resp = zaz [ , paste0 ( " item" , 1 : 4 ) ] )
icc.tam.sup <- function ( x , items = 1 : x $ nitems , type = " expected" , TT = F ,
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 ( -3 , 3 , 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 ) )
if ( TT == 0 ) {
graphics :: plot ( theta , expScore [ , i ] -0.2 , type = " l" , lwd = 3 , las = 1 , ylab = " Expected item response" ,
main = NULL , xlab = " " ,
col = " #204776" , ylim = ylim2 , xlim = ... )
} else {
if ( TT == 1 ) {
lines ( theta , expScore [ , i ] +0.2 , type = " l" , lwd = 3 , las = 1 , col = " #ca346d" )
} else {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 2 , las = 1 , col = " #999999" , lty = 2 )
}
}
} 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
#*************************************************
}
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/icc_residif_1.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.sup ( zaza , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 0 )
icc.tam.sup ( zaza2 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 1 )
icc.tam.sup ( zaza3 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 2 )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = -2 , x1 = -2 , y1 = 0.375 , y0 = 0.575 , length = 0.15 , lwd = 2 , col = " #ca346d" )
arrows ( x0 = 0 , x1 = 0 , y1 = 1.6 , y0 = 1.8 , length = 0.15 , lwd = 2 , col = " #ca346d" )
arrows ( x0 = 2 , x1 = 2 , y1 = 2.7 , y0 = 2.9 , length = 0.15 , lwd = 2 , col = " #ca346d" )
text ( x = -2 , y = 0.725 , col = " #ca346d" , " -" , cex = 1.5 )
text ( x = 0 , y = 2.0 , col = " #ca346d" , " -" , cex = 1.5 )
text ( x = 2 , y = 3 , col = " #ca346d" , " -" , cex = 1.5 )
text ( x = -2 , y = 0.0 , col = " #204776" , " +" , cex = 1.5 )
text ( x = 0 , y = 0.975 , col = " #204776" , " +" , cex = 1.5 )
text ( x = 2 , y = 2.3 , col = " #204776" , " +" , cex = 1.5 )
arrows ( x0 = -2 , x1 = -2 , y1 = 0.305 , y0 = 0.105 , length = 0.15 , lwd = 2 , col = " #204776" )
arrows ( x0 = 0 , x1 = 0 , y1 = 1.4 , y0 = 1.2 , length = 0.15 , lwd = 2 , col = " #204776" )
arrows ( x0 = 2 , x1 = 2 , y1 = 2.625 , y0 = 2.425 , length = 0.15 , lwd = 2 , col = " #204776" )
text ( x = -2.55 , y = -0.45 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.45 , " Better\nmental\nhealth" , adj = 1 )
legend ( cex = 0.9 , y = 3 , x = -3 , lty = c ( 1 , 1 , 2 , NA , NA ) , lwd = c ( 2 , 2 , 2 , NA , NA ) , pch = c ( NA , NA , NA , NA , NA ) , col = c ( ' #204776' , ' #ca346d' , " #999999" , NA , NA ) , c ( " Control group ICC" , " Treatment group ICC" , " Overall ICC" , " Person-item residuals - Control" , " Person-item residuals - Treatment" ) )
par ( font = 5 )
legend ( cex = 0.9 , y = 3 , x = -3 , lty = c ( NA , NA , NA , NA , NA ) , lwd = c ( NA , NA , NA , NA , NA ) , pt.cex = c ( NA , NA , NA , 1.5 , 1.5 ) , pch = c ( NA , NA , NA , 174 , 174 ) , col = c ( NA , NA , NA , ' #204776' , ' #ca346d' ) , c ( NA , NA , NA , NA , NA ) , bty = " n" )
par ( font = 1 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
#### ICC DIF SUPPL RESIDIF 2
zaz <- read.csv ( " /home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N300/scenario_YA_300.csv" )
zaza <- tam.mml ( resp = zaz [zaz $ TT == 0 , paste0 ( " item" , 1 : 4 ) ] )
zaza2 <- tam.mml ( resp = zaz [zaz $ TT == 1 , paste0 ( " item" , 1 : 4 ) ] )
zaza3 <- tam.mml ( resp = zaz [ , paste0 ( " item" , 1 : 4 ) ] )
icc.tam.sup <- function ( x , items = 1 : x $ nitems , type = " expected" , TT = F ,
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 ( -3 , 3 , 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 ) )
if ( TT == 0 ) {
graphics :: plot ( theta , expScore [ , i ] -0.2 , type = " l" , lwd = 3 , las = 1 , ylab = " Expected item response" ,
main = NULL , xlab = " " ,
col = " #204776" , ylim = ylim2 , xlim = ... )
} else {
if ( TT == 1 ) {
lines ( theta , expScore [ , i ] +0.2 , type = " l" , lwd = 3 , las = 1 , col = " #ca346d" )
} else {
lines ( theta , expScore [ , i ] , type = " l" , lwd = 2 , las = 1 , col = " #999999" , lty = 2 )
}
}
} 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
#*************************************************
}
png ( file = ' /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Figures/PNG/icc_residif_2.png' , width = 800 , height = 800 )
par ( xpd = T , mar = c ( 6.1 , 5.1 , 7.6 , 2.1 ) )
icc.tam.sup ( zaza , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 0 )
icc.tam.sup ( zaza2 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 1 )
icc.tam.sup ( zaza3 , type = " expected" , export = F , package = " graphics" , items = 3 , axes = F , TT = 2 )
axis ( 1 )
axis ( 2 , las = 2 )
title ( main = ' Item: \n "Have you been able to enjoy your normal daily activities?" ' , font.main = 2 )
arrows ( x0 = -2.65 , x1 = -3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = 2.65 , x1 = 3 , y0 = -0.45 , length = 0.15 , lwd = 2 )
arrows ( x0 = -2 , x1 = -2 , y1 = 0.375 , y0 = 0.675 , length = 0.15 , lwd = 2 , col = " #ca346d" )
arrows ( x0 = 0 , x1 = 0 , y1 = 1.9 , y0 = 2.45 , length = 0.15 , lwd = 2 , col = " #ca346d" )
arrows ( x0 = 2 , x1 = 2 , y1 = 2.875 , y0 = 3.075 , length = 0.15 , lwd = 2 , col = " #ca346d" )
text ( x = -2 , y = 0.85 , col = " #ca346d" , " -" , cex = 1.5 )
text ( x = 0 , y = 2.65 , col = " #ca346d" , " -" , cex = 1.5 )
text ( x = 2 , y = 3.15 , col = " #ca346d" , " -" , cex = 1.5 )
text ( x = -2 , y = 0.0 , col = " #204776" , " +" , cex = 1.5 )
text ( x = 0 , y = 0.975 , col = " #204776" , " +" , cex = 1.5 )
text ( x = 2 , y = 2.3 , col = " #204776" , " +" , cex = 1.5 )
arrows ( x0 = -2 , x1 = -2 , y1 = 0.305 , y0 = 0.105 , length = 0.15 , lwd = 2 , col = " #204776" )
arrows ( x0 = 0 , x1 = 0 , y1 = 1.75 , y0 = 1.15 , length = 0.15 , lwd = 2 , col = " #204776" )
arrows ( x0 = 2 , x1 = 2 , y1 = 2.8 , y0 = 2.425 , length = 0.15 , lwd = 2 , col = " #204776" )
text ( x = -2.55 , y = -0.45 , " Worse\nmental\nhealth" , adj = 0 )
text ( x = 2.5 , y = -0.45 , " Better\nmental\nhealth" , adj = 1 )
legend ( cex = 0.8 , y = 3 , x = -3 , lty = c ( 1 , 1 , 2 , NA , NA ) , lwd = c ( 2 , 2 , 2 , NA , NA ) , pch = c ( NA , NA , NA , NA , NA ) , col = c ( ' #204776' , ' #ca346d' , " #999999" , NA , NA ) , c ( " Control group ICC" , " Treatment group ICC" , " Overall ICC" , " Person-item residuals - Control" , " Person-item residuals - Treatment" ) )
par ( font = 5 )
legend ( cex = 0.8 , y = 3 , x = -3 , lty = c ( NA , NA , NA , NA , NA ) , lwd = c ( NA , NA , NA , NA , NA ) , pt.cex = c ( NA , NA , NA , 1.5 , 1.5 ) , pch = c ( NA , NA , NA , 174 , 174 ) , col = c ( NA , NA , NA , ' #204776' , ' #ca346d' ) , c ( NA , NA , NA , NA , NA ) , bty = " n" )
par ( font = 1 )
title ( xlab = expression ( " Latent variable " * theta * " \n (mental health)" ) )
par ( xpd = F )
dev.off ( )
##########################
# DETECTION PERF NODIF
##########################
#### res.dat ROSALI
res.dat.sup.rosali <- res.dat.dif.rosali [ , c ( " N" , " J" , " eff.size" , " nb.dif" , " dif.size" ,
" prop.perfect" , " flexible.detect" , " moreflexible.detect" , " dif.detected" ) ]
colnames ( res.dat.sup.rosali ) [3 ] <- " true.beta"
colnames ( res.dat.sup.rosali ) [5 ] <- " true.gamma"
colnames ( res.dat.sup.rosali ) [6 ] <- " perfect"
colnames ( res.dat.sup.rosali ) [7 ] <- " flexible"
colnames ( res.dat.sup.rosali ) [8 ] <- " mostflexible"
res.dat.sup.rosali [res.dat.sup.rosali $ nb.dif == 0 , " true.gamma" ] <- NA
res.dat.sup.rosali [is.na ( res.dat.sup.rosali ) ] <- " "
res.dat.sup.rosali.w <- reshape ( res.dat.sup.rosali ,
direction = " wide" , idvar = c ( " J" , " true.beta" , " nb.dif" , ' true.gamma' ) , timevar = " N" )
res.dat.sup.rosali.nodif <- res.dat.sup.rosali.w [res.dat.sup.rosali.w $ nb.dif == 0 , ]
res.dat.sup.rosali.dif <- res.dat.sup.rosali.w [res.dat.sup.rosali.w $ nb.dif != 0 , ]
#### res.dat RESIDIF
res.dat.sup.residif <- res.dat.dif.resali [ , c ( " N" , " J" , " eff.size" , " nb.dif" , " dif.size" ,
" prop.perfect" , " flexible.detect" , " moreflexible.detect" , " dif.detected" ) ]
colnames ( res.dat.sup.residif ) [3 ] <- " true.beta"
colnames ( res.dat.sup.residif ) [5 ] <- " true.gamma"
colnames ( res.dat.sup.residif ) [6 ] <- " perfect"
colnames ( res.dat.sup.residif ) [7 ] <- " flexible"
colnames ( res.dat.sup.residif ) [8 ] <- " mostflexible"
res.dat.sup.residif [res.dat.sup.residif $ nb.dif == 0 , " true.gamma" ] <- NA
res.dat.sup.residif [is.na ( res.dat.sup.residif ) ] <- " "
res.dat.sup.residif.w <- reshape ( res.dat.sup.residif ,
direction = " wide" , idvar = c ( " J" , " true.beta" , " nb.dif" , ' true.gamma' ) , timevar = " N" )
res.dat.sup.residif.nodif <- res.dat.sup.residif.w [res.dat.sup.residif.w $ nb.dif == 0 , ]
res.dat.sup.residif.dif <- res.dat.sup.residif.w [res.dat.sup.residif.w $ nb.dif != 0 , ]
#### Sortie table nodif
write.csv ( cbind ( res.dat.sup.rosali.nodif [ , c ( 1 : 3 , 8 , 12 , 16 ) ] , res.dat.sup.residif.nodif [ , c ( 8 , 12 , 16 ) ] ) , " /home/corentin/Documents/These/Valorisation/Articles/Simulations 1/Tables/nodif_detect.csv" )
##########################
# DETECTION PERF DIF
##########################
