Split-Half Reliabilitäten

TODO

• Was passiert bei nicht listwise deletion mit den Missings? (Markus)

• In Funktion einbauen (Yannick)

  • type = “all”
  • type = c(“sp”, “h”)
  • automatic = TRUE (oder als type)

• match.arg anschauen

• Neue Funktion, die automatische Auswahl trifft (Eric)

  • Auf Varianzgleichheit testen etc. (evtl. Argument zur Testauswahl)

• Alle Funktionen mit richtigen Argumenten fertig schreiben (Eva)

• Welche Formeln brauchen welche Parameter

• Prüfung einbauen, ob Argumente pn und qn benötigt (Eva)

Code

calc_test_parameters <- function(x, y, pn, qn, na.rm=FALSE) 
{
  if (length(x) != length(y))
    stop("x and y need to have the same length") 
  if (pn <= 0 | qn <= 0 | floor(pn) != pn | floor(qn) != qn)
    stop("qn and pn must be positive integers")

  # listwise deletion of NAs if prompted
  if (na.rm) {
      missall <- is.na(x) | is.na(y)
      x <- x[!missall]
      y <- y[!missall]
  }

  inp <- list(n = length(x),             
              s1 = sd(x),     # todo: na.rm?              
              s2 = sd(y),               
              s_diff = sd(x-y),            
              s_x = sd(x+y),           
              p = pn / (pn + qn),               
              q = qn / (pn + qn),          
              r12 = cor(x,y)) # na.rm?
  return(inp)
}

# reliability formulas
spearman_brown <- function(l) {
    (2 * l$r12)/(1 + l$r12)
}

horst <- function(l) {
    r12 <- l$r12
    p <- l$p
    q <- l$q
    squarert <- sqrt(r12^2 + 4 * p * q * (1 - r12^2))
    num <- r12 * (squarert - r12)
    den <- 2 * p * q * (1 - r12^2)
    num/den
}

# user function
rel_split_half <- function(x, y, pn, qn, na.rm = FALSE, type = "spearman") {
    par <- calc_test_parameters(x = x, y = y, pn = pn, qn = qn, na.rm = na.rm)
    if (type == "spearman") 
        res <- spearman_brown(par)
    if (type == "horst") 
        res <- horst(par)
    res
}

# examples example for same test length
x1 <- c(14, 12, 10, 10, 7, 10, 7, 8, 6, 5, 3, 1)
x2 <- c(15, 14, 11, 10, 12, 6, 8, 6, 7, 6, 3, 2)
pn <- 15
qn <- 15

rel_split_half(x1, x2, pn, qn, type = "spearman")

## [1] 0.9214

# example for unequal test length
x1 <- c(8, 9, 10, 15, 19, 11, 10, 6, 4, 12)
x2 <- c(2, 7, 6, 2, 10, 3, 7, 2, 6, 8)
pn <- 20
qn <- 10
rel_split_half(x1, x2, pn, qn, type = "horst")

## [1] 0.5766

TODO

flanagan <- function(r12, s1, s2) {
    num <- 4 * s1 * s2 * r12
    den <- s1^2 + s2^2 + 2 * s1 * s2 * r12
    rel <- num/den
    rel
}

rulon <- function(s_diff, s_x) {
    rel <- 1 - (s_diff^2/s_x^2)
    rel
}

raju <- function(s1, s2, p, q, s_x) {
    #TODO: nochmal die Formel checken: was ist s?
    rel <- (1/2 * p * q) * (1 - (s1^2 + s2^2/s_x^2))
    rel
}