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

Added weighting option to pcm

Browse Source
This commit is contained in:
Corentin Choisy
2025-05-26 14:30:47 +02:00
parent 1dc42a2708
commit 983a095097
2 changed files with 35 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
R/pcm.R
View File

@ -10,6 +10,7 @@
#' @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 weights string containing the name of the column where optional weights are stored in df
#' @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"
@ -18,7 +19,7 @@
#' @import PP
#' @export
pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose=T,fit="ucminf",method.theta="eap") {
pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights=NULL,verbose=T,fit="ucminf",method.theta="eap") {
##### Detecting errors
if (any(!(items %in% colnames(df)))) {
@ -69,14 +70,22 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose
print(df)
colnames(df)[2:(length(colnames(df)))] <- paste0("item",seq(1,length(colnames(df))-1))
df.long <- reshape(df,v.names=c("item"),direction="long",varying=c(items))
colnames(df.long) <- c("id","item","resp")
if (is.null(weights)) {
colnames(df.long) <- c("id","item","resp")
} else {
colnames(df.long) <- c("id","item","resp","weights")
}
nbitems <- length(2:(length(colnames(df))))
maxmod <- max(df[,2:(length(colnames(df)))])
df.long$item <- factor(df.long$item,levels=seq(1,length(colnames(df))-1),ordered = F)
df.long$resp <- factor(df.long$resp,0:maxmod,ordered=T)
df.long$id <- factor(df.long$id)
# fit pcm
mod <- olmm(resp ~ 0 + ce(item) + re(0|id),data=df.long,family = adjacent(link = "logit"))
if (is.null(weights)) {
mod <- olmm(resp ~ 0 + ce(item) + re(0|id),data=df.long,family = adjacent(link = "logit"))
} else {
mod <- olmm(resp ~ 0 + ce(item) + re(0|id),data=df.long,family = adjacent(link = "logit"),weights = df.long$weights)
}
comod <- coef(mod)
# output results
restab <- t(sapply(1:nbitems,function(x) comod[seq(x,length(comod)-1,nbitems)]))
@ -102,7 +111,11 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose
df <- df[,c('id',items,"grp")]
colnames(df)[2:(length(colnames(df))-1)] <- paste0("item",seq(1,length(colnames(df))-2))
df.long <- reshape(df,v.names=c("item"),direction="long",varying=c(items))
colnames(df.long) <- c("id","grp","item","resp")
if (is.null(weights)) {
colnames(df.long) <- c("id","grp","item","resp")
} else {
colnames(df.long) <- c("id","grp","item","resp","weights")
}
nbitems <- length(2:(length(colnames(df))-1))
maxmod <- max(df[,2:(length(colnames(df))-1)])
df.long$item <- factor(df.long$item,levels=seq(1,length(colnames(df))-2),ordered = F)
@ -119,7 +132,11 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose
# fit pcm
formudif <- paste0("resp ~ 0 + ge(grp",ifelse(length(difvar.unif>0),"+",""),ifelse(length(difvar.unif>0),paste0(difvar.unif,":grp",collapse="+"),""),")+ce(item",ifelse(length(difvar.nonunif>0),"+",""),ifelse(length(difvar.nonunif)>0,paste0(difvar.nonunif,":grp",collapse="+"),""),")+re(0|id)")
formudif <- as.formula(formudif)
mod <- olmm(formudif,data=df.long,family = adjacent(link = "logit"),control=olmm_control(fit=fit))
if (is.null(weights)) {
mod <- olmm(formudif,data=df.long,family = adjacent(link = "logit"),control=olmm_control(fit=fit))
} else {
mod <- olmm(formudif,data=df.long,family = adjacent(link = "logit"),control=olmm_control(fit=fit),weights = df.long$weights)
}
comod <- coef(mod)
# output results
nbcoef <- nbitems+length(difvar.nonunif)
@ -183,14 +200,22 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,verbose
df <- df[,c('id',items,"grp")]
colnames(df)[2:(length(colnames(df))-1)] <- paste0("item",seq(1,length(colnames(df))-2))
df.long <- reshape(df,v.names=c("item"),direction="long",varying=c(items))
colnames(df.long) <- c("id","grp","item","resp")
if (is.null(weights)) {
colnames(df.long) <- c("id","grp","item","resp")
} else {
colnames(df.long) <- c("id","grp","item","resp","weights")
}
nbitems <- length(2:(length(colnames(df))-1))
maxmod <- max(df[,2:(length(colnames(df))-1)])
df.long$item <- factor(df.long$item,levels=seq(1,length(colnames(df))-2),ordered = F)
df.long$resp <- factor(df.long$resp,0:maxmod,ordered=T)
df.long$id <- factor(df.long$id)
# fit pcm
mod <- olmm(resp ~ 0 + ge(grp) + ce(item) + re(0|id),data=df.long,family = adjacent(link = "logit"),control=olmm_control(fit=fit))
if (is.null(weights)) {
mod <- olmm(resp ~ 0 + ge(grp) + ce(item) + re(0|id),data=df.long,family = adjacent(link = "logit"),control=olmm_control(fit=fit))
} else {
mod <- olmm(resp ~ 0 + ge(grp) + ce(item) + re(0|id),data=df.long,family = adjacent(link = "logit"),control=olmm_control(fit=fit),weights=df.long$weights)
}
comod <- coef(mod)
# output results
restab <- t(sapply(1:nbitems,function(x) comod[seq(x,length(comod)-2,nbitems)]))

3
man/pcm.Rd
View File

@ -10,6 +10,7 @@ pcm(
grp = NULL,
dif.items = NULL,
type.dif = NULL,
weights = NULL,
verbose = T,
fit = "ucminf",
method.theta = "eap"
@ -26,6 +27,8 @@ pcm(
\item{type.dif}{vector containing DIF form for each item specified in dif.items. 1 is homogeneous DIF, 0 is heterogeneous DIF}
\item{weights}{string containing the name of the column where optional weights are stored in df}
\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}