Added theta estimation methods

This commit is contained in:
2025-05-06 08:31:24 +02:00
parent a70686cae0
commit 28e43dee33
6 changed files with 34 additions and 8 deletions

View File

@ -14,4 +14,5 @@ RoxygenNote: 7.3.2
Imports:
vcrpart,
rjags,
dclone
dclone,
PP

View File

@ -4,6 +4,7 @@ export(bpcm)
export(pcm)
export(res_ij)
export(residif)
import(PP)
import(dclone)
import(rjags)
import(vcrpart)

14
R/pcm.R
View File

@ -10,11 +10,15 @@
#' @param grp string containing the name of the column where an optional group membership variable is stored in df
#' @param dif.items vector containing the list of indexes in "items" corresponding to dif items
#' @param type.dif vector containing DIF form for each item specified in dif.items. 1 is homogeneous DIF, 0 is heterogeneous DIF
#' @param verbose set to TRUE to print a detailed output, FALSE otherwise
#' @param fit string determining the optimization algorithm. Values "ucminf" or "nlminb" ar recommended
#' @param method.theta string determining the estimation method for individual latent variable values. Either "eap", "mle" or "wle"
#' @return A data.frame containing various model outputs
#' @import vcrpart
#' @import PP
#' @export
pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose=T,fit="ucminf") {
pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose=T,fit="ucminf",method.theta="eap") {
##### Detecting errors
if (any(!(items %in% colnames(df)))) {
@ -205,7 +209,13 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose
}
}
theta <- -1*ranef(mod,norm=F)+ifelse(grp==1,beta,0)
if (method.theta=="eap") {
theta <- c(-1*ranef(mod,norm=F)+ifelse(grp==1,beta,0))
} else if (method.theta=="wle") {
theta <- PP::PP_gpcm(as.matrix(df[,items]),t(restab),rep(1,length(items)))$resPP$resPP[,1]
} else if (method.theta=="mle") {
theta <- PP::PP_gpcm(as.matrix(df[,items]),t(restab),rep(1,length(items)),type="mle")$resPP$resPP[,1]
}
resid <- apply(matrix(1:nbitems,ncol=length(nbitems)),1, function(k) sapply(1:nrow(df), function(j) res_ij(theta[j],restab[k,],df[j,items[k]],beta=0)))
colnames(resid) <- items_o

View File

@ -8,11 +8,14 @@
#' @param df data.frame containing the data
#' @param items vector containing the names of columns where item responses are stored in df
#' @param grp vector containing the name of the column where an optional group membership variable is stored in df
#' @param method.theta string determining the estimation method for individual latent variable values. Either "eap", "mle" or "wle"
#' @param verbose set to TRUE to print a detailed output, FALSE otherwise
#' @return A data.frame containing a column listing the detected DIF item and another listing detected DIF forms
#' @import vcrpart
#' @import PP
#' @export
residif <- function(df=NULL,items=NULL,grp=NULL,verbose=T) {
residif <- function(df=NULL,items=NULL,grp=NULL,method.theta="eap",verbose=T) {
if (any(!(items %in% colnames(df)))) {
stop("ERROR: provided item name does not exist in df")
}
@ -37,7 +40,7 @@ residif <- function(df=NULL,items=NULL,grp=NULL,verbose=T) {
cat("#################################################################################################\n")
}
startt <- Sys.time()
pcm_initial <- pcm(df = df,items = items,grp = grp,verbose=F)
pcm_initial <- pcm(df = df,items = items,grp = grp,verbose=F,method.theta = method.theta)
dat <- df
dat$score <- rowSums(dat[,items])
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)
@ -73,7 +76,7 @@ residif <- function(df=NULL,items=NULL,grp=NULL,verbose=T) {
res.items <- c(res.items,res.item)
res.uni <- res.anova[[numitem]][3,"Pr(>F)"]>0.05
res.uniform <- c(res.uniform,res.uni)
pcm_while <- pcm(df = df,items = items,grp = grp,dif.items = res.items,type.dif = res.uniform,verbose=F)
pcm_while <- pcm(df = df,items = items,grp = grp,dif.items = res.items,type.dif = res.uniform,verbose=F,method.theta = method.theta)
res.anova <- rep(NA,nbitems)
pval <- rep(NA,nbitems_o)
fval <- rep(NA,nbitems_o)

View File

@ -11,7 +11,8 @@ pcm(
dif.items = NULL,
type.dif = NULL,
verbose = T,
fit = "ucminf"
fit = "ucminf",
method.theta = "eap"
)
}
\arguments{
@ -24,6 +25,12 @@ pcm(
\item{dif.items}{vector containing the list of indexes in "items" corresponding to dif items}
\item{type.dif}{vector containing DIF form for each item specified in dif.items. 1 is homogeneous DIF, 0 is heterogeneous DIF}
\item{verbose}{set to TRUE to print a detailed output, FALSE otherwise}
\item{fit}{string determining the optimization algorithm. Values "ucminf" or "nlminb" ar recommended}
\item{method.theta}{string determining the estimation method for individual latent variable values. Either "eap", "mle" or "wle"}
}
\value{
A data.frame containing various model outputs

View File

@ -4,7 +4,7 @@
\alias{residif}
\title{RESIDIF procedure for DIF detection as per Andrich and Hagquist (2015)}
\usage{
residif(df = NULL, items = NULL, grp = NULL, verbose = T)
residif(df = NULL, items = NULL, grp = NULL, method.theta = "eap", verbose = T)
}
\arguments{
\item{df}{data.frame containing the data}
@ -12,6 +12,10 @@ residif(df = NULL, items = NULL, grp = NULL, verbose = T)
\item{items}{vector containing the names of columns where item responses are stored in df}
\item{grp}{vector containing the name of the column where an optional group membership variable is stored in df}
\item{method.theta}{string determining the estimation method for individual latent variable values. Either "eap", "mle" or "wle"}
\item{verbose}{set to TRUE to print a detailed output, FALSE otherwise}
}
\value{
A data.frame containing a column listing the detected DIF item and another listing detected DIF forms