tests/testthat/test-02_Cauchy.R

In joker: Probability Distributions and Parameter Estimation

test_that("Cauchy distr works", {

  # Preliminaries
  D <- Cauchy(0.7)

  # Types
  expect_s4_class(D, "Distribution")
  expect_s4_class(D, "Cauchy")

  # Errors
  expect_error(Cauchy(c(0.1, 0.2)))
  expect_error(Cauchy(2, - 1))

})

test_that("Cauchy dpqr work", {

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale

  # Types
  expect_true(is.function(d(D)))
  expect_true(is.function(p(D)))
  expect_true(is.function(qn(D)))
  expect_true(is.function(r(D)))

  # Values
  expect_equal(d(D)(m), 1 / (pi * g))
  expect_equal(p(D)(m), 0.5)
  expect_equal(qn(D)(0.5), m)
  expect_equal(qn(D)(0), -Inf)
  expect_equal(qn(D)(1), Inf)

  # 2-Way Calls
  expect_equal(d(D)(1), dcauchy(1, m, g))
  expect_equal(p(D)(1), pcauchy(1, m, g))
  expect_equal(qn(D)(1), qcauchy(1, m, g))
  expect_equal(qn(D)(0), qcauchy(0, m, g))
  expect_equal(d(D)(1), d(D, 1))
  expect_equal(p(D)(1), p(D, 1))
  expect_equal(qn(D)(1), qn(D, 1))
  expect_equal(qn(D)(0), qn(D, 0))

})

test_that("Cauchy moments work", {

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale

  # Types
  expect_warning(mean(D))
  expect_true(is.numeric(median(D)))
  expect_true(is.numeric(mode(D)))
  expect_warning(var(D))
  expect_warning(sd(D))
  expect_warning(skew(D))
  expect_warning(kurt(D))
  expect_true(is.numeric(entro(D)))
  expect_true(is.numeric(finf(D)))

})

test_that("Cauchy likelihood works", {

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale
  set.seed(1)
  n <- 100L
  x <- r(D)(n)

  # Types
  expect_true(is.numeric(llcauchy(x, m, g)))

  # 2-Way Calls
  expect_equal(llcauchy(x, m, g), ll(D, x))
  expect_equal(ll(D)(x), ll(D, x))

  # ll and lloptim convergence comparison
  method <- "L-BFGS-B"
  lower <- c(-Inf, 1e-5)
  upper <- c(Inf, Inf)

  par1 <- optim(par = me(D, x),
                fn = lloptim,
                gr = dlloptim,
                tx = x,
                distr = D,
                method = method,
                lower = lower,
                upper = upper,
                control = list(fnscale = -1))$par

  par2 <- optim(par = me(D, x),
                fn = function(par, x) { ll(Cauchy(par[1], par[2]), x) },
                x = x,
                method = method,
                lower = lower,
                upper = upper,
                control = list(fnscale = -1))$par

  expect_equal(par1, par2, tolerance = 0.01)

})

test_that("Cauchy estim works", {

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale
  set.seed(1)
  n <- 100L
  x <- r(D)(n)

  # Types
  expect_true(is.list(ecauchy(x, type = "mle")))
  expect_true(is.list(ecauchy(x, type = "me")))

  # 2-Way Calls
  expect_equal(ecauchy(x, type = "mle"), e(D, x, type = "mle"))
  expect_equal(ecauchy(x, type = "me"), e(D, x, type = "me"))

  skip_if(Sys.getenv("JOKER_EXTENDED_TESTS") != "true",
          "Skipping extended test unless JOKER_EXTENDED_TESTS='true'")

  # Simulations
  d <- test_consistency("me", D)
  expect_equal(d$prm_true, d$prm_est, tolerance = 0.02)
  d <- test_consistency("mle", D)
  expect_equal(d$prm_true, d$prm_est, tolerance = 0.03)

  # Errors
  expect_error(e(D, x, type = "xxx"))
  expect_error(e(D, x, type = "mle", par0 = "xxx"))

})

test_that("Cauchy avar works", {

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale
  set.seed(1)
  n <- 100L
  x <- r(D)(n)

  expect_true(is.matrix(vcauchy(m, g)))

  # Errors
  expect_error(v(D, type = "xxx"))

})

test_that("Cauchy small metrics work", {

  skip_if(Sys.getenv("JOKER_EXTENDED_TESTS") != "true",
          "Skipping extended test unless JOKER_EXTENDED_TESTS='true'")

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale
  set.seed(1)
  n <- 100L
  x <- r(D)(n)

  prm <- list(name = "location",
              val = seq(-2, 2, by = 1))

  expect_no_error(
    x <- small_metrics(D, prm,
                       est = c("mle", "me"),
                       obs = c(20, 50),
                       sam = 1e2,
                       seed = 1,
                       bar = FALSE)
  )

  expect_no_error(
    plot(x, save = TRUE, path = tempdir())
  )

  # Types
  expect_s4_class(x, "SmallMetrics")

})

## NEEDS CHECKING
test_that("Cauchy large metrics work", {

  # Preliminaries
  D <- Cauchy(2, 1)
  m <- D@location
  g <- D@scale
  set.seed(1)
  n <- 100L
  x <- r(D)(n)

  prm <- list(name = "location",
              val = seq(-2, 2, by = 1))

  expect_no_error(
    x <- large_metrics(D, prm,
                       est = c("mle"))
  )

  expect_no_error(
    plot(x, save = TRUE, path = tempdir())
  )

  # Types
  expect_s4_class(x, "LargeMetrics")

  prm <- list(name = "scale",
              val = seq(0.5, 2, by = 0.5))

  expect_no_error(
    x <- large_metrics(D, prm,
                       est = c("mle"))
  )

  expect_no_error(
    plot(x, save = TRUE, path = tempdir())
  )

  # Types
  expect_s4_class(x, "LargeMetrics")

})