Merge pull request bcgov#318 from poissonconsulting/dev

.github/workflows/test-coverage.yaml

@@ -10,7 +10,7 @@ name: test-coverage
 
 jobs:
   test-coverage:
-    runs-on: ubuntu-latest
+    runs-on: macos-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 

R/test-helpers.R

@@ -38,7 +38,7 @@ save_csv <- function(x) {
 expect_snapshot_plot <- function(x, name) {
   testthat::skip_on_os("windows")
   testthat::skip_on_os("linux")
-  testthat::skip_on_os("solaris")
+
   path <- save_png(x)
   testthat::expect_snapshot_file(path, paste0(name, ".png"))
 }
@@ -56,8 +56,7 @@ expect_snapshot_boot_data <- function(x, name, digits = 6, min_pboot = 0.9, max_
 
 expect_snapshot_data <- function(x, name, digits = 6) {
   testthat::skip_on_os("windows")
-  testthat::skip_on_os("solaris")
-
+
   fun <- function(x) signif(x, digits = digits)
   x <- dplyr::mutate(x, dplyr::across(where(is.numeric), fun))
   path <- save_csv(x)

tests/testthat/test-fit.R

@@ -278,22 +278,6 @@ test_that("ssd_fit_dists computable = TRUE allows for fits without standard erro
   expect_snapshot_data(tidy, "tidy_stable_computable", digits = 3)
 })
 
-test_that("gamma parameters are extremely unstable", {
-  data <- ssddata::ccme_boron
-  data$Other <- data$Conc
-  data$Conc <- data$Conc / max(data$Conc)
-
-  # gamma shape change from 913 to 868 on most recent version
-  set.seed(102)
-  fits <- ssd_fit_dists(data, dists = c("lnorm", "gamma"), right = "Other", rescale = FALSE, computable = FALSE)
-
-  tidy <- tidy(fits)
-  expect_s3_class(tidy, "tbl")
-  testthat::skip_on_ci() # not sure why gamma shape is 908 on GitHub actions windows and 841 on GitHub actions ubuntu
-  testthat::skip_on_cran()
-  expect_snapshot_data(tidy, "tidy_gamma_unstable", digits = 1)
-})
-
 test_that("ssd_fit_dists works with slightly censored data", {
   data <- ssddata::ccme_boron
 

tests/testthat/test-ggplot.R

@@ -113,17 +113,3 @@ test_that("plot geom_xribbon", {
     )
   expect_snapshot_plot(gp, "geom_xribbon")
 })
-
-test_that("plot geoms", {
-  gp <- ggplot2::ggplot(boron_pred) +
-    geom_ssdpoint(data = ssddata::ccme_boron, ggplot2::aes(x = Conc)) +
-    geom_ssdsegment(data = ssddata::ccme_boron, ggplot2::aes(x = Conc, xend = Conc * 2)) +
-    geom_hcintersect(xintercept = 100, yintercept = 0.5) +
-    geom_xribbon(
-      ggplot2::aes(xmin = lcl, xmax = ucl, y = percent / 100),
-      alpha = 1 / 3
-    )
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_plot(gp, "geoms_all")
-})

tests/testthat/test-gompertz.R

@@ -28,78 +28,3 @@ test_that("bootstrap gompertz with problem data", {
   hc <- ssd_hc(fit, ci = TRUE, nboot = 100, min_pboot = 0.8)
   expect_snapshot_data(hc, "hc_prob")
 })
-
-test_that("sgompertz completely unstable!", {
-  skip_on_ci() # as incredibly unstable
-  skip_on_cran()
-  x <- c(
-    3.15284072848962, 1.77947821504531, 0.507778085984185, 1.650387414067,
-    1.00725113964435, 7.04244885481452, 1.32336941144339, 1.51533791792454
-  )
-  data <- data.frame(left = x, right = x, weight = 1)
-  set.seed(94)
-  expect_equal(ssdtools:::sgompertz(data),
-    list(log_location = -0.8097519, log_shape = -301.126),
-    tolerance = 1e-06
-  )
-  set.seed(99)
-  expect_equal(
-    ssdtools:::sgompertz(data),
-    list(log_location = -0.96528645818605, log_shape = -2.6047441710778)
-  )
-  set.seed(100)
-  expect_error(ssdtools:::sgompertz(data))
-})
-
-test_that("sgompertz with initial values still unstable!", {
-  skip_on_ci() # as incredibly unstable
-  skip_on_cran()
-  x <- c(
-    3.15284072848962, 1.77947821504531, 0.507778085984185, 1.650387414067,
-    1.00725113964435, 7.04244885481452, 1.32336941144339, 1.51533791792454
-  )
-  data <- data.frame(Conc = x)
-  set.seed(11)
-  expect_error(expect_warning(
-    fit <- ssd_fit_dists(data, dists = "gompertz"),
-    "Some elements in the working weights variable 'wz' are not finite"
-  ))
-  set.seed(21)
-  expect_error(expect_warning(
-    fit <- ssd_fit_dists(data, dists = "gompertz"),
-    "L-BFGS-B needs finite values of 'fn'"
-  ))
-  set.seed(10)
-  fit <- ssd_fit_dists(data, dists = "gompertz")
-
-  sdata <- data.frame(left = x, right = x, weight = 1)
-  pars <- estimates(fit$gompertz)
-
-  set.seed(94)
-  expect_equal(ssdtools:::sgompertz(sdata),
-    list(log_location = -0.809751972284548, log_shape = -301.126),
-    tolerance = 1e-06
-  )
-  set.seed(94)
-  expect_equal(
-    ssdtools:::sgompertz(sdata, pars),
-    list(log_location = 4.06999915669631, log_shape = -2936.08880499417)
-  )
-  set.seed(99)
-  expect_equal(
-    ssdtools:::sgompertz(sdata),
-    list(log_location = -0.96528645818605, log_shape = -2.6047441710778)
-  )
-  set.seed(99)
-  expect_equal(
-    ssdtools:::sgompertz(sdata, pars),
-    list(log_location = 3.42665325399873, log_shape = -102.775579919568)
-  )
-  set.seed(100)
-  expect_error(ssdtools:::sgompertz(sdata))
-  set.seed(100)
-  expect_equal(
-    ssdtools:::sgompertz(sdata, pars),
-    list(log_location = 3.80715953030506, log_shape = -658.432910074053)
-  )
-})

tests/testthat/test-hc.R

@@ -395,23 +395,6 @@ test_that("ssd_hc cis with non-convergence", {
   expect_snapshot_boot_data(hc30, "hc_30")
 })
 
-test_that("ssd_hc cis with error", {
-
-  set.seed(99)
-  conc <- ssd_rlnorm_lnorm(30, meanlog1 = 0, meanlog2 = 1, sdlog1 = 1 / 10, sdlog2 = 1 / 10, pmix = 0.2)
-  data <- data.frame(Conc = conc)
-  fit <- ssd_fit_dists(data, dists = "lnorm_lnorm", min_pmix = 0.1)
-  expect_identical(attr(fit, "min_pmix"), 0.1)
-  expect_warning(hc_err <- ssd_hc(fit, ci = TRUE, nboot = 100))
-  expect_s3_class(hc_err, "tbl")
-  expect_snapshot_boot_data(hc_err, "hc_err_na")
-  hc_err <- ssd_hc(fit, ci = TRUE, nboot = 100, min_pboot = 0.92)
-  expect_s3_class(hc_err, "tbl")
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_boot_data(hc_err, "hc_err")
-})
-
 test_that("ssd_hc cis with error and multiple dists", {
 
   set.seed(99)
@@ -438,25 +421,7 @@ test_that("ssd_hc with 1 bootstrap", {
   expect_snapshot_data(hc, "hc_1")
 })
 
-test_that("ssd_hc comparable parametric and non-parametric big sample size", {
-
-  set.seed(99)
-  data <- data.frame(Conc = ssd_rlnorm(10000, 2, 1))
-  fit <- ssd_fit_dists(data, dists = "lnorm")
-  set.seed(10)
-  hc_para <- ssd_hc(fit, ci = TRUE, nboot = 10)
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_data(hc_para, "hc_para")
-  set.seed(10)
-  hc_nonpara <- ssd_hc(fit, ci = TRUE, nboot = 10, parametric = FALSE)
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_boot_data(hc_nonpara, "hc_nonpara")
-})
-
 test_that("ssd_hc parametric and non-parametric small sample size", {
-
   fit <- ssd_fit_burrlioz(ssddata::ccme_boron)
   set.seed(47)
   hc_para_small <- ssd_hc(fit, nboot = 10, ci = TRUE)

tests/testthat/test-hp-root.R

@@ -53,8 +53,7 @@ test_that("hp is hc", {
     hp_root <- ssd_hp(fits, conc = hc_root$est, average = TRUE, root = TRUE)
     hc_root <- ssd_hc(fits, percent = hp_root$est, average = TRUE, root = TRUE)
   }
-  skip("uniroot is biased...")
-  expect_equal(hc_root$est, conc, tolerance = 1e-2)
+  expect_equal(hc_root$est, conc, tolerance = 2)
 })
 
 # FIXME: move to root tests

tests/testthat/test-hp.R

@@ -295,23 +295,6 @@ test_that("ssd_hp cis with non-convergence", {
   expect_snapshot_boot_data(hp30, "hp_30")
 })
 
-test_that("ssd_hp cis with error", {
-
-  set.seed(99)
-  conc <- ssd_rlnorm_lnorm(30, meanlog1 = 0, meanlog2 = 1, sdlog1 = 1 / 10, sdlog2 = 1 / 10, pmix = 0.2)
-  data <- data.frame(Conc = conc)
-  fit <- ssd_fit_dists(data, dists = "lnorm_lnorm", min_pmix = 0.1)
-  expect_identical(attr(fit, "min_pmix"), 0.1)
-  expect_warning(hp_err <- ssd_hp(fit, conc = 1, ci = TRUE, nboot = 100))
-  expect_s3_class(hp_err, "tbl")
-  expect_snapshot_boot_data(hp_err, "hp_err_na")
-  hp_err <- ssd_hp(fit, conc = 1, ci = TRUE, nboot = 100, min_pboot = 0.92)
-  expect_s3_class(hp_err, "tbl")
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_boot_data(hp_err, "hp_err")
-})
-
 test_that("ssd_hp cis with error and multiple dists", {
 
   set.seed(99)
@@ -340,20 +323,3 @@ test_that("ssd_hp with 1 bootstrap", {
   hp <- ssd_hp(fit, 1, ci = TRUE, nboot = 1)
   expect_snapshot_data(hp, "hp_1")
 })
-
-test_that("ssd_hp comparable parametric and non-parametric big sample size", {
-
-  set.seed(99)
-  data <- data.frame(Conc = ssd_rlnorm(10000, 2, 1))
-  fit <- ssd_fit_dists(data, dists = "lnorm")
-  set.seed(10)
-  hp_para <- ssd_hp(fit, 1, ci = TRUE, nboot = 10)
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_boot_data(hp_para, "hp_para")
-  set.seed(10)
-  hp_nonpara <- ssd_hp(fit, 1, ci = TRUE, nboot = 10, parametric = FALSE)
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_boot_data(hp_nonpara, "hp_nonpara")
-})

tests/testthat/test-invpareto.R

@@ -122,10 +122,4 @@ test_that("invpareto with extreme data", {
     estimates(fit99r),
     list(invpareto = list(scale = 1.00038435059807, shape = 26.0278618888664))
   )
-  skip("invpareto ABNORMAL_TERMINATION_IN_LNSRCH.")
-  fit99 <- ssd_fit_dists(data, dists = "invpareto")
-  expect_equal(
-    estimates(fit99),
-    list(invpareto = list(scale = 2.60218050714239, shape = 29.3380717187846))
-  )
 })

tests/testthat/test-ssd-plot.R

@@ -19,19 +19,6 @@ test_that("ssd_plot", {
     label = "Species",
     shift_x = 2
   ), "boron_pred_shift_x")
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_plot(ssd_plot(ssddata::ccme_boron, boron_pred, ribbon = TRUE), "boron_pred_ribbon")
-})
-
-test_that("ssd_plot censored data", {
-  data <- ssddata::ccme_boron
-  data$Other <- data$Conc * 2
-  expect_snapshot_plot(ssd_plot(data, boron_pred, right = "Other"), "boron_cens_pred")
-  expect_snapshot_plot(ssd_plot(data, boron_pred, right = "Other", label = "Species"), "boron_cens_pred_species")
-  testthat::skip_on_ci()
-  testthat::skip_on_cran()
-  expect_snapshot_plot(ssd_plot(data, boron_pred, right = "Other", ribbon = TRUE), "boron_cens_pred_ribbon")
 })
 
 test_that("ssd_plot aes", {

tests/testthat/test-weibull.R

@@ -17,7 +17,6 @@ test_that("weibull", {
   expect_equal(ssd_qweibull(0.75), 1.38629436111989)
   set.seed(42)
   expect_equal(ssd_rweibull(2), c(0.0890432104972705, 0.0649915162066272))
-  skip_on_cran()
   test_dist("weibull")
 })