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

corrected warnings

Browse Source
This commit is contained in:
Corentin Choisy
2025-06-03 15:50:13 +02:00
parent 873020b813
commit 66a3500d44
1 changed files with 18 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
R/pcm.R
View File

@ -43,11 +43,13 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
if (!("id"%in%colnames(df))) {
stop('ERROR: no column named id provided')
}
if (!is.null(grp) & any(apply(df[df[,grp]==0,items],2,max)<max(df[,items])) | any(apply(df[df[,grp]==1,items],2,max)<max(df[,items])) ) {
suppressWarnings(
if (!is.null(grp) & any(apply(df[df[,grp]==0,items],2,function(k) max(k,na.rm = T))<max(df[,items],na.rm = T)) | any(apply(df[df[,grp]==1,items],2,function(k) max(k,na.rm = T))<max(df[,items],na.rm=T)) ) {
if (fit=="ucminf") {
fit <- "optim"
}
}
)
##### Analysis
restab.diftype <- NULL
se.beta <- NULL
@ -79,12 +81,12 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
if (is.null(weights)) {
colnames(df.long) <- c("id","item","resp")
nbitems <- length(2:(length(colnames(df))))
maxmod <- max(df[,2:(length(colnames(df)))])
maxmod <- max(df[,2:(length(colnames(df)))],na.rm = T)
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)])
maxmod <- max(df[,2:(length(colnames(df))-1)],na.rm = T)
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)
@ -128,12 +130,12 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
if (is.null(weights)) {
colnames(df.long) <- c("id","grp","item","resp")
nbitems <- length(2:(length(colnames(df))-1))
maxmod <- max(df[,2:(length(colnames(df))-1)])
maxmod <- max(df[,2:(length(colnames(df))-1)],na.rm = T)
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)])
maxmod <- max(df[,2:(length(colnames(df))-2)],na.rm = T)
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)
@ -230,12 +232,12 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
if (is.null(weights)) {
colnames(df.long) <- c("id","grp","item","resp")
nbitems <- length(2:(length(colnames(df))-1))
maxmod <- max(df[,2:(length(colnames(df))-1)])
maxmod <- max(df[,2:(length(colnames(df))-1)],na.rm = T)
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)])
maxmod <- max(df[,2:(length(colnames(df))-2)],na.rm = T)
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)
@ -268,6 +270,7 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
}
}
if (is.null(grpo)) {
if (method.theta=="eap") {
theta <- c(-1*ranef(mod,norm=F)+ ifelse(is.null(grpo),0, ifelse(grp==1,beta,0) ) )
} else if (method.theta=="wle") {
@ -275,6 +278,8 @@ pcm <- function(df=NULL,items=NULL,grp=NULL,dif.items=NULL,type.dif=NULL,weights
} 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) resi(theta[j],restab[k,],df[j,items[k]],beta=0)))
colnames(resid) <- items_o