Nothing
# Copyright 2015-2023 Province of British Columbia
# Copyright 2021 Environment and Climate Change Canada
# Copyright 2023-2024 Australian Government Department of Climate Change,
# Energy, the Environment and Water
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# https://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
test_that("hc", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
set.seed(102)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, average = FALSE, samples = TRUE)
expect_s3_class(hc, "tbl")
expect_snapshot_data(hc, "hc")
})
test_that("hc estimate with censored data same number of 2parameters", {
data <- ssddata::ccme_boron
data$right <- data$Conc
data$Conc[c(3, 6, 8)] <- NA
fit <- ssd_fit_dists(data, right = "right", dists = c("lnorm", "llogis"))
hc <- ssd_hc(fit)
expect_snapshot_data(hc, "censored_2ll")
})
test_that("hc estimate with censored data same number of 5parameters", {
data <- ssddata::ccme_boron
data$right <- data$Conc
data$Conc[c(3, 6, 8)] <- NA
fit <- ssd_fit_dists(data, right = "right", dists = c("lnorm_lnorm", "llogis_llogis"))
hc <- ssd_hc(fit)
expect_snapshot_data(hc, "censored_5ll")
})
test_that("hc not estimate with different number of parameters", {
data <- ssddata::ccme_boron
data$right <- data$Conc
data$Conc[c(3, 6, 8)] <- NA
fit <- ssd_fit_dists(data, right = "right", dists = c("lnorm", "lnorm_lnorm"))
hc_each <- ssd_hc(fit, average = FALSE)
expect_snapshot_data(hc_each, "censored_each")
expect_warning(
hc_ave <- ssd_hc(fit),
"Model averaged estimates cannot be calculated for censored data when the distributions have different numbers of parameters."
)
expect_snapshot_data(hc_ave, "censored_ave")
})
test_that("ssd_hc list must be named", {
chk::expect_chk_error(ssd_hc(list()))
})
test_that("ssd_hc list names must be unique", {
chk::expect_chk_error(ssd_hc(list("lnorm" = NULL, "lnorm" = NULL)))
})
test_that("ssd_hc list handles zero length list", {
hc <- ssd_hc(structure(list(), .Names = character(0)))
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot", "samples"))
expect_identical(hc$dist, character(0))
expect_identical(hc$proportion, numeric(0))
expect_identical(hc$se, numeric(0))
})
test_that("ssd_hc list works null values handles zero length list", {
hc <- ssd_hc(list("lnorm" = NULL))
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot"))
expect_equal(hc$dist, "lnorm")
expect_identical(hc$proportion, 0.05)
expect_equal(hc$est, 0.193040816698737)
expect_equal(hc$se, NA_real_)
})
test_that("ssd_hc list works multiple percent values", {
hc <- ssd_hc(list("lnorm" = NULL), proportion = c(1, 99) / 100)
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot"))
expect_identical(hc$proportion, c(1, 99) / 100)
expect_equal(hc$dist, c("lnorm", "lnorm"))
expect_equal(hc$est, c(0.097651733070336, 10.2404736563121))
expect_identical(hc$se, c(NA_real_, NA_real_))
})
test_that("ssd_hc list works partial percent values", {
hc <- ssd_hc(list("lnorm" = NULL), proportion = c(50.5) / 100)
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot"))
expect_identical(hc$proportion, 50.5 / 100)
expect_equal(hc$dist, "lnorm")
expect_equal(hc$est, 1.01261234261044)
expect_identical(hc$se, NA_real_)
})
test_that("ssd_hc list works specified values", {
hc <- ssd_hc(list("lnorm" = list(meanlog = 2, sdlog = 2)))
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot"))
expect_identical(hc$proportion, 0.05)
expect_equal(hc$dist, "lnorm")
expect_equal(hc$est, 0.275351379333677)
expect_equal(hc$se, NA_real_)
})
test_that("ssd_hc list works multiple NULL distributions", {
hc <- ssd_hc(list("lnorm" = NULL, "llogis" = NULL))
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot"))
expect_identical(hc$proportion, c(5, 5) / 100)
expect_equal(hc$dist, c("lnorm", "llogis"))
expect_equal(hc$est, c(0.193040816698737, 0.0526315789473684))
expect_equal(hc$se, c(NA_real_, NA_real_))
})
test_that("ssd_hc list works multiple NULL distributions with multiple percent", {
hc <- ssd_hc(list("lnorm" = NULL, "llogis" = NULL), proportion = c(1, 99) / 100)
expect_s3_class(hc, "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot"))
expect_equal(hc$dist, c("lnorm", "lnorm", "llogis", "llogis"))
expect_identical(hc$proportion, c(1, 99, 1, 99) / 100)
expect_equal(hc$est, c(0.097651733070336, 10.2404736563121, 0.0101010101010101, 98.9999999999999))
expect_equal(hc$se, c(NA_real_, NA_real_, NA_real_, NA_real_))
})
test_that("ssd_hc fitdists works zero length percent", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, proportion = numeric(0))
expect_s3_class(hc, class = "tbl_df")
expect_identical(colnames(hc), c("dist", "proportion", "est", "se", "lcl", "ucl", "wt", "nboot", "pboot", "samples"))
expect_equal(hc$dist, character(0))
expect_identical(hc$proportion, numeric(0))
expect_equal(hc$est, numeric(0))
expect_equal(hc$se, numeric(0))
})
test_that("ssd_hc fitdists works NA percent", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, proportion = NA_real_)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc114")
})
test_that("ssd_hc fitdists works 0 percent", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, proportion = 0)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc122")
})
test_that("ssd_hc fitdists works 100 percent", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, proportion = 1)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc130")
})
test_that("ssd_hc fitdists works multiple percents", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, proportion = c(1, 99) / 100)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc138")
})
test_that("ssd_hc fitdists works fractions", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, proportion = 50.5 / 100)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc505")
})
test_that("ssd_hc fitdists averages", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
hc <- ssd_hc(fits, ci_method = "weighted_arithmetic", multi_est = FALSE)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc145")
})
test_that("ssd_hc fitdists correctly averages", {
fits <- ssd_fit_dists(ssddata::aims_molybdenum_marine,
dists = c("lgumbel", "lnorm_lnorm"),
min_pmix = 0
)
hc <- ssd_hc(fits, average = FALSE, ci_method = "multi_free")
expect_equal(hc$est, c(3881.17238083968, 5540.52003), tolerance = 1e-5)
expect_equal(hc$wt, c(0.0968427088339105, 0.90315729116609))
hc_avg <- ssd_hc(fits, ci_method = "weighted_arithmetic", multi_est = FALSE)
expect_equal(hc_avg$est, sum(hc$est * hc$wt))
})
test_that("ssd_hc fitdists averages single dist by multiple percent", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, average = TRUE, proportion = 1:99 / 100)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc153")
})
test_that("ssd_hc fitdists not average single dist by multiple percent gives whole numeric", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
hc <- ssd_hc(fits, average = FALSE, proportion = 1:99 / 100)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc161")
})
test_that("ssd_hc fitdists not average", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
hc <- ssd_hc(fits, average = FALSE)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc168")
})
test_that("ssd_hc fitdists correct for rescaling", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
fits_rescale <- ssd_fit_dists(ssddata::ccme_boron, rescale = TRUE)
hc <- ssd_hc(fits, ci_method = "weighted_arithmetic")
hc_rescale <- ssd_hc(fits_rescale, ci_method = "weighted_arithmetic")
expect_equal(hc_rescale, hc, tolerance = 1e-04)
})
test_that("ssd_hc fitdists cis", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
set.seed(102)
hc <- ssd_hc(fits, ci = TRUE, ci_method = "weighted_arithmetic", samples = TRUE)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc_cis")
})
test_that("ssd_hc fitdists cis level = 0.8", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
set.seed(102)
hc <- ssd_hc(fits, ci = TRUE, level = 0.8, ci_method = "weighted_arithmetic", samples = TRUE)
expect_s3_class(hc, "tbl_df")
expect_snapshot_data(hc, "hc_cis_level08")
})
test_that("ssd_hc doesn't calculate cis with inconsistent censoring", {
data <- ssddata::ccme_boron
data$Conc2 <- data$Conc
data$Conc[1] <- 0.5
data$Conc2[1] <- 1.0
fits <- ssd_fit_dists(data, dists = c("lnorm", "llogis"))
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic")
expect_equal(hc$se, 0.475836654747499, tolerance = 1e-6)
fits <- ssd_fit_dists(data, right = "Conc2", dists = c("lnorm", "llogis"))
set.seed(10)
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10),
"^Parametric CIs cannot be calculated for censored data[.]$"
)
expect_identical(hc$se, NA_real_)
})
test_that("ssd_hc works with fully left censored data", {
data <- ssddata::ccme_boron
data$Conc2 <- data$Conc
data$Conc <- 0
fits <- ssd_fit_dists(data, right = "Conc2", dists = c("lnorm", "llogis"))
set.seed(10)
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic"),
"^Parametric CIs cannot be calculated for censored data[.]$"
)
expect_snapshot_data(hc, "fullyleft")
})
test_that("ssd_hc warns with partially left censored data", {
data <- ssddata::ccme_boron
data$right <- data$Conc
data$Conc[c(3, 6, 8)] <- NA
set.seed(100)
fits <- ssd_fit_dists(data, dists = "lnorm", right = "right")
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, average = FALSE),
"Parametric CIs cannot be calculated for censored data\\."
)
expect_snapshot_data(hc, "partialeft")
})
test_that("ssd_hc works with fully left censored data", {
data <- ssddata::ccme_boron
data$right <- data$Conc
data$right[data$Conc < 4] <- 4
data$Conc[data$Conc < 4] <- NA
set.seed(100)
fits <- ssd_fit_dists(data, dists = "lnorm", right = "right")
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, average = FALSE),
"^Parametric CIs cannot be calculated for censored data\\.$"
)
expect_snapshot_data(hc, "partialeftfull")
})
test_that("ssd_hc works with partially left censored data non-parametric", {
data <- ssddata::ccme_boron
data$right <- data$Conc
data$Conc[c(3, 6, 8)] <- NA
set.seed(100)
fits <- ssd_fit_dists(data, dists = "lnorm", right = "right")
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, average = FALSE, parametric = FALSE)
expect_snapshot_data(hc, "partialeftnonpara")
expect_gt(hc$ucl, hc$est)
})
test_that("ssd_hc not work partially censored even if all same left", {
data <- ssddata::ccme_boron
data$Conc2 <- data$Conc
data$Conc <- 0.1
fits <- ssd_fit_dists(data, right = "Conc2", dists = c("lnorm", "llogis"))
set.seed(10)
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10),
"^Parametric CIs cannot be calculated for censored data[.]$"
)
})
test_that("ssd_hc doesn't works with inconsisently censored data", {
data <- ssddata::ccme_boron
data$Conc2 <- data$Conc
data$Conc <- 0
data$Conc[1] <- data$Conc2[1] / 2
fits <- ssd_fit_dists(data, right = "Conc2", dists = c("lnorm", "llogis"))
set.seed(10)
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10),
"^Parametric CIs cannot be calculated for censored data[.]$"
)
})
test_that("ssd_hc same with equally weighted data", {
data <- ssddata::ccme_boron
data$Weight <- rep(1, nrow(data))
fits <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm")
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10)
data$Weight <- rep(2, nrow(data))
fits2 <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm")
set.seed(10)
hc2 <- ssd_hc(fits2, ci = TRUE, nboot = 10)
expect_equal(hc2, hc)
})
test_that("ssd_hc calculates cis with equally weighted data", {
data <- ssddata::ccme_boron
data$Weight <- rep(2, nrow(data))
fits <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm")
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic", samples = TRUE)
expect_snapshot_data(hc, "hcici")
})
test_that("ssd_hc calculates cis in parallel but one distribution", {
local_multisession()
data <- ssddata::ccme_boron
fits <- ssd_fit_dists(data, dists = "lnorm")
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic", samples = TRUE)
expect_snapshot_data(hc, "hcici_multi")
})
test_that("ssd_hc calculates cis with two distributions", {
data <- ssddata::ccme_boron
fits <- ssd_fit_dists(data, dists = c("lnorm", "llogis"))
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic")
expect_equal(hc$se, 0.511475169043532, tolerance = 1e-6)
})
test_that("ssd_hc calculates cis in parallel with two distributions", {
local_multisession()
data <- ssddata::ccme_boron
fits <- ssd_fit_dists(data, dists = c("lnorm", "llogis"))
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic")
expect_equal(hc$se, 0.511475169043532, tolerance = 1e-6)
})
test_that("ssd_hc doesn't calculate cis with unequally weighted data", {
data <- ssddata::ccme_boron
data$Weight <- rep(1, nrow(data))
data$Weight[1] <- 2
fits <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm")
expect_warning(
hc <- ssd_hc(fits, ci = TRUE, nboot = 10),
"^Parametric CIs cannot be calculated for unequally weighted data[.]$"
)
expect_identical(hc$se, NA_real_)
})
test_that("ssd_hc no effect with higher weight one distribution", {
data <- ssddata::ccme_boron
data$Weight <- rep(1, nrow(data))
fits <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm")
data$Weight <- rep(10, nrow(data))
fits_10 <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm")
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10)
set.seed(10)
hc_10 <- ssd_hc(fits_10, ci = TRUE, nboot = 10)
expect_equal(hc_10, hc)
})
test_that("ssd_hc effect with higher weight two distributions", {
data <- ssddata::ccme_boron
data$Weight <- rep(1, nrow(data))
fits <- ssd_fit_dists(data, weight = "Weight", dists = c("lnorm", "llogis"))
data$Weight <- rep(10, nrow(data))
fits_10 <- ssd_fit_dists(data, weight = "Weight", dists = c("lnorm", "llogis"))
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic", multi_est = FALSE)
set.seed(10)
hc_10 <- ssd_hc(fits_10, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic", multi_est = FALSE)
expect_equal(hc$est, 1.6490386909599, tolerance = 1e-5)
expect_equal(hc_10$est, 1.68117856793665, tolerance = 1e-5)
expect_equal(hc$se, 0.511475588315084, tolerance = 1e-6)
expect_equal(hc_10$se, 0.455819671683407, tolerance = 1e-6)
})
test_that("ssd_hc cis with non-convergence", {
set.seed(99)
conc <- ssd_rlnorm_lnorm(100, 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.15)
expect_identical(attr(fit, "min_pmix"), 0.15)
hc15 <- ssd_hc(fit, ci = TRUE, nboot = 100, min_pboot = 0.9, ci_method = "weighted_arithmetic")
attr(fit, "min_pmix") <- 0.3
expect_identical(attr(fit, "min_pmix"), 0.3)
hc30 <- ssd_hc(fit, ci = TRUE, nboot = 100, min_pboot = 0.9, ci_method = "weighted_arithmetic")
expect_s3_class(hc30, "tbl")
expect_snapshot_data(hc30, "hc_30")
})
test_that("ssd_hc cis with error and multiple dists", {
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 = c("lnorm", "llogis_llogis"), min_pmix = 0.1)
expect_identical(attr(fit, "min_pmix"), 0.1)
set.seed(99)
skip_on_cran() # did not throw the expected warning.
expect_warning(hc_err_two <- ssd_hc(fit, ci = TRUE, nboot = 100, average = FALSE, delta = 100))
expect_snapshot_boot_data(hc_err_two, "hc_err_two")
set.seed(99)
expect_warning(hc_err_avg <- ssd_hc(fit,
ci = TRUE, nboot = 100,
delta = 100, ci_method = "weighted_arithmetic"
))
expect_snapshot_boot_data(hc_err_avg, "hc_err_avg")
})
test_that("ssd_hc with 1 bootstrap", {
fit <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
set.seed(10)
hc <- ssd_hc(fit, ci = TRUE, nboot = 1, ci_method = "weighted_arithmetic")
expect_snapshot_data(hc, "hc_1")
})
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, samples = TRUE)
expect_snapshot_data(hc_para_small, "hc_para_small")
set.seed(47)
hc_nonpara_small <- ssd_hc(fit, nboot = 10, ci = TRUE, parametric = FALSE, samples = TRUE)
expect_snapshot_data(hc_para_small, "hc_para_small")
})
test_that("ssd_hc_burrlioz gets estimates with invpareto", {
fit <- ssd_fit_burrlioz(ssddata::ccme_boron)
set.seed(47)
hc_boron <- ssd_hc(fit, nboot = 10, ci = TRUE, min_pboot = 0, samples = TRUE)
expect_snapshot_data(hc_boron, "hc_boron")
})
test_that("ssd_hc_burrlioz gets estimates with burrIII3", {
set.seed(99)
data <- data.frame(Conc = ssd_rburrIII3(30))
fit <- ssd_fit_burrlioz(data)
expect_identical(names(fit), "burrIII3")
set.seed(49)
hc_burrIII3 <- ssd_hc(fit, nboot = 10, ci = TRUE, min_pboot = 0, samples = TRUE)
expect_snapshot_data(hc_burrIII3, "hc_burrIII3")
})
test_that("ssd_hc_burrlioz gets estimates with burrIII3 parametric", {
set.seed(99)
data <- data.frame(Conc = ssd_rburrIII3(30))
fit <- ssd_fit_burrlioz(data)
expect_identical(names(fit), "burrIII3")
set.seed(49)
hc_burrIII3 <- ssd_hc(fit,
nboot = 10, ci = TRUE, min_pboot = 0,
parametric = TRUE, samples = TRUE
)
expect_snapshot_data(hc_burrIII3, "hc_burrIII3_parametric")
})
test_that("ssd_hc passing all boots ccme_chloride lnorm_lnorm", {
fits <- ssd_fit_dists(ssddata::ccme_chloride,
min_pmix = 0.0001, at_boundary_ok = TRUE,
dists = c("lnorm_lnorm", "llogis_llogis")
)
set.seed(102)
expect_warning(hc <- ssd_hc(fits, ci = TRUE, nboot = 1000, average = FALSE))
expect_s3_class(hc, "tbl_df")
expect_snapshot_boot_data(hc, "hc_cis_chloride50")
})
test_that("ssd_hc save_to", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = "lnorm")
set.seed(102)
hc <- ssd_hc(fits, nboot = 3, ci = TRUE, ci_method = "multi_fixed", save_to = dir, samples = TRUE)
expect_snapshot_data(hc, "hc_save_to")
expect_identical(list.files(dir), c(
"data_000000000_lnorm.csv", "data_000000001_lnorm.csv", "data_000000002_lnorm.csv",
"data_000000003_lnorm.csv", "estimates_000000000_lnorm.rds",
"estimates_000000001_lnorm.rds", "estimates_000000002_lnorm.rds",
"estimates_000000003_lnorm.rds"
))
data <- read.csv(file.path(dir, "data_000000000_lnorm.csv"))
expect_snapshot_data(hc, "hc_save_to1data")
boot1 <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
expect_snapshot_data(hc, "hc_save_to1")
ests <- readRDS(file.path(dir, "estimates_000000000_lnorm.rds"))
ests1 <- readRDS(file.path(dir, "estimates_000000001_lnorm.rds"))
expect_identical(names(ests), names(ests1))
expect_identical(names(ests), c(
"meanlog", "sdlog"
))
})
test_that("ssd_hc save_to ci_method = weighted_samples", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = "lnorm")
set.seed(102)
hc <- ssd_hc(fits, nboot = 3, ci = TRUE, save_to = dir, ci_method = "weighted_arithmetic", samples = TRUE)
expect_snapshot_data(hc, "hc_save_to_not_multi")
expect_identical(list.files(dir), c(
"data_000000000_lnorm.csv", "data_000000001_lnorm.csv", "data_000000002_lnorm.csv",
"data_000000003_lnorm.csv", "estimates_000000000_lnorm.rds",
"estimates_000000001_lnorm.rds", "estimates_000000002_lnorm.rds",
"estimates_000000003_lnorm.rds"
))
data1 <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
expect_snapshot_data(hc, "hc_save_to1_not_multi")
})
test_that("ssd_hc save_to ci_method = weighted_samples default", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron)
set.seed(102)
hc <- ssd_hc(fits, nboot = 1, ci = TRUE, save_to = dir, ci_method = "weighted_arithmetic", multi_est = FALSE, samples = TRUE)
expect_snapshot_data(hc, "hc_save_to_not_multi_default")
expect_identical(
sort(list.files(dir)),
sort(c(
"data_000000000_gamma.csv", "data_000000000_lgumbel.csv", "data_000000000_llogis.csv",
"data_000000000_lnorm_lnorm.csv", "data_000000000_lnorm.csv",
"data_000000000_weibull.csv", "data_000000001_gamma.csv", "data_000000001_lgumbel.csv",
"data_000000001_llogis.csv", "data_000000001_lnorm_lnorm.csv",
"data_000000001_lnorm.csv", "data_000000001_weibull.csv", "estimates_000000000_gamma.rds",
"estimates_000000000_lgumbel.rds", "estimates_000000000_llogis.rds",
"estimates_000000000_lnorm_lnorm.rds", "estimates_000000000_lnorm.rds",
"estimates_000000000_weibull.rds", "estimates_000000001_gamma.rds",
"estimates_000000001_lgumbel.rds", "estimates_000000001_llogis.rds",
"estimates_000000001_lnorm_lnorm.rds", "estimates_000000001_lnorm.rds",
"estimates_000000001_weibull.rds"
))
)
boot1 <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
expect_snapshot_data(hc, "hc_save_to1_not_multi_default")
})
test_that("ssd_hc save_to rescale", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = "lnorm", rescale = TRUE)
set.seed(102)
hc <- ssd_hc(fits, nboot = 3, ci = TRUE, ci_method = "multi_fixed", save_to = dir, samples = TRUE)
expect_snapshot_data(hc, "hc_save_to_rescale")
expect_identical(list.files(dir), c(
"data_000000000_lnorm.csv", "data_000000001_lnorm.csv", "data_000000002_lnorm.csv",
"data_000000003_lnorm.csv", "estimates_000000000_lnorm.rds",
"estimates_000000001_lnorm.rds", "estimates_000000002_lnorm.rds",
"estimates_000000003_lnorm.rds"
))
boot1 <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
expect_snapshot_data(hc, "hc_save_to1_rescale")
})
test_that("ssd_hc save_to lnorm 1", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = "lnorm")
set.seed(102)
hc <- ssd_hc(fits, nboot = 1, ci = TRUE, ci_method = "multi_fixed", save_to = dir, samples = TRUE)
expect_snapshot_data(hc, "hc_save_to11")
expect_identical(list.files(dir), c(
"data_000000000_lnorm.csv", "data_000000001_lnorm.csv", "estimates_000000000_lnorm.rds",
"estimates_000000001_lnorm.rds"
))
boot1 <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
fit1 <- ssd_fit_dists(boot1, dist = "lnorm", left = "left", right = "right", weight = "weight")
est <- ssd_hc(fit1)$est
expect_equal(hc$lcl, est, tolerance = 1e-6)
expect_identical(hc$lcl, hc$ucl)
})
test_that("ssd_hc save_to replaces", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = "lnorm")
set.seed(102)
hc <- ssd_hc(fits, nboot = 1, ci = TRUE, ci_method = "multi_fixed", save_to = dir)
expect_identical(list.files(dir), c(
"data_000000000_lnorm.csv", "data_000000001_lnorm.csv", "estimates_000000000_lnorm.rds",
"estimates_000000001_lnorm.rds"
))
boot <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
hc2 <- ssd_hc(fits, nboot = 1, ci = TRUE, ci_method = "multi_fixed", save_to = dir)
expect_identical(list.files(dir), c(
"data_000000000_lnorm.csv", "data_000000001_lnorm.csv", "estimates_000000000_lnorm.rds",
"estimates_000000001_lnorm.rds"
))
boot2 <- read.csv(file.path(dir, "data_000000001_lnorm.csv"))
expect_snapshot_data(boot, "hc_boot1_replace")
expect_snapshot_data(boot2, "hc_boot2_replace")
})
test_that("ssd_hc fix_weight", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = c("lnorm", "lgumbel"))
set.seed(102)
hc_unfix <- ssd_hc(fits, nboot = 100, ci = TRUE, ci_method = "multi_free", samples = TRUE)
expect_snapshot_data(hc_unfix, "hc_unfix")
set.seed(102)
hc_fix <- ssd_hc(fits, nboot = 100, ci = TRUE, ci_method = "multi_fixed", samples = TRUE)
expect_snapshot_data(hc_fix, "hc_fix")
})
test_that("ssd_hc multiple values", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = c("lnorm", "lgumbel"))
set.seed(102)
hc_unfix <- ssd_hc(fits, proportion = c(5, 10) / 100, nboot = 100, ci = TRUE, ci_method = "multi_free", samples = TRUE)
expect_snapshot_data(hc_unfix, "hc_unfixmulti")
set.seed(102)
hc_fix <- ssd_hc(fits, proportion = c(5, 10) / 100, nboot = 100, ci = TRUE, ci_method = "multi_fixed", samples = TRUE)
expect_snapshot_data(hc_fix, "hc_fixmulti")
})
test_that("ssd_hc multiple values save_to", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = c("lnorm", "lgumbel"))
set.seed(102)
hc <- ssd_hc(fits, proportion = c(5, 10) / 100, nboot = 2, save_to = dir, ci = TRUE, ci_method = "multi_fixed")
expect_identical(list.files(dir), c(
"data_000000000_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv",
"estimates_000000000_multi.rds", "estimates_000000001_multi.rds",
"estimates_000000002_multi.rds"
))
})
test_that("ssd_hc not multi_ci save_to", {
dir <- withr::local_tempdir()
fits <- ssd_fit_dists(ssddata::ccme_boron, dist = c("lnorm", "lgumbel"))
set.seed(102)
hc <- ssd_hc(fits, nboot = 2, ci_method = "weighted_arithmetic", save_to = dir, ci = TRUE)
expect_identical(list.files(dir), c(
"data_000000000_lgumbel.csv", "data_000000000_lnorm.csv", "data_000000001_lgumbel.csv",
"data_000000001_lnorm.csv", "data_000000002_lgumbel.csv", "data_000000002_lnorm.csv",
"estimates_000000000_lgumbel.rds", "estimates_000000000_lnorm.rds",
"estimates_000000001_lgumbel.rds", "estimates_000000001_lnorm.rds",
"estimates_000000002_lgumbel.rds", "estimates_000000002_lnorm.rds"
))
})
test_that("ssd_hc identical if in parallel", {
data <- ssddata::ccme_boron
fits <- ssd_fit_dists(data, dists = c("lnorm", "llogis"))
set.seed(10)
hc <- ssd_hc(fits, ci = TRUE, nboot = 500)
local_multisession(workers = 2)
set.seed(10)
hc2 <- ssd_hc(fits, ci = TRUE, nboot = 500)
expect_equal(hc, hc2, tolerance = 1e-6)
})
test_that("hc multi_ci false weighted", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = c("lnorm", "gamma"))
set.seed(102)
hc <- ssd_hc(fits, ci = TRUE, nboot = 10, average = TRUE, samples = TRUE, ci_method = "weighted_samples", multi_est = FALSE, min_pboot = 0.8)
expect_s3_class(hc, "tbl")
expect_snapshot_data(hc, "hc_weighted_samples")
})
test_that("hc multis match", {
fits <- ssd_fit_dists(ssddata::ccme_boron, dists = c("lnorm", "gamma"))
set.seed(102)
hc_tf <- ssd_hc(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = TRUE, ci_method = "weighted_samples")
set.seed(102)
hc_ft <- ssd_hc(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "multi_fixed")
set.seed(102)
hc_ff <- ssd_hc(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_samples")
set.seed(102)
hc_tt <- ssd_hc(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = TRUE, ci_method = "multi_fixed")
expect_identical(hc_tf$est, hc_tt$est)
expect_identical(hc_ft$est, hc_ff$est)
expect_identical(hc_ft$se, hc_tt$se)
expect_identical(hc_ff$se, hc_tf$se)
})
test_that("hc weighted bootie", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
set.seed(102)
hc_weighted2 <- ssd_hc(fits,
ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_samples",
samples = TRUE
)
set.seed(102)
hc_unweighted2 <- ssd_hc(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_arithmetic", samples = TRUE)
expect_identical(hc_weighted2$est, hc_unweighted2$est)
expect_identical(length(hc_weighted2$samples[[1]]), 11L)
expect_identical(length(hc_unweighted2$samples[[1]]), 60L)
expect_snapshot_boot_data(hc_weighted2, "hc_weighted2")
expect_snapshot_boot_data(hc_unweighted2, "hc_unweighted2")
})
test_that("hc percent deprecated", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
lifecycle::expect_deprecated(hc <- ssd_hc(fits, percent = 10))
hc2 <- ssd_hc(fits, proportion = 0.1)
expect_identical(hc2, hc)
lifecycle::expect_deprecated(hc <- ssd_hc(fits, percent = c(5, 10)))
hc2 <- ssd_hc(fits, proportion = c(0.05, 0.1))
expect_identical(hc2, hc)
})
test_that("hc proportion multiple decimal places", {
fits <- ssd_fit_dists(ssddata::ccme_boron)
hc2 <- ssd_hc(fits, proportion = 0.111111)
expect_identical(hc2$proportion, 0.111111)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.