Correted pcm weights
This commit is contained in:
54
R/pcm.R
54
R/pcm.R
@ -1,5 +1,5 @@
|
||||
## File Name: pcm.R
|
||||
## File version: 1.0
|
||||
## File version: 1.1
|
||||
|
||||
#' Compute Partial Credit Model (PCM) for polytomous and dichotomous items
|
||||
#'
|
||||
@ -10,7 +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 weights string containing the name of the column where an optional variable containing weights is 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"
|
||||
@ -19,6 +19,7 @@
|
||||
#' @import PP
|
||||
#' @export
|
||||
|
||||
|
||||
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
|
||||
|
||||
@ -68,20 +69,23 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
|
||||
# prepare data
|
||||
if (is.null(weights)) {
|
||||
df <- df[,c('id',items)]
|
||||
colnames(df)[2:(length(colnames(df)))] <- paste0("item",seq(1,length(colnames(df))-1))
|
||||
} else {
|
||||
df <- df[,c('id',items,weights)]
|
||||
colnames(df)[2:(length(colnames(df)-1))] <- paste0("item",seq(1,length(colnames(df))-1))
|
||||
}
|
||||
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))
|
||||
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)
|
||||
} else {
|
||||
colnames(df.long) <- c("id","weights","item","resp")
|
||||
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
|
||||
@ -114,19 +118,23 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
|
||||
# prepare data
|
||||
if (is.null(weights)) {
|
||||
df <- df[,c('id',items,"grp")]
|
||||
colnames(df)[2:(length(colnames(df))-1)] <- paste0("item",seq(1,length(colnames(df))-2))
|
||||
} else {
|
||||
df <- df[,c('id',items,"grp",weights)]
|
||||
colnames(df)[2:(length(colnames(df))-2)] <- paste0("item",seq(1,length(colnames(df))-3))
|
||||
}
|
||||
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))
|
||||
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)
|
||||
} else {
|
||||
colnames(df.long) <- c("id","grp","weights","item","resp")
|
||||
nbitems <- length(2:(length(colnames(df))-2))
|
||||
maxmod <- max(df[,2:(length(colnames(df))-2)])
|
||||
df.long$item <- factor(df.long$item,levels=seq(1,length(colnames(df))-3),ordered = F)
|
||||
}
|
||||
df.long$resp <- factor(df.long$resp,0:maxmod,ordered=T)
|
||||
df.long$id <- factor(df.long$id)
|
||||
|
||||
@ -148,7 +156,11 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
|
||||
comod <- coef(mod)
|
||||
# output results
|
||||
nbcoef <- nbitems+length(difvar.nonunif)
|
||||
if (is.null(weights)) {
|
||||
restab <- t(sapply(1:nbcoef,function(x) comod[seq(x,length(comod)-2-length(difvar.unif),nbitems+length(difvar.nonunif))]))
|
||||
} else {
|
||||
restab <- t(sapply(1:nbcoef,function(x) comod[seq(x,length(comod)-2-length(difvar.unif),nbitems+length(difvar.nonunif))]))
|
||||
}
|
||||
difcoef.unif <- NULL
|
||||
if (length(difvar.unif)>0) {
|
||||
difcoef.unif <- comod[(length(comod)-length(difvar.unif)):(length(comod)-1)]
|
||||
@ -207,19 +219,24 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
|
||||
# prepare data
|
||||
if (is.null(weights)) {
|
||||
df <- df[,c('id',items,"grp")]
|
||||
colnames(df)[2:(length(colnames(df))-1)] <- paste0("item",seq(1,length(colnames(df))-2))
|
||||
|
||||
} else {
|
||||
df <- df[,c('id',items,"grp",weights)]
|
||||
colnames(df)[2:(length(colnames(df))-2)] <- paste0("item",seq(1,length(colnames(df))-3))
|
||||
}
|
||||
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))
|
||||
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)
|
||||
} else {
|
||||
colnames(df.long) <- c("id","grp","weights","item","resp")
|
||||
nbitems <- length(2:(length(colnames(df))-2))
|
||||
maxmod <- max(df[,2:(length(colnames(df))-2)])
|
||||
df.long$item <- factor(df.long$item,levels=seq(1,length(colnames(df))-3),ordered = F)
|
||||
}
|
||||
df.long$resp <- factor(df.long$resp,0:maxmod,ordered=T)
|
||||
df.long$id <- factor(df.long$id)
|
||||
# fit pcm
|
||||
@ -230,7 +247,11 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
|
||||
}
|
||||
comod <- coef(mod)
|
||||
# output results
|
||||
if (is.null(weights)) {
|
||||
restab <- t(sapply(1:nbitems,function(x) comod[seq(x,length(comod)-2,nbitems)]))
|
||||
} else {
|
||||
restab <- t(sapply(1:nbitems,function(x) comod[seq(x,length(comod)-2,nbitems)]))
|
||||
}
|
||||
rownames(restab) <- items_o
|
||||
colnames(restab) <- paste0("delta_",1:maxmod)
|
||||
restab.dif <- NULL
|
||||
@ -278,6 +299,3 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
|
||||
)
|
||||
return(out)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
@ -27,7 +27,7 @@ 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{weights}{string containing the name of the column where an optional variable containing weights is stored in df}
|
||||
|
||||
\item{verbose}{set to TRUE to print a detailed output, FALSE otherwise}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user