You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
278 lines
9.5 KiB
R
278 lines
9.5 KiB
R
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])
|
|
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)
|
|
fval <- rep(NA,nbitems)
|
|
for (i in items) {
|
|
dat[,paste0('res_',i)] <- IRT.residuals(pcm_initial)$stand_residuals[,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*3))) {
|
|
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)] <- IRT.residuals(pcm_while)$stand_residuals[,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']
|
|
}
|
|
zz <- 0
|
|
for (name_i in items_n) {
|
|
zz <- zz+1
|
|
if (grepl("TT",name_i)) {
|
|
pval[zz] <- 1
|
|
fval[zz] <- 0
|
|
}
|
|
}
|
|
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 {
|
|
if (verbose) {
|
|
cat("No DIF was detected\n")
|
|
}
|
|
return(NULL)
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
resali_BF2 <- 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])
|
|
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)
|
|
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)
|
|
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+1))) {
|
|
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 {
|
|
if (verbose) {
|
|
cat("No DIF was detected\n")
|
|
}
|
|
return(NULL)
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
resali_LRT <- 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]
|
|
items_n_alt <- paste0(items_n,c("_TT","_noTT"))
|
|
for (i in items_n) {
|
|
df[df$TT==0,paste0(i,"_noTT")] <- df[df$TT==0,i]
|
|
df[df$TT==1,paste0(i,"_TT")] <- df[df$TT==1,i]
|
|
}
|
|
resp_alt <- df[,items_n_alt]
|
|
pcm_initial <- TAM::tam.mml(resp=resp,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F)
|
|
pcm_alt <- TAM::tam.mml(resp=resp_alt,Y=grp,irtmodel = "PCM",est.variance = T,verbose=F)
|
|
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)
|
|
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)
|
|
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
|
|
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']
|
|
}
|
|
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 {
|
|
if (verbose) {
|
|
cat("No DIF was detected\n")
|
|
}
|
|
return(NULL)
|
|
}
|
|
}
|
|
else {
|
|
if (verbose) {
|
|
cat("No DIF was detected\n")
|
|
}
|
|
return(NULL)
|
|
}
|
|
} |