corentinchoisy/simul_these
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Modified RESALI version

Browse Source
This commit is contained in:
Corentin Choisy
2024-04-02 14:36:17 +02:00
parent a2fec9c87d
commit 13d80a3e74
3 changed files with 159 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
RProject/.RData
View File

Binary file not shown.

162
RProject/.Rhistory
View File

@ -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

78
RProject/resali.R Normal file
View File

@ -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)
}
}