Modified RESALI version

RProject/.Rhistory

@@ -1,84 +1,3 @@
-resp <- df[,c(dif.items.list)]
-}
-}
-else {
-resp <- df[,c(nodif.items.list)]
-}
-print(grp)
-tam1 <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = model,est.variance = T,verbose=F)
-}
-}
-return(summary(tam1))
-}
-rosali(dat=dat,items=1:7,group="TT")
-rosali <- function(dat=NULL,items=NULL,group=NULL) {
-nbitems <- length(items)
-items2 <- items
-# Un seul groupe
-if (length(group)!=1) {
-stop('Only one variable can be used for the group option')
-}
-# Recoder groupe en 0/1
-dat[,group] <- as.factor(dat[,group])
-if (!(all(names(levels(dat[,group]))==c("0","1")))) {
-levels(dat[,group]) <- c("0","1")
-}
-dat[,group] <- as.numeric(dat[,group])
-model_a <- pcm(df=dat,items=items,group = group,dif.items = items)
-model_b <- pcm(df=dat,items=items,group = group,dif.items = NULL)
-return(c(model_a,model_b))
-}
-rosali(dat=dat,items=1:7,group="TT")
-rosali <- function(dat=NULL,items=NULL,group=NULL) {
-nbitems <- length(items)
-items2 <- items
-# Un seul groupe
-if (length(group)!=1) {
-stop('Only one variable can be used for the group option')
-}
-# Recoder groupe en 0/1
-dat[,group] <- as.factor(dat[,group])
-if (!(all(names(levels(dat[,group]))==c("0","1")))) {
-levels(dat[,group]) <- c("0","1")
-}
-dat[,group] <- as.numeric(dat[,group])-1
-model_a <- pcm(df=dat,items=items,group = group,dif.items = items)
-model_b <- pcm(df=dat,items=items,group = group,dif.items = NULL)
-return(c(model_a,model_b))
-}
-rosali(dat=dat,items=1:7,group="TT")
-## File Name: pcm.R
-## File version: 1.0
-#' @import TAM
-#' @export
-pcm <- function(df=NULL,items=NULL,group=NULL,model="PCM2",method="MML",dif.items=NULL) {
-# Prepare analysis
-if (is.null(items)) {
-nbitems <- sum(sapply(1:100,function(x) paste0('item',x)) %in% colnames(df))
-items <- paste0('item',seq(1,nbitems))
-resp <- df[,items]
-}
-else {
-nbitems <- length(items)
-resp <- df[,paste0("item",items)]
-}
-if (is.null(group)) {
-grp <- NULL
-}
-else {
-grp <- df[,group]
-df$grp <- grp
-if (!is.null(dif.items)) {
-for (i in dif.items) {
-df[,paste0('item',i,'_noTT')] <- NA
-df[,paste0('item',i,'_TT')] <- NA
-df[df$grp==0,paste0('item',i,'_noTT')] <- df[df$grp==0,paste0('item',i)]
-df[df$grp==1,paste0('item',i,'_TT')] <- df[df$grp==1,paste0('item',i)]
-}
-}
-}
-# Analyze
-if (method=='MML') {
 if (is.null(dif.items)) {
 tam1 <-  TAM::tam.mml(resp=resp,Y=grp,irtmodel = model,est.variance = T,verbose=F)
 }
@@ -510,3 +429,84 @@ return(difit)
 rosali(dat=dat,items=1:7,group="TT")
 pcm(dat,items=1:7,group="TT",dif.items=1:2)
 summary(pcm(dat,items=1:7,group="TT",dif.items=1:2))
+library(TAM)
+resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) {
+if (verbose) {
+cat('-----------------------------------------------------------\n')
+cat('COMPUTING INITIAL PCM\n')
+cat('-----------------------------------------------------------\n')
+}
+nbitems <- length(items)
+nbitems_o <- nbitems
+items_n <- paste0('item',items)
+resp <- df[,items_n]
+grp <- df[,group]
+pcm_initial <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F)
+dat <- df
+dat$score <- rowSums(dat[,items_n])
+dat$score_q5 <- cut(dat$score,quantile(dat$score,seq(0,1,0.2)),labels=1:5,include.lowest=T)
+res.anova <- rep(NA,nbitems)
+pval <- rep(NA,nbitems)
+fval <- rep(NA,nbitems)
+for (i in items) {
+dat[,paste0('res_',i)] <- rowMeans(predict(pcm_initial)$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')
+}
+res.items <- c()
+res.uniform <- c()
+k <- 1
+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("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 {
+cat("No DIF was detected")
+return(NULL)
+}
+}
+resali(df=dat,items=1:7,group="TT")
+dat$dif1
+dat$dif2
+dat$dif3

RProject/resali.R

@@ -0,0 +1,78 @@
+library(TAM)
+
+resali <- function(df=NULL,items=NULL,group=NULL,verbose=T) {
+  if (verbose) {
+  cat('-----------------------------------------------------------\n')
+  cat('COMPUTING INITIAL PCM\n')
+  cat('-----------------------------------------------------------\n')
+  }
+  nbitems <- length(items)
+  nbitems_o <- nbitems
+  items_n <- paste0('item',items)
+  resp <- df[,items_n]
+  grp <- df[,group]
+  pcm_initial <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F)
+  dat <- df
+  dat$score <- rowSums(dat[,items_n])
+  dat$score_q5 <- cut(dat$score,quantile(dat$score,seq(0,1,0.2)),labels=1:5,include.lowest=T)
+  res.anova <- rep(NA,nbitems)
+  pval <- rep(NA,nbitems)
+  fval <- rep(NA,nbitems)
+  for (i in items) {
+    dat[,paste0('res_',i)] <- rowMeans(predict(pcm_initial)$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')
+  }
+  res.items <- c()
+  res.uniform <- c()
+  k <- 1
+  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("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 {
+    cat("No DIF was detected")
+    return(NULL)
+  }
+}