diff --git a/R/pcm.R b/R/pcm.R index d4d2b61..f96427b 100644 --- a/R/pcm.R +++ b/R/pcm.R @@ -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)])) diff --git a/man/pcm.Rd b/man/pcm.Rd index ec90d33..46b892b 100644 --- a/man/pcm.Rd +++ b/man/pcm.Rd @@ -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}