Added shinyapp for results visualization
This commit is contained in:
@ -485,11 +485,21 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
beta.same.sign.truebeta.p <- ifelse(rep(eff.size,nrow(s))==0,NA,(rep(eff.size,nrow(s))/s$beta)>0)
|
||||
num.reject <- which((s$beta-1.96*s$se_beta)>0 | (s$beta+1.96*s$se_beta)<0)
|
||||
dif.d <- mean(sapply(1:1000,function(x) any(!is.na(s[x,paste0("dif_",1:unique(b$J),"_1")]))))
|
||||
if (nb.dif.true==0) {
|
||||
if (nb.dif.true==0 & unique(b$J)==4) {
|
||||
prop.perfect <- NA
|
||||
flexible.detect <- NA
|
||||
moreflexible.detect <- NA
|
||||
any.detect <- NA
|
||||
thay.tpr <- NA
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) sum( !is.na(s[x,paste0("dif_detect_",1:4)]) )/4 ))
|
||||
}
|
||||
if (nb.dif.true==0 & unique(b$J)==7) {
|
||||
prop.perfect <- NA
|
||||
flexible.detect <- NA
|
||||
moreflexible.detect <- NA
|
||||
any.detect <- NA
|
||||
thay.tpr <- NA
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) sum( !is.na(s[x,paste0("dif_detect_",1:7)]) )/7 ))
|
||||
}
|
||||
if (nb.dif.true==1 & unique(b$J)==4 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==1,s[x,"dif_detect_unif_1"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1")])
|
||||
@ -501,6 +511,8 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
moreflexible.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
moreflexible.detect <- mean(moreflexible.detect)
|
||||
any.detect <- moreflexible.detect
|
||||
thay.tpr <- moreflexible.detect
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])!=s[x,"real_dif_1"],na.rm=F)/4,0) ))
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==4 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==2,s[x,"dif_detect_unif_1"]==1 & s[x,"dif_detect_unif_2"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2")])
|
||||
@ -515,6 +527,9 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/4,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==7 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))==2,s[x,"dif_detect_unif_1"]==1 & s[x,"dif_detect_unif_2"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2")])
|
||||
@ -529,6 +544,9 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==3 & unique(b$J)==7 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))==3,s[x,"dif_detect_unif_1"]==1 & s[x,"dif_detect_unif_2"]==1 & s[x,"dif_detect_unif_3"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[3])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")])
|
||||
@ -543,6 +561,9 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]) | s[x,"real_dif_3"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"]),na.rm=F)/3,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==1 & unique(b$J)==4 & unique(b$M)==2) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==1, s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1")])
|
||||
@ -552,6 +573,8 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
moreflexible.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
moreflexible.detect <- mean(moreflexible.detect)
|
||||
any.detect <- moreflexible.detect
|
||||
thay.tpr <- moreflexible.detect
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])!=s[x,"real_dif_1"],na.rm=F)/4,0) ))
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==4 & unique(b$M)==2) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==2,s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2")])
|
||||
@ -564,6 +587,8 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/4,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==7 & unique(b$M)==2) {
|
||||
@ -577,6 +602,9 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==3 & unique(b$J)==7 & unique(b$M)==2) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))==3,s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[3])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")])
|
||||
@ -589,6 +617,9 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]) | s[x,"real_dif_3"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"]),na.rm=F)/3,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
z <- data.frame(m.beta=mean(s$beta),
|
||||
se.empirical.beta=sd(s$beta),
|
||||
@ -603,7 +634,9 @@ compile_simulation2_rosali <- function(scenario) {
|
||||
prop.perfect=prop.perfect,
|
||||
flexible.detect=flexible.detect,
|
||||
moreflexible.detect=moreflexible.detect,
|
||||
any.detect=any.detect
|
||||
any.detect=any.detect,
|
||||
thay.tpr=thay.tpr,
|
||||
thay.fpr=thay.fpr
|
||||
)
|
||||
d <- cbind(b,a,z)
|
||||
d$prop.
|
||||
@ -724,11 +757,21 @@ compile_simulation2_resali <- function(scenario) {
|
||||
beta.same.sign.truebeta.p <- ifelse(rep(eff.size,nrow(s))==0,NA,(rep(eff.size,nrow(s))/s$beta)>0)
|
||||
num.reject <- which((s$beta-1.96*s$se_beta)>0 | (s$beta+1.96*s$se_beta)<0)
|
||||
dif.d <- mean(sapply(1:1000,function(x) any(!is.na(s[x,paste0("dif_",1:unique(b$J),"_1")]))))
|
||||
if (nb.dif.true==0) {
|
||||
if (nb.dif.true==0 & unique(b$J)==4) {
|
||||
prop.perfect <- NA
|
||||
flexible.detect <- NA
|
||||
moreflexible.detect <- NA
|
||||
any.detect <- NA
|
||||
thay.tpr <- NA
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) sum( !is.na(s[x,paste0("dif_detect_",1:4)]) )/4 ))
|
||||
}
|
||||
if (nb.dif.true==0 & unique(b$J)==7) {
|
||||
prop.perfect <- NA
|
||||
flexible.detect <- NA
|
||||
moreflexible.detect <- NA
|
||||
any.detect <- NA
|
||||
thay.tpr <- NA
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) sum( !is.na(s[x,paste0("dif_detect_",1:7)]) )/7 ))
|
||||
}
|
||||
if (nb.dif.true==1 & unique(b$J)==4 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==1,s[x,"dif_detect_unif_1"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1")])
|
||||
@ -740,6 +783,8 @@ compile_simulation2_resali <- function(scenario) {
|
||||
moreflexible.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
moreflexible.detect <- mean(moreflexible.detect)
|
||||
any.detect <- moreflexible.detect
|
||||
thay.tpr <- moreflexible.detect
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])!=s[x,"real_dif_1"],na.rm=F)/4,0) ))
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==4 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==2,s[x,"dif_detect_unif_1"]==1 & s[x,"dif_detect_unif_2"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2")])
|
||||
@ -754,6 +799,9 @@ compile_simulation2_resali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/4,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==7 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))==2,s[x,"dif_detect_unif_1"]==1 & s[x,"dif_detect_unif_2"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2")])
|
||||
@ -768,6 +816,9 @@ compile_simulation2_resali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==3 & unique(b$J)==7 & unique(b$M)==4) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))==3,s[x,"dif_detect_unif_1"]==1 & s[x,"dif_detect_unif_2"]==1 & s[x,"dif_detect_unif_3"]==1 & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[3])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")])
|
||||
@ -782,6 +833,9 @@ compile_simulation2_resali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]) | s[x,"real_dif_3"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"]),na.rm=F)/3,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==1 & unique(b$J)==4 & unique(b$M)==2) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==1, s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1")])
|
||||
@ -791,6 +845,8 @@ compile_simulation2_resali <- function(scenario) {
|
||||
moreflexible.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
moreflexible.detect <- mean(moreflexible.detect)
|
||||
any.detect <- moreflexible.detect
|
||||
thay.tpr <- moreflexible.detect
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])!=s[x,"real_dif_1"],na.rm=F)/4,0) ))
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==4 & unique(b$M)==2) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))==2,s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:4),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2")])
|
||||
@ -803,6 +859,8 @@ compile_simulation2_resali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:4)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:4)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:4)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:4)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/4,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==2 & unique(b$J)==7 & unique(b$M)==2) {
|
||||
@ -816,6 +874,9 @@ compile_simulation2_resali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"]),na.rm=F)/2,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
if (nb.dif.true==3 & unique(b$J)==7 & unique(b$M)==2) {
|
||||
perfect.detection <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))==3,s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[1])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[2])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")]) & s[x,paste0('dif_detect_',which(sapply(paste0("dif_detect_",1:7),function(y) !is.na(s[x,y])))[3])]%in%c(s[x,c("real_dif_1","real_dif_2","real_dif_3")])
|
||||
@ -828,6 +889,9 @@ compile_simulation2_resali <- function(scenario) {
|
||||
any.detect <- sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,s[x,"real_dif_1"]%in%c(s[x,paste0("dif_detect_",1:7)]) |
|
||||
s[x,"real_dif_2"]%in%c(s[x,paste0("dif_detect_",1:7)]) | s[x,"real_dif_3"]%in%c(s[x,paste0("dif_detect_",1:7)]),0) )
|
||||
any.detect <- mean(any.detect)
|
||||
thay.tpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"]),na.rm=F)/3,0) ))
|
||||
thay.fpr <- mean(sapply(1:1000,function(x) ifelse(sum(!is.na(s[x,paste0("dif_detect_",1:7)]))!=0,sum(!(unlist(s[x,paste0("dif_detect_",1:7)])%in%c(s[x,"real_dif_1"],s[x,"real_dif_2"],s[x,"real_dif_3"])),na.rm=F)/7,0) ))
|
||||
|
||||
}
|
||||
z <- data.frame(m.beta=mean(s$beta),
|
||||
se.empirical.beta=sd(s$beta),
|
||||
@ -862,32 +926,6 @@ for (x in results[seq(2,length(results))]) {
|
||||
res.dat.dif.resali$bias <- res.dat.dif.resali$eff.size-res.dat.dif.resali$m.beta
|
||||
|
||||
|
||||
##############################################################################
|
||||
#----------------------------------------------------------------------------#
|
||||
######################### AGGREGATION OF ALL METHODS #########################
|
||||
#----------------------------------------------------------------------------#
|
||||
##############################################################################
|
||||
|
||||
# Items dichotomiques
|
||||
|
||||
res.dat$method <- "NONE"
|
||||
res.dat.dif$method <- "PERFECT"
|
||||
res.dat.dif.rosali$method <- "ROSALI"
|
||||
res.dat.dif.resali$method <- "RESIDUS"
|
||||
|
||||
res.dat.dicho <- res.dat[res.dat$M==2,]
|
||||
res.dat.dicho <- rbind(res.dat.dicho,res.dat.dif[res.dat.dif$M==2,])
|
||||
res.dat.dicho <- rbind.fill(res.dat.dicho,res.dat.dif.rosali[res.dat.dif.rosali$M==2,])
|
||||
res.dat.dicho <- rbind(res.dat.dicho,res.dat.dif.rosali[res.dat.dif.resali$M==2,])
|
||||
|
||||
# Items polytomiques
|
||||
|
||||
res.dat.poly <- res.dat[res.dat$M==4,]
|
||||
res.dat.poly <- rbind(res.dat.poly,res.dat.dif[res.dat.dif$M==4,])
|
||||
res.dat.poly <- rbind.fill(res.dat.poly,res.dat.dif.rosali[res.dat.dif.rosali$M==4,])
|
||||
res.dat.poly <- rbind(res.dat.poly,res.dat.dif.rosali[res.dat.dif.resali$M==4,])
|
||||
|
||||
|
||||
|
||||
##############################################################################
|
||||
#----------------------------------------------------------------------------#
|
||||
@ -1139,4 +1177,42 @@ res.dat[res.dat$scenario %in% paste0(4,'E') & res.dat$N==50,]$theoretical.power
|
||||
|
||||
### DIF scenarios
|
||||
|
||||
res.dat.dif$theoretical.power <- res.dat[81:nrow(res.dat),]$theoretical.power
|
||||
res.dat.dif$theoretical.power <- res.dat[81:nrow(res.dat),]$theoretical.power
|
||||
res.dat.dif.rosali$theoretical.power <- res.dat$theoretical.power
|
||||
res.dat.dif.resali$theoretical.power <- res.dat$theoretical.power
|
||||
|
||||
|
||||
##############################################################################
|
||||
#----------------------------------------------------------------------------#
|
||||
######################### AGGREGATION OF ALL METHODS #########################
|
||||
#----------------------------------------------------------------------------#
|
||||
##############################################################################
|
||||
|
||||
|
||||
|
||||
# Correction of N=50 scenarios
|
||||
|
||||
res.dat[res.dat$N==50,]$dif.size <- sapply(which(res.dat$N==50),function(k) res.dat[k-1,]$dif.size)
|
||||
res.dat.dif[res.dat.dif$N==50,]$dif.size <- sapply(which(res.dat.dif$N==50),function(k) res.dat.dif[k-1,]$dif.size)
|
||||
res.dat.dif.rosali[res.dat.dif.rosali$N==50,]$dif.size <- sapply(which(res.dat.dif.rosali$N==50),function(k) res.dat.dif.rosali[k-1,]$dif.size)
|
||||
res.dat.dif.resali[res.dat.dif.resali$N==50,]$dif.size <- sapply(which(res.dat.dif.resali$N==50),function(k) res.dat.dif.resali[k-1,]$dif.size)
|
||||
|
||||
|
||||
# Items dichotomiques
|
||||
|
||||
res.dat$method <- "NONE"
|
||||
res.dat.dif$method <- "PERFECT"
|
||||
res.dat.dif.rosali$method <- "ROSALI"
|
||||
res.dat.dif.resali$method <- "RESIDUS"
|
||||
|
||||
res.dat.dicho <- res.dat[res.dat$M==2,]
|
||||
res.dat.dicho <- rbind(res.dat.dicho,res.dat.dif[res.dat.dif$M==2,])
|
||||
res.dat.dicho <- rbind.fill(res.dat.dicho,res.dat.dif.rosali[res.dat.dif.rosali$M==2,])
|
||||
res.dat.dicho <- rbind(res.dat.dicho,res.dat.dif.rosali[res.dat.dif.resali$M==2,])
|
||||
|
||||
# Items polytomiques
|
||||
|
||||
res.dat.poly <- res.dat[res.dat$M==4,]
|
||||
res.dat.poly <- rbind(res.dat.poly,res.dat.dif[res.dat.dif$M==4,])
|
||||
res.dat.poly <- rbind.fill(res.dat.poly,res.dat.dif.rosali[res.dat.dif.rosali$M==4,])
|
||||
res.dat.poly <- rbind(res.dat.poly,res.dat.dif.rosali[res.dat.dif.resali$M==4,])
|
||||
|
||||
Reference in New Issue
Block a user