tests/testthat/test-dist_builtins.R

In pmxcv: Integration-Based Coefficients of Variance

test_that("built-in moments/cv%s are comparable to numeric moments/cv%s", {
  set.seed(652)
  samp_n <- 10^6
  rand_var <- runif(1, 0.3, 3)
  norm_vals <- rnorm(samp_n, sd=sqrt(rand_var))
  tolerance <- 5/100 # high tolerance, given comparison is to numeric

  # log
  lnorm_u <- exp(runif(1, -3, 3))
  lnorm_vals <- exp( log(lnorm_u) + norm_vals)


  lnorm_num_m1 <- mean(lnorm_vals)
  lnorm_bin_m1 <- dist.moment("log", u=lnorm_u, v=rand_var, n=1)
  expect_lt(abs(lnorm_bin_m1/lnorm_num_m1 - 1), tolerance)
  lnorm_num_m2 <- lnorm_num_m1^2 + var(lnorm_vals)
  lnorm_bin_m2 <- dist.moment("log", u=lnorm_u, v=rand_var, n=2)
  expect_lt(abs(lnorm_num_m2/lnorm_bin_m2 - 1), tolerance)
  lnorm_bin_m1_2 <- dist.moment("log", u=lnorm_u, v=rand_var, n=1, exact = FALSE)
  expect_lt(abs(lnorm_bin_m1_2/lnorm_num_m1 - 1), tolerance)
  lnorm_bin_m2_2 <- dist.moment("log", u=lnorm_u, v=rand_var, n=2, exact = FALSE)
  expect_lt(abs(lnorm_bin_m2_2/lnorm_bin_m2 - 1), tolerance)

  lnorm_numcv <- numcv(lnorm_vals)
  lnorm_intcv <- dist.intcv("log", u=lnorm_u, v=rand_var)
  expect_lt(abs(lnorm_intcv/lnorm_numcv - 1), tolerance)
  lnorm_intcv2 <- dist.intcv("log", u=lnorm_u, v=rand_var, exact=FALSE)
  expect_lt(abs(lnorm_intcv2/lnorm_numcv - 1), tolerance)
  lnorm_intcv3 <- dist.intcv("log", v=rand_var, exact=FALSE)
  expect_lt(abs(lnorm_intcv3/lnorm_numcv - 1), tolerance)

  #logexp
  logexp_u <- runif(1, -0.5, 0.1)
  logexp_vals <- exp( log(logexp_u + 1) + norm_vals) - 1


  logexp_num_m1 <- mean(logexp_vals)
  logexp_bin_m1 <- dist.moment("logexp", u=logexp_u, v=rand_var, n=1)
  expect_lt(abs(logexp_bin_m1/logexp_num_m1 - 1), tolerance)
  logexp_num_m2 <- logexp_num_m1^2 + var(logexp_vals)
  logexp_bin_m2 <- dist.moment("logexp", u=logexp_u, v=rand_var, n=2)
  expect_lt(abs(logexp_num_m2/logexp_bin_m2 - 1), tolerance)

  logexp_numcv <- abs(numcv(logexp_vals))
  logexp_intcv <- dist.intcv("logexp", u=logexp_u, v=rand_var)
  expect_lt(abs(logexp_intcv/logexp_numcv - 1), tolerance)

  #logit
  logit_u <- runif(1, 0.001, 0.999)
  logit_vals <- 1/(1 + 1/exp( log(logit_u) - log(1-logit_u) + norm_vals))


  logit_num_m1 <- mean(logit_vals)
  logit_bin_m1 <- dist.moment("logit", u=logit_u, v=rand_var, n=1)
  expect_lt(abs(logit_bin_m1/logit_num_m1 - 1), tolerance)
  logit_num_m2 <- logit_num_m1^2 + var(logit_vals)
  logit_bin_m2 <- dist.moment("logit", u=logit_u, v=rand_var, n=2)
  expect_lt(abs(logit_num_m2/logit_bin_m2 - 1), tolerance)

  logit_numcv <- numcv(logit_vals)
  logit_intcv <- dist.intcv("logit", u=logit_u, v=rand_var)
  expect_lt(abs(logit_intcv/logit_numcv - 1), tolerance)

  #arcsin
  arcsin_u <- runif(1, 0, 1)
  arcsin_vals <- sin(asin(sqrt(arcsin_u)) + norm_vals)^2


  arcsin_num_m1 <- mean(arcsin_vals)
  arcsin_bin_m1 <- dist.moment("arcsin", u=arcsin_u, v=rand_var, n=1)
  expect_lt(abs(arcsin_bin_m1/arcsin_num_m1 - 1), tolerance)
  arcsin_num_m2 <- arcsin_num_m1^2 + var(arcsin_vals)
  arcsin_bin_m2 <- dist.moment("arcsin", u=arcsin_u, v=rand_var, n=2)
  expect_lt(abs(arcsin_num_m2/arcsin_bin_m2 - 1), tolerance)

  arcsin_numcv <- numcv(arcsin_vals)
  arcsin_intcv <- dist.intcv("arcsin", u=arcsin_u, v=rand_var)
  expect_lt(abs(arcsin_intcv/arcsin_numcv - 1), tolerance)

  #nmboxcox (numeric is too unstable for this test)
  if (FALSE) {
    nmboxcox_u <- runif(1, 0.1, 10)
    potential_lambdas <- c(runif(1,-2,-0.5), runif(1,0.5,2))
    lambda_test <- sample(potential_lambdas,1)
    eta_exps <- exp(norm_vals)
    eta_tranforms <- ((eta_exps^lambda_test) - 1)/lambda_test
    nmboxcox_vals <- nmboxcox_u*exp(eta_tranforms)
    nmboxcox_vals <- nmboxcox_vals[is.finite(nmboxcox_vals) & abs(nmboxcox_vals)<10^6]


    nmboxcox_num_m1 <- mean(nmboxcox_vals)
    nmboxcox_bin_m1 <- dist.moment("nmboxcox", u=nmboxcox_u, v=rand_var, lambda=lambda_test, n=1)
    expect_lt(abs(nmboxcox_bin_m1/nmboxcox_num_m1 - 1), tolerance)
    nmboxcox_num_m2 <- nmboxcox_num_m1^2 + var(nmboxcox_vals)
    nmboxcox_bin_m2 <- dist.moment("nmboxcox", u=nmboxcox_u, v=rand_var, lambda=lambda_test, n=2)
    expect_lt(abs(nmboxcox_num_m2/nmboxcox_bin_m2 - 1), tolerance)

    nmboxcox_numcv <- numcv(nmboxcox_vals)
    nmboxcox_intcv <- dist.intcv("nmboxcox", u=nmboxcox_u, v=rand_var, lambda=lambda_test)
    expect_lt(abs(nmboxcox_intcv/nmboxcox_numcv - 1), tolerance)
  }
  nmboxcox_u <- runif(1, 0.1, 10)
  potential_lambdas <- c(runif(1,-2,-0.5), runif(1,0.5,2))
  lambda_test <- sample(potential_lambdas,1)
  nmboxcox_bin_m1 <- dist.moment("nmboxcox", u=nmboxcox_u, v=rand_var, lambda=lambda_test, n=1)
  nmboxcox_bin_m2 <- dist.moment("nmboxcox", u=nmboxcox_u, v=rand_var, lambda=lambda_test, n=2)

  nmboxcox_momentcv <- 100*sqrt( nmboxcox_bin_m2/nmboxcox_bin_m1^2 - 1 )
  nmboxcox_intcv <- dist.intcv("nmboxcox", u=nmboxcox_u, v=rand_var, lambda=lambda_test)
  expect_lt(abs(nmboxcox_intcv/nmboxcox_momentcv - 1), tolerance)

  ## Other functionality

  # return function
  fun.logitcv <- dist.intcv("logit", fun=TRUE)
  test_logitcv <-  fun.logitcv(u=logit_u, v=rand_var)
  expect_equal(test_logitcv,logit_intcv)
  fun.logcv <- dist.intcv("log", fun=TRUE)
  test_logcv <-  fun.logcv(v=rand_var)
  lnorm_intcv <- dist.intcv("log", v=rand_var)
  expect_equal(test_logcv,lnorm_intcv)

  # missing builtin errors
  expect_error(dist.moment("binomial", u=1, v=rand_var, n=1))
  expect_error(dist.intcv("binomial", u=1, v=rand_var))

})