R/SepRel.R

In eRm: Extended Rasch Modeling

SepRel <- function (pobject){   # requires an object of class "ppar"
  if(!("ppar" %in% class(pobject))) stop('"pobject" must be of class "ppar"')

  # get person scores from theta table (which is generated by the person.parameter function)
  PersonScoresFull <- pobject[["theta.table"]][["Person Parameter"]]
  names(PersonScoresFull) <- rownames(pobject[["theta.table"]])
  PersonScoresFull <- PersonScoresFull[pobject[["theta.table"]][["Interpolated"]] == FALSE]  ## disregard full/0 responses
  PersonScores <- PersonScoresFull[complete.cases(PersonScoresFull)]
  # get standard errors 
  se_vec <- unlist(pobject[["se.theta"]])
  names(se_vec) <- gsub("NAgroup[0-9]+.", "", names(se_vec))
  ind <- match(names(PersonScores), names(se_vec))    ## put them in right order
  StandardErrors <- se_vec[ind]
  

  # ==============================
  # compute seperation reliability
  # ==============================

  # compute the Observed Variance (also known as Total Person Variability or Squared Standard Deviation)
  SSD.PersonScores <- var(PersonScores)

  # compute the Mean Square Measurement error (also known as Model Error variance)
  MSE <- sum((StandardErrors)^2) / length(StandardErrors)

  separation.reliability <- (SSD.PersonScores-MSE) / SSD.PersonScores

  # define the outcome of the function "SepRel" as an object of class "separation" 
  result <- structure(
    list(
      "sep.rel" = separation.reliability,
      "SSD.PS" = SSD.PersonScores,
      "MSE" = MSE
    ),
    class="eRm_SepRel"
  )

  return(result)

}



print.eRm_SepRel <- function(x, ...){
  if(interactive()) writeLines("")
  writeLines(paste0("Separation Reliability: ", round(x$sep.rel, 4L)))
  if(interactive()) writeLines("")
}



summary.eRm_SepRel <- function(object, ...){
  txt1 <- format(c(
    "Separation Reliability: ",
    "Observed Variance: ",
    "Mean Square Measurement Error: "
  ), justify = "right")
  
  txt2 <- c(
    " (Squared Standard Deviation)",
    " (Model Error Variance)"
  )
  
  if(interactive()) writeLines("")
    writeLines(paste0(txt1[1L], round(object$sep.rel, 4L)))
  writeLines("")
    writeLines(paste0(txt1[2L], round(object$SSD.PS, 4L), txt2[1L]))
    writeLines(paste0(txt1[3L], round(object$MSE, 4L), txt2[2L]))
  if(interactive()) writeLines("")
}