From cd486059c11359514d33ee4eb9b59a3b9d0eb3ee Mon Sep 17 00:00:00 2001 From: corentinchoisy Date: Tue, 16 Apr 2024 17:06:38 +0200 Subject: [PATCH] Modified RESALI (Corrected score quantile calculation) --- Rproject/resali.R | 107 ++++++++++++++++++++++++---------------------- 1 file changed, 55 insertions(+), 52 deletions(-) diff --git a/Rproject/resali.R b/Rproject/resali.R index 304f32a..1cf0a42 100644 --- a/Rproject/resali.R +++ b/Rproject/resali.R @@ -2,9 +2,9 @@ library(TAM) resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) { if (verbose) { - cat('-----------------------------------------------------------\n') - cat('COMPUTING INITIAL PCM\n') - cat('-----------------------------------------------------------\n') + cat('-----------------------------------------------------------\n') + cat('COMPUTING INITIAL PCM\n') + cat('-----------------------------------------------------------\n') } nbitems <- length(items) nbitems_o <- nbitems @@ -15,6 +15,9 @@ resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) { dat <- df dat$score <- rowSums(dat[,items_n]) nqt <- ifelse(length(unique(quantile(dat$score,seq(0,1,0.2))))==6,5,length(unique(quantile(dat$score,seq(0,1,0.2))))-1) + while (length(unique(quantile(dat$score,seq(0,1,1/nqt))))!=nqt+1) { + nqt <- nqt-1 + } dat$score_q5 <- cut(dat$score,unique(quantile(dat$score,seq(0,1,1/nqt))),labels=1:nqt,include.lowest=T) res.anova <- rep(NA,nbitems) pval <- rep(NA,nbitems) @@ -26,8 +29,8 @@ resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) { fval[i] <- res.anova[[i]][1,'F value'] } if (verbose) { - cat('DONE\n') - cat('-----------------------------------------------------------\n') + cat('DONE\n') + cat('-----------------------------------------------------------\n') } res.items <- c() res.uniform <- c() @@ -35,8 +38,8 @@ resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) { while(any(pval<0.05/(nbitems_o*3))) { k <- k+1 if (verbose) { - cat(paste('COMPUTING STEP',k,'\n')) - cat('-----------------------------------------------------------\n') + cat(paste('COMPUTING STEP',k,'\n')) + cat('-----------------------------------------------------------\n') } res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)]) res.items <- c(res.items,res.item) @@ -59,13 +62,13 @@ resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) { fval[i] <- res.anova[[i]][1,'F value'] } if (verbose) { - cat('DONE\n') - cat('-----------------------------------------------------------\n') + cat('DONE\n') + cat('-----------------------------------------------------------\n') } } if (verbose) { - cat("DETECTED DIF ITEMS\n") - cat('-----------------------------------------------------------\n') + cat("DETECTED DIF ITEMS\n") + cat('-----------------------------------------------------------\n') } if (length(res.items>0)) { results <- data.frame(dif.items=res.items, @@ -211,52 +214,52 @@ resali_LRT <- function(df=NULL,items=NULL,group=NULL,verbose=T) { res.uniform <- c() k <- 1 if (anova(pcm_initial,pcm_alt)$p[1]<0.05) { - while(any(pval<0.05/nbitems_o)) { - k <- k+1 - if (verbose) { - cat(paste('COMPUTING STEP',k,'\n')) - cat('-----------------------------------------------------------\n') - } - res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)]) - res.items <- c(res.items,res.item) - res.uni <- res.anova[[which.max(fval)]][3,"Pr(>F)"]>0.05 - res.uniform <- c(res.uniform,res.uni) - items_n <- c(items_n[items_n!=paste0('item',res.item)],paste0("item",res.item,c("noTT","TT"))) - dat[,paste0("item",res.item,'TT')] <- dat[dat$TT==1,paste0('item',res.item)] - dat[,paste0("item",res.item,'noTT')] <- dat[dat$TT==0,paste0('item',res.item)] - resp <- dat[,items_n] - grp <- dat[,group] - pcm_while <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F) - nbitems <- length(items_n) - res.anova <- rep(NA,nbitems) - pval <- rep(NA,nbitems) - fval <- rep(NA,nbitems) - for (i in 1:nbitems) { - dat[,paste0('res_',i)] <- rowMeans(predict(pcm_while)$stand.resid[,,i]) - res.anova[i] <- summary(aov(dat[,paste0('res_',i)]~TT*score_q5,data=dat)) - pval[i] <- res.anova[[i]][1,"Pr(>F)"] - fval[i] <- res.anova[[i]][1,'F value'] + while(any(pval<0.05/nbitems_o)) { + k <- k+1 + if (verbose) { + cat(paste('COMPUTING STEP',k,'\n')) + cat('-----------------------------------------------------------\n') + } + res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)]) + res.items <- c(res.items,res.item) + res.uni <- res.anova[[which.max(fval)]][3,"Pr(>F)"]>0.05 + res.uniform <- c(res.uniform,res.uni) + items_n <- c(items_n[items_n!=paste0('item',res.item)],paste0("item",res.item,c("noTT","TT"))) + dat[,paste0("item",res.item,'TT')] <- dat[dat$TT==1,paste0('item',res.item)] + dat[,paste0("item",res.item,'noTT')] <- dat[dat$TT==0,paste0('item',res.item)] + resp <- dat[,items_n] + grp <- dat[,group] + pcm_while <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F) + nbitems <- length(items_n) + res.anova <- rep(NA,nbitems) + pval <- rep(NA,nbitems) + fval <- rep(NA,nbitems) + for (i in 1:nbitems) { + dat[,paste0('res_',i)] <- rowMeans(predict(pcm_while)$stand.resid[,,i]) + res.anova[i] <- summary(aov(dat[,paste0('res_',i)]~TT*score_q5,data=dat)) + pval[i] <- res.anova[[i]][1,"Pr(>F)"] + fval[i] <- res.anova[[i]][1,'F value'] + } + if (verbose) { + cat('DONE\n') + cat('-----------------------------------------------------------\n') + } } if (verbose) { - cat('DONE\n') + cat("DETECTED DIF ITEMS\n") cat('-----------------------------------------------------------\n') } - } - if (verbose) { - cat("DETECTED DIF ITEMS\n") - cat('-----------------------------------------------------------\n') - } - if (length(res.items>0)) { - results <- data.frame(dif.items=res.items, - uniform=1*res.uniform) - return(results) - } - else { - if (verbose) { - cat("No DIF was detected\n") + if (length(res.items>0)) { + results <- data.frame(dif.items=res.items, + uniform=1*res.uniform) + return(results) + } + else { + if (verbose) { + cat("No DIF was detected\n") + } + return(NULL) } - return(NULL) - } } else { if (verbose) {