corentinchoisy
/
ROSALI-SIM
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Modified RESALI (Corrected score quantile calculation)

Browse Source
main
Corentin Choisy 7 months ago
parent 635c7c081e
commit cd486059c1
1 changed files with 55 additions and 52 deletions
Show Stats Download Patch File Download Diff File

107
Rproject/resali.R
Unescape Escape View File

@ -2,9 +2,9 @@ library(TAM)
resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) { resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) {
if (verbose) { if (verbose) {
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
cat('COMPUTING INITIAL PCM\n') cat('COMPUTING INITIAL PCM\n')
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
nbitems <- length(items) nbitems <- length(items)
nbitems_o <- nbitems nbitems_o <- nbitems
@ -15,6 +15,9 @@ resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) {
dat <- df dat <- df
dat$score <- rowSums(dat[,items_n]) 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) 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) 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) res.anova <- rep(NA,nbitems)
pval <- 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'] fval[i] <- res.anova[[i]][1,'F value']
} }
if (verbose) { if (verbose) {
cat('DONE\n') cat('DONE\n')
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
res.items <- c() res.items <- c()
res.uniform <- 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))) { while(any(pval<0.05/(nbitems_o*3))) {
k <- k+1 k <- k+1
if (verbose) { if (verbose) {
cat(paste('COMPUTING STEP',k,'\n')) cat(paste('COMPUTING STEP',k,'\n'))
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)]) res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)])
res.items <- c(res.items,res.item) 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'] fval[i] <- res.anova[[i]][1,'F value']
} }
if (verbose) { if (verbose) {
cat('DONE\n') cat('DONE\n')
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
} }
if (verbose) { if (verbose) {
cat("DETECTED DIF ITEMS\n") cat("DETECTED DIF ITEMS\n")
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
if (length(res.items>0)) { if (length(res.items>0)) {
results <- data.frame(dif.items=res.items, 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() res.uniform <- c()
k <- 1 k <- 1
if (anova(pcm_initial,pcm_alt)$p[1]<0.05) { if (anova(pcm_initial,pcm_alt)$p[1]<0.05) {
while(any(pval<0.05/nbitems_o)) { while(any(pval<0.05/nbitems_o)) {
k <- k+1 k <- k+1
if (verbose) { if (verbose) {
cat(paste('COMPUTING STEP',k,'\n')) cat(paste('COMPUTING STEP',k,'\n'))
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)]) res.item <- gsub("[a-z]", "",colnames(resp)[which.max(fval)])
res.items <- c(res.items,res.item) res.items <- c(res.items,res.item)
res.uni <- res.anova[[which.max(fval)]][3,"Pr(>F)"]>0.05 res.uni <- res.anova[[which.max(fval)]][3,"Pr(>F)"]>0.05
res.uniform <- c(res.uniform,res.uni) 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"))) 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,'TT')] <- dat[dat$TT==1,paste0('item',res.item)]
dat[,paste0("item",res.item,'noTT')] <- dat[dat$TT==0,paste0('item',res.item)] dat[,paste0("item",res.item,'noTT')] <- dat[dat$TT==0,paste0('item',res.item)]
resp <- dat[,items_n] resp <- dat[,items_n]
grp <- dat[,group] grp <- dat[,group]
pcm_while <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F) pcm_while <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F)
nbitems <- length(items_n) nbitems <- length(items_n)
res.anova <- rep(NA,nbitems) res.anova <- rep(NA,nbitems)
pval <- rep(NA,nbitems) pval <- rep(NA,nbitems)
fval <- rep(NA,nbitems) fval <- rep(NA,nbitems)
for (i in 1:nbitems) { for (i in 1:nbitems) {
dat[,paste0('res_',i)] <- rowMeans(predict(pcm_while)$stand.resid[,,i]) 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)) res.anova[i] <- summary(aov(dat[,paste0('res_',i)]~TT*score_q5,data=dat))
pval[i] <- res.anova[[i]][1,"Pr(>F)"] pval[i] <- res.anova[[i]][1,"Pr(>F)"]
fval[i] <- res.anova[[i]][1,'F value'] fval[i] <- res.anova[[i]][1,'F value']
}
if (verbose) {
cat('DONE\n')
cat('-----------------------------------------------------------\n')
}
} }
if (verbose) { if (verbose) {
cat('DONE\n') cat("DETECTED DIF ITEMS\n")
cat('-----------------------------------------------------------\n') cat('-----------------------------------------------------------\n')
} }
} if (length(res.items>0)) {
if (verbose) { results <- data.frame(dif.items=res.items,
cat("DETECTED DIF ITEMS\n") uniform=1*res.uniform)
cat('-----------------------------------------------------------\n') return(results)
} }
if (length(res.items>0)) { else {
results <- data.frame(dif.items=res.items, if (verbose) {
uniform=1*res.uniform) cat("No DIF was detected\n")
return(results) }
} return(NULL)
else {
if (verbose) {
cat("No DIF was detected\n")
} }
return(NULL)
}
} }
else { else {
if (verbose) { if (verbose) {

Write Preview
Loading…
Cancel
Save