tests/testthat/test-dev.R

test_that("beta_binom missing values", {
  expect_identical(dev_beta_binom(logical(0), integer(0), numeric(0), numeric(0)), numeric(0))
  expect_identical(dev_beta_binom(NA, 1, 1, 1), NA_real_)
  expect_identical(dev_beta_binom(1, NA, 1, 1), NA_real_)
  expect_identical(dev_beta_binom(1, 1, NA, 1), NA_real_)
  expect_identical(dev_beta_binom(1, 1, 1, NA), NA_real_)
})

test_that("beta_binom known values", {
  expect_equal(dev_beta_binom(1), 1.38629436111989)
  expect_equal(dev_beta_binom(1, 1, 0), Inf)
  expect_equal(dev_beta_binom(1, 1, 0, 0.5), Inf)
  expect_equal(dev_beta_binom(1, 1, 0.5, 0), 1.38629436111989)
  expect_identical(dev_beta_binom(1, 1, 0.5, 0), dev_binom(1, 1, 0.5))
  expect_equal(dev_beta_binom(1, 1, 0.5, 1), 1.38629430121326)
  expect_equal(dev_beta_binom(1, 1, 0.5, 0.5), 1.38629430121326)
  expect_equal(dev_beta_binom(1, 2, 0.2, 0), 0.892574205256839)
  expect_equal(dev_beta_binom(1, 2, 0.2, 1), 0.892574205256839)
  expect_equal(dev_beta_binom(1, 2, 0.2, 0.5), 0.892574205256839)
  expect_equal(dev_beta_binom(1, 5, 0.3, 0), 0.257320924779852)
  expect_equal(dev_beta_binom(1, 5, 0.3, 1), 5.7171585443605e-05) # was negative with naive sat. model
  expect_equal(dev_beta_binom(1, 5, 0.3, 0.5), 0.0274314034251604) # was negative with naive sat. model
  expect_identical(dev_beta_binom(1, 1, 1, 0.5), 0)
  expect_identical(dev_beta_binom(1, 1, 1), 0)
  expect_identical(dev_beta_binom(1, 1, 1, 1), 0)
  expect_identical(dev_beta_binom(0, 0), 0)
  expect_identical(dev_beta_binom(0, 0, 1), 0)
  expect_identical(dev_beta_binom(0, 0, 1, 1), 0)
  expect_identical(dev_beta_binom(1, 2), 0)
  expect_identical(dev_beta_binom(1, 2, 1), Inf)
  expect_equal(dev_beta_binom(1, 2, 0, 1), Inf)
  expect_equal(dev_beta_binom(0, 1), 1.38629436111989)
  expect_equal(dev_beta_binom(0, 1, 1), Inf)
  expect_equal(dev_beta_binom(0, 1, 1, 0.5), Inf)
  expect_equal(dev_beta_binom(0, 1, 1, 1), Inf)
  expect_equal(dev_beta_binom(0, 2), 2.77258872223978)
  expect_equal(dev_beta_binom(0, 2, 1), Inf)
  expect_equal(dev_beta_binom(0, 2, 0.5), 2.77258872223978)
  expect_equal(dev_beta_binom(0, 2, 0.5, 0.1), 2.67954869096997)
  expect_equal(dev_beta_binom(0, 2, 0.5, 0.5), 2.40794560865187)
  expect_equal(dev_beta_binom(0, 2, 0.1), 0.421442062631305)
  expect_equal(dev_beta_binom(0, 2, 0.1, 0.1), 0.410887933834857)
  expect_equal(dev_beta_binom(0, 2, 0.1, 0.5), 0.377484235738089)
  expect_equal(dev_beta_binom(1, 2, 1, 10), Inf)
  expect_equal(dev_beta_binom(2, 2, 1, 10), 0)
  expect_equal(dev_beta_binom(0, 2, 0.5, 10), 1.56031711509915)
  expect_equal(dev_beta_binom(0, 2, 0, 10), 0)
})

test_that("beta_binom vectorized", {
  expect_equal(dev_beta_binom(0:3, 5, 0, 0), dev_binom(0:3, 5, 0))
  expect_equal(dev_beta_binom(c(0, 1, 3, 0), 3, 0.5, 0.5), c(3.21887580642895, 0.179750127270295, 3.2188756770985, 3.21887580642895))
  expect_equal(dev_beta_binom(0:3, 0:3, rep(1, 4), 0), rep(0, 4))
  expect_equal(dev_beta_binom(0:3, 1:4, seq(0, 1, length.out = 4), 0:3),c(0, 0.235566071312767, 0.076961041136129, Inf))
})

test_that("beta_binom vectorized missing values", {
  expect_equal(dev_beta_binom(c(NA,1), 0:1, 0:1, 0:1), c(NA,0))
  expect_equal(dev_beta_binom(c(0,NA), 0:1, 0:1, 0:1), c(0,NA))
  expect_equal(dev_beta_binom(c(0:1), c(NA,1), 0:1, 0:1), c(NA,0))
  expect_equal(dev_beta_binom(c(0:1), c(0,NA), 0:1, 0:1), c(0,NA))
  expect_equal(dev_beta_binom(c(0:1), c(0:1), c(NA,1), 0:1), c(0,0))
  expect_equal(dev_beta_binom(c(0:1), c(0:1), c(0,NA), 0:1), c(0,NA))
  expect_equal(dev_beta_binom(c(0:1), c(0:1), 0:1, c(NA,1)), c(0,0))
  expect_equal(dev_beta_binom(c(0:1), c(0:1), 0:1, c(0,NA)), c(0,NA))
})

test_that("beta_binom res", {
  expect_equal(dev_beta_binom(1, 3, 0.5, 0.5), dev_beta_binom(1, 3, 0.5, 0.5, res = TRUE)^2)
  expect_equal(dev_beta_binom(0:1, c(2, 4), 0.5, 5), dev_beta_binom(0:1, c(2, 4), 0.5, 5, res = TRUE)^2)
})

test_that("beta_binom ran", {
  set.seed(101)
  samples <- ran_beta_binom(100000, 100, 0.5, 0.01)
  expect_equal(mean(samples), 49.99347)
  expect_equal(var(samples), 37.4491218503185)
  res <- dev_beta_binom(samples, 100, 0.5, 0.01, res = TRUE)
  expect_equal(mean(res), -0.00107466576791911, tolerance = 1e-04) # for M1
  # ══ Failed tests ════════════════════════════════════════════════════════════════
  # ── Failure ('test-dev.R:79:3'): beta_binom ran ─────────────────────────────────
  # mean(res) (`actual`) not equal to -0.00107466576791911 (`expected`).
  #
  # `actual`: -0.00107458
  # `expected`: -0.00107467
  expect_equal(sd(res), 1.0040052194768)
})

test_that("deviance beta_binom", {
  samples <- ran_beta_binom(100, size = 3, prob = 0.5, theta = 0) # binomial case.
  mod <- glm(cbind(samples,3-samples)~1, family = binomial)
  deviance <- sum(dev_beta_binom(samples, size = 3, ilogit(coef(mod)[1])), theta = 0)
  expect_equal(deviance, deviance(mod))
  # no packages that calculate deviance using binomial saturated model.
})

test_that("bern missing values", {
  expect_identical(dev_bern(logical(0), integer(0)), numeric(0))
  expect_identical(dev_bern(NA, 1), NA_real_)
  expect_identical(dev_bern(1, NA), NA_real_)
})

test_that("bern known values", {
  expect_identical(dev_bern(1, 1), 0)
  expect_identical(dev_bern(0, 0), 0)
  expect_identical(dev_bern(1, 0), Inf)
  expect_identical(dev_bern(0, 1), Inf)
  expect_equal(dev_bern(1, 0.5), 1.38629436111989)
  expect_equal(dev_bern(0, 0.5), 1.38629436111989)
  expect_equal(dev_bern(1, 0.7), 0.713349887877465)
  expect_equal(dev_bern(0, 0.7), 2.40794560865187)
})

test_that("bern vectorized", {
  expect_equal(dev_bern(0:1, 0:1), c(0,0))
  expect_equal(dev_bern(0:1, 1:0), c(Inf,Inf))
  expect_equal(dev_bern(0:1, c(0.3,0.6)), c(0.713349887877465, 1.02165124753198))
})

test_that("bern vectorized missing values", {
  expect_equal(dev_bern(c(NA,1), 0:1), c(NA,0))
  expect_equal(dev_bern(c(0,NA), 0:1), c(0,NA))
  expect_equal(dev_bern(c(0:1), c(NA,1)), c(NA,0))
  expect_equal(dev_bern(c(0:1), c(0,NA)), c(0,NA))
})

test_that("dev_bern res", {
  expect_equal(dev_bern(0, 0.5), dev_bern(0, 0.5, res = TRUE)^2)
  expect_equal(dev_bern(0:1, c(0.3,0.6)), dev_bern(0:1, c(0.3,0.6), res = TRUE)^2)
})

test_that("bern log_lik", {
  expect_equal(dev_bern(0:1, 0.5),
               2 * (log_lik_bern(0:1, 0:1) - log_lik_bern(0:1, 0.5)))
  expect_equal(dev_bern(0:1, 0.7),
               2 * (log_lik_bern(0:1, 0:1) - log_lik_bern(0:1, 0.7)))
})

test_that("bern deviance", {
  samples <- ran_bern(1000)
  mod <- glm(cbind(samples,1-samples)~1, family = binomial)
  deviance <- sum(dev_bern(samples, ilogit(coef(mod)[1])))
  expect_equal(deviance, deviance(mod))
})

test_that("bern ran", {
  set.seed(101)
  samples <- ran_bern(1000)
  res <- dev_bern(samples, res = TRUE)
  expect_equal(mean(res),-0.0494512209456499)
  expect_equal(sd(res),1.17695971555483)
})

test_that("dev_binom", {
  expect_identical(dev_binom(integer(0), integer(0), integer(0)), numeric(0))
  expect_identical(dev_binom(NA, 1, 1), NA_real_)
  expect_identical(dev_binom(1, NA, 1), NA_real_)
  expect_identical(dev_binom(1, 1, NA), NA_real_)
  expect_equal(dev_binom(1, 3, 0.5), dev_binom(1, 3, 0.5, res = TRUE)^2)
  expect_equal(dev_binom(0, 1, 0.5, res = TRUE), -1.17741002251547)
  expect_equal(dev_binom(1, 1, 0.5, res = TRUE), 1.17741002251547)
  expect_equal(dev_binom(0, 1, 0.7, res = TRUE), -1.55175565365552)
  expect_equal(dev_binom(1, 1, 0.7, res = TRUE), 0.844600430900592)
  expect_identical(dev_binom(1, 2, 0.5), 0)
  expect_identical(dev_binom(5, 10, 0.5), 0)
  expect_equal(dev_binom(1, 10, 0.5, res = TRUE), -2.71316865369073)
  expect_equal(dev_binom(1:9, 10, 0.5, res = TRUE),
               c(-2.71316865369073, -1.96338868806845, -1.28283185573988, -0.634594572159089,
                 0, 0.634594572159089, 1.28283185573988, 1.96338868806845, 2.71316865369073))
})

test_that("deviance binom log_lik", {
  expect_equal(dev_binom(0:3, 3, 0.5),
               2 * (log_lik_binom(0:3, 3, 0:3/3) - log_lik_binom(0:3, 3, 0.5)))
})

test_that("deviance binom", {
  samples <- ran_binom(100, 3)
  mod <- glm(cbind(samples,3-samples)~1, family = binomial)
  deviance <- sum(dev_binom(samples, size = 3, ilogit(coef(mod)[1])))
  expect_equal(deviance, deviance(mod))
})

test_that("gamma_pois missing values", {
  expect_identical(dev_gamma_pois(logical(0), integer(0), numeric(0)), numeric(0))
  expect_identical(dev_gamma_pois(NA, 1), NA_real_)
  expect_identical(dev_gamma_pois(1, NA), NA_real_)
  expect_identical(dev_gamma_pois(1, 1, NA), NA_real_)
})

test_that("gamma_pois known values", {
  expect_identical(dev_gamma_pois(1, 1), 0)
  expect_identical(dev_gamma_pois(1, 1, 1), 0)
  expect_identical(dev_gamma_pois(0, 0), 0)
  expect_identical(dev_gamma_pois(0, 0, 1), 0)
  expect_identical(dev_gamma_pois(1, 0), Inf)
  expect_identical(dev_gamma_pois(1, 0, 1), Inf)
  expect_identical(dev_gamma_pois(0, 1), 2)
  expect_equal(dev_gamma_pois(0, 1, 1), 1.38629436111989)
  expect_identical(dev_gamma_pois(0, 2), 4)
  expect_equal(dev_gamma_pois(0, 2, 1), 2.19722457733622)
  expect_equal(dev_gamma_pois(0, 2, 2), 1.6094379124341)
})

test_that("gamma_pois vectorized", {
  expect_equal(dev_gamma_pois(0:3, 2, 0), c(4, 0.613705638880109, 0, 0.432790648648986))
  expect_equal(dev_gamma_pois(0:3, 0:3, rep(1, 4)), rep(0, 4))
  expect_equal(dev_gamma_pois(0:3, 3:0, 0:3), c(6, 0.235566071312767, 0.218460603409828, Inf))
})

test_that("gamma_pois vectorized missing values", {
  expect_equal(dev_gamma_pois(c(NA,1), 0:1, 0:1), c(NA,0))
  expect_equal(dev_gamma_pois(c(0,NA), 0:1, 0:1), c(0,NA))
  expect_equal(dev_gamma_pois(c(0:1), c(NA,1), 0:1), c(NA,0))
  expect_equal(dev_gamma_pois(c(0:1), c(0,NA), 0:1), c(0,NA))
  expect_equal(dev_gamma_pois(c(0:1), c(0:1), c(NA,0)), c(NA,0))
  expect_equal(dev_gamma_pois(c(0:1), c(0:1), c(0,NA)), c(0,NA))
})

test_that("gamma_pois res", {
  expect_equal(dev_gamma_pois(0, 0.5), dev_gamma_pois(0, 0.5, res = TRUE)^2)
  expect_equal(dev_gamma_pois(0:1, c(0.3,0.6)), dev_gamma_pois(0:1, c(0.3,0.6), res = TRUE)^2)
})

test_that("gamma_pois log_lik", {
  expect_equal(dev_gamma_pois(0:1, 0.5),
               2 * (log_lik_gamma_pois(0:1, 0:1) - log_lik_gamma_pois(0:1, 0.5)))
  expect_equal(dev_gamma_pois(0:1, 0.7),
               2 * (log_lik_gamma_pois(0:1, 0:1) - log_lik_gamma_pois(0:1, 0.7)))
  expect_equal(dev_gamma_pois(0:1, 0.7, 1),
               2 * (log_lik_gamma_pois(0:1, 0:1, 1) - log_lik_gamma_pois(0:1, 0.7, 1)))
})

test_that("gamma_pois deviance", {
  samples <- ran_gamma_pois(10000, 3, 0.5)
  mod <- MASS::glm.nb(samples~1)
  deviance <- sum(dev_gamma_pois(samples, exp(coef(mod)[1]), theta = 1/mod$theta))
  expect_equal(deviance, deviance(mod))
})

test_that("gamma_pois ran", {
  set.seed(100)
  samples <- ran_gamma_pois(100000, 3, 0.5)
  expect_equal(mean(samples), 3.00867)
  expect_equal(var(samples), 7.50806991179912)
  res <- dev_gamma_pois(samples, 3, 0.5, res = TRUE)
  expect_equal(mean(res),-0.260848965857529)
  expect_equal(sd(res), 1.0243876393499)
})

test_that("gamma_pois_zi missing values", {
  expect_identical(dev_gamma_pois_zi(logical(0), integer(0), numeric(0), numeric(0)), numeric(0))
  expect_identical(dev_gamma_pois_zi(NA, 1, 1, 1), NA_real_)
  expect_identical(dev_gamma_pois_zi(1, NA, 1, 1), NA_real_)
  expect_identical(dev_gamma_pois_zi(1, 1, NA, 1), NA_real_)
  expect_identical(dev_gamma_pois_zi(1, 1, 1, NA), NA_real_)
})

test_that("gamma_pois_zi known values", {
  expect_identical(dev_gamma_pois_zi(1, 1), 0)
  expect_identical(dev_gamma_pois_zi(1, 1, 1), 0)
  expect_identical(dev_gamma_pois_zi(1, 1, 1, 1), Inf)
  expect_identical(dev_gamma_pois_zi(0, 0), 0)
  expect_identical(dev_gamma_pois_zi(0, 0, 1), 0)
  expect_identical(dev_gamma_pois_zi(0, 0, 1, 1), 0)
  expect_identical(dev_gamma_pois_zi(1, 0), Inf)
  expect_identical(dev_gamma_pois_zi(1, 0, 1), Inf)
  expect_identical(dev_gamma_pois_zi(1, 0, 1, 1), Inf)
  expect_identical(dev_gamma_pois_zi(0, 1), 2)
  expect_equal(dev_gamma_pois_zi(0, 1, 1), 1.38629436111989)
  expect_equal(dev_gamma_pois_zi(0, 1, 1, 0.5), 0.575364144903562)
  expect_equal(dev_gamma_pois_zi(0, 1, 1, 1), 0)
  expect_identical(dev_gamma_pois_zi(0, 2), 4)
  expect_equal(dev_gamma_pois_zi(0, 2, 1), 2.19722457733622)
  expect_equal(dev_gamma_pois_zi(0, 2, 1, 0.1), 1.83258146374831)
  expect_equal(dev_gamma_pois_zi(0, 2, 1, 0.5), 0.810930216216329)
  expect_equal(dev_gamma_pois_zi(0, 2, 2), 1.6094379124341)
  expect_equal(dev_gamma_pois_zi(0, 2, 2, 0.1), 1.37635018002824)
  expect_equal(dev_gamma_pois_zi(0, 2, 2, 0.5), 0.647014262314894)
})

test_that("gamma_pois_zi vectorized", {
  expect_equal(dev_gamma_pois_zi(0:3, 2, 0, 0), c(4, 0.613705638880109, 0, 0.432790648648986))
  expect_equal(dev_gamma_pois_zi(c(0, 1, 3, 0), 3, 0.5, 0.5), c(1.08945435088334, 2.25402352637961, 1.38629436111989, 1.08945435088334))
    expect_equal(dev_gamma_pois_zi(0:3, 0:3, rep(1, 4), 0), rep(0, 4))
  expect_equal(dev_gamma_pois_zi(0:3, 3:0, 0:3, seq(0, 1, length.out = 4)), c(6, 1.0464962875291, 2.41568518074605, Inf))
})

test_that("gamma_pois_zi vectorized missing values", {
  expect_equal(dev_gamma_pois_zi(c(NA,1), 0:1, 0:1, 0:1), c(NA,Inf))
  expect_equal(dev_gamma_pois_zi(c(0,NA), 0:1, 0:1, 0:1), c(0,NA))
  expect_equal(dev_gamma_pois_zi(c(0:1), c(NA,1), 0:1, 0:1), c(NA,Inf))
  expect_equal(dev_gamma_pois_zi(c(0:1), c(0,NA), 0:1, 0:1), c(0,NA))
  expect_equal(dev_gamma_pois_zi(c(0:1), c(0:1), c(NA,1), 0:1), c(NA,Inf))
  expect_equal(dev_gamma_pois_zi(c(0:1), c(0:1), c(0,NA), 0:1), c(0,NA))
  expect_equal(dev_gamma_pois_zi(c(0:1), c(0:1), 0:1, c(NA,1)), c(NA,Inf))
  expect_equal(dev_gamma_pois_zi(c(0:1), c(0:1), 0:1, c(0,NA)), c(0,NA))
})

test_that("gamma_pois_zi res", {
  expect_equal(dev_gamma_pois_zi(0, 0.5, 0.5), dev_gamma_pois_zi(0, 0.5, 0.5, res = TRUE)^2)
  expect_equal(dev_gamma_pois_zi(0:1, c(0.3,0.6), 0.5), dev_gamma_pois_zi(0:1, c(0.3,0.6), 0.5, res = TRUE)^2)
})

test_that("gamma_pois_zi log_lik", {
  expect_equal(dev_gamma_pois_zi(0:1, 0.5),
               2 * (log_lik_gamma_pois_zi(0:1, 0:1) - log_lik_gamma_pois_zi(0:1, 0.5)))
  expect_equal(dev_gamma_pois_zi(0:1, 0.7),
               2 * (log_lik_gamma_pois_zi(0:1, 0:1) - log_lik_gamma_pois_zi(0:1, 0.7)))
  expect_equal(dev_gamma_pois_zi(0:1, 0.7, 1),
               2 * (log_lik_gamma_pois_zi(0:1, 0:1, 1) - log_lik_gamma_pois_zi(0:1, 0.7, 1)))
  expect_equal(dev_gamma_pois_zi(0:1, 0.7, 1, 0.5),
               2 * (log_lik_gamma_pois_zi(0:1, 0:1, 1) - log_lik_gamma_pois_zi(0:1, 0.7, 1, 0.5)))
})

test_that("gamma_pois_zi ran", {
  set.seed(100)
  samples <- ran_gamma_pois_zi(100000, 3, 0.5, 0.5)
  expect_equal(mean(samples), 1.51352)
  expect_equal(var(samples), 6.07855799517995)
  res <- dev_gamma_pois_zi(samples, 3, 0.5, 0.5, res = TRUE)
  expect_equal(mean(res),-0.299429507479032)
  expect_equal(sd(res), 1.18261741535124)
})

test_that("dev_lnorm", {
  expect_equal(dev_lnorm(3,4,5),
               2 * (log_lik_lnorm(3, log(3), 5) - log_lik_lnorm(3, 4, 5)))

  expect_identical(dev_lnorm(integer(0), integer(0), integer(0)), numeric(0))
  expect_identical(dev_lnorm(exp(0)), 0)
  expect_identical(dev_lnorm(1), 0)
  expect_identical(dev_lnorm(0, res = TRUE), -Inf)
  expect_identical(dev_lnorm(0), Inf)
  expect_identical(dev_lnorm(-1, res = TRUE), -Inf)
  expect_identical(dev_lnorm(NA, 1, 1), NA_real_)
  expect_identical(dev_lnorm(1, NA, 1), NA_real_)
  expect_identical(dev_lnorm(1, 1, NA), NA_real_)
  expect_equal(dev_lnorm(-2), dev_lnorm(-2, res = TRUE)^2)
  expect_equal(dev_lnorm(exp(-2:2), res = TRUE), c(-2, -1, 0, 1, 2))
  expect_equal(dev_lnorm(exp(-2:2), sdlog = 2, res = TRUE), dev_norm(-2:2, res = TRUE)/2)
  expect_equal(dev_lnorm(exp(-2:2), sdlog = 1/2, res = TRUE), dev_norm(-2:2, res = TRUE) * 2)
  expect_equal(dev_lnorm(exp(-2:2), meanlog = -2:2), rep(0, 5))
  expect_equal(dev_lnorm(exp(-2:2), meanlog = -1:3, sdlog = 1:5, res = TRUE),
               c(-1, -0.5, -0.333333333333333, -0.25, -0.2))
})

test_that("deviance lnorm", {
  samples <- ran_lnorm(100)
  mod <- lm(log(samples)~1)
  deviance <- sum(dev_lnorm(samples, coef(mod)[1]))
  expect_equal(deviance, deviance(mod))
})

test_that("dev_neg_bin", {
  expect_identical(dev_neg_binom(integer(0), integer(0), integer(0)), numeric(0))
  expect_identical(dev_neg_binom(1, 1, 0), 0)
  expect_identical(dev_neg_binom(1, 1, 1), 0)
  expect_identical(dev_neg_binom(0, 1, 0), 2)
  expect_equal(dev_neg_binom(0, 1, 2), 1.09861228866811)
  expect_equal(dev_neg_binom(0, 1, 1), 1.386294361119891)

  expect_identical(dev_neg_binom(NA, 1, 1), NA_real_)
  expect_identical(dev_neg_binom(1, NA, 1), NA_real_)
  expect_identical(dev_neg_binom(1, 1, NA), NA_real_)
  expect_equal(dev_neg_binom(1, 3, 1), dev_neg_binom(1, 3, 1, res = TRUE)^2)

  expect_equal(dev_neg_binom(c(1, 2, 5), 4, 1/2, res = TRUE),
               c(-1.177410022515, -0.686390663271, 0.270787731555))
  expect_equal(dev_neg_binom(c(1, 2, 5), c(1, 3, 5), 1/2, res = TRUE),
               c(0, -0.404089071964, 0))
})


test_that("dev_norm", {
  expect_equal(dev_norm(3,4,5),
               2 * (log_lik_norm(3, 3, 5) - log_lik_norm(3, 4, 5)))
  expect_identical(dev_norm(integer(0), integer(0), integer(0)), numeric(0))
  expect_identical(dev_norm(0), 0)
  expect_identical(dev_norm(NA, 1, 1), NA_real_)
  expect_identical(dev_norm(1, NA, 1), NA_real_)
  expect_identical(dev_norm(1, 1, NA), NA_real_)
  expect_equal(dev_norm(-2), dev_norm(-2, res = TRUE)^2)
  expect_equal(dev_norm(-2:2, res = TRUE), c(-2, -1, 0, 1, 2))
  expect_equal(dev_norm(-2:2, sd = 2, res = TRUE), dev_norm(-2:2, res = TRUE)/2)
  expect_equal(dev_norm(-2:2, sd = 1/2, res = TRUE), dev_norm(-2:2, res = TRUE) * 2)
  expect_equal(dev_norm(-2:2, mean = -2:2, res = TRUE), rep(0, 5))
  expect_equal(dev_norm(-2:2, mean = -1:3, sd = 1:5, res = TRUE),
               c(-1, -0.5, -0.333333333333333, -0.25, -0.2))
})

test_that("deviance norm", {
  samples <- ran_norm(100)
  mod <- lm(samples~1)
  deviance <- sum(dev_norm(samples, coef(mod)[1]))
  expect_equal(deviance, deviance(mod))
})

test_that("pois missing values", {
  expect_identical(dev_pois(logical(0), integer(0)), numeric(0))
  expect_identical(dev_pois(NA, 1), NA_real_)
  expect_identical(dev_pois(1, NA), NA_real_)
})

test_that("pois known values", {
  expect_identical(dev_pois(1, 1), 0)
  expect_identical(dev_pois(0, 0), 0)
  expect_identical(dev_pois(1, 0), Inf)
  expect_identical(dev_pois(0, 1), 2)
  expect_identical(dev_pois(0, 2), 4)
  expect_equal(dev_pois(1, 2), 0.613705638880109)
  expect_identical(dev_pois(2, 2), 0)
  expect_equal(dev_pois(3, 2), 0.432790648648986)
  expect_equal(dev_pois(3, 2.5), 0.0939293407637276)
})

test_that("pois vectorized", {
  expect_equal(dev_pois(0:3, 2), c(4, 0.613705638880109, 0, 0.432790648648986))
  expect_equal(dev_pois(0:3, 0:3), rep(0, 4))
  expect_equal(dev_pois(0:3, 3:0), c(6, 0.613705638880109, 0.772588722239781, Inf))
})

test_that("pois vectorized missing values", {
  expect_equal(dev_pois(c(NA,1), 0:1), c(NA,0))
  expect_equal(dev_pois(c(0,NA), 0:1), c(0,NA))
  expect_equal(dev_pois(c(0:1), c(NA,1)), c(NA,0))
  expect_equal(dev_pois(c(0:1), c(0,NA)), c(0,NA))
})

test_that("pois res", {
  expect_equal(dev_pois(0, 0.5), dev_pois(0, 0.5, res = TRUE)^2)
  expect_equal(dev_pois(0:1, c(0.3,0.6)), dev_pois(0:1, c(0.3,0.6), res = TRUE)^2)
})

test_that("pois log_lik", {
  expect_equal(dev_pois(0:1, 0.5),
               2 * (log_lik_pois(0:1, 0:1) - log_lik_pois(0:1, 0.5)))
  expect_equal(dev_pois(0:1, 0.7),
               2 * (log_lik_pois(0:1, 0:1) - log_lik_pois(0:1, 0.7)))
})

test_that("pois deviance", {
  samples <- ran_pois(1000)
  mod <- glm(samples~1, family = poisson)
  deviance <- sum(dev_pois(samples, exp(coef(mod)[1])))
  expect_equal(deviance, deviance(mod))
})

test_that("pois ran", {
  set.seed(101)
  samples <- ran_pois(1000)
  expect_equal(mean(samples), 0.984)
  expect_equal(var(samples), 1.02476876876877)
  res <- dev_pois(samples, 1, res = TRUE)
  expect_equal(mean(res),-0.235540962010425)
  expect_equal(sd(res),1.05758754072283)
})

test_that("pois_zi missing values", {
  expect_identical(dev_pois_zi(logical(0), integer(0), numeric(0)), numeric(0))
  expect_identical(dev_pois_zi(NA, 1, 1), NA_real_)
  expect_identical(dev_pois_zi(1, NA, 1), NA_real_)
  expect_identical(dev_pois_zi(1, 1, NA), NA_real_)
})

test_that("pois_zi known values", {
  expect_identical(dev_pois_zi(1, 1), 0)
  expect_equal(dev_pois_zi(1, 1, 0.5), 1.38629436111989)
  expect_identical(dev_pois_zi(1, 1, 1), Inf)
  expect_identical(dev_pois_zi(0, 1), 2)
  expect_identical(dev_pois_zi(0, 1, 0.5), 0.759770986083445)
  expect_identical(dev_pois_zi(0, 1, 1), 0)
  expect_identical(dev_pois_zi(0, 1000), Inf)
  expect_equal(dev_pois_zi(0, 1000, 0.5), 1.38629436111989)
  expect_equal(dev_pois_zi(0, 1000, 1), 0)
  expect_identical(dev_pois_zi(0, 0), 0)
  expect_identical(dev_pois_zi(0, 0, 1), 0)
  expect_identical(dev_pois_zi(1, 0), Inf)
  expect_identical(dev_pois_zi(1, 0, 1), Inf)
  expect_identical(dev_pois_zi(0, 2), 4)
  expect_equal(dev_pois_zi(0, 2, 0.5), 1.13243833903395)
  expect_equal(dev_pois_zi(1, 2), 0.613705638880109)
  expect_equal(dev_pois_zi(1, 2, 0.5), 2)
  expect_equal(dev_pois_zi(3, 3.5,res = TRUE),
               -0.274036349845144)
  expect_equal(dev_pois_zi(3, 3.5, 0.1, res = TRUE),
               -0.534618511045121)
  expect_equal(dev_pois_zi(3, 3.5, 0.2, res = TRUE),
               0.72206857268882)
  expect_equal(dev_pois_zi(3, 3.5, 0.90, res = TRUE),
               2.16339226841194)
})

test_that("pois_zi vectorized", {
  expect_equal(dev_pois_zi(0:3, 2, 0), c(4, 0.613705638880109, 0, 0.432790648648986))
  expect_equal(dev_pois_zi(0:3, 0:3, c(0, 0.1, 0.5, 1)), c(0, 0.210721031315653, 1.38629436111989, Inf))
  expect_equal(dev_pois_zi(0:3, 3:0, c(0, 0.1, 0.5, 1)), c(6, 0.824426670195762, 2.15888308335967, Inf))
})

test_that("pois_zi vectorized missing values", {
  expect_equal(dev_pois_zi(c(NA,1), 0:1, 0:1), c(NA,Inf))
  expect_equal(dev_pois_zi(c(0,NA), 0:1, 0:1), c(0,NA))
  expect_equal(dev_pois_zi(c(0:1), c(NA,1), 0:1), c(NA,Inf))
  expect_equal(dev_pois_zi(c(0:1), c(0,NA), 0:1), c(0,NA))
  expect_equal(dev_pois_zi(c(0:1), 0:1, c(NA,1)), c(NA,Inf))
  expect_equal(dev_pois_zi(c(0:1), 0:1, c(1,NA)), c(0,NA))
})

test_that("pois_zi res", {
  expect_equal(dev_pois_zi(0, 0.5, 0.5), dev_pois_zi(0, 0.5, 0.5, res = TRUE)^2)
  expect_equal(dev_pois_zi(0:1, c(0.3,0.6), 0.5), dev_pois_zi(0:1, c(0.3,0.6), 0.5, res = TRUE)^2)
})

test_that("pois_zi log_lik", {
  expect_equal(dev_pois_zi(0, 0.5),
               2 * (log_lik_pois_zi(0, 0) - log_lik_pois_zi(0, 0.5)))
  expect_equal(dev_pois_zi(0, 0.5, 0.5),
               2 * (log_lik_pois_zi(0, 0, 0.5) - log_lik_pois_zi(0, 0.5, 0.5)))
  expect_equal(dev_pois_zi(1, 0.5),
               2 * (log_lik_pois_zi(1, 1) - log_lik_pois_zi(1, 0.5)))
  expect_equal(dev_pois_zi(1, 0.5, 0.5),
               2 * (log_lik_pois_zi(1, 1, 0) - log_lik_pois_zi(1, 0.5, 0.5)))
})

test_that("pois_zi ran", {
  set.seed(101)
  samples <- ran_pois_zi(1000, 3, 0.5)
  expect_equal(mean(samples), 1.565)
  expect_equal(sd(samples), 1.94462247147269)
  res <- dev_pois_zi(samples, 3, 0.5, res = TRUE)
  expect_equal(mean(res), -0.119914019357374)
  expect_equal(sd(res), 1.31269320210938)
})

test_that("gamma missing values", {
  expect_identical(dev_gamma(logical(0), integer(0), numeric(0)), numeric(0))
  expect_identical(dev_gamma(NA, 1, 1), NA_real_)
  expect_identical(dev_gamma(1, NA, 1), NA_real_)
  expect_identical(dev_gamma(1, 1, NA), NA_real_)
})

test_that("gamma known values", {
  expect_identical(dev_gamma(1, 1), 0)
  expect_equal(dev_gamma(1, 1, 0.5), 0.386294361119891)
  expect_identical(dev_gamma(1, 1, 1), 0)
  expect_identical(dev_gamma(0, 1), Inf)
  expect_identical(dev_gamma(0, 1, 0.5), Inf)
  expect_equal(dev_gamma(1, 1, 0.5), 0.386294361119891)
  expect_equal(dev_gamma(1, 1000, 1), 11.8175105579643)
  expect_equal(dev_gamma(0, 2, 0.5), Inf)
  expect_equal(dev_gamma(1, 2), 0.386294361119891)
  expect_equal(dev_gamma(1, 2, 0.5), 1.27258872223978)
  expect_equal(dev_gamma(3, 3.5, res = TRUE),
               -0.150289966199447)
  expect_equal(dev_gamma(3, 3.5, 0.1, res = TRUE),
               -1.75638837307447)
  expect_equal(dev_gamma(3, 3.5, 0.2, res = TRUE),
               -1.36749198439328)
  expect_equal(dev_gamma(3, 3.5, 0.90, res = TRUE),
               -0.248755972445511)
})

test_that("gamma vectorized", {
  expect_equal(dev_gamma(0:3, 2, 1), c(Inf, 0.386294361119891, 0, 0.189069783783671))
  expect_equal(dev_gamma(0:3, 1:4, c(0.1, 0.5, 1, 2)),
               c(Inf, 1.27258872223978, 0.144263549549662, 0.189069783783671))
  expect_equal(dev_gamma(0:3, 4:1, c(0.1, 0.5, 1, 2)),
               c(Inf, 1.91685227178944, 0, 6.41648106154389))
})

test_that("gamma vectorized missing values", {
  expect_equal(dev_gamma(c(NA,1), 1:2, 1:2), c(NA, 0))
  expect_equal(dev_gamma(c(0,NA), 1:2, 1:2), c(Inf, NA))
  expect_equal(dev_gamma(c(1:2), c(NA,1), 1:2), c(NA, 3.22741127776022))
  expect_equal(dev_gamma(c(1:2), c(1,NA), 1:2), c(0,NA))
  expect_equal(dev_gamma(c(1:2), 1:2, c(NA,1)), c(NA,0))
  expect_equal(dev_gamma(c(1:2), 1:2, c(1,NA)), c(0,NA))
})

test_that("gamma res", {
  expect_equal(dev_gamma(0, 0.5, 0.5), dev_gamma(0, 0.5, 0.5, res = TRUE)^2)
  expect_equal(dev_gamma(1:2, c(0.3,0.6), 0.5), dev_gamma(1:2, c(0.3,0.6), 0.5, res = TRUE)^2)
})

test_that("gamma log_lik", { # couldn't determine exact parameter values for saturated log likelihood
  expect_equal(dev_gamma(1, 1, 1),
               2 * (log_lik_gamma(1, 1, 1) - log_lik_gamma(1, 1, 1)))
  expect_equal(dev_gamma(2, 1, 1),
               2 * (log_lik_gamma(2, 1, 0.5) - log_lik_gamma(2, 1, 1)))
  # hack to divide multiply by 1 / shape
  expect_equal(dev_gamma(5, 3, 2),
               2 * (1/3) * (log_lik_gamma(5, 3, 3/5) - log_lik_gamma(5, 3, 2)))
})

test_that("gamma ran", {
  set.seed(101)
  samples <- ran_gamma(10000, 3, 1)
  expect_equal(mean(samples), 2.98927441565774)
  expect_equal(sd(samples), 1.71676055992005)
  res <- dev_gamma(samples, 3, 1, res = TRUE)
  expect_equal(mean(res), -0.115132947326996)
  expect_equal(sd(res), 0.579070230993174)
})

test_that("gamma deviance", {
  samples <- ran_gamma(1000, 3, 1/2)
  mod <- glm(samples~1, family = Gamma(link = "identity"))
  deviance <- sum(dev_gamma(samples, coef(mod)))
  expect_equal(deviance, deviance(mod))
})

test_that("student missing values", {
  expect_identical(dev_student(logical(0), integer(0), numeric(0), numeric(0)), numeric(0))
  expect_identical(dev_student(NA, 1, 1, 1), NA_real_)
  expect_identical(dev_student(1, NA, 1, 1), NA_real_)
  expect_identical(dev_student(1, 1, NA, 1), NA_real_)
  expect_identical(dev_student(1, 1, 1, NA), NA_real_)
})

test_that("student known values", {
  expect_identical(dev_student(1, 1), 0)
  expect_identical(dev_student(1, 1, 1), 0)
  expect_identical(dev_student(1, 1, 1, 1), 0)
  expect_identical(dev_student(0, 0), 0)
  expect_identical(dev_student(0, 0, 1), 0)
  expect_identical(dev_student(0, 0, 1, 1), 0)
  expect_identical(dev_student(0, 0, 0), dev_norm(0, 0, 0))
  expect_identical(dev_student(0, 0, 0, 10), dev_norm(0, 0, 0))
  expect_equal(dev_student(1, 0), 1)
  expect_equal(dev_student(1, 0, 1), 1)
  expect_equal(dev_student(1, 0, 1, 1), 1.38629436111989)
  expect_equal(dev_student(0, 1), 1)
  expect_equal(dev_student(0, 1, 1), 1)
  expect_equal(dev_student(0, 1, 1, 0.5), 1.21639532432449)
  expect_equal(dev_student(0, 1, 1, 1), 1.38629436111989)
  expect_identical(dev_student(0, 2), 4)
  expect_identical(dev_student(0, 2, 1), 4)
  expect_equal(dev_student(0, 2, 1, 0.1), 3.70119460283334)
  expect_equal(dev_student(0, 2, 1, 0.5), 3.29583686600433)
  expect_equal(dev_student(0, 2, 2), 1)
  expect_equal(dev_student(0, 2, 2, 0.1), 1.04841197784757)
  expect_equal(dev_student(0, 2, 2, 0.5), 1.21639532432449)
})

test_that("student vectorized", {
  expect_equal(dev_student(0:3, 2, 0.1, 0), c(400, 100, 0, 100))
  expect_equal(dev_student(c(0, 1, 3, 0), 3, 0.5, 0.5), c(8.83331693749932, 6.59167373200866, 0, 8.83331693749932))
  expect_equal(dev_student(0:3, 0:3, rep(1, 4), 0), rep(0, 4))
  expect_equal(dev_student(0:3, 3:0, 0:3, seq(0, 1, length.out = 4)), c(Inf, 1.15072828980712, 0.385376699568146, 1.38629436111989))
})

test_that("student vectorized missing values", {
  expect_equal(dev_student(c(NA,1), 0:1, 0:1, 0:1), c(NA,0))
  expect_equal(dev_student(c(0,NA), 0:1, 1:2, 0:1), c(0,NA))
  expect_equal(dev_student(c(0:1), c(NA,1), 1:2, 0:1), c(NA,0))
  expect_equal(dev_student(c(0:1), c(0,NA), 1:2, 0:1), c(0,NA))
  expect_equal(dev_student(c(0:1), c(0:1), c(NA,1), 0:1), c(NA,0))
  expect_equal(dev_student(c(0:1), c(0:1), c(1,NA), 0:1), c(0,NA))
  expect_equal(dev_student(c(0:1), c(0:1), 0:1, c(NA,1)), c(NaN,0))
  expect_equal(dev_student(c(0:1), c(0:1), 1:2, c(0,NA)), c(0,NA))
})

test_that("student res", {
  expect_equal(dev_student(10, 0.5, 0.5), dev_student(10, 0.5, 0.5, res = TRUE)^2)
  expect_equal(dev_student(0:1, c(0.3,0.6), 0.5), dev_student(0:1, c(0.3,0.6), 0.5, res = TRUE)^2)
})

test_that("student log_lik", {
  expect_equal(dev_student(0:1, 1:2, 2:3, theta = 0),
               2 * (log_lik_student(0:1, 0:1, 2:3, theta = 0) - log_lik_student(0:1, 1:2, 2:3, theta = 0)))
  expect_equal(dev_student(0:1, 1:2, 2:3, theta = 0.7),
               2 * (log_lik_student(0:1, 0:1, 2:3, theta = 0.7) - log_lik_student(0:1, 1:2, 2:3, theta = 0.7)))
  expect_equal(dev_student(1, 0.7, 1, 5),
               2 * (log_lik_student(1, 1, 1, 5) - log_lik_student(1, 0.7, 1, 5)))
})

test_that("student ran", {
  set.seed(101)
  samples <- ran_student(100000, 3, 0.5, 0.5)
  expect_equal(mean(samples), 3.00401173552349)
  expect_equal(var(samples), 2.47432193782075)
  res <- dev_student(samples, 3, 0.5, 0.5, res = TRUE)
  expect_equal(mean(res), -0.00261197674374733)
  expect_equal(sd(res), 1.35218891518458)
})

test_that("student deviance", {
  samples <- ran_student(1000, 3, 0.5, 0)
  mod <- glm(samples~1, family = gaussian)
  deviance <- sum(dev_student(samples, coef(mod)[1]))
  expect_equal(deviance, deviance(mod))
})

Try the extras package in your browser

Any scripts or data that you put into this service are public.

extras documentation built on May 31, 2023, 6:22 p.m.