File: rostdeviance.r

package info (click to toggle)
r-cran-erm 1.0-1-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 2,152 kB
  • sloc: f90: 400; ansic: 103; makefile: 8
file content (26 lines) | stat: -rwxr-xr-x 1,158 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
rostdeviance <- function(object)
{
# Analysis of Deviance Table (Test against a saturated model)
# object... object of class ppar

#---------------saturated model---------------------
  X <- object$X
  N <- dim(X)[1]                     #number of subjects
  K <- dim(X)[2]                     #number of items
  x.ch <- apply(X,1,toString)        #response patters as string vectors
  nx <- as.vector(table(x.ch))       #pattern frequencies
  lsat <- sum(nx*(log(nx/N)))        #log-likelihood of saturated model (Rost, p.334)
  #npar.sat <- length(nx)
  npar.sat <- prod(apply(X, 2, max) + 1) - 1  #number of possible response patterns - 1
#------------end saturated model--------------------

  rv <- rowSums(X, na.rm = TRUE)                          #person raw scores
  lmml <- sum(table(rv)*log(table(rv)/N))+object$loglik.cml   #MML likelihood
  npar.mml <- dim(object$W)[2]        #+ length(table(rv)) ... not sure about that
  
  dev <- -2*(lmml - lsat)             #deviance
  df.chi <- npar.sat - npar.mml
  p.value <- 1-pchisq(dev,df.chi)
  result <- list(value = dev, df = df.chi, p.value = p.value)
  return(result)
}