tests/testthat/test-bias.R

In Durga: Effect Size Estimation and Visualisation

# Test bias correction


# Exact method bias correction as described by Hedges (fails for large DF)
HedgesBiasCorrectExact <- function(df) {
  gamma(df / 2) / (sqrt(df / 2) * gamma((df - 1) / 2))
}

# Some debugging stuff that isn't part of the test suite
# microbenchmark::microbenchmark(esBiasCorrectExact(10), esBiasCorrectApprox(10), times = 10000)

test_that("bias correction", {

  dfs <- seq(2, 100, length = 30)

  # Compare my exact method with that in package effectsize
  expect_equal(esBiasCorrectExact(dfs), HedgesBiasCorrectExact(dfs))

  # Compare exact method with Hedges' approximation
  for (df in dfs) {
    # Check approximation is with tolerance described by Hedges. I have slightly increased the tolerance values from those specified by Hedges
    tol <- ifelse(df >= 10, ifelse(df > 50, 1.5 * 10e-5, .000335), 0.0075)
    if (abs(esBiasCorrectApprox(df) - esBiasCorrectExact(df)) > tol) {
      message(sprintf("Bias approximation failed: df %d, approx %g, exact %g, diff %g, tolerance %g",
                      df, esBiasCorrectApprox(df), esBiasCorrectExact(df), esBiasCorrectApprox(df) - esBiasCorrectExact(df), tol))
      expect(FALSE, "Bias correction")
    }
  }

  # plot(dfs, esBiasCorrectApprox(dfs) - esBiasCorrectExact(dfs), log = "y", pch = 16, cex = 0.5,
  #      main = "Error in approx. method", xlab = "Degrees of freedom", ylab = "Error",
  #      sub = "With Hedges' stated accuracy")
  # #points(dfs, esBiasCorrectApprox(dfs) - HedgesBiasCorrectExact(dfs), pch = 3, col = 6)
  # abline(h = c(0.007, .00033, 1.5 * 10e-6), col = 2:4)
  # abline(v = c(2, 10, 50), col = 2:4)
})

test_that("bias limits", {

  # Bias correction for large sample sizes should be almost the same as no bias correction
  df <- data.frame(val = c(rnorm(500), rnorm(500, 0.2, sd = 0.5)),
                   group = rep(c("Group 1", "Group 2"), each = 500))
  dg <- DurgaDiff(df, 1, 2, effect.type = "hedges g")
  dd <- DurgaDiff(df, 1, 2, effect.type = "cohens d")
  # I don't know what the "correct" tolerance should be here
  expect_equal(dg$group.differences[[1]]$t1, dd$group.differences[[1]]$t1)

  df <- data.frame(val = c(rnorm(100), rnorm(100, 0.2)),
                   group = rep(c("Group 1", "Group 2"), each = 100))
  expect_error(DurgaDiff(df, 1, 2, effect.type = "hedges g"), NA)
})



# I do not have any way to test the degrees of freedom calculation described in
# Equation 16 in Delacre et al., 2021. This is not a test, but visually compares
# it to the calculation used for the same purpose in the effectsize package.
# Unfortunately, the source of the effectsize calculation is not identified
if (FALSE) {
  d <- replicate(100, {
    x1 <- rnorm(round(runif(1, 3, 60)))
    x2 <- rnorm(round(runif(1, 3, 60)))
    delacreDF <- esDFAsterisk(x1, x2)

    # The effectsize calculation
    s1 <- stats::sd(x1)
    s2 <- stats::sd(x2)
    n1 <- length(x1)
    n2 <- length(x2)
    se1 <- sqrt(s1^2 / n1)
    se2 <- sqrt(s2^2 / n2)
    se <- sqrt(se1^2 + se2^2)
    effectsizeDF <- se^4 / (se1^4 / (n1 - 1) + se2^4 / (n2 - 1))

    c(delacreDF, effectsizeDF)
  })
  plot(d[1, ], d[2, ])
}