diff --git a/CODE_OF_CONDUCT.md b/.github/CODE_OF_CONDUCT.md similarity index 99% rename from CODE_OF_CONDUCT.md rename to .github/CODE_OF_CONDUCT.md index eb131c4a8..3ac34c82d 100644 --- a/CODE_OF_CONDUCT.md +++ b/.github/CODE_OF_CONDUCT.md @@ -59,7 +59,7 @@ representative at an online or offline event. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be -reported to the community leaders responsible for enforcement at .github/. +reported to the community leaders responsible for enforcement at codeofconduct@posit.co. All complaints will be reviewed and investigated promptly and fairly. All community leaders are obligated to respect the privacy and security of the diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 40074d5fa..58aedd389 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -1,14 +1,16 @@ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help - +# on: push: - branches: [main, dev] + branches: [main, master] pull_request: - branches: [main, dev] + branches: [main, master, dev] name: R-CMD-check +permissions: read-all + jobs: R-CMD-check: runs-on: ${{ matrix.config.os }} @@ -23,19 +25,20 @@ jobs: - {os: windows-latest, r: 'release'} # use 4.1 to check with rtools40's older compiler - - {os: windows-latest, r: '4.1'} + - {os: windows-latest, r: 'oldrel-3'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} - - {os: ubuntu-latest, r: 'oldrel-2'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: ubuntu-latest, r: 'oldrel-2'} + - {os: ubuntu-latest, r: 'oldrel-3'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -53,3 +56,4 @@ jobs: - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 0b5cf4893..93ef053b4 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -2,14 +2,16 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: main + branches: [main, master] pull_request: - branches: main + branches: [main, master, dev] release: types: [published] workflow_dispatch: -name: pkgdown +name: pkgdown.yaml + +permissions: read-all jobs: pkgdown: @@ -22,7 +24,7 @@ jobs: permissions: contents: write steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -41,7 +43,7 @@ jobs: - name: Deploy to GitHub pages 🚀 if: github.event_name != 'pull_request' - uses: JamesIves/github-pages-deploy-action@v4.4.1 + uses: JamesIves/github-pages-deploy-action@v4.5.0 with: clean: false branch: gh-pages diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 689ae0ec7..9211f4b52 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -2,20 +2,22 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: main + branches: [main, master] pull_request: - branches: main + branches: [main, master, dev] -name: test-coverage +name: test-coverage.yaml + +permissions: read-all jobs: test-coverage: - runs-on: macos-latest + runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: @@ -23,28 +25,37 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr + extra-packages: any::covr, any::xml2 needs: coverage - name: Test coverage run: | - covr::codecov( + cov <- covr::package_coverage( quiet = FALSE, clean = FALSE, - install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) + covr::to_cobertura(cov) shell: Rscript {0} + - uses: codecov/codecov-action@v4 + with: + fail_ci_if_error: true + file: ./cobertura.xml + plugin: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + - name: Show testthat output if: always() run: | ## -------------------------------------------------------------------- - find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true shell: bash - name: Upload test results if: failure() - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: coverage-test-failures path: ${{ runner.temp }}/package diff --git a/.gitignore b/.gitignore index e6c2c1366..3ed4cd642 100644 --- a/.gitignore +++ b/.gitignore @@ -10,9 +10,8 @@ *.html -docs/ -inst/docs/ -inst/doc -paper/paper.pdf -scripts/boron_samples1 -scripts/checks.md +/docs/ +/inst/docs/ +/paper/paper.pdf +/scripts/boron_samples1 +/scripts/checks.md diff --git a/DESCRIPTION b/DESCRIPTION index fdc2f0294..816bd12f3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,9 +38,9 @@ Description: Species sensitivity distributions are cumulative probability different species as described by Posthuma et al.(2001) . The ssdtools package uses Maximum Likelihood to fit distributions such as the gamma, log-logistic, log-normal and - log-normal log-normal mixture. Multiple distributions can - be averaged using Akaike Information Criteria. Confidence intervals - on hazard concentrations and proportions are produced by parametric + log-normal log-normal mixture. Multiple distributions can be averaged + using Akaike Information Criteria. Confidence intervals on hazard + concentrations and proportions are produced by parametric bootstrapping. License: Apache License (== 2.0) | file LICENSE URL: https://github.com/bcgov/ssdtools, https://bcgov.github.io/ssdtools/ @@ -53,6 +53,7 @@ Imports: furrr, generics, ggplot2, + glue, goftest, graphics, grid, @@ -61,6 +62,7 @@ Imports: plyr, purrr, Rcpp, + rlang, scales, ssddata, stats, @@ -69,7 +71,8 @@ Imports: TMB, universals, utils, - VGAM + VGAM, + withr Suggests: actuar, covr, @@ -80,7 +83,6 @@ Suggests: fitdistrplus, foreach, future, - glue, grDevices, knitr, magrittr, @@ -89,13 +91,11 @@ Suggests: R.rsp, readr, reshape2, - rlang, rmarkdown, - testthat, + testthat (>= 3.0.0), tidyr, tidyselect, - tinytex, - withr + tinytex LinkingTo: Rcpp, RcppEigen, diff --git a/NAMESPACE b/NAMESPACE index af9e9890d..69ab74190 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,6 +68,7 @@ export(rgompertz) export(rlgumbel) export(scale_color_ssd) export(scale_colour_ssd) +export(ssd_censor_data) export(ssd_data) export(ssd_dists) export(ssd_dists_all) @@ -145,6 +146,7 @@ export(tidy) export(waiver) import(chk) import(ggplot2) +import(rlang) importFrom(Rcpp,sourceCpp) importFrom(TMB,MakeADFun) importFrom(TMB,sdreport) @@ -159,6 +161,7 @@ importFrom(generics,tidy) importFrom(ggplot2,autoplot) importFrom(ggplot2,sym) importFrom(ggplot2,waiver) +importFrom(glue,glue) importFrom(goftest,ad.test) importFrom(goftest,cvm.test) importFrom(graphics,par) @@ -173,6 +176,7 @@ importFrom(grid,segmentsGrob) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,deprecate_stop) importFrom(lifecycle,deprecate_warn) +importFrom(lifecycle,deprecated) importFrom(lifecycle,expect_deprecated) importFrom(parallel,nextRNGStream) importFrom(parallel,nextRNGSubStream) diff --git a/NEWS.md b/NEWS.md index 866e9df32..d499e7245 100644 --- a/NEWS.md +++ b/NEWS.md @@ -91,7 +91,7 @@ ssdtools version 1.0.0 is the first major release of `ssdtools` with some import ## Fitting -An important change to the functionality of `ssd_fit_dists()` was to switch from model fitting using [`fitdistrplus`](https://github.com/aursiber/fitdistrplus) to [`TMB`](https://github.com/kaskr/adcomp) which has resulted in improved handling of censored data. +An important change to the functionality of `ssd_fit_dists()` was to switch from model fitting using [`fitdistrplus`](https://github.com/lbbe-software/fitdistrplus) to [`TMB`](https://github.com/kaskr/adcomp) which has resulted in improved handling of censored data. Although it was hoped that model fitting would be faster this is currently not the case. As a result of the change the `fitdists` objects returned by `ssd_fit_dists()` from previous versions of `ssdtools` are not compatible with the major release and should be regenerated. diff --git a/R/bcanz.R b/R/bcanz.R index c7e0ab75b..f9ddcf484 100644 --- a/R/bcanz.R +++ b/R/bcanz.R @@ -32,7 +32,7 @@ ssd_dists_bcanz <- function(npars = c(2L, 5L)) { chk_unique(npars) check_dim(npars, values = 1:2) chk_subset(npars, c(2L, 5L)) - + ssd_dists(bcanz = TRUE, npars = npars) } @@ -50,8 +50,8 @@ ssd_dists_bcanz <- function(npars = c(2L, 5L)) { #' ssd_fit_bcanz(ssddata::ccme_boron) ssd_fit_bcanz <- function(data, left = "Conc", dists = ssd_dists_bcanz()) { ssd_fit_dists(data, - left = left, - dists = dists + left = left, + dists = dists ) } @@ -72,10 +72,10 @@ ssd_fit_bcanz <- function(data, left = "Conc", dists = ssd_dists_bcanz()) { #' ssd_hc_bcanz(fits, nboot = 100) ssd_hc_bcanz <- function(x, nboot = 10000, min_pboot = 0.95) { ssd_hc(x, - proportion = c(0.01, 0.05, 0.1, 0.2), - ci = TRUE, - nboot = nboot, - min_pboot = min_pboot + proportion = c(0.01, 0.05, 0.1, 0.2), + ci = TRUE, + nboot = nboot, + min_pboot = min_pboot ) } @@ -95,9 +95,9 @@ ssd_hc_bcanz <- function(x, nboot = 10000, min_pboot = 0.95) { #' ssd_hp_bcanz(fits, nboot = 100) ssd_hp_bcanz <- function(x, conc = 1, nboot = 10000, min_pboot = 0.95) { ssd_hp(x, - conc = conc, - ci = TRUE, - nboot = nboot, - min_pboot = min_pboot + conc = conc, + ci = TRUE, + nboot = nboot, + min_pboot = min_pboot ) } diff --git a/R/boot.R b/R/boot.R index 001aa4cf7..d537b21a7 100644 --- a/R/boot.R +++ b/R/boot.R @@ -58,14 +58,14 @@ sample_parameters <- function(i, dist, fun, data, args, pars, weighted, censorin parametric = parametric ) - if(!is.null(save_to)) { + if (!is.null(save_to)) { readr::write_csv(new_data, boot_filepath(i, dist, save_to)) } if (dist == "lnorm_lnorm") { pars <- slnorm_lnorm(new_data) } - if(dist == "multi") { + if (dist == "multi") { dist2 <- names(pars) } else { dist2 <- dist @@ -76,17 +76,17 @@ sample_parameters <- function(i, dist, fun, data, args, pars, weighted, censorin range_shape2 = range_shape2, control = control, pars = pars, hessian = FALSE, censoring = censoring, weighted = weighted )$result - + if (is.null(fit)) { return(NULL) } est <- estimates(fit, all_estimates = TRUE) - - if(!is.null(save_to)) { + + if (!is.null(save_to)) { saveRDS(est, boot_filepath(i, dist, save_to, prefix = "estimates", ext = ".rds")) } - - if(!is.null(wts)) { + + if (!is.null(wts)) { est[names(wts)] <- unname(wts) } est @@ -99,23 +99,23 @@ boot_estimates <- function(fun, dist, estimates, pars, nboot, data, weighted, ce args <- c(args, estimates) data <- data[c("left", "right", "weight")] - + seeds <- seed_streams(nboot) - - if(fix_weights) { + + if (fix_weights) { wts <- estimates[stringr::str_detect(names(estimates), "\\.weight$")] } else { wts <- NULL } - - if(!is.null(save_to)) { - if(!requireNamespace("readr", quietly = TRUE)) { + + if (!is.null(save_to)) { + if (!requireNamespace("readr", quietly = TRUE)) { err("Package 'readr' must be installed.") } readr::write_csv(data, boot_filepath(0, dist, save_to)) saveRDS(estimates, boot_filepath(0, dist, save_to, prefix = "estimates", ext = ".rds")) } - + estimates <- future_map(1:nboot, sample_parameters, dist = dist, fun = sfun, data = data, args = args, pars = pars, @@ -125,7 +125,9 @@ boot_estimates <- function(fun, dist, estimates, pars, nboot, data, weighted, ce wts = wts, .options = furrr::furrr_options(seed = seeds) ) - names(estimates) <- boot_filename(1:length(estimates), prefix = "", sep = "", - dist = paste0("_", dist)) + names(estimates) <- boot_filename(1:length(estimates), + prefix = "", sep = "", + dist = paste0("_", dist) + ) estimates[!vapply(estimates, is.null, TRUE)] } diff --git a/R/censor.R b/R/censor.R index 6ca98f309..4070e0f35 100644 --- a/R/censor.R +++ b/R/censor.R @@ -12,6 +12,32 @@ # See the License for the specific language governing permissions and # limitations under the License. + +#' Censor Data +#' +#' @inheritParams params +#' +#' @return A tibble of the censored data. +#' @export +#' +#' @examples +#' ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, Inf)) +ssd_censor_data <- function(data, left = "Conc", ..., right = left, censoring = c(0, Inf)) { + .chk_data(data, left, right) + chk_unused(...) + + if(left == right) { + right <- "right" + data$right <- data[[left]] + } + + processed <- process_data(data, left, right) + censored <- censor_data(processed, censoring) + data[[left]] <- censored$left + data[[right]] <- censored$right + data +} + .is_censored <- function(x) { !identical(x, c(0, Inf)) } @@ -31,58 +57,43 @@ censoring_text <- function(x) { censoring } -#' Is Censored -#' `r lifecycle::badge('deprecated')` -#' -#' Deprecated for [`ssd_is_censored()`]. -#' -#' @param x A fitdists object. -#' -#' @return A flag indicating if the data is censored. -#' @export -#' @seealso [`ssd_is_censored()`] -#' -#' @examples -#' fits <- ssd_fit_dists(ssddata::ccme_boron) -#' is_censored(fits) -is_censored <- function(x) { - lifecycle::deprecate_warn("0.3.7", "is_censored()", "ssd_is_censored()") - chk_s3_class(x, "fitdists") - ssd_is_censored(x) -} - censor_data <- function(data, censoring) { if (!.is_censored(censoring)) { return(data) } chk_not_any_na(censoring) - + + data$right[data$left < censoring[1]] <- censoring[1] data$left[data$left < censoring[1]] <- 0 + data$left[data$right > censoring[2]] <- censoring[2] data$right[data$right > censoring[2]] <- Inf data } censoring <- function(data) { censoring <- c(0, Inf) - data <- data[data$left != data$right, ] + + censored <- data[data$left != data$right, ] + data <- data[data$left == data$right, ] - if (!nrow(data)) { + if (!nrow(censored)) { return(censoring) } - left <- data$left == 0 - right <- is.infinite(data$right) - - if (any(!left & !right)) { + if (any(censored$left != 0 & !is.infinite(censored$right))) { return(c(NA_real_, NA_real_)) } - censoring[1] <- max(0, data$right[data$left == 0]) - censoring[2] <- min(Inf, censoring[2], data$left[is.infinite(data$right)]) + censoring[1] <- max(0, censored$right[censored$left == 0]) + censoring[2] <- min(Inf, censored$left[is.infinite(censored$right)]) if (censoring[1] >= censoring[2]) { return(c(NA_real_, NA_real_)) } + + if(any(data$right < censoring[1]) || any(data$left > censoring[2])) { + return(c(NA_real_, NA_real_)) + } censoring } diff --git a/R/censored.R b/R/censored.R index 23c5e46f4..347fd7982 100644 --- a/R/censored.R +++ b/R/censored.R @@ -54,3 +54,23 @@ ssd_is_censored.fitdists <- function(x, ...) { chk_unused(...) .is_censored(.censoring_fitdists(x)) } + +#' Is Censored +#' `r lifecycle::badge('deprecated')` +#' +#' Deprecated for [`ssd_is_censored()`]. +#' +#' @param x A fitdists object. +#' +#' @return A flag indicating if the data is censored. +#' @export +#' @seealso [`ssd_is_censored()`] +#' +#' @examples +#' fits <- ssd_fit_dists(ssddata::ccme_boron) +#' is_censored(fits) +is_censored <- function(x) { + lifecycle::deprecate_warn("0.3.7", "is_censored()", "ssd_is_censored()") + chk_s3_class(x, "fitdists") + ssd_is_censored(x) +} diff --git a/R/cis.R b/R/cis.R index c5eaff383..9ab182b26 100644 --- a/R/cis.R +++ b/R/cis.R @@ -21,7 +21,7 @@ xcis_estimates <- function(x, args, n, what, level, samples) { ests <- do.call(what, args) names(ests) <- n quantile <- quantile(ests, probs = probs(level)) - samples <- if(samples) ests else numeric(0) + samples <- if (samples) ests else numeric(0) data.frame( se = sd(ests), lcl = quantile[1], ucl = quantile[2], samples = I(list(samples)), diff --git a/R/data.R b/R/data.R index 01c0ef7cd..c42db9fe1 100644 --- a/R/data.R +++ b/R/data.R @@ -42,16 +42,16 @@ #' } #' @family dists #' @examples -#' dist +#' dist_data "dist_data" #' Pearson 1000 Data -#' +#' #' An example tibble of 1000 values simulated using a Pearson distribution #' with a #FIXME of #FIXME and a #FIXME of #FIXME. -#' +#' #' The data is released under $FIXME -#' +#' #' @format A tbl data frame that includes: #' \describe{ #' \item{Conc}{A numeric vector of the simulate concentrations.} diff --git a/R/devtools-helpers.R b/R/devtools-helpers.R index f0ed48eb1..62a924d82 100644 --- a/R/devtools-helpers.R +++ b/R/devtools-helpers.R @@ -1,4 +1,4 @@ -# Copyright 2023 Province of British Columbia +# Copyright 2024 Province of British Columbia # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -15,6 +15,9 @@ release_questions <- function() { c( "Have you confirmed Apache 2.0 license at the top of all code files?", - "Have you confirmed Creative Commons license for all non-code files?" + "Have you confirmed Creative Commons license for all non-code files?", + "Have you run `data-raw/data-raw.R`?", + "Have you tested using `ssdtests` package?", + "Have you updated `small-sample-bias.pdf` using `ssdtests` package?" ) } diff --git a/R/dists.R b/R/dists.R index b2b95ba29..9ddfe24b2 100644 --- a/R/dists.R +++ b/R/dists.R @@ -29,11 +29,11 @@ ssd_dists <- function(bcanz = NULL, tails = NULL, npars = 2:5) { chk_null_or(bcanz, vld = vld_flag) chk_null_or(tails, vld = vld_flag) - + chk_whole_numeric(npars) chk_not_any_na(npars) chk_range(npars, c(2L, 5L)) - + dists <- ssdtools::dist_data if (!is.null(bcanz)) { dists <- dists[dists$bcanz == bcanz, ] @@ -42,7 +42,7 @@ ssd_dists <- function(bcanz = NULL, tails = NULL, npars = 2:5) { dists <- dists[dists$tails == tails, ] } dists <- dists[dists$npars %in% npars, ] - + dists$dist } diff --git a/R/estimates.R b/R/estimates.R index 9d275822e..13198433d 100644 --- a/R/estimates.R +++ b/R/estimates.R @@ -43,11 +43,14 @@ estimates.fitdists <- function(x, all_estimates = FALSE, ...) { wt <- glance(x)$weight y <- purrr::map2(y, wt, function(a, b) c(list(weight = b), a)) names(y) <- names(x) - if(!all_estimates) { + if (!all_estimates) { return(y) } all <- emulti_ssd() - wall <- purrr::map(all, function(x) {x$weight <- 0; x}) + wall <- purrr::map(all, function(x) { + x$weight <- 0 + x + }) args <- y args$.x <- wall do.call("list_assign", args) diff --git a/R/fit-burrlioz.R b/R/fit-burrlioz.R index 73020d013..a5366995e 100644 --- a/R/fit-burrlioz.R +++ b/R/fit-burrlioz.R @@ -27,12 +27,13 @@ #' @examples #' ssd_fit_burrlioz(ssddata::ccme_boron) ssd_fit_burrlioz <- function(data, left = "Conc", rescale = FALSE, + control = list(), silent = FALSE) { if (nrow(data) <= 8) { fit <- ssd_fit_dists(data, left = left, dists = "llogis", computable = FALSE, nrow = 5L, - rescale = rescale, silent = silent + rescale = rescale, silent = silent, control = control, ) class(fit) <- c("fitburrlioz", class(fit)) return(fit) @@ -46,6 +47,7 @@ ssd_fit_burrlioz <- function(data, left = "Conc", rescale = FALSE, left = left, dists = "burrIII3", rescale = rescale, computable = FALSE, at_boundary_ok = TRUE, silent = TRUE, + control = control, range_shape1 = range_shape1, range_shape2 = range_shape2 ), diff --git a/R/fit.R b/R/fit.R index a80c0f972..bfe0050b4 100644 --- a/R/fit.R +++ b/R/fit.R @@ -17,9 +17,9 @@ nullify_nonfit <- function(fit, dist, data, rescale, computable, min_pmix, range_shape1, range_shape2, at_boundary_ok, silent) { error <- fit$error fit <- fit$result - + rescale <- if (rescale == 1) " (try rescaling data)" else NULL - + if (!is.null(error)) { if (!silent) { wrn( @@ -38,7 +38,7 @@ nullify_nonfit <- function(fit, dist, data, rescale, computable, } return(NULL) } - + if (!optimizer_converged(fit)) { message <- optimizer_message(fit) if (!silent) { @@ -66,58 +66,58 @@ nullify_nonfit <- function(fit, dist, data, rescale, computable, remove_nonfits <- function(fits, data, rescale, computable, min_pmix, range_shape1, range_shape2, at_boundary_ok, silent) { fits <- mapply(nullify_nonfit, fits, names(fits), - MoreArgs = list( - data = data, rescale = rescale, computable = computable, - min_pmix = min_pmix, - range_shape1 = range_shape1, range_shape2 = range_shape2, - at_boundary_ok = at_boundary_ok, silent = silent - ), SIMPLIFY = FALSE + MoreArgs = list( + data = data, rescale = rescale, computable = computable, + min_pmix = min_pmix, + range_shape1 = range_shape1, range_shape2 = range_shape2, + at_boundary_ok = at_boundary_ok, silent = silent + ), SIMPLIFY = FALSE ) fits <- fits[!vapply(fits, is.null, TRUE)] fits } -fit_dists <- function(data, dists, min_pmix, range_shape1, range_shape2, control, at_boundary_ok= TRUE, silent = TRUE, rescale = FALSE, computable = FALSE, pars = NULL, hessian = TRUE) { +fit_dists <- function(data, dists, min_pmix, range_shape1, range_shape2, control, at_boundary_ok = TRUE, silent = TRUE, rescale = FALSE, computable = FALSE, pars = NULL, hessian = TRUE) { data <- data[c("left", "right", "weight")] safe_fit_dist <- safely(fit_tmb) names(dists) <- dists - if(!is.null(pars)) { + if (!is.null(pars)) { pars <- pars[dists] } else { pars <- rep(list(NULL), length(dists)) } - - fits <- purrr::map2(dists, pars, .f = safe_fit_dist, - data = data, min_pmix = min_pmix, - range_shape1 = range_shape1, range_shape2 = range_shape2, control = control, - hessian = hessian + + fits <- purrr::map2(dists, pars, + .f = safe_fit_dist, + data = data, min_pmix = min_pmix, + range_shape1 = range_shape1, range_shape2 = range_shape2, control = control, + hessian = hessian ) fits <- remove_nonfits(fits, - data = data, rescale = rescale, - computable = computable, min_pmix = min_pmix, - range_shape1 = range_shape1, range_shape2 = range_shape2, - at_boundary_ok = at_boundary_ok, silent = silent + data = data, rescale = rescale, + computable = computable, min_pmix = min_pmix, + range_shape1 = range_shape1, range_shape2 = range_shape2, + at_boundary_ok = at_boundary_ok, silent = silent ) - + class(fits) <- "fitdists" fits } fits_dists <- function(data, dists, min_pmix, range_shape1, range_shape2, control, censoring, weighted, all_dists = TRUE, - at_boundary_ok= TRUE, silent = TRUE, rescale = FALSE, computable = FALSE, pars = NULL, hessian = TRUE) { + at_boundary_ok = TRUE, silent = TRUE, rescale = FALSE, computable = FALSE, pars = NULL, hessian = TRUE) { fits <- fit_dists(data, dists, - min_pmix = min_pmix, range_shape1 = range_shape1, - range_shape2 = range_shape2, - at_boundary_ok = at_boundary_ok, - control = control, silent = silent, - rescale = rescale, computable = computable - + min_pmix = min_pmix, range_shape1 = range_shape1, + range_shape2 = range_shape2, + at_boundary_ok = at_boundary_ok, + control = control, silent = silent, + rescale = rescale, computable = computable ) if (!length(fits)) { err("All distributions failed to fit.") } - if(all_dists && length(fits) != length(dists)) { + if (all_dists && length(fits) != length(dists)) { err("One or more distributions failed to fit.") } @@ -130,7 +130,7 @@ fits_dists <- function(data, dists, min_pmix, range_shape1, range_shape2, contro attrs$min_pmix <- min_pmix attrs$range_shape1 <- range_shape1 attrs$range_shape2 <- range_shape2 - + .attrs_fitdists(fits) <- attrs fits } @@ -139,15 +139,19 @@ fits_dists <- function(data, dists, min_pmix, range_shape1, range_shape2, contro #' #' Fits one or more distributions to species sensitivity data. #' -#' By default the 'llogis', 'gamma' and 'lnorm' -#' distributions are fitted to the data. -#' For a complete list of the implemented distributions see [`ssd_dists_all()`]. +#' By default the 'gamma', 'lgumbel', 'llogis', 'lnorm', 'lnorm_lnorm' and +#' 'weibull' distributions are fitted to the data. +#' For a complete list of the distributions that are currently implemented in +#' `ssdtools` see [`ssd_dists_all()`]. #' #' If weight specifies a column in the data frame with positive numbers, #' weighted estimation occurs. #' However, currently only the resultant parameter estimates are available. #' -#' If the `right` argument is different to the `left` argument then the data are considered to be censored. +#' If the `right` argument is different to the `left` argument +#' then the data are considered to be censored. +#' +#' The optim argument `pgtol` is set to 1e-5 if not specified via the control argument. #' #' @inheritParams params #' @return An object of class fitdists. @@ -178,13 +182,13 @@ ssd_fit_dists <- function( check_dim(dists, values = TRUE) chk_not_any_na(dists) chk_unique(dists) - + chk_subset(dists, ssd_dists_all()) - + chk_whole_number(nrow) chk_gte(nrow, 4L) .chk_data(data, left, right, weight, nrow) - + chk_flag(rescale) chk_flag(reweight) chk_flag(computable) @@ -206,7 +210,7 @@ ssd_fit_dists <- function( chk_sorted(range_shape2) chk_list(control) chk_flag(silent) - + org_data <- as_tibble(data) data <- process_data(data, left, right, weight) attrs <- adjust_data(data, rescale = rescale, reweight = reweight, silent = silent) @@ -214,16 +218,22 @@ ssd_fit_dists <- function( if (any(is.infinite(attrs$data$right))) { err("Distributions cannot currently be fitted to right censored data.") } - fits <- fits_dists(attrs$data, dists, - min_pmix = min_pmix, range_shape1 = range_shape1, - range_shape2 = range_shape2, - all_dists = all_dists, - at_boundary_ok = at_boundary_ok, - control = control, silent = silent, - rescale = attrs$rescale, computable = computable, - censoring = attrs$censoring, - weighted = attrs$weighted) + if(!utils::hasName(control, "pgtol")) { + control$pgtol <- 1e-5 + } + + fits <- fits_dists(attrs$data, dists, + min_pmix = min_pmix, range_shape1 = range_shape1, + range_shape2 = range_shape2, + all_dists = all_dists, + at_boundary_ok = at_boundary_ok, + control = control, silent = silent, + rescale = attrs$rescale, computable = computable, + censoring = attrs$censoring, + weighted = attrs$weighted + ) + .org_data_fitdists(fits) <- org_data .cols_fitdists(fits) <- list(left = left, right = right, weight = weight) .unequal_fitdists(fits) <- attrs$unequal diff --git a/R/ggplot.R b/R/ggplot.R index 8766f9f13..8d1eef1ec 100644 --- a/R/ggplot.R +++ b/R/ggplot.R @@ -48,7 +48,7 @@ scale_color_ssd <- function(...) { } #' Species Sensitivity Data Points -#' +#' #' Uses the empirical cumulative distribution to create scatterplot of points `x`. #' #' @inheritParams ggplot2::layer @@ -182,9 +182,9 @@ geom_xribbon <- function(mapping = NULL, #' Species Sensitivity Data Points #' `r lifecycle::badge('deprecated')` -#' +#' #' `geom_ssd()` has been deprecated for `geom_ssdpoint()`. -#' +#' #' @inheritParams ggplot2::layer #' @inheritParams ggplot2::geom_point #' @export diff --git a/R/hc-burrlioz.R b/R/hc-burrlioz.R index e6ac31819..3808c804b 100644 --- a/R/hc-burrlioz.R +++ b/R/hc-burrlioz.R @@ -14,7 +14,7 @@ #' Hazard Concentrations for Burrlioz Fit #' `r lifecycle::badge('deprecated')` -#' +#' #' Deprecated for [`ssd_hc()`]. #' #' @inheritParams params @@ -29,15 +29,15 @@ ssd_hc_burrlioz <- function(x, percent, proportion = 0.05, ci = FALSE, level = 0 min_pboot = 0.95, parametric = FALSE) { lifecycle::deprecate_warn("0.3.5", "ssd_hc_burrlioz()", "ssd_hc()") chk_s3_class(x, "fitburrlioz") - - if(lifecycle::is_present(percent)) { + + if (lifecycle::is_present(percent)) { lifecycle::deprecate_soft("1.0.6.9009", "ssd_hc(percent)", "ssd_hc(proportion)", id = "hc") chk_vector(percent) chk_numeric(percent) chk_range(percent, c(0, 100)) proportion <- percent / 100 } - + chk_vector(proportion) chk_numeric(proportion) chk_range(proportion) diff --git a/R/hc.R b/R/hc.R index fb5752750..85b573273 100644 --- a/R/hc.R +++ b/R/hc.R @@ -14,36 +14,36 @@ #' Hazard Concentrations for Species Sensitivity Distributions #' -#' Calculates concentration(s) with bootstrap confidence intervals -#' that protect specified proportion(s) of species for +#' Calculates concentration(s) with bootstrap confidence intervals +#' that protect specified proportion(s) of species for #' individual or model-averaged distributions #' using parametric or non-parametric bootstrapping. -#' -#' Model-averaged estimates and/or confidence intervals (including standard error) -#' can be calculated by treating the distributions as +#' +#' Model-averaged estimates and/or confidence intervals (including standard error) +#' can be calculated by treating the distributions as #' constituting a single mixture distribution #' versus 'taking the mean'. #' When calculating the model averaged estimates treating the -#' distributions as constituting a single mixture distribution +#' distributions as constituting a single mixture distribution #' ensures that `ssd_hc()` is the inverse of `ssd_hp()`. -#' +#' #' If treating the distributions as constituting a single mixture distribution #' when calculating model average confidence intervals then #' `weighted` specifies whether to use the original model weights versus -#' re-estimating for each bootstrap sample unless 'taking the mean' in which case +#' re-estimating for each bootstrap sample unless 'taking the mean' in which case #' `weighted` specifies -#' whether to take bootstrap samples from each distribution proportional to -#' its weight (so that they sum to `nboot`) versus -#' calculating the weighted arithmetic means of the lower +#' whether to take bootstrap samples from each distribution proportional to +#' its weight (so that they sum to `nboot`) versus +#' calculating the weighted arithmetic means of the lower #' and upper confidence limits based on `nboot` samples for each distribution. -#' -#' Distributions with an absolute AIC difference greater +#' +#' Distributions with an absolute AIC difference greater #' than a delta of by default 7 have considerably less support (weight < 0.01) #' and are excluded #' prior to calculation of the hazard concentrations to reduce the run time. -#' +#' #' @references -#' +#' #' Burnham, K.P., and Anderson, D.R. 2002. Model Selection and Multimodel Inference. Springer New York, New York, NY. doi:10.1007/b97636. #' #' @inheritParams params @@ -71,38 +71,38 @@ ssd_hc <- function(x, ...) { #' @describeIn ssd_hc Hazard Concentrations for Distributional Estimates #' @export #' @examples -#' +#' #' ssd_hc(ssd_match_moments()) ssd_hc.list <- function( - x, - percent, - proportion = 0.05, + x, + percent, + proportion = 0.05, ...) { chk_list(x) chk_named(x) chk_unique(names(x)) chk_unused(...) - - if(lifecycle::is_present(percent)) { + + if (lifecycle::is_present(percent)) { lifecycle::deprecate_soft("1.0.6.9009", "ssd_hc(percent)", "ssd_hc(proportion)", id = "hc") chk_vector(percent) chk_numeric(percent) chk_range(percent, c(0, 100)) proportion <- percent / 100 } - + chk_vector(proportion) chk_numeric(proportion) chk_range(proportion) - + if (!length(x)) { hc <- no_hcp() hc <- dplyr::rename(hc, proportion = "value") return(hc) } hc <- mapply(.ssd_hc_dist, x, names(x), - MoreArgs = list(proportion = proportion), - SIMPLIFY = FALSE + MoreArgs = list(proportion = proportion), + SIMPLIFY = FALSE ) bind_rows(hc) } @@ -110,31 +110,29 @@ ssd_hc.list <- function( #' @describeIn ssd_hc Hazard Concentrations for fitdists Object #' @export #' @examples -#' +#' #' fits <- ssd_fit_dists(ssddata::ccme_boron) #' ssd_hc(fits) ssd_hc.fitdists <- function( - x, - percent, + x, + percent, proportion = 0.05, average = TRUE, - ci = FALSE, - level = 0.95, + ci = FALSE, + level = 0.95, nboot = 1000, min_pboot = 0.95, multi_est = TRUE, ci_method = "weighted_samples", - parametric = TRUE, - delta = 9.21, + parametric = TRUE, + delta = 9.21, samples = FALSE, save_to = NULL, control = NULL, - ... -) { - + ...) { chk_unused(...) - - if(lifecycle::is_present(percent)) { + + if (lifecycle::is_present(percent)) { lifecycle::deprecate_soft("1.0.6.9009", "ssd_hc(percent)", "ssd_hc(proportion)", id = "hc") chk_vector(percent) chk_numeric(percent) @@ -147,12 +145,12 @@ ssd_hc.fitdists <- function( chk_range(proportion) chk_string(ci_method) chk_subset(ci_method, c("weighted_samples", "weighted_arithmetic", "multi_free", "multi_fixed")) - + fix_weights <- ci_method %in% c("weighted_samples", "multi_fixed") multi_ci <- ci_method %in% c("multi_free", "multi_fixed") hcp <- ssd_hcp_fitdists( - x = x, + x = x, value = proportion, ci = ci, level = level, @@ -167,8 +165,9 @@ ssd_hc.fitdists <- function( control = control, samples = samples, save_to = save_to, - hc = TRUE) - + hc = TRUE + ) + hcp <- dplyr::rename(hcp, proportion = "value") hcp } @@ -176,43 +175,43 @@ ssd_hc.fitdists <- function( #' @describeIn ssd_hc Hazard Concentrations for fitburrlioz Object #' @export #' @examples -#' +#' #' fit <- ssd_fit_burrlioz(ssddata::ccme_boron) #' ssd_hc(fit) ssd_hc.fitburrlioz <- function( - x, - percent, + x, + percent, proportion = 0.05, - ci = FALSE, - level = 0.95, + ci = FALSE, + level = 0.95, nboot = 1000, - min_pboot = 0.95, - parametric = FALSE, - samples = FALSE, - save_to = NULL, + min_pboot = 0.95, + parametric = FALSE, + samples = FALSE, + save_to = NULL, ...) { chk_length(x, upper = 1L) chk_named(x) chk_subset(names(x), c("burrIII3", "invpareto", "llogis", "lgumbel")) chk_unused(...) - - if(lifecycle::is_present(percent)) { + + if (lifecycle::is_present(percent)) { lifecycle::deprecate_soft("1.0.6.9009", "ssd_hc(percent)", "ssd_hc(proportion)", id = "hc") chk_vector(percent) chk_numeric(percent) chk_range(percent, c(0, 100)) proportion <- percent / 100 } - + chk_vector(proportion) chk_numeric(proportion) chk_range(proportion) - fun <- if(names(x) == "burrIII3") fit_burrlioz else fit_tmb + fun <- if (names(x) == "burrIII3") fit_burrlioz else fit_tmb - hcp <- ssd_hcp_fitdists ( + hcp <- ssd_hcp_fitdists( x = x, - value = proportion, + value = proportion, ci = ci, level = level, nboot = nboot, @@ -227,8 +226,9 @@ ssd_hc.fitburrlioz <- function( control = NULL, hc = TRUE, fix_weights = FALSE, - fun = fun) - + fun = fun + ) + hcp <- dplyr::rename(hcp, proportion = "value") hcp } diff --git a/R/hcp.R b/R/hcp.R index caf5a4442..51e8f74f0 100644 --- a/R/hcp.R +++ b/R/hcp.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -30,7 +30,7 @@ no_hcp <- function(hc) { no_ci_hcp <- function(value, dist, est, rescale, hc) { na <- rep(NA_real_, length(value)) - multiplier <- if(hc) rescale else 100 + multiplier <- if (hc) rescale else 100 hcp <- tibble( dist = rep(dist, length(value)), value = value, @@ -47,17 +47,17 @@ no_ci_hcp <- function(value, dist, est, rescale, hc) { } ci_hcp <- function(cis, estimates, value, dist, est, rescale, nboot, hc) { - multiplier <- if(hc) rescale else 100 - + multiplier <- if (hc) rescale else 100 + hcp <- tibble( dist = dist, - value = value, + value = value, est = est * multiplier, - se = cis$se * multiplier, - lcl = cis$lcl * multiplier, + se = cis$se * multiplier, + lcl = cis$lcl * multiplier, ucl = cis$ucl * multiplier, wt = rep(1, length(value)), - nboot = nboot, + nboot = nboot, pboot = length(estimates) / nboot, samples = I(lapply(cis$samples, function(x) x * multiplier)) ) @@ -65,46 +65,48 @@ ci_hcp <- function(cis, estimates, value, dist, est, rescale, nboot, hc) { } .ssd_hcp <- function( - x, dist, estimates, + x, dist, estimates, fun, pars, value, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control, save_to, samples, hc, fix_weights = FALSE) { - args <- estimates - - if(hc) { + + if (hc) { args$p <- value what <- paste0("ssd_q", dist) } else { args$q <- value / rescale what <- paste0("ssd_p", dist) } - + est <- do.call(what, args) if (!ci) { return(no_ci_hcp(value = value, dist = dist, est = est, rescale = rescale, hc = hc)) } - + censoring <- censoring / rescale - - ests <- boot_estimates(fun = fun, dist = dist, estimates = estimates, - pars = pars, nboot = nboot, data = data, weighted = weighted, - censoring = censoring, min_pmix = min_pmix, - range_shape1 = range_shape1, - range_shape2 = range_shape2, - parametric = parametric, - control = control, - save_to = save_to, - fix_weights = fix_weights + + ests <- boot_estimates( + fun = fun, dist = dist, estimates = estimates, + pars = pars, nboot = nboot, data = data, weighted = weighted, + censoring = censoring, min_pmix = min_pmix, + range_shape1 = range_shape1, + range_shape2 = range_shape2, + parametric = parametric, + control = control, + save_to = save_to, + fix_weights = fix_weights ) x <- value - if(!hc) { + if (!hc) { x <- x / rescale } cis <- cis_estimates(ests, what, level = level, x = x, samples = samples) - hcp <- ci_hcp(cis, estimates = ests, value = value, dist = dist, - est = est, rescale = rescale, nboot = nboot, hc = hc) + hcp <- ci_hcp(cis, + estimates = ests, value = value, dist = dist, + est = est, rescale = rescale, nboot = nboot, hc = hc + ) replace_min_pboot_na(hcp, min_pboot) } @@ -116,17 +118,19 @@ ci_hcp <- function(cis, estimates, value, dist, est, rescale, nboot, hc) { estimates <- estimates(x) dist <- .dist_tmbfit(x) pars <- .pars_tmbfit(x) - if(fix_weights && average) { + if (fix_weights && average) { nboot <- round(nboot * weight) } - .ssd_hcp(x, dist = dist, estimates = estimates, - fun = fun, pars = pars, - value = value, ci = ci, level = level, nboot = nboot, - min_pboot = min_pboot, - data = data, rescale = rescale, weighted = weighted, censoring = censoring, - min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, - parametric = parametric, control = control, save_to = save_to, samples = samples, - hc = hc) + .ssd_hcp(x, + dist = dist, estimates = estimates, + fun = fun, pars = pars, + value = value, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, control = control, save_to = save_to, samples = samples, + hc = hc + ) } hcp_ind <- function(hcp, weight, method) { @@ -163,7 +167,7 @@ replace_estimates <- function(hcp, est) { hcp_average <- function(hcp, weight, value, method, nboot) { samples <- group_samples(hcp) - + hcp <- lapply(hcp, function(x) x[c("value", "est", "se", "lcl", "ucl", "pboot")]) hcp <- lapply(hcp, as.matrix) hcp <- Reduce(function(x, y) { @@ -183,7 +187,6 @@ hcp_average <- function(hcp, weight, value, method, nboot) { } hcp_weighted <- function(hcp, level, samples, min_pboot) { - quantiles <- purrr::map(hcp$samples, stats::quantile, probs = probs(level)) quantiles <- purrr::transpose(quantiles) hcp$lcl <- unlist(quantiles[[1]]) @@ -194,49 +197,52 @@ hcp_weighted <- function(hcp, level, samples, min_pboot) { hcp$lcl[fail] <- NA_real_ hcp$ucl[fail] <- NA_real_ hcp$se[fail] <- NA_real_ - if(!samples) { + if (!samples) { hcp$samples <- I(list(numeric(0))) } hcp } -.ssd_hcp_ind <- function(x, value, ci, level, nboot, min_pboot, estimates, - data, rescale, - weighted, censoring, min_pmix, range_shape1, +.ssd_hcp_ind <- function(x, value, ci, level, nboot, min_pboot, estimates, + data, rescale, + weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control, hc, save_to, samples, fun) { weight <- purrr::map_dbl(estimates, function(x) x$weight) - hcp <- purrr::map2(x, weight, .ssd_hcp_tmbfit, - value = value, ci = ci, level = level, nboot = nboot, - min_pboot = min_pboot, - data = data, rescale = rescale, weighted = weighted, censoring = censoring, - min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, - parametric = parametric, fix_weights = FALSE, average = FALSE, control = control, - hc = hc, save_to = save_to, samples = samples, fun = fun) + hcp <- purrr::map2(x, weight, .ssd_hcp_tmbfit, + value = value, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, fix_weights = FALSE, average = FALSE, control = control, + hc = hc, save_to = save_to, samples = samples, fun = fun + ) method <- if (parametric) "parametric" else "non-parametric" - + hcp_ind(hcp, weight, method) } .ssd_hcp_multi <- function(x, value, ci, level, nboot, min_pboot, data, rescale, weighted, censoring, min_pmix, - range_shape1, range_shape2, parametric, control, + range_shape1, range_shape2, parametric, control, save_to, samples, fix_weights, hc) { estimates <- estimates(x, all_estimates = TRUE) dist <- "multi" fun <- fits_dists pars <- pars_fitdists(x) - - hcp <- .ssd_hcp(x, dist = dist, estimates = estimates, - fun = fun, pars = pars, - value = value, ci = ci, level = level, nboot = nboot, - min_pboot = min_pboot, - data = data, rescale = rescale, weighted = weighted, censoring = censoring, - min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, - parametric = parametric, control = control, save_to = save_to, - samples = samples, - hc = hc, fix_weights = fix_weights) + + hcp <- .ssd_hcp(x, + dist = dist, estimates = estimates, + fun = fun, pars = pars, + value = value, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, control = control, save_to = save_to, + samples = samples, + hc = hc, fix_weights = fix_weights + ) hcp$dist <- "average" method <- if (parametric) "parametric" else "non-parametric" hcp$method <- method @@ -246,28 +252,29 @@ hcp_weighted <- function(hcp, level, samples, min_pboot) { .ssd_hcp_conventional <- function(x, value, ci, level, nboot, min_pboot, estimates, data, rescale, weighted, censoring, min_pmix, - range_shape1, range_shape2, parametric, control, + range_shape1, range_shape2, parametric, control, save_to, samples, fix_weights, hc, fun) { - if(ci & fix_weights) { + if(ci && fix_weights) { atleast1 <- round(glance(x)$weight * nboot) >= 1L x <- subset(x, names(x)[atleast1]) estimates <- estimates[atleast1] } weight <- purrr::map_dbl(estimates, function(x) x$weight) - hcp <- purrr::map2(x, weight, .ssd_hcp_tmbfit, - value = value, ci = ci, level = level, nboot = nboot, - min_pboot = min_pboot, - data = data, rescale = rescale, weighted = weighted, censoring = censoring, - min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, - parametric = parametric, fix_weights = fix_weights, average = TRUE, control = control, - hc = hc, save_to = save_to, samples = samples || fix_weights, fun = fun) - + hcp <- purrr::map2(x, weight, .ssd_hcp_tmbfit, + value = value, ci = ci, level = level, nboot = nboot, + min_pboot = min_pboot, + data = data, rescale = rescale, weighted = weighted, censoring = censoring, + min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, + parametric = parametric, fix_weights = fix_weights, average = TRUE, control = control, + hc = hc, save_to = save_to, samples = samples || fix_weights, fun = fun + ) + method <- if (parametric) "parametric" else "non-parametric" - - hcp <- hcp_average(hcp, weight, value, method, nboot) - if(!fix_weights) { - if(!samples) { + + hcp <- hcp_average(hcp, weight, value, method, nboot) + if (!fix_weights) { + if (!samples) { hcp$samples <- I(list(numeric(0))) } return(hcp) @@ -276,31 +283,30 @@ hcp_weighted <- function(hcp, level, samples, min_pboot) { } .ssd_hcp_fitdists <- function( - x, - value, - ci, - level, + x, + value, + ci, + level, nboot, - average, + average, multi_est, - min_pboot, - parametric, - multi_ci, + min_pboot, + parametric, + multi_ci, fix_weights, control, hc, save_to, samples, fun) { - if (!length(x) || !length(value)) { return(no_hcp()) } - + if (is.null(control)) { control <- .control_fitdists(x) } - + data <- .data_fitdists(x) rescale <- .rescale_fitdists(x) censoring <- .censoring_fitdists(x) @@ -310,98 +316,110 @@ hcp_weighted <- function(hcp, level, samples, min_pboot) { weighted <- .weighted_fitdists(x) unequal <- .unequal_fitdists(x) estimates <- .list_estimates(x, all_estimates = FALSE) - + if (parametric && ci && identical(censoring, c(NA_real_, NA_real_))) { wrn("Parametric CIs cannot be calculated for inconsistently censored data.") ci <- FALSE } - + if (parametric && ci && unequal) { wrn("Parametric CIs cannot be calculated for unequally weighted data.") ci <- FALSE } - + if (!ci) { nboot <- 0L } - - if(!average) { + + if (!average) { hcp <- .ssd_hcp_ind( - x, value = value, ci = ci, level = level, nboot = nboot, + x, + value = value, ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, estimates = estimates, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, - hc = hc, save_to = save_to, samples = samples, fun = fun) + hc = hc, save_to = save_to, samples = samples, fun = fun + ) return(hcp) } - if(.is_censored(censoring) & !identical_parameters(x)) { + if(.is_censored(censoring) && !identical_parameters(x)) { wrn("Model averaged estimates cannot be calculated for censored data when the distributions have different numbers of parameters.") } - - if(multi_ci) { + + if (multi_ci) { hcp <- .ssd_hcp_multi( - x, value, ci = ci, level = level, nboot = nboot, + x, value, + ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, save_to = save_to, samples = samples, - fix_weights = fix_weights, hc = hc) - - if(multi_est) { + fix_weights = fix_weights, hc = hc + ) + + if (multi_est) { return(hcp) } - + est <- .ssd_hcp_conventional( - x, value, ci = FALSE, level = level, nboot = nboot, + x, value, + ci = FALSE, level = level, nboot = nboot, min_pboot = min_pboot, estimates = estimates, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, save_to = save_to, samples = samples, - fix_weights = fix_weights, hc = hc, fun = fun) - + fix_weights = fix_weights, hc = hc, fun = fun + ) + hcp <- replace_estimates(hcp, est) - + return(hcp) } - + hcp <- .ssd_hcp_conventional( - x, value, ci = ci, level = level, nboot = nboot, + x, value, + ci = ci, level = level, nboot = nboot, min_pboot = min_pboot, estimates = estimates, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, save_to = save_to, samples = samples, - fix_weights = fix_weights, hc = hc, fun = fun) + fix_weights = fix_weights, hc = hc, fun = fun + ) - if(!multi_est) { - if(!fix_weights) { + if (!multi_est) { + if (!fix_weights) { return(hcp) } est <- .ssd_hcp_conventional( - x, value, ci = FALSE, level = level, nboot = nboot, + x, value, + ci = FALSE, level = level, nboot = nboot, min_pboot = min_pboot, estimates = estimates, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, save_to = save_to, samples = samples, - fix_weights = fix_weights, hc = hc, fun = fun) + fix_weights = fix_weights, hc = hc, fun = fun + ) } else { est <- .ssd_hcp_multi( - x, value, ci = FALSE, level = level, nboot = nboot, + x, value, + ci = FALSE, level = level, nboot = nboot, min_pboot = min_pboot, data = data, rescale = rescale, weighted = weighted, censoring = censoring, min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2, parametric = parametric, control = control, save_to = save_to, samples = samples, - fix_weights = fix_weights, hc = hc) + fix_weights = fix_weights, hc = hc + ) } hcp <- replace_estimates(hcp, est) - + hcp } ssd_hcp_fitdists <- function( - x, - value, - ci, + x, + value, + ci, level, nboot, average, @@ -416,7 +434,6 @@ ssd_hcp_fitdists <- function( hc, fix_weights, fun = fit_tmb) { - chk_vector(value) chk_numeric(value) chk_flag(ci) @@ -437,16 +454,16 @@ ssd_hcp_fitdists <- function( chk_null_or(control, vld = vld_list) chk_null_or(save_to, vld = vld_dir) chk_flag(samples) - + x <- subset(x, delta = delta) - + hcp <- .ssd_hcp_fitdists( - x, + x, value = value, - ci = ci, - level = level, + ci = ci, + level = level, nboot = nboot, - average = average, + average = average, multi_est = multi_est, min_pboot = min_pboot, parametric = parametric, diff --git a/R/helpers.R b/R/helpers.R index d897e9be3..7a51d4b26 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -124,7 +124,9 @@ is_at_boundary <- function(fit, data, min_pmix = 0.5, range_shape1 = c(0.05, 20) geomid <- function(x) { x <- x[is.finite(x)] x <- x[x > 0] - if(!length(x)) return(1) + if (!length(x)) { + return(1) + } exp(mean(log(range(x)))) } diff --git a/R/hp.R b/R/hp.R index 528ba68da..6493b5cdf 100644 --- a/R/hp.R +++ b/R/hp.R @@ -15,7 +15,7 @@ #' Hazard Proportion #' #' Calculates proportion of species affected at specified concentration(s) -#' with quantile based bootstrap confidence intervals for +#' with quantile based bootstrap confidence intervals for #' individual or model-averaged distributions #' using parametric or non-parametric bootstrapping. #' For more information see the inverse function [`ssd_hc()`]. @@ -34,49 +34,47 @@ ssd_hp <- function(x, ...) { #' @describeIn ssd_hp Hazard Proportions for fitdists Object #' @export ssd_hp.fitdists <- function( - x, - conc = 1, + x, + conc = 1, average = TRUE, - ci = FALSE, - level = 0.95, + ci = FALSE, + level = 0.95, nboot = 1000, min_pboot = 0.95, multi_est = TRUE, ci_method = "weighted_samples", - parametric = TRUE, - delta = 9.21, + parametric = TRUE, + delta = 9.21, samples = FALSE, save_to = NULL, control = NULL, - ... -) { - + ...) { chk_vector(conc) chk_numeric(conc) chk_subset(ci_method, c("weighted_samples", "weighted_arithmetic", "multi_free", "multi_fixed")) - + chk_unused(...) - + fix_weights <- ci_method %in% c("weighted_samples", "multi_fixed") multi_ci <- ci_method %in% c("multi_free", "multi_fixed") - + hcp <- ssd_hcp_fitdists( - x = x, - value = conc, - ci = ci, - level = level, + x = x, + value = conc, + ci = ci, + level = level, nboot = nboot, - average = average, - multi_est = multi_est, - delta = delta, + average = average, + multi_est = multi_est, + delta = delta, min_pboot = min_pboot, - parametric = parametric, - multi_ci = multi_ci, + parametric = parametric, + multi_ci = multi_ci, fix_weights = fix_weights, - control = control, - save_to = save_to, - samples = samples, + control = control, + save_to = save_to, + samples = samples, hc = FALSE ) hcp <- dplyr::rename(hcp, conc = "value") @@ -87,19 +85,19 @@ ssd_hp.fitdists <- function( #' @describeIn ssd_hp Hazard Proportions for fitburrlioz Object #' @export #' @examples -#' +#' #' fit <- ssd_fit_burrlioz(ssddata::ccme_boron) #' ssd_hp(fit) ssd_hp.fitburrlioz <- function( - x, - conc = 1, - ci = FALSE, - level = 0.95, + x, + conc = 1, + ci = FALSE, + level = 0.95, nboot = 1000, - min_pboot = 0.95, - parametric = FALSE, + min_pboot = 0.95, + parametric = FALSE, samples = FALSE, - save_to = NULL, + save_to = NULL, ...) { chk_length(x, upper = 1L) chk_named(x) @@ -108,12 +106,12 @@ ssd_hp.fitburrlioz <- function( chk_numeric(conc) chk_flag(ci) chk_unused(...) - - fun <- if(names(x) == "burrIII3") fit_burrlioz else fit_tmb - - hcp <- ssd_hcp_fitdists ( + + fun <- if (names(x) == "burrIII3") fit_burrlioz else fit_tmb + + hcp <- ssd_hcp_fitdists( x = x, - value = conc, + value = conc, ci = ci, level = level, nboot = nboot, @@ -128,8 +126,9 @@ ssd_hp.fitburrlioz <- function( samples = samples, hc = FALSE, fix_weights = FALSE, - fun = fun) - + fun = fun + ) + hcp <- dplyr::rename(hcp, conc = "value") hcp } diff --git a/R/internal.R b/R/internal.R index d5fd5b785..7d38cd7bc 100644 --- a/R/internal.R +++ b/R/internal.R @@ -12,7 +12,7 @@ # See the License for the specific language governing permissions and # limitations under the License. -identical_parameters <- function(x){ +identical_parameters <- function(x) { length(unique(npars(x))) < 2 } @@ -35,7 +35,7 @@ pow <- function(x, y) x^y root <- function(p, f) { q <- rep(NA_real_, length(p)) - for(i in seq_along(p)) { + for (i in seq_along(p)) { q[i] <- stats::uniroot(f, p = p[i], lower = 0, upper = 1, extendInt = "upX", tol = .Machine$double.eps)$root } q diff --git a/R/licensing.R b/R/licensing.R index aa42b2a25..9e01f0e5f 100644 --- a/R/licensing.R +++ b/R/licensing.R @@ -1,19 +1,19 @@ #' Licensing Markdown -#' -#' A string of markdown code indicating the licensing of the code +#' +#' A string of markdown code indicating the licensing of the code #' and documentation #' @export #' @examples #' ssd_licensing_md() ssd_licensing_md <- function() { -"## Licensing + "## Licensing Copyright 2018-2024 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 - + The documentation is released under the [CC BY 4.0 License](https://creativecommons.org/licenses/by/4.0/) - + The code is released under the [Apache License 2.0](https://www.apache.org/licenses/LICENSE-2.0) " diff --git a/R/llogis-llogis.R b/R/llogis-llogis.R index e69da6969..7167f9c9b 100644 --- a/R/llogis-llogis.R +++ b/R/llogis-llogis.R @@ -62,8 +62,10 @@ ssd_rllogis_llogis <- function(n, locationlog1 = 0, scalelog1 = 1, #' #' ssd_ellogis_llogis() ssd_ellogis_llogis <- function() { - list(locationlog1 = 0, scalelog1 = 1, - locationlog2 = 1, scalelog2 = 1, pmix = 0.5) + list( + locationlog1 = 0, scalelog1 = 1, + locationlog2 = 1, scalelog2 = 1, pmix = 0.5 + ) } sllogis_llogis <- function(data, pars = NULL) { @@ -123,12 +125,16 @@ rlogis_logis_ssd <- function(n, location1, scale1, location2, scale2, pmix) { pllogis_llogis_ssd <- function(q, locationlog1, scalelog1, locationlog2, scalelog2, pmix) { - plogis_logis_ssd(log(q), location1 = locationlog1, scale1 = scalelog1, - location2 = locationlog2, scale2 = scalelog2, pmix = pmix) + plogis_logis_ssd(log(q), + location1 = locationlog1, scale1 = scalelog1, + location2 = locationlog2, scale2 = scalelog2, pmix = pmix + ) } qllogis_llogis_ssd <- function(p, locationlog1, scalelog1, locationlog2, scalelog2, pmix) { - exp(qlogis_logis_ssd(p, location1 = locationlog1, scale1 = scalelog1, - location2 = locationlog2, scale2 = scalelog2, pmix = pmix)) + exp(qlogis_logis_ssd(p, + location1 = locationlog1, scale1 = scalelog1, + location2 = locationlog2, scale2 = scalelog2, pmix = pmix + )) } diff --git a/R/lnorm-lnorm.R b/R/lnorm-lnorm.R index 6a145483c..98410caa0 100644 --- a/R/lnorm-lnorm.R +++ b/R/lnorm-lnorm.R @@ -21,9 +21,9 @@ ssd_plnorm_lnorm <- function(q, meanlog1 = 0, sdlog1 = 1, meanlog2 = 1, sdlog2 = 1, pmix = 0.5, lower.tail = TRUE, log.p = FALSE) { pdist("lnorm_lnorm", - q = q, meanlog1 = meanlog1, sdlog1 = sdlog1, - meanlog2 = meanlog2, sdlog2 = sdlog2, pmix = pmix, - lower.tail = lower.tail, log.p = log.p + q = q, meanlog1 = meanlog1, sdlog1 = sdlog1, + meanlog2 = meanlog2, sdlog2 = sdlog2, pmix = pmix, + lower.tail = lower.tail, log.p = log.p ) } @@ -36,9 +36,9 @@ ssd_qlnorm_lnorm <- function(p, meanlog1 = 0, sdlog1 = 1, meanlog2 = 1, sdlog2 = 1, pmix = 0.5, lower.tail = TRUE, log.p = FALSE) { qdist("lnorm_lnorm", - p = p, meanlog1 = meanlog1, sdlog1 = sdlog1, - meanlog2 = meanlog2, sdlog2 = sdlog2, pmix = pmix, - lower.tail = lower.tail, log.p = log.p + p = p, meanlog1 = meanlog1, sdlog1 = sdlog1, + meanlog2 = meanlog2, sdlog2 = sdlog2, pmix = pmix, + lower.tail = lower.tail, log.p = log.p ) } @@ -51,8 +51,8 @@ ssd_qlnorm_lnorm <- function(p, meanlog1 = 0, sdlog1 = 1, ssd_rlnorm_lnorm <- function(n, meanlog1 = 0, sdlog1 = 1, meanlog2 = 1, sdlog2 = 1, pmix = 0.5, chk = TRUE) { rdist("lnorm_lnorm", - n = n, meanlog1 = meanlog1, sdlog1 = sdlog1, - meanlog2 = meanlog2, sdlog2 = sdlog2, pmix = pmix, chk = chk + n = n, meanlog1 = meanlog1, sdlog1 = sdlog1, + meanlog2 = meanlog2, sdlog2 = sdlog2, pmix = pmix, chk = chk ) } @@ -62,17 +62,19 @@ ssd_rlnorm_lnorm <- function(n, meanlog1 = 0, sdlog1 = 1, #' #' ssd_elnorm_lnorm() ssd_elnorm_lnorm <- function() { - list(meanlog1 = 0, sdlog1 = 1, - meanlog2 = 1, sdlog2 = 1, pmix = 0.5) + list( + meanlog1 = 0, sdlog1 = 1, + meanlog2 = 1, sdlog2 = 1, pmix = 0.5 + ) } slnorm_lnorm <- function(data, pars = NULL) { if (!is.null(pars)) { return(pars) } - + x <- mean_weighted_values(data) - + x <- sort(x) n <- length(x) n2 <- floor(n / 2) @@ -104,7 +106,7 @@ qlnorm_lnorm_ssd <- function(p, meanlog1, sdlog1, meanlog2, sdlog2, pmix) { if (sdlog1 <= 0 || sdlog2 <= 0 || pmix <= 0 || pmix >= 1) { return(NaN) } - + f <- function(x, p) { plnorm_lnorm_ssd(x, meanlog1, sdlog1, meanlog2, sdlog2, pmix) - p } diff --git a/R/lnorm.R b/R/lnorm.R index 2ded3da59..ca0837ce0 100644 --- a/R/lnorm.R +++ b/R/lnorm.R @@ -64,7 +64,7 @@ slnorm <- function(data, pars = NULL) { list( meanlog = mean(log(x), na.rm = TRUE) * (1 + 1e-3), - log_sdlog = log(sd(log(x), na.rm = TRUE)) * (1 - 1e-3) + log_sdlog = log(sd(log(x), na.rm = TRUE)) * (1 - 1e-3) ) } diff --git a/R/min-pmix.R b/R/min-pmix.R index 7dc351bee..9d9ec748a 100644 --- a/R/min-pmix.R +++ b/R/min-pmix.R @@ -12,5 +12,5 @@ ssd_min_pmix <- function(n) { chk_whole_number(n) chk_gt(n) - max(min(3/n, 0.5), 0.1) + max(min(3 / n, 0.5), 0.1) } diff --git a/R/multi.R b/R/multi.R index 25fc0003b..6bb5d999f 100644 --- a/R/multi.R +++ b/R/multi.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -16,271 +16,271 @@ #' @describeIn ssd_p Cumulative Distribution Function for Multiple Distributions #' @export #' @examples -#' -#' # multi +#' +#' # multi #' ssd_pmulti(1) ssd_pmulti <- function( - q, - burrIII3.weight = 0, - burrIII3.shape1 = 1, - burrIII3.shape2 = 1, - burrIII3.scale = 1, - gamma.weight = 0, - gamma.shape = 1, - gamma.scale = 1, - gompertz.weight = 0, - gompertz.location = 1, - gompertz.shape = 1, - invpareto.weight = 0, - invpareto.shape = 3, - invpareto.scale = 1, - lgumbel.weight = 0, - lgumbel.locationlog = 0, - lgumbel.scalelog = 1, - llogis.weight = 0, - llogis.locationlog = 0, - llogis.scalelog = 1, - llogis_llogis.weight = 0, - llogis_llogis.locationlog1 = 0, - llogis_llogis.scalelog1 = 1, - llogis_llogis.locationlog2 = 1, - llogis_llogis.scalelog2 = 1, - llogis_llogis.pmix = 0.5, - lnorm.weight = 1, - lnorm.meanlog = 0, - lnorm.sdlog = 1, - lnorm_lnorm.weight = 0, - lnorm_lnorm.meanlog1 = 0, - lnorm_lnorm.sdlog1 = 1, - lnorm_lnorm.meanlog2 = 1, - lnorm_lnorm.sdlog2 = 1, - lnorm_lnorm.pmix = 0.5, - weibull.weight = 0, - weibull.shape = 1, - weibull.scale = 1, + q, + burrIII3.weight = 0, + burrIII3.shape1 = 1, + burrIII3.shape2 = 1, + burrIII3.scale = 1, + gamma.weight = 0, + gamma.shape = 1, + gamma.scale = 1, + gompertz.weight = 0, + gompertz.location = 1, + gompertz.shape = 1, + invpareto.weight = 0, + invpareto.shape = 3, + invpareto.scale = 1, + lgumbel.weight = 0, + lgumbel.locationlog = 0, + lgumbel.scalelog = 1, + llogis.weight = 0, + llogis.locationlog = 0, + llogis.scalelog = 1, + llogis_llogis.weight = 0, + llogis_llogis.locationlog1 = 0, + llogis_llogis.scalelog1 = 1, + llogis_llogis.locationlog2 = 1, + llogis_llogis.scalelog2 = 1, + llogis_llogis.pmix = 0.5, + lnorm.weight = 1, + lnorm.meanlog = 0, + lnorm.sdlog = 1, + lnorm_lnorm.weight = 0, + lnorm_lnorm.meanlog1 = 0, + lnorm_lnorm.sdlog1 = 1, + lnorm_lnorm.meanlog2 = 1, + lnorm_lnorm.sdlog2 = 1, + lnorm_lnorm.pmix = 0.5, + weibull.weight = 0, + weibull.shape = 1, + weibull.scale = 1, lower.tail = TRUE, log.p = FALSE) { pdist("multi", - q = q, - burrIII3.weight = burrIII3.weight, - burrIII3.shape1 = burrIII3.shape1, - burrIII3.shape2 = burrIII3.shape2, - burrIII3.scale = burrIII3.scale, - gamma.weight = gamma.weight, - gamma.shape = gamma.shape, - gamma.scale = gamma.scale, - gompertz.weight = gompertz.weight, - gompertz.location = gompertz.location, - gompertz.shape = gompertz.shape, - invpareto.weight = invpareto.weight, - invpareto.shape = invpareto.shape, - invpareto.scale = invpareto.scale, - lgumbel.weight = lgumbel.weight, - lgumbel.locationlog = lgumbel.locationlog, - lgumbel.scalelog = lgumbel.scalelog, - llogis.weight = llogis.weight, - llogis.locationlog = llogis.locationlog, - llogis.scalelog = llogis.scalelog, - llogis_llogis.weight = llogis_llogis.weight, - llogis_llogis.locationlog1 = llogis_llogis.locationlog1, - llogis_llogis.scalelog1 = llogis_llogis.scalelog1, - llogis_llogis.locationlog2 = llogis_llogis.locationlog2, - llogis_llogis.scalelog2 = llogis_llogis.scalelog2, - llogis_llogis.pmix = llogis_llogis.pmix, - lnorm.weight = lnorm.weight, - lnorm.meanlog = lnorm.meanlog, - lnorm.sdlog = lnorm.sdlog, - lnorm_lnorm.weight = lnorm_lnorm.weight, - lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, - lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, - lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, - lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, - lnorm_lnorm.pmix = lnorm_lnorm.pmix, - weibull.weight = weibull.weight, - weibull.shape = weibull.shape, - weibull.scale = weibull.scale, - lower.tail = lower.tail, log.p = log.p + q = q, + burrIII3.weight = burrIII3.weight, + burrIII3.shape1 = burrIII3.shape1, + burrIII3.shape2 = burrIII3.shape2, + burrIII3.scale = burrIII3.scale, + gamma.weight = gamma.weight, + gamma.shape = gamma.shape, + gamma.scale = gamma.scale, + gompertz.weight = gompertz.weight, + gompertz.location = gompertz.location, + gompertz.shape = gompertz.shape, + invpareto.weight = invpareto.weight, + invpareto.shape = invpareto.shape, + invpareto.scale = invpareto.scale, + lgumbel.weight = lgumbel.weight, + lgumbel.locationlog = lgumbel.locationlog, + lgumbel.scalelog = lgumbel.scalelog, + llogis.weight = llogis.weight, + llogis.locationlog = llogis.locationlog, + llogis.scalelog = llogis.scalelog, + llogis_llogis.weight = llogis_llogis.weight, + llogis_llogis.locationlog1 = llogis_llogis.locationlog1, + llogis_llogis.scalelog1 = llogis_llogis.scalelog1, + llogis_llogis.locationlog2 = llogis_llogis.locationlog2, + llogis_llogis.scalelog2 = llogis_llogis.scalelog2, + llogis_llogis.pmix = llogis_llogis.pmix, + lnorm.weight = lnorm.weight, + lnorm.meanlog = lnorm.meanlog, + lnorm.sdlog = lnorm.sdlog, + lnorm_lnorm.weight = lnorm_lnorm.weight, + lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, + lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, + lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, + lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, + lnorm_lnorm.pmix = lnorm_lnorm.pmix, + weibull.weight = weibull.weight, + weibull.shape = weibull.shape, + weibull.scale = weibull.scale, + lower.tail = lower.tail, log.p = log.p ) } #' @describeIn ssd_q Quantile Function for Multiple Distributions #' @export #' @examples -#' -#' # multi +#' +#' # multi #' ssd_qmulti(0.5) ssd_qmulti <- function( - p, - burrIII3.weight = 0, - burrIII3.shape1 = 1, - burrIII3.shape2 = 1, - burrIII3.scale = 1, - gamma.weight = 0, - gamma.shape = 1, - gamma.scale = 1, - gompertz.weight = 0, - gompertz.location = 1, - gompertz.shape = 1, - invpareto.weight = 0, - invpareto.shape = 3, - invpareto.scale = 1, - lgumbel.weight = 0, - lgumbel.locationlog = 0, - lgumbel.scalelog = 1, - llogis.weight = 0, - llogis.locationlog = 0, - llogis.scalelog = 1, - llogis_llogis.weight = 0, - llogis_llogis.locationlog1 = 0, - llogis_llogis.scalelog1 = 1, - llogis_llogis.locationlog2 = 1, - llogis_llogis.scalelog2 = 1, - llogis_llogis.pmix = 0.5, - lnorm.weight = 1, - lnorm.meanlog = 0, - lnorm.sdlog = 1, - lnorm_lnorm.weight = 0, - lnorm_lnorm.meanlog1 = 0, - lnorm_lnorm.sdlog1 = 1, - lnorm_lnorm.meanlog2 = 1, - lnorm_lnorm.sdlog2 = 1, - lnorm_lnorm.pmix = 0.5, - weibull.weight = 0, - weibull.shape = 1, - weibull.scale = 1, + p, + burrIII3.weight = 0, + burrIII3.shape1 = 1, + burrIII3.shape2 = 1, + burrIII3.scale = 1, + gamma.weight = 0, + gamma.shape = 1, + gamma.scale = 1, + gompertz.weight = 0, + gompertz.location = 1, + gompertz.shape = 1, + invpareto.weight = 0, + invpareto.shape = 3, + invpareto.scale = 1, + lgumbel.weight = 0, + lgumbel.locationlog = 0, + lgumbel.scalelog = 1, + llogis.weight = 0, + llogis.locationlog = 0, + llogis.scalelog = 1, + llogis_llogis.weight = 0, + llogis_llogis.locationlog1 = 0, + llogis_llogis.scalelog1 = 1, + llogis_llogis.locationlog2 = 1, + llogis_llogis.scalelog2 = 1, + llogis_llogis.pmix = 0.5, + lnorm.weight = 1, + lnorm.meanlog = 0, + lnorm.sdlog = 1, + lnorm_lnorm.weight = 0, + lnorm_lnorm.meanlog1 = 0, + lnorm_lnorm.sdlog1 = 1, + lnorm_lnorm.meanlog2 = 1, + lnorm_lnorm.sdlog2 = 1, + lnorm_lnorm.pmix = 0.5, + weibull.weight = 0, + weibull.shape = 1, + weibull.scale = 1, lower.tail = TRUE, log.p = FALSE) { qdist("multi", - p = p, - burrIII3.weight = burrIII3.weight, - burrIII3.shape1 = burrIII3.shape1, - burrIII3.shape2 = burrIII3.shape2, - burrIII3.scale = burrIII3.scale, - gamma.weight = gamma.weight, - gamma.shape = gamma.shape, - gamma.scale = gamma.scale, - gompertz.weight = gompertz.weight, - gompertz.location = gompertz.location, - gompertz.shape = gompertz.shape, - invpareto.weight = invpareto.weight, - invpareto.shape = invpareto.shape, - invpareto.scale = invpareto.scale, - lgumbel.weight = lgumbel.weight, - lgumbel.locationlog = lgumbel.locationlog, - lgumbel.scalelog = lgumbel.scalelog, - llogis.weight = llogis.weight, - llogis.locationlog = llogis.locationlog, - llogis.scalelog = llogis.scalelog, - llogis_llogis.weight = llogis_llogis.weight, - llogis_llogis.locationlog1 = llogis_llogis.locationlog1, - llogis_llogis.scalelog1 = llogis_llogis.scalelog1, - llogis_llogis.locationlog2 = llogis_llogis.locationlog2, - llogis_llogis.scalelog2 = llogis_llogis.scalelog2, - llogis_llogis.pmix = llogis_llogis.pmix, - lnorm.weight = lnorm.weight, - lnorm.meanlog = lnorm.meanlog, - lnorm.sdlog = lnorm.sdlog, - lnorm_lnorm.weight = lnorm_lnorm.weight, - lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, - lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, - lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, - lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, - lnorm_lnorm.pmix = lnorm_lnorm.pmix, - weibull.weight = weibull.weight, - weibull.shape = weibull.shape, - weibull.scale = weibull.scale, - lower.tail = lower.tail, log.p = log.p + p = p, + burrIII3.weight = burrIII3.weight, + burrIII3.shape1 = burrIII3.shape1, + burrIII3.shape2 = burrIII3.shape2, + burrIII3.scale = burrIII3.scale, + gamma.weight = gamma.weight, + gamma.shape = gamma.shape, + gamma.scale = gamma.scale, + gompertz.weight = gompertz.weight, + gompertz.location = gompertz.location, + gompertz.shape = gompertz.shape, + invpareto.weight = invpareto.weight, + invpareto.shape = invpareto.shape, + invpareto.scale = invpareto.scale, + lgumbel.weight = lgumbel.weight, + lgumbel.locationlog = lgumbel.locationlog, + lgumbel.scalelog = lgumbel.scalelog, + llogis.weight = llogis.weight, + llogis.locationlog = llogis.locationlog, + llogis.scalelog = llogis.scalelog, + llogis_llogis.weight = llogis_llogis.weight, + llogis_llogis.locationlog1 = llogis_llogis.locationlog1, + llogis_llogis.scalelog1 = llogis_llogis.scalelog1, + llogis_llogis.locationlog2 = llogis_llogis.locationlog2, + llogis_llogis.scalelog2 = llogis_llogis.scalelog2, + llogis_llogis.pmix = llogis_llogis.pmix, + lnorm.weight = lnorm.weight, + lnorm.meanlog = lnorm.meanlog, + lnorm.sdlog = lnorm.sdlog, + lnorm_lnorm.weight = lnorm_lnorm.weight, + lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, + lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, + lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, + lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, + lnorm_lnorm.pmix = lnorm_lnorm.pmix, + weibull.weight = weibull.weight, + weibull.shape = weibull.shape, + weibull.scale = weibull.scale, + lower.tail = lower.tail, log.p = log.p ) } #' @describeIn ssd_r Random Generation for Multiple Distributions #' @export #' @examples -#' -#' # multi +#' +#' # multi #' set.seed(50) #' hist(ssd_rmulti(1000), breaks = 100) -#' +#' #' fits <- ssd_fit_dists(ssddata::ccme_boron) #' do.call("ssd_rmulti", c(n = 10, estimates(fits))) ssd_rmulti <- function( - n, - burrIII3.weight = 0, - burrIII3.shape1 = 1, - burrIII3.shape2 = 1, - burrIII3.scale = 1, - gamma.weight = 0, - gamma.shape = 1, - gamma.scale = 1, - gompertz.weight = 0, - gompertz.location = 1, - gompertz.shape = 1, - invpareto.weight = 0, - invpareto.shape = 3, - invpareto.scale = 1, - lgumbel.weight = 0, - lgumbel.locationlog = 0, - lgumbel.scalelog = 1, - llogis.weight = 0, - llogis.locationlog = 0, - llogis.scalelog = 1, - llogis_llogis.weight = 0, - llogis_llogis.locationlog1 = 0, - llogis_llogis.scalelog1 = 1, - llogis_llogis.locationlog2 = 1, - llogis_llogis.scalelog2 = 1, - llogis_llogis.pmix = 0.5, - lnorm.weight = 1, - lnorm.meanlog = 0, - lnorm.sdlog = 1, - lnorm_lnorm.weight = 0, - lnorm_lnorm.meanlog1 = 0, - lnorm_lnorm.sdlog1 = 1, - lnorm_lnorm.meanlog2 = 1, - lnorm_lnorm.sdlog2 = 1, - lnorm_lnorm.pmix = 0.5, - weibull.weight = 0, - weibull.shape = 1, - weibull.scale = 1, + n, + burrIII3.weight = 0, + burrIII3.shape1 = 1, + burrIII3.shape2 = 1, + burrIII3.scale = 1, + gamma.weight = 0, + gamma.shape = 1, + gamma.scale = 1, + gompertz.weight = 0, + gompertz.location = 1, + gompertz.shape = 1, + invpareto.weight = 0, + invpareto.shape = 3, + invpareto.scale = 1, + lgumbel.weight = 0, + lgumbel.locationlog = 0, + lgumbel.scalelog = 1, + llogis.weight = 0, + llogis.locationlog = 0, + llogis.scalelog = 1, + llogis_llogis.weight = 0, + llogis_llogis.locationlog1 = 0, + llogis_llogis.scalelog1 = 1, + llogis_llogis.locationlog2 = 1, + llogis_llogis.scalelog2 = 1, + llogis_llogis.pmix = 0.5, + lnorm.weight = 1, + lnorm.meanlog = 0, + lnorm.sdlog = 1, + lnorm_lnorm.weight = 0, + lnorm_lnorm.meanlog1 = 0, + lnorm_lnorm.sdlog1 = 1, + lnorm_lnorm.meanlog2 = 1, + lnorm_lnorm.sdlog2 = 1, + lnorm_lnorm.pmix = 0.5, + weibull.weight = 0, + weibull.shape = 1, + weibull.scale = 1, chk = TRUE) { rdist("multi", - n = n, - burrIII3.weight = burrIII3.weight, - burrIII3.shape1 = burrIII3.shape1, - burrIII3.shape2 = burrIII3.shape2, - burrIII3.scale = burrIII3.scale, - gamma.weight = gamma.weight, - gamma.shape = gamma.shape, - gamma.scale = gamma.scale, - gompertz.weight = gompertz.weight, - gompertz.location = gompertz.location, - gompertz.shape = gompertz.shape, - invpareto.weight = invpareto.weight, - invpareto.shape = invpareto.shape, - invpareto.scale = invpareto.scale, - lgumbel.weight = lgumbel.weight, - lgumbel.locationlog = lgumbel.locationlog, - lgumbel.scalelog = lgumbel.scalelog, - llogis.weight = llogis.weight, - llogis.locationlog = llogis.locationlog, - llogis.scalelog = llogis.scalelog, - llogis_llogis.weight = llogis_llogis.weight, - llogis_llogis.locationlog1 = llogis_llogis.locationlog1, - llogis_llogis.scalelog1 = llogis_llogis.scalelog1, - llogis_llogis.locationlog2 = llogis_llogis.locationlog2, - llogis_llogis.scalelog2 = llogis_llogis.scalelog2, - llogis_llogis.pmix = llogis_llogis.pmix, - lnorm.weight = lnorm.weight, - lnorm.meanlog = lnorm.meanlog, - lnorm.sdlog = lnorm.sdlog, - lnorm_lnorm.weight = lnorm_lnorm.weight, - lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, - lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, - lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, - lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, - lnorm_lnorm.pmix = lnorm_lnorm.pmix, - weibull.weight = weibull.weight, - weibull.shape = weibull.shape, - weibull.scale = weibull.scale, - chk = chk + n = n, + burrIII3.weight = burrIII3.weight, + burrIII3.shape1 = burrIII3.shape1, + burrIII3.shape2 = burrIII3.shape2, + burrIII3.scale = burrIII3.scale, + gamma.weight = gamma.weight, + gamma.shape = gamma.shape, + gamma.scale = gamma.scale, + gompertz.weight = gompertz.weight, + gompertz.location = gompertz.location, + gompertz.shape = gompertz.shape, + invpareto.weight = invpareto.weight, + invpareto.shape = invpareto.shape, + invpareto.scale = invpareto.scale, + lgumbel.weight = lgumbel.weight, + lgumbel.locationlog = lgumbel.locationlog, + lgumbel.scalelog = lgumbel.scalelog, + llogis.weight = llogis.weight, + llogis.locationlog = llogis.locationlog, + llogis.scalelog = llogis.scalelog, + llogis_llogis.weight = llogis_llogis.weight, + llogis_llogis.locationlog1 = llogis_llogis.locationlog1, + llogis_llogis.scalelog1 = llogis_llogis.scalelog1, + llogis_llogis.locationlog2 = llogis_llogis.locationlog2, + llogis_llogis.scalelog2 = llogis_llogis.scalelog2, + llogis_llogis.pmix = llogis_llogis.pmix, + lnorm.weight = lnorm.weight, + lnorm.meanlog = lnorm.meanlog, + lnorm.sdlog = lnorm.sdlog, + lnorm_lnorm.weight = lnorm_lnorm.weight, + lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, + lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, + lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, + lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, + lnorm_lnorm.pmix = lnorm_lnorm.pmix, + weibull.weight = weibull.weight, + weibull.shape = weibull.shape, + weibull.scale = weibull.scale, + chk = chk ) } @@ -306,7 +306,7 @@ ssd_emulti <- function() { args <- estimates(fitdists, all_estimates = TRUE) args$p <- p args$lower.tail <- lower.tail - args$log.p <- log.p + args$log.p <- log.p do.call("ssd_qmulti", args) } @@ -324,8 +324,11 @@ emulti_ssd <- function() { names(es) <- dists es <- purrr::map(es, function(x) c(list(weight = 0), x)) dists_bcanz <- ssd_dists_bcanz() - wt <- 1/length(dists_bcanz) - purrr::map_if(es, dists %in% dists_bcanz, function(x) {x$weight <- wt; x}) + wt <- 1 / length(dists_bcanz) + purrr::map_if(es, dists %in% dists_bcanz, function(x) { + x$weight <- wt + x + }) } value_args <- function(x) { @@ -349,12 +352,15 @@ pmulti_fun <- function(list) { normalize_weights <- function(list) { dlist <- purrr::keep(list, function(x) !is.na(x$weight) && x$weight > 0) - if(!length(dlist)) { + if (!length(dlist)) { err("At least one distribution must have a positive weight.") } weights <- purrr::map_dbl(dlist, function(x) x$weight) wts <- weights / sum(weights) - wlist <- purrr::map2(dlist, wts, function(x, wt) { x$weight <- wt; x}) + wlist <- purrr::map2(dlist, wts, function(x, wt) { + x$weight <- wt + x + }) wlist } @@ -366,14 +372,14 @@ pmulti_list <- function(q, list) { qmulti_list <- function(p, list) { nlist <- normalize_weights(list) - + f <- pmulti_fun(nlist) root(p, f) } pmulti_ssd <- function( q, - burrIII3.weight, + burrIII3.weight, burrIII3.shape1, burrIII3.shape2, burrIII3.scale, @@ -411,50 +417,53 @@ pmulti_ssd <- function( weibull.shape, weibull.scale) { list <- .relist_estimates( - list(burrIII3.weight = burrIII3.weight, - burrIII3.shape1 = burrIII3.shape1, - burrIII3.shape2 = burrIII3.shape2, - burrIII3.scale = burrIII3.scale, - gamma.weight = gamma.weight, - gamma.shape = gamma.shape, - gamma.scale = gamma.scale, - gompertz.weight = gompertz.weight, - gompertz.location = gompertz.location, - gompertz.shape = gompertz.shape, - invpareto.weight = invpareto.weight, - invpareto.shape = invpareto.shape, - invpareto.scale = invpareto.scale, - lgumbel.weight = lgumbel.weight, - lgumbel.locationlog = lgumbel.locationlog, - lgumbel.scalelog = lgumbel.scalelog, - llogis.weight = llogis.weight, - llogis.locationlog = llogis.locationlog, - llogis.scalelog = llogis.scalelog, - llogis_llogis.weight = llogis_llogis.weight, - llogis_llogis.locationlog1 = llogis_llogis.locationlog1, - llogis_llogis.scalelog1 = llogis_llogis.scalelog1, - llogis_llogis.locationlog2 = llogis_llogis.locationlog2, - llogis_llogis.scalelog2 = llogis_llogis.scalelog2, - llogis_llogis.pmix = llogis_llogis.pmix, - lnorm.weight = lnorm.weight, - lnorm.meanlog = lnorm.meanlog, - lnorm.sdlog = lnorm.sdlog, - lnorm_lnorm.weight = lnorm_lnorm.weight, - lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, - lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, - lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, - lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, - lnorm_lnorm.pmix = lnorm_lnorm.pmix, - weibull.weight = weibull.weight, - weibull.shape = weibull.shape, - weibull.scale = weibull.scale)) - + list( + burrIII3.weight = burrIII3.weight, + burrIII3.shape1 = burrIII3.shape1, + burrIII3.shape2 = burrIII3.shape2, + burrIII3.scale = burrIII3.scale, + gamma.weight = gamma.weight, + gamma.shape = gamma.shape, + gamma.scale = gamma.scale, + gompertz.weight = gompertz.weight, + gompertz.location = gompertz.location, + gompertz.shape = gompertz.shape, + invpareto.weight = invpareto.weight, + invpareto.shape = invpareto.shape, + invpareto.scale = invpareto.scale, + lgumbel.weight = lgumbel.weight, + lgumbel.locationlog = lgumbel.locationlog, + lgumbel.scalelog = lgumbel.scalelog, + llogis.weight = llogis.weight, + llogis.locationlog = llogis.locationlog, + llogis.scalelog = llogis.scalelog, + llogis_llogis.weight = llogis_llogis.weight, + llogis_llogis.locationlog1 = llogis_llogis.locationlog1, + llogis_llogis.scalelog1 = llogis_llogis.scalelog1, + llogis_llogis.locationlog2 = llogis_llogis.locationlog2, + llogis_llogis.scalelog2 = llogis_llogis.scalelog2, + llogis_llogis.pmix = llogis_llogis.pmix, + lnorm.weight = lnorm.weight, + lnorm.meanlog = lnorm.meanlog, + lnorm.sdlog = lnorm.sdlog, + lnorm_lnorm.weight = lnorm_lnorm.weight, + lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, + lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, + lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, + lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, + lnorm_lnorm.pmix = lnorm_lnorm.pmix, + weibull.weight = weibull.weight, + weibull.shape = weibull.shape, + weibull.scale = weibull.scale + ) + ) + pmulti_list(q, list) } qmulti_ssd <- function( q, - burrIII3.weight, + burrIII3.weight, burrIII3.shape1, burrIII3.shape2, burrIII3.scale, @@ -491,52 +500,54 @@ qmulti_ssd <- function( weibull.weight, weibull.shape, weibull.scale) { - list <- .relist_estimates( - list(burrIII3.weight = burrIII3.weight, - burrIII3.shape1 = burrIII3.shape1, - burrIII3.shape2 = burrIII3.shape2, - burrIII3.scale = burrIII3.scale, - gamma.weight = gamma.weight, - gamma.shape = gamma.shape, - gamma.scale = gamma.scale, - gompertz.weight = gompertz.weight, - gompertz.location = gompertz.location, - gompertz.shape = gompertz.shape, - invpareto.weight = invpareto.weight, - invpareto.shape = invpareto.shape, - invpareto.scale = invpareto.scale, - lgumbel.weight = lgumbel.weight, - lgumbel.locationlog = lgumbel.locationlog, - lgumbel.scalelog = lgumbel.scalelog, - llogis.weight = llogis.weight, - llogis.locationlog = llogis.locationlog, - llogis.scalelog = llogis.scalelog, - llogis_llogis.weight = llogis_llogis.weight, - llogis_llogis.locationlog1 = llogis_llogis.locationlog1, - llogis_llogis.scalelog1 = llogis_llogis.scalelog1, - llogis_llogis.locationlog2 = llogis_llogis.locationlog2, - llogis_llogis.scalelog2 = llogis_llogis.scalelog2, - llogis_llogis.pmix = llogis_llogis.pmix, - lnorm.weight = lnorm.weight, - lnorm.meanlog = lnorm.meanlog, - lnorm.sdlog = lnorm.sdlog, - lnorm_lnorm.weight = lnorm_lnorm.weight, - lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, - lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, - lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, - lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, - lnorm_lnorm.pmix = lnorm_lnorm.pmix, - weibull.weight = weibull.weight, - weibull.shape = weibull.shape, - weibull.scale = weibull.scale)) - + list( + burrIII3.weight = burrIII3.weight, + burrIII3.shape1 = burrIII3.shape1, + burrIII3.shape2 = burrIII3.shape2, + burrIII3.scale = burrIII3.scale, + gamma.weight = gamma.weight, + gamma.shape = gamma.shape, + gamma.scale = gamma.scale, + gompertz.weight = gompertz.weight, + gompertz.location = gompertz.location, + gompertz.shape = gompertz.shape, + invpareto.weight = invpareto.weight, + invpareto.shape = invpareto.shape, + invpareto.scale = invpareto.scale, + lgumbel.weight = lgumbel.weight, + lgumbel.locationlog = lgumbel.locationlog, + lgumbel.scalelog = lgumbel.scalelog, + llogis.weight = llogis.weight, + llogis.locationlog = llogis.locationlog, + llogis.scalelog = llogis.scalelog, + llogis_llogis.weight = llogis_llogis.weight, + llogis_llogis.locationlog1 = llogis_llogis.locationlog1, + llogis_llogis.scalelog1 = llogis_llogis.scalelog1, + llogis_llogis.locationlog2 = llogis_llogis.locationlog2, + llogis_llogis.scalelog2 = llogis_llogis.scalelog2, + llogis_llogis.pmix = llogis_llogis.pmix, + lnorm.weight = lnorm.weight, + lnorm.meanlog = lnorm.meanlog, + lnorm.sdlog = lnorm.sdlog, + lnorm_lnorm.weight = lnorm_lnorm.weight, + lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, + lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, + lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, + lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, + lnorm_lnorm.pmix = lnorm_lnorm.pmix, + weibull.weight = weibull.weight, + weibull.shape = weibull.shape, + weibull.scale = weibull.scale + ) + ) + qmulti_list(q, list) } rmulti_ssd <- function( - n, - burrIII3.weight, + n, + burrIII3.weight, burrIII3.shape1, burrIII3.shape2, burrIII3.scale, @@ -574,44 +585,47 @@ rmulti_ssd <- function( weibull.shape, weibull.scale) { p <- runif(n) - + list <- .relist_estimates( - list(burrIII3.weight = burrIII3.weight, - burrIII3.shape1 = burrIII3.shape1, - burrIII3.shape2 = burrIII3.shape2, - burrIII3.scale = burrIII3.scale, - gamma.weight = gamma.weight, - gamma.shape = gamma.shape, - gamma.scale = gamma.scale, - gompertz.weight = gompertz.weight, - gompertz.location = gompertz.location, - gompertz.shape = gompertz.shape, - invpareto.weight = invpareto.weight, - invpareto.shape = invpareto.shape, - invpareto.scale = invpareto.scale, - lgumbel.weight = lgumbel.weight, - lgumbel.locationlog = lgumbel.locationlog, - lgumbel.scalelog = lgumbel.scalelog, - llogis.weight = llogis.weight, - llogis.locationlog = llogis.locationlog, - llogis.scalelog = llogis.scalelog, - llogis_llogis.weight = llogis_llogis.weight, - llogis_llogis.locationlog1 = llogis_llogis.locationlog1, - llogis_llogis.scalelog1 = llogis_llogis.scalelog1, - llogis_llogis.locationlog2 = llogis_llogis.locationlog2, - llogis_llogis.scalelog2 = llogis_llogis.scalelog2, - llogis_llogis.pmix = llogis_llogis.pmix, - lnorm.weight = lnorm.weight, - lnorm.meanlog = lnorm.meanlog, - lnorm.sdlog = lnorm.sdlog, - lnorm_lnorm.weight = lnorm_lnorm.weight, - lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, - lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, - lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, - lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, - lnorm_lnorm.pmix = lnorm_lnorm.pmix, - weibull.weight = weibull.weight, - weibull.shape = weibull.shape, - weibull.scale = weibull.scale)) + list( + burrIII3.weight = burrIII3.weight, + burrIII3.shape1 = burrIII3.shape1, + burrIII3.shape2 = burrIII3.shape2, + burrIII3.scale = burrIII3.scale, + gamma.weight = gamma.weight, + gamma.shape = gamma.shape, + gamma.scale = gamma.scale, + gompertz.weight = gompertz.weight, + gompertz.location = gompertz.location, + gompertz.shape = gompertz.shape, + invpareto.weight = invpareto.weight, + invpareto.shape = invpareto.shape, + invpareto.scale = invpareto.scale, + lgumbel.weight = lgumbel.weight, + lgumbel.locationlog = lgumbel.locationlog, + lgumbel.scalelog = lgumbel.scalelog, + llogis.weight = llogis.weight, + llogis.locationlog = llogis.locationlog, + llogis.scalelog = llogis.scalelog, + llogis_llogis.weight = llogis_llogis.weight, + llogis_llogis.locationlog1 = llogis_llogis.locationlog1, + llogis_llogis.scalelog1 = llogis_llogis.scalelog1, + llogis_llogis.locationlog2 = llogis_llogis.locationlog2, + llogis_llogis.scalelog2 = llogis_llogis.scalelog2, + llogis_llogis.pmix = llogis_llogis.pmix, + lnorm.weight = lnorm.weight, + lnorm.meanlog = lnorm.meanlog, + lnorm.sdlog = lnorm.sdlog, + lnorm_lnorm.weight = lnorm_lnorm.weight, + lnorm_lnorm.meanlog1 = lnorm_lnorm.meanlog1, + lnorm_lnorm.sdlog1 = lnorm_lnorm.sdlog1, + lnorm_lnorm.meanlog2 = lnorm_lnorm.meanlog2, + lnorm_lnorm.sdlog2 = lnorm_lnorm.sdlog2, + lnorm_lnorm.pmix = lnorm_lnorm.pmix, + weibull.weight = weibull.weight, + weibull.shape = weibull.shape, + weibull.scale = weibull.scale + ) + ) qmulti_list(p, list) } diff --git a/R/params.R b/R/params.R index 95f0565be..f160b9a51 100644 --- a/R/params.R +++ b/R/params.R @@ -19,13 +19,14 @@ #' @param at_boundary_ok A flag specifying whether a model with one or more #' parameters at the boundary should be considered to have converged (default = FALSE). #' @param average A flag specifying whether to provide model averaged values as opposed to a value for each distribution. -#' @param bcanz A flag or NULL specifying whether to only include distributions in the set that is approved by BC, Canada, Australia and New Zealand for official guidelines. +#' @param bcanz A flag or NULL specifying whether to only include distributions in the set that is approved by BC, Canada, Australia and New Zealand for official guidelines. #' @param breaks A character vector #' @param bounds A named non-negative numeric vector of the left and right bounds for #' uncensored missing (0 and Inf) data in terms of the orders of magnitude #' relative to the extremes for non-missing values. #' @param chk A flag specifying whether to check the arguments. #' @param ci A flag specifying whether to estimate confidence intervals (by bootstrapping). +#' @param censoring A numeric vector of the left and right censoring values. #' @param color A string of the column in data for the color aesthetic. #' @param computable A flag specifying whether to only return fits with numerically computable standard errors. #' @param conc A numeric vector of concentrations to calculate the hazard proportions for. @@ -56,17 +57,17 @@ #' @param meanlog mean on log scale parameter. #' @param meanlog1 mean on log scale parameter. #' @param meanlog2 mean on log scale parameter. -#' @param min_pboot A number between 0 and 1 of the minimum -#' proportion of bootstrap samples that must successfully fit (return a likelihood) +#' @param min_pboot A number between 0 and 1 of the minimum +#' proportion of bootstrap samples that must successfully fit (return a likelihood) #' to report the confidence intervals. #' @param min_pmix A number between 0 and 0.5 specifying the minimum proportion in mixture models. #' @param n A whole number of the effective number of rows of data. #' @param npars A whole numeric vector specifying which distributions to include based on the number of parameters. #' @param all_estimates A flag specifying whether to calculate estimates for all implemented distributions. -#' @param ci_method A string specifying which method to use for estimating the bootstrap values. +#' @param ci_method A string specifying which method to use for estimating the bootstrap values. #' Possible values are "multi_free" and "multi_fixed" which treat the distributions as constituting a single distribution but differ in whether the model weights are fixed and "weighted_samples" and "weighted_arithmetic" take bootstrap samples from each distribution proportional to its weight versus calculating the weighted arithmetic means of the lower and upper confidence limits. #' @param multi_est A flag specifying whether to treat the distributions as constituting a single distribution (as opposed to taking the mean) when calculating model averaged estimates. -#' @param na.rm A flag specifying whether to silently remove missing values or +#' @param na.rm A flag specifying whether to silently remove missing values or #' remove them with a warning. #' @param n positive number of observations. #' @param nboot A count of the number of bootstrap samples to use to estimate the confidence limits. A value of 10,000 is recommended for official guidelines. @@ -89,7 +90,7 @@ #' @param ribbon A flag indicating whether to plot the confidence interval as a grey ribbon as opposed to green solid lines. #' @param right A string of the column in data with the right concentration values. #' @param save_to NULL or a string specifying a directory to save where the bootstrap datasets and parameter estimates (when successfully converged) to. -#' @param samples A flag specfying whether to include a numeric vector of the bootstrap samples as a list column in the output. +#' @param samples A flag specfying whether to include a numeric vector of the bootstrap samples as a list column in the output. #' @param scale scale parameter. #' @param scalelog1 scalelog1 parameter. #' @param scalelog2 scalelog2 parameter. diff --git a/R/plot-cdf.R b/R/plot-cdf.R index c3c56f498..58f92b6df 100644 --- a/R/plot-cdf.R +++ b/R/plot-cdf.R @@ -35,12 +35,12 @@ ssd_plot_cdf <- function(x, ...) { ssd_plot_cdf.fitdists <- function(x, average = FALSE, delta = 9.21, ...) { chk_scalar(average) chk_logical(average) - - if(!is.na(average)) { - pred <- ssd_hc(x, proportion = 1:99/100, average = average, delta = delta) + + if (!is.na(average)) { + pred <- ssd_hc(x, proportion = 1:99 / 100, average = average, delta = delta) } else { - pred <- ssd_hc(x, proportion = 1:99/100, average = FALSE, delta = delta) - pred_ave <- ssd_hc(x, proportion = 1:99/100, average = TRUE, delta = delta) + pred <- ssd_hc(x, proportion = 1:99 / 100, average = FALSE, delta = delta) + pred_ave <- ssd_hc(x, proportion = 1:99 / 100, average = TRUE, delta = delta) pred <- dplyr::bind_rows(pred, pred_ave) } data <- ssd_data(x) @@ -67,7 +67,7 @@ ssd_plot_cdf.fitdists <- function(x, average = FALSE, delta = 9.21, ...) { #' lnorm = c(meanlog = 2, sdlog = 2) #' )) ssd_plot_cdf.list <- function(x, ...) { - pred <- ssd_hc(x, proportion = 1:99/100) + pred <- ssd_hc(x, proportion = 1:99 / 100) data <- data.frame(Conc = numeric(0)) linetype <- if (length(unique(pred$dist)) > 1) "dist" else NULL diff --git a/R/plot-cf.R b/R/plot-cf.R index 17a78884e..d0f8c2feb 100644 --- a/R/plot-cf.R +++ b/R/plot-cf.R @@ -14,7 +14,7 @@ #' Cullen and Frey Plot #' `r lifecycle::badge('deprecated')` -#' +#' #' Plots a Cullen and Frey graph of the skewness and kurtosis #' for non-censored data. #' diff --git a/R/plot-data.R b/R/plot-data.R index f5fb95bb9..b5d955ad8 100644 --- a/R/plot-data.R +++ b/R/plot-data.R @@ -35,10 +35,10 @@ ssd_plot_data <- function(data, left = "Conc", right = left, chk_number(shift_x) chk_range(shift_x, c(1, 1000)) - + chk_number(add_x) chk_range(add_x, c(-1000, 1000)) - + .chk_bounds(bounds) data <- process_data(data, left, right, weight = NULL) @@ -84,8 +84,10 @@ ssd_plot_data <- function(data, left = "Conc", right = left, ), stat = "identity") } - gp <- gp + plot_coord_scale(data, xlab = xlab, ylab = ylab, - trans = trans, xbreaks = xbreaks) + gp <- gp + plot_coord_scale(data, + xlab = xlab, ylab = ylab, + trans = trans, xbreaks = xbreaks + ) if (!is.null(label)) { data$right <- (data$right + add_x) * shift_x diff --git a/R/predict.R b/R/predict.R index fdff26f2c..946b3a67c 100644 --- a/R/predict.R +++ b/R/predict.R @@ -29,45 +29,45 @@ stats::predict #' fits <- ssd_fit_dists(ssddata::ccme_boron) #' predict(fits) predict.fitdists <- function( - object, - percent, - proportion = 1:99/100, + object, + percent, + proportion = 1:99 / 100, average = TRUE, - ci = FALSE, - level = 0.95, + ci = FALSE, + level = 0.95, nboot = 1000, min_pboot = 0.95, multi_est = TRUE, ci_method = "weighted_samples", - parametric = TRUE, - delta = 9.21, + parametric = TRUE, + delta = 9.21, control = NULL, ...) { chk_unused(...) - - - if(lifecycle::is_present(percent)) { + + + if (lifecycle::is_present(percent)) { lifecycle::deprecate_soft("1.0.6.9009", "ssd_hc(percent)", "ssd_hc(proportion)", id = "hc") chk_vector(percent) chk_numeric(percent) chk_range(percent, c(0, 100)) proportion <- percent / 100 } - + chk_vector(proportion) chk_numeric(proportion) chk_range(proportion) - + ssd_hc( object, - proportion = proportion, - ci = ci, + proportion = proportion, + ci = ci, level = level, - nboot = nboot, + nboot = nboot, min_pboot = min_pboot, multi_est = multi_est, - average = average, - delta = delta, + average = average, + delta = delta, parametric = parametric, ci_method = ci_method, control = control @@ -88,34 +88,34 @@ predict.fitdists <- function( #' fits <- ssd_fit_burrlioz(ssddata::ccme_boron) #' predict(fits) predict.fitburrlioz <- function( - object, - percent, - proportion = 1:99/100, + object, + percent, + proportion = 1:99 / 100, ci = FALSE, - level = 0.95, + level = 0.95, nboot = 1000, min_pboot = 0.95, parametric = TRUE, ...) { chk_unused(...) - - if(lifecycle::is_present(percent)) { + + if (lifecycle::is_present(percent)) { lifecycle::deprecate_soft("1.0.6.9009", "ssd_hc(percent)", "ssd_hc(proportion)", id = "hc") chk_vector(percent) chk_numeric(percent) chk_range(percent, c(0, 100)) proportion <- percent / 100 } - + chk_vector(proportion) chk_numeric(proportion) chk_range(proportion) - + ssd_hc(object, - proportion = proportion, - ci = ci, + proportion = proportion, + ci = ci, level = level, - nboot = nboot, + nboot = nboot, min_pboot = min_pboot, parametric = parametric ) diff --git a/R/ssd-plot.R b/R/ssd-plot.R index 5e4fbee4f..9f0b543e6 100644 --- a/R/ssd-plot.R +++ b/R/ssd-plot.R @@ -22,7 +22,7 @@ plot_coord_scale <- function(data, xlab, ylab, trans, xbreaks = waiver()) { if (is.waive(xbreaks) & trans == "log10") { xbreaks <- trans_breaks("log10", function(x) 10^x) } - + list( coord_trans(x = trans), scale_x_continuous(xlab, @@ -50,7 +50,7 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, label = NULL, shape = NULL, color = NULL, size = 2.5, linetype = NULL, linecolor = NULL, xlab = "Concentration", ylab = "Species Affected", - ci = TRUE, ribbon = TRUE, hc = 0.05, + ci = TRUE, ribbon = TRUE, hc = 0.05, shift_x = 3, add_x = 0, bounds = c(left = 1, right = 1), trans = "log10", xbreaks = waiver()) { @@ -71,7 +71,7 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, chk_range(shift_x, c(1, 1000)) chk_number(add_x) chk_range(add_x, c(-1000, 1000)) - + chk_flag(ci) chk_flag(ribbon) @@ -153,8 +153,10 @@ ssd_plot <- function(data, pred, left = "Conc", right = left, ), stat = "identity") } - gp <- gp + plot_coord_scale(data, xlab = xlab, ylab = ylab, - trans = trans, xbreaks = xbreaks) + gp <- gp + plot_coord_scale(data, + xlab = xlab, ylab = ylab, + trans = trans, xbreaks = xbreaks + ) if (!is.null(label)) { data$right <- (data$right + add_x) * shift_x diff --git a/R/ssdtools-package.R b/R/ssdtools-package.R index 31c7392f8..39fc5dd26 100644 --- a/R/ssdtools-package.R +++ b/R/ssdtools-package.R @@ -19,14 +19,16 @@ utils::globalVariables("where") ## usethis namespace: start #' @import chk ggplot2 +#' @import rlang #' @importFrom abind abind #' @importFrom furrr future_map furrr_options #' @importFrom generics augment glance tidy #' @importFrom ggplot2 autoplot sym +#' @importFrom glue glue #' @importFrom goftest ad.test cvm.test #' @importFrom graphics par plot title #' @importFrom grid gList gpar grobName gTree polygonGrob segmentsGrob -#' @importFrom lifecycle expect_deprecated deprecate_soft deprecate_stop deprecate_warn +#' @importFrom lifecycle deprecated expect_deprecated deprecate_soft deprecate_stop deprecate_warn #' @importFrom parallel nextRNGStream nextRNGSubStream #' @importFrom plyr summarise #' @importFrom purrr list_assign transpose diff --git a/R/test-helpers.R b/R/test-helpers.R index e5816bec0..62ee193a4 100644 --- a/R/test-helpers.R +++ b/R/test-helpers.R @@ -25,7 +25,7 @@ save_png <- function(x, width = 400, height = 400) { grDevices::png(path, width = width, height = height) on.exit(grDevices::dev.off()) print(x) - + path } @@ -38,7 +38,7 @@ save_csv <- function(x) { expect_snapshot_plot <- function(x, name) { testthat::skip_on_os("windows") testthat::skip_on_os("linux") - + path <- save_png(x) testthat::expect_snapshot_file(path, paste0(name, ".png")) } @@ -61,9 +61,10 @@ expect_snapshot_data <- function(x, name, digits = 6) { x <- dplyr::mutate(x, dplyr::across(where(is.list), lapply_fun)) path <- save_csv(x) testthat::expect_snapshot_file( - path, - paste0(name, ".csv"), - compare = testthat::compare_file_text) + path, + paste0(name, ".csv"), + compare = testthat::compare_file_text + ) } ep <- function(text) { @@ -71,7 +72,7 @@ ep <- function(text) { } test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FALSE) { - if(!multi) { + if (!multi) { ep(glue::glue("expect_identical(ssd_p{dist}(numeric(0)), numeric(0))")) ep(glue::glue("expect_identical(ssd_p{dist}(NA), NA_real_)")) ep(glue::glue("expect_identical(ssd_p{dist}(NaN), NaN)")) @@ -79,11 +80,11 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA ep(glue::glue("expect_identical(ssd_p{dist}(-Inf), 0)")) ep(glue::glue("expect_identical(ssd_p{dist}(Inf), 1)")) ep(glue::glue("expect_gt(ssd_p{dist}(1.000001), ssd_p{dist}(1))")) - + ep(glue::glue("expect_equal(ssd_p{dist}(1, log.p = TRUE), log(ssd_p{dist}(1)))")) ep(glue::glue("expect_equal(ssd_p{dist}(1, lower.tail = FALSE), 1- ssd_p{dist}(1))")) ep(glue::glue("expect_equal(ssd_p{dist}(1, lower.tail = FALSE, log.p = TRUE), log(1 - ssd_p{dist}(1)))")) - + ep(glue::glue("expect_identical(p{}(c(NA, NaN, 0, Inf, -Inf)), c(NA, NaN, 0, Inf, -Inf))")) ep(glue::glue("expect_equal(ssd_p{dist}(1:2, 1:2, 3:4), @@ -91,7 +92,7 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA ep(glue::glue("expect_equal(ssd_p{dist}(1:2, c(1, NA), 3:4), c(ssd_p{dist}(1, 1, 3), NA_real_))")) } - + ep(glue::glue("expect_identical(ssd_q{dist}(numeric(0)), numeric(0))")) ep(glue::glue("expect_identical(ssd_q{dist}(NA), NA_real_)")) ep(glue::glue("expect_identical(ssd_q{dist}(NaN), NaN)")) @@ -106,10 +107,10 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), log.p = TRUE), ssd_q{dist}(0.75))")) ep(glue::glue("expect_identical(ssd_q{dist}(0.75, lower.tail = FALSE), ssd_q{dist}(0.25))")) ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), lower.tail = FALSE, log.p = TRUE), ssd_q{dist}(0.25))")) - + ep(glue::glue("expect_identical(ssd_q{dist}(c(NA, NaN, 0, Inf, -Inf)), c(NA, NaN, 0, NaN, NaN))")) - - if(!multi) { + + if (!multi) { ep(glue::glue("expect_identical(ssd_q{dist}(c(0.25, 0.75), 1:2, 3:4), c(ssd_q{dist}(0.25, 1, 3), ssd_q{dist}(0.75, 2, 4)))")) ep(glue::glue("expect_identical(ssd_q{dist}(c(0.25, 0.75), c(1,NA), 3:4), c(ssd_q{dist}(0.25, 1, 3), NA_real_))")) ep(glue::glue("expect_equal(ssd_q{dist}(ssd_p{dist}(c(0, 0.1, 0.5, 0.9, 0.99))), c(0, 0.1, 0.5, 0.9, 0.99), tolerance = {qroottolerance})")) @@ -117,7 +118,7 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA ep(glue::glue("expect_identical(ssd_r{dist}(2, NA), c(NA, NA_real_))")) ep(glue::glue("expect_error(ssd_r{dist}(1, 1:2))")) } - + ep(glue::glue("expect_identical(ssd_r{dist}(numeric(0)), numeric(0))")) ep(glue::glue("expect_identical(ssd_r{dist}(0), numeric(0))")) ep(glue::glue("expect_error(ssd_r{dist}(NA))")) @@ -126,14 +127,14 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA ep(glue::glue("expect_identical(length(ssd_r{dist}(2)), 2L)")) ep(glue::glue("expect_identical(length(ssd_r{dist}(3:4)), 2L)")) ep(glue::glue("expect_identical(length(ssd_r{dist}(c(NA, 1))), 2L)")) - - if(!multi) { + + if (!multi) { ests <- ep(glue::glue("ssd_e{dist}()")) testthat::expect_true(vld_list(ests)) testthat::expect_true(vld_all(ests, vld_number)) testthat::expect_true(vld_length(ests, length = 2L, upper = 5L)) testthat::expect_true(vld_named(ests)) - + set.seed(97) data <- data.frame(Conc = ep(glue::glue("ssd_r{dist}(1000)"))) fits <- ssd_fit_dists(data = data, dists = dist) @@ -143,12 +144,12 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA testthat::expect_identical(tidy$dist[1], dist) tidy$lower <- tidy$est - tidy$se * 3 tidy$upper <- tidy$est + tidy$se * 3 - + default <- ep(glue::glue("formals(ssd_r{dist})")) default$n <- NULL default$chk <- NULL default <- data.frame(term = names(default), default = unlist(default)) - + tidy <- merge(tidy, default, by = "term", all = "TRUE") testthat::expect_true(all(tidy$default > tidy$lower - upadj)) testthat::expect_true(all(tidy$default < tidy$upper + upadj)) diff --git a/R/wqg.R b/R/wqg.R index 72453332a..6d1c50992 100644 --- a/R/wqg.R +++ b/R/wqg.R @@ -37,6 +37,8 @@ #' ssd_wqg_bc(ssddata::ccme_boron) #' } ssd_wqg_bc <- function(data, left = "Conc") { + lifecycle::deprecate_warn("1.0.6.9016", "ssd_wqg_bc()", "ssd_fit_bcanz()", + details = "Please use `ssd_fit_bcanz()` and `ssd_hc_bcanz()` instead.") fits <- ssd_fit_dists(data, left = left, rescale = FALSE) ssd_hc(fits, ci = TRUE, nboot = 10000) } @@ -66,6 +68,8 @@ ssd_wqg_bc <- function(data, left = "Conc") { #' ssd_wqg_burrlioz(ssddata::ccme_boron) #' } ssd_wqg_burrlioz <- function(data, left = "Conc") { + lifecycle::deprecate_warn("1.0.6.9016", "ssd_wqg_burrlioz()", "ssd_fit_bcanz()", + details = "Please use `ssd_fit_burrlioz()` and `ssd_hc_burrlioz()` instead.") fit <- ssd_fit_burrlioz(data, left = left, rescale = FALSE) ssd_hc_burrlioz(fit, ci = TRUE, nboot = 10000) } diff --git a/README.Rmd b/README.Rmd index 68a82915c..cb42a49b8 100644 --- a/README.Rmd +++ b/README.Rmd @@ -4,20 +4,21 @@ output: github_document -```{r setup, include = FALSE} +```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", - fig.path = "man/figures/README-" + fig.path = "man/figures/README-", + out.width = "100%" ) ``` # ssdtools -[![Lifecycle:Stable](https://img.shields.io/badge/Lifecycle-Stable-97ca00)](https://github.com/bcgov/repomountie/blob/master/doc/lifecycle-badges.md) +[![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![R-CMD-check](https://github.com/bcgov/ssdtools/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/bcgov/ssdtools/actions/workflows/R-CMD-check.yaml) -[![codecov](https://codecov.io/github/bcgov/ssdtools/graph/badge.svg?token=gVKHQQD1Jp)](https://codecov.io/github/bcgov/ssdtools) +[![Codecov test coverage](https://codecov.io/gh/bcgov/ssdtools/graph/badge.svg?token=gVKHQQD1Jp)](https://app.codecov.io/gh/bcgov/ssdtools) [![CRAN status](https://www.r-pkg.org/badges/version/ssdtools)](https://cran.r-project.org/package=ssdtools) ![CRAN downloads](https://cranlogs.r-pkg.org/badges/ssdtools) @@ -31,20 +32,25 @@ Confidence intervals on hazard concentrations and proportions are produced by bo ## Installation -To install the latest version from [CRAN](https://CRAN.R-project.org/package=ssdtools) -```{r, eval = FALSE} +To install the latest release version from [CRAN](https://CRAN.R-project.org/package=ssdtools). +```r install.packages("ssdtools") ``` +To install the latest development version from [r-universe](https://bcgov.r-universe.dev/ssdtools). +```r +install.packages("ssdtools", repos = c("https://bcgov.r-universe.dev", "https://cloud.r-project.org")) +``` + To install the latest development version from [GitHub](https://github.com/bcgov/ssdtools) -```{r, eval = FALSE} -# install.packages("remotes") -remotes::install_github("bcgov/ssdtools") +```r +# install.packages("pak", repos = sprintf("https://r-lib.github.io/p/pak/stable/%s/%s/%s", .Platform$pkgType, R.Version()$os, R.Version()$arch)) +pak::pak("bcgov/ssdtools") ``` ## Introduction -The dependency [`ssddata`](https://cran.r-project.org/web/packages/ssddata/index.html) provides a example data sets for several chemicals including Boron. +The dependency [`ssddata`](https://cran.r-project.org/package=ssddata) provides a example data sets for several chemicals including Boron. ```{r, message=FALSE} library(ssdtools) ssddata::ccme_boron @@ -113,7 +119,7 @@ Get started with ssdtools at . -For the latest changes visit [NEWS](https://bcgov.github.io/ssdtools/news). +For the latest changes visit [NEWS](https://bcgov.github.io/ssdtools/news/). The citation for the shiny app: diff --git a/README.md b/README.md index a9a0c8ae5..8f5f0ebb6 100644 --- a/README.md +++ b/README.md @@ -5,9 +5,11 @@ -[![Lifecycle:Stable](https://img.shields.io/badge/Lifecycle-Stable-97ca00)](https://github.com/bcgov/repomountie/blob/master/doc/lifecycle-badges.md) +[![Lifecycle: +stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![R-CMD-check](https://github.com/bcgov/ssdtools/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/bcgov/ssdtools/actions/workflows/R-CMD-check.yaml) -[![codecov](https://codecov.io/github/bcgov/ssdtools/graph/badge.svg?token=gVKHQQD1Jp)](https://codecov.io/github/bcgov/ssdtools) +[![Codecov test +coverage](https://codecov.io/gh/bcgov/ssdtools/graph/badge.svg?token=gVKHQQD1Jp)](https://app.codecov.io/gh/bcgov/ssdtools) [![CRAN status](https://www.r-pkg.org/badges/version/ssdtools)](https://cran.r-project.org/package=ssdtools) ![CRAN downloads](https://cranlogs.r-pkg.org/badges/ssdtools) @@ -27,25 +29,31 @@ are produced by bootstrapping. ## Installation -To install the latest version from -[CRAN](https://CRAN.R-project.org/package=ssdtools) +To install the latest release version from +[CRAN](https://CRAN.R-project.org/package=ssdtools). ``` r install.packages("ssdtools") ``` +To install the latest development version from +[r-universe](https://bcgov.r-universe.dev/ssdtools). + +``` r +install.packages("ssdtools", repos = c("https://bcgov.r-universe.dev", "https://cloud.r-project.org")) +``` + To install the latest development version from [GitHub](https://github.com/bcgov/ssdtools) ``` r -# install.packages("remotes") -remotes::install_github("bcgov/ssdtools") +# install.packages("pak", repos = sprintf("https://r-lib.github.io/p/pak/stable/%s/%s/%s", .Platform$pkgType, R.Version()$os, R.Version()$arch)) +pak::pak("bcgov/ssdtools") ``` ## Introduction -The dependency -[`ssddata`](https://cran.r-project.org/web/packages/ssddata/index.html) +The dependency [`ssddata`](https://cran.r-project.org/package=ssddata) provides a example data sets for several chemicals including Boron. ``` r @@ -79,7 +87,7 @@ and can be quickly plotted using `autoplot` autoplot(fits) ``` -![](man/figures/README-unnamed-chunk-5-1.png) + The goodness of fit can be assessed using `ssd_gof` @@ -106,7 +114,7 @@ print(hc5) #> # A tibble: 1 × 11 #> dist proportion est se lcl ucl wt method nboot pboot samples #> -#> 1 average 0.05 1.26 0.781 0.407 3.29 1 parametr… 1000 0.999 +#> 1 average 0.05 1.26 0.782 0.407 3.29 1 parametr… 1000 1 ``` To bootstrap in parallel set `future::plan()`. For example: @@ -145,7 +153,7 @@ ssd_plot(ssddata::ccme_boron, boron_pred, scale_colour_ssd() ``` -![](man/figures/README-unnamed-chunk-10-1.png) + ## References @@ -161,7 +169,7 @@ A shiny app to allow non-R users to interface with ssdtools is available at . For the latest changes visit -[NEWS](https://bcgov.github.io/ssdtools/news). +[NEWS](https://bcgov.github.io/ssdtools/news/). The citation for the shiny app: @@ -208,8 +216,9 @@ By contributing to this project, you agree to abide by its terms. ## Licensing -Copyright 2024 Province of British Columbia, Environment and Climate -Change Canada, and Australian Government Department of Climate Change, +Copyright 2018-2024 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 The documentation is released under the [CC BY 4.0 diff --git a/_pkgdown.yml b/_pkgdown.yml index 0a103b72d..79eb35b63 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,115 +1,118 @@ +url: ~ template: bootstrap: 5 authors: Joe Thorley: - href: "https://github.com/joethorley" + href: https://github.com/joethorley Rebecca Fisher: - href: "https://www.aims.gov.au/about/our-people/dr-rebecca-fisher" + href: https://www.aims.gov.au/about/our-people/dr-rebecca-fisher David Fox: - href: "https://training.ecotox.science/who-we-are/" + href: https://training.ecotox.science/who-we-are/ Carl Schwarz: - href: "https://www.sfu.ca/stat-actsci/department/profiles/carl-schwarz.html" + href: https://www.sfu.ca/stat-actsci/department/profiles/carl-schwarz.html Province of British Columbia: - href: "https://www2.gov.bc.ca/" + href: https://www2.gov.bc.ca/ Environment and Climate Change Canada: - href: "https://www.canada.ca/en/environment-climate-change.html" + href: https://www.canada.ca/en/environment-climate-change.html Australian Government Department of Climate Change, Energy, the Environment and Water: - href: "https://www.dcceew.gov.au/" - + href: https://www.dcceew.gov.au/ destination: docs - reference: - title: Distribution Names desc: Functions that return character vectors of distribution names contents: - - '`ssd_dists`' - - '`ssd_dists_all`' - - '`ssd_dists_bcanz`' + - ssd_dists + - ssd_dists_all + - ssd_dists_bcanz - title: Fit desc: Functions that fit distributions to data contents: - - '`ssd_fit_dists`' - - '`ssd_fit_bcanz`' - - '`ssd_fit_burrlioz`' + - ssd_fit_dists + - ssd_fit_bcanz + - ssd_fit_burrlioz - title: Hazard Concentrations desc: Functions that calculate hazard concentrations contents: - - '`ssd_hc`' - - '`ssd_hc_bcanz`' - - '`ssd_wqg_bc`' - - '`ssd_wqg_burrlioz`' + - ssd_hc + - ssd_hc_bcanz - title: Hazard Proportions desc: Functions that calculate hazard proportions contents: - - '`ssd_hp`' - - '`ssd_hp_bcanz`' + - ssd_hp + - ssd_hp_bcanz +- title: Manipulate Data + desc: Functions that manipulate data + contents: + - ssd_censor_data + - ssd_data + - ssd_sort_data - title: Manipulate Fits desc: Functions that manipulate fits of distributions contents: - - '`augment.fitdists`' - - '`coef.fitdists`' - - '`estimates.fitdists`' - - '`glance.fitdists`' - - '`predict.fitburrlioz`' - - '`predict.fitdists`' - - '`ssd_gof`' - - '`subset.fitdists`' - - '`tidy.fitdists`' + - augment.fitdists + - coef.fitdists + - estimates.fitdists + - glance.fitdists + - predict.fitburrlioz + - predict.fitdists + - ssd_gof + - subset.fitdists + - tidy.fitdists - title: Plots desc: Functions to Generate Plots contents: - - '`autoplot.fitdists`' - - '`geom_hcintersect`' - - '`geom_ssdpoint`' - - '`geom_ssdsegment`' - - '`geom_xribbon`' - - '`scale_colour_ssd`' - - '`ssd_pal`' - - '`ssd_plot`' - - '`ssd_plot_cdf`' - - '`ssd_plot_data`' - - '`ssdtools-ggproto`' + - autoplot.fitdists + - geom_hcintersect + - geom_ssdpoint + - geom_ssdsegment + - geom_xribbon + - scale_colour_ssd + - ssd_pal + - ssd_plot + - ssd_plot_cdf + - ssd_plot_data + - ssdtools-ggproto - title: Distributional Functions desc: Distribution, quantile, random functions contents: - - '`ssd_p`' - - '`ssd_q`' - - '`ssd_r`' - - '`ssd_e`' + - ssd_p + - ssd_q + - ssd_r + - ssd_e - title: Miscellaneous desc: Miscellaneous functions and data contents: - - '`boron_pred`' - - '`comma_signif`' - - '`dist_data`' - - '`is.fitdists`' - - '`ssd_licensing_md`' - - '`npars`' - - '`ssd_data`' - - '`ssd_ecd`' - - '`ssd_ecd_data`' - - '`ssd_exposure`' - - '`ssd_fit_dists`' - - '`ssd_is_censored`' - - '`ssd_match_moments`' - - '`ssd_sort_data`' - - '`pearson1000`' + - boron_pred + - comma_signif + - dist_data + - is.fitdists + - ssd_licensing_md + - npars + - ssd_ecd + - ssd_ecd_data + - ssd_exposure + - ssd_is_censored + - ssd_match_moments + - ssd_min_pmix + - pearson1000 - title: Deprecated desc: Deprecated functions which will become defunct in future versions contents: - - '`geom_ssd`' - - '`is_censored`' - - '`ssd_hc_burrlioz`' - - '`ssd_plot_cf`' - - '`stat_ssd`' - - '`dgompertz`' - - '`pgompertz`' - - '`qgompertz`' - - '`rgompertz`' - - '`dlgumbel`' - - '`plgumbel`' - - '`qlgumbel`' - - '`rlgumbel`' + - geom_ssd + - is_censored + - ssd_wqg_bc + - ssd_wqg_burrlioz + - ssd_hc_burrlioz + - ssd_plot_cf + - stat_ssd + - dgompertz + - pgompertz + - qgompertz + - rgompertz + - dlgumbel + - plgumbel + - qlgumbel + - rlgumbel articles: - title: All vignettes diff --git a/cran-comments.md b/cran-comments.md index 90e332251..dbffa79e1 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,14 +1,3 @@ -## Test environments - -release 4.3.1 - -* OSX (local) - release -* OSX (macbuilder) - release -* OSX (actions) - release -* Ubuntu (actions) - oldrel, release and devel -* Windows (actions) - release -* Windows (winbuilder) - devel - ## R CMD check results 0 errors | 0 warnings | 1 note diff --git a/man/dist_data.Rd b/man/dist_data.Rd index 92fb65abd..1182fdd8c 100644 --- a/man/dist_data.Rd +++ b/man/dist_data.Rd @@ -23,7 +23,7 @@ A data frame of information on the implemented distributions. } } \examples{ -dist +dist_data } \seealso{ Other dists: diff --git a/man/figures/README-unnamed-chunk-10-1.png b/man/figures/README-unnamed-chunk-10-1.png deleted file mode 100644 index afd42b04b..000000000 Binary files a/man/figures/README-unnamed-chunk-10-1.png and /dev/null differ diff --git a/man/figures/README-unnamed-chunk-5-1.png b/man/figures/README-unnamed-chunk-4-1.png similarity index 100% rename from man/figures/README-unnamed-chunk-5-1.png rename to man/figures/README-unnamed-chunk-4-1.png diff --git a/man/figures/README-unnamed-chunk-9-1.png b/man/figures/README-unnamed-chunk-9-1.png index f9f13635a..afd42b04b 100644 Binary files a/man/figures/README-unnamed-chunk-9-1.png and b/man/figures/README-unnamed-chunk-9-1.png differ diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg index 4baaee01c..b61c57c3f 100644 --- a/man/figures/lifecycle-deprecated.svg +++ b/man/figures/lifecycle-deprecated.svg @@ -1 +1,21 @@ -lifecyclelifecycledeprecateddeprecated \ No newline at end of file + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg index d1d060e92..5d88fc2c6 100644 --- a/man/figures/lifecycle-experimental.svg +++ b/man/figures/lifecycle-experimental.svg @@ -1 +1,21 @@ -lifecyclelifecycleexperimentalexperimental \ No newline at end of file + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg index e015dc811..9bf21e76b 100644 --- a/man/figures/lifecycle-stable.svg +++ b/man/figures/lifecycle-stable.svg @@ -1 +1,29 @@ -lifecyclelifecyclestablestable \ No newline at end of file + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg index 75f24f553..db8d757f7 100644 --- a/man/figures/lifecycle-superseded.svg +++ b/man/figures/lifecycle-superseded.svg @@ -1 +1,21 @@ - lifecyclelifecyclesupersededsuperseded \ No newline at end of file + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/is_censored.Rd b/man/is_censored.Rd index 3b73c6553..d20923754 100644 --- a/man/is_censored.Rd +++ b/man/is_censored.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/censor.R +% Please edit documentation in R/censored.R \name{is_censored} \alias{is_censored} \title{Is Censored diff --git a/man/params.Rd b/man/params.Rd index 8c759944a..951b0433e 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -27,6 +27,8 @@ relative to the extremes for non-missing values.} \item{ci}{A flag specifying whether to estimate confidence intervals (by bootstrapping).} +\item{censoring}{A numeric vector of the left and right censoring values.} + \item{color}{A string of the column in data for the color aesthetic.} \item{computable}{A flag specifying whether to only return fits with numerically computable standard errors.} diff --git a/man/ssd_censor_data.Rd b/man/ssd_censor_data.Rd new file mode 100644 index 000000000..6b281fc0f --- /dev/null +++ b/man/ssd_censor_data.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/censor.R +\name{ssd_censor_data} +\alias{ssd_censor_data} +\title{Censor Data} +\usage{ +ssd_censor_data(data, left = "Conc", ..., right = left, censoring = c(0, Inf)) +} +\arguments{ +\item{data}{A data frame.} + +\item{left}{A string of the column in data with the concentrations.} + +\item{...}{Unused.} + +\item{right}{A string of the column in data with the right concentration values.} + +\item{censoring}{A numeric vector of the left and right censoring values.} +} +\value{ +A tibble of the censored data. +} +\description{ +Censor Data +} +\examples{ +ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, Inf)) +} diff --git a/man/ssd_fit_burrlioz.Rd b/man/ssd_fit_burrlioz.Rd index 8b4a30385..66dafa7ce 100644 --- a/man/ssd_fit_burrlioz.Rd +++ b/man/ssd_fit_burrlioz.Rd @@ -4,7 +4,13 @@ \alias{ssd_fit_burrlioz} \title{Fit Burrlioz Distributions} \usage{ -ssd_fit_burrlioz(data, left = "Conc", rescale = FALSE, silent = FALSE) +ssd_fit_burrlioz( + data, + left = "Conc", + rescale = FALSE, + control = list(), + silent = FALSE +) } \arguments{ \item{data}{A data frame.} @@ -13,6 +19,8 @@ ssd_fit_burrlioz(data, left = "Conc", rescale = FALSE, silent = FALSE) \item{rescale}{A flag specifying whether to rescale concentration values by dividing by the geometric mean of the minimum and maximum positive finite values.} +\item{control}{A list of control parameters passed to \code{\link[stats:optim]{stats::optim()}}.} + \item{silent}{A flag indicating whether fits should fail silently.} } \value{ diff --git a/man/ssd_fit_dists.Rd b/man/ssd_fit_dists.Rd index e085647ec..c47b4e290 100644 --- a/man/ssd_fit_dists.Rd +++ b/man/ssd_fit_dists.Rd @@ -64,15 +64,19 @@ An object of class fitdists. Fits one or more distributions to species sensitivity data. } \details{ -By default the 'llogis', 'gamma' and 'lnorm' -distributions are fitted to the data. -For a complete list of the implemented distributions see \code{\link[=ssd_dists_all]{ssd_dists_all()}}. +By default the 'gamma', 'lgumbel', 'llogis', 'lnorm', 'lnorm_lnorm' and +'weibull' distributions are fitted to the data. +For a complete list of the distributions that are currently implemented in +\code{ssdtools} see \code{\link[=ssd_dists_all]{ssd_dists_all()}}. If weight specifies a column in the data frame with positive numbers, weighted estimation occurs. However, currently only the resultant parameter estimates are available. -If the \code{right} argument is different to the \code{left} argument then the data are considered to be censored. +If the \code{right} argument is different to the \code{left} argument +then the data are considered to be censored. + +The optim argument \code{pgtol} is set to 1e-5 if not specified via the control argument. } \examples{ fits <- ssd_fit_dists(ssddata::ccme_boron) diff --git a/man/ssd_p.Rd b/man/ssd_p.Rd index 77c04c2f4..e651d66da 100644 --- a/man/ssd_p.Rd +++ b/man/ssd_p.Rd @@ -276,7 +276,7 @@ ssd_plnorm_lnorm(1) ssd_plnorm(1) -# multi +# multi ssd_pmulti(1) ssd_pweibull(1) diff --git a/man/ssd_q.Rd b/man/ssd_q.Rd index aa163167b..5ebe2b641 100644 --- a/man/ssd_q.Rd +++ b/man/ssd_q.Rd @@ -276,7 +276,7 @@ ssd_qlnorm_lnorm(0.5) ssd_qlnorm(0.5) -# multi +# multi ssd_qmulti(0.5) ssd_qweibull(0.5) diff --git a/man/ssd_r.Rd b/man/ssd_r.Rd index 0a2065e7e..77d58ff6f 100644 --- a/man/ssd_r.Rd +++ b/man/ssd_r.Rd @@ -267,7 +267,7 @@ hist(ssd_rlnorm_lnorm(10000), breaks = 1000) set.seed(50) hist(ssd_rlnorm(10000), breaks = 1000) -# multi +# multi set.seed(50) hist(ssd_rmulti(1000), breaks = 100) diff --git a/tests/testthat/_snaps/censor/boron_10.csv b/tests/testthat/_snaps/censor/boron_10.csv new file mode 100644 index 000000000..3b078a06c --- /dev/null +++ b/tests/testthat/_snaps/censor/boron_10.csv @@ -0,0 +1,29 @@ +Chemical,Species,Conc,Group,Units,right +Boron,Oncorhynchus mykiss,2.1,Fish,mg/L,2.1 +Boron,Ictalurus punctatus,2.4,Fish,mg/L,2.4 +Boron,Micropterus salmoides,4.1,Fish,mg/L,4.1 +Boron,Brachydanio rerio,10,Fish,mg/L,10 +Boron,Carassius auratus,10,Fish,mg/L,Inf +Boron,Pimephales promelas,10,Fish,mg/L,Inf +Boron,Daphnia magna,6,Invertebrate,mg/L,6 +Boron,Opercularia bimarginata,10,Invertebrate,mg/L,10 +Boron,Ceriodaphnia dubia,10,Invertebrate,mg/L,Inf +Boron,Entosiphon sulcatum,10,Invertebrate,mg/L,Inf +Boron,Chironomus decorus,10,Invertebrate,mg/L,Inf +Boron,Paramecium caudatum,10,Invertebrate,mg/L,Inf +Boron,Rana pipiens,10,Amphibian,mg/L,Inf +Boron,Bufo fowleri,10,Amphibian,mg/L,Inf +Boron,Bufo americanus,10,Amphibian,mg/L,Inf +Boron,Ambystoma jeffersonianum,10,Amphibian,mg/L,Inf +Boron,Ambystoma maculatum,10,Amphibian,mg/L,Inf +Boron,Rana sylvatica,10,Amphibian,mg/L,Inf +Boron,Elodea canadensis,1,Plant,mg/L,1 +Boron,Spirodella polyrrhiza,1.8,Plant,mg/L,1.8 +Boron,Chlorella pyrenoidosa,2,Plant,mg/L,2 +Boron,Phragmites australis,4,Plant,mg/L,4 +Boron,Chlorella vulgaris,5.2,Plant,mg/L,5.2 +Boron,Selenastrum capricornutum,10,Plant,mg/L,Inf +Boron,Scenedesmus subspicatus,10,Plant,mg/L,Inf +Boron,Myriophyllum spicatum,10,Plant,mg/L,Inf +Boron,Anacystis nidulans,10,Plant,mg/L,Inf +Boron,Lemna minor,10,Plant,mg/L,Inf diff --git a/tests/testthat/_snaps/censor/boron_25.csv b/tests/testthat/_snaps/censor/boron_25.csv new file mode 100644 index 000000000..f1533e86c --- /dev/null +++ b/tests/testthat/_snaps/censor/boron_25.csv @@ -0,0 +1,29 @@ +Chemical,Species,Conc,Group,Units,right +Boron,Oncorhynchus mykiss,0,Fish,mg/L,2.5 +Boron,Ictalurus punctatus,0,Fish,mg/L,2.5 +Boron,Micropterus salmoides,4.1,Fish,mg/L,4.1 +Boron,Brachydanio rerio,10,Fish,mg/L,10 +Boron,Carassius auratus,15.6,Fish,mg/L,15.6 +Boron,Pimephales promelas,18.3,Fish,mg/L,18.3 +Boron,Daphnia magna,6,Invertebrate,mg/L,6 +Boron,Opercularia bimarginata,10,Invertebrate,mg/L,10 +Boron,Ceriodaphnia dubia,13.4,Invertebrate,mg/L,13.4 +Boron,Entosiphon sulcatum,15,Invertebrate,mg/L,15 +Boron,Chironomus decorus,20,Invertebrate,mg/L,20 +Boron,Paramecium caudatum,20,Invertebrate,mg/L,20 +Boron,Rana pipiens,20.4,Amphibian,mg/L,20.4 +Boron,Bufo fowleri,48.6,Amphibian,mg/L,48.6 +Boron,Bufo americanus,50,Amphibian,mg/L,50 +Boron,Ambystoma jeffersonianum,70.7,Amphibian,mg/L,70.7 +Boron,Ambystoma maculatum,70.7,Amphibian,mg/L,70.7 +Boron,Rana sylvatica,70.7,Amphibian,mg/L,70.7 +Boron,Elodea canadensis,0,Plant,mg/L,2.5 +Boron,Spirodella polyrrhiza,0,Plant,mg/L,2.5 +Boron,Chlorella pyrenoidosa,0,Plant,mg/L,2.5 +Boron,Phragmites australis,4,Plant,mg/L,4 +Boron,Chlorella vulgaris,5.2,Plant,mg/L,5.2 +Boron,Selenastrum capricornutum,12.3,Plant,mg/L,12.3 +Boron,Scenedesmus subspicatus,30,Plant,mg/L,30 +Boron,Myriophyllum spicatum,34.2,Plant,mg/L,34.2 +Boron,Anacystis nidulans,50,Plant,mg/L,50 +Boron,Lemna minor,60,Plant,mg/L,60 diff --git a/tests/testthat/_snaps/censor/boron_2510.csv b/tests/testthat/_snaps/censor/boron_2510.csv new file mode 100644 index 000000000..903ce8a06 --- /dev/null +++ b/tests/testthat/_snaps/censor/boron_2510.csv @@ -0,0 +1,29 @@ +Chemical,Species,Conc,Group,Units,right +Boron,Oncorhynchus mykiss,0,Fish,mg/L,2.5 +Boron,Ictalurus punctatus,0,Fish,mg/L,2.5 +Boron,Micropterus salmoides,4.1,Fish,mg/L,4.1 +Boron,Brachydanio rerio,10,Fish,mg/L,10 +Boron,Carassius auratus,10,Fish,mg/L,Inf +Boron,Pimephales promelas,10,Fish,mg/L,Inf +Boron,Daphnia magna,6,Invertebrate,mg/L,6 +Boron,Opercularia bimarginata,10,Invertebrate,mg/L,10 +Boron,Ceriodaphnia dubia,10,Invertebrate,mg/L,Inf +Boron,Entosiphon sulcatum,10,Invertebrate,mg/L,Inf +Boron,Chironomus decorus,10,Invertebrate,mg/L,Inf +Boron,Paramecium caudatum,10,Invertebrate,mg/L,Inf +Boron,Rana pipiens,10,Amphibian,mg/L,Inf +Boron,Bufo fowleri,10,Amphibian,mg/L,Inf +Boron,Bufo americanus,10,Amphibian,mg/L,Inf +Boron,Ambystoma jeffersonianum,10,Amphibian,mg/L,Inf +Boron,Ambystoma maculatum,10,Amphibian,mg/L,Inf +Boron,Rana sylvatica,10,Amphibian,mg/L,Inf +Boron,Elodea canadensis,0,Plant,mg/L,2.5 +Boron,Spirodella polyrrhiza,0,Plant,mg/L,2.5 +Boron,Chlorella pyrenoidosa,0,Plant,mg/L,2.5 +Boron,Phragmites australis,4,Plant,mg/L,4 +Boron,Chlorella vulgaris,5.2,Plant,mg/L,5.2 +Boron,Selenastrum capricornutum,10,Plant,mg/L,Inf +Boron,Scenedesmus subspicatus,10,Plant,mg/L,Inf +Boron,Myriophyllum spicatum,10,Plant,mg/L,Inf +Boron,Anacystis nidulans,10,Plant,mg/L,Inf +Boron,Lemna minor,10,Plant,mg/L,Inf diff --git a/tests/testthat/_snaps/gompertz/hc_prob.csv b/tests/testthat/_snaps/gompertz/hc_prob.csv index 0715b8565..e84d104f5 100644 --- a/tests/testthat/_snaps/gompertz/hc_prob.csv +++ b/tests/testthat/_snaps/gompertz/hc_prob.csv @@ -1,7 +1,7 @@ dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples average,0.05,0.179453,0.307799,0.0992422,1.23754,1,parametric,100,0.92,"c(`000000001_gompertz` = 0.232668, `000000003_gompertz` = 0.104651, `000000004_gompertz` = 0.546479, `000000005_gompertz` = 0.59723, `000000006_gompertz` = 0.232644, `000000007_gompertz` = 0.26047, `000000008_gompertz` = 0.194946, `000000009_gompertz` = 0.687566, `000000010_gompertz` = 0.158672, `000000011_gompertz` = 0.252489, `000000012_gompertz` = 0.212705, `000000013_gompertz` = 1.32526, `000000014_gompertz` = 0.196413, `000000015_gompertz` = 0.556619, `000000016_gompertz` = 0.542088, `000000017_gompertz` = 0.258851, -`000000018_gompertz` = 0.467362, `000000019_gompertz` = 0.444558, `000000020_gompertz` = 0.252365, `000000021_gompertz` = 1.00627, `000000022_gompertz` = 0.262159, `000000023_gompertz` = 0.201961, `000000024_gompertz` = 0.221781, `000000025_gompertz` = 0.370823, `000000026_gompertz` = 0.381622, `000000027_gompertz` = 0.587692, `000000028_gompertz` = 0.154181, `000000031_gompertz` = 0.10423, `000000032_gompertz` = 0.250053, `000000033_gompertz` = 0.462225, `000000034_gompertz` = 0.39652, `000000035_gompertz` = 0, +`000000018_gompertz` = 0.467362, `000000019_gompertz` = 0.444558, `000000020_gompertz` = 0.252366, `000000021_gompertz` = 1.00627, `000000022_gompertz` = 0.262159, `000000023_gompertz` = 0.201961, `000000024_gompertz` = 0.221781, `000000025_gompertz` = 0.370823, `000000026_gompertz` = 0.381622, `000000027_gompertz` = 0.587692, `000000028_gompertz` = 0.154181, `000000031_gompertz` = 0.10423, `000000032_gompertz` = 0.250053, `000000033_gompertz` = 0.462225, `000000034_gompertz` = 0.39652, `000000035_gompertz` = 0, `000000036_gompertz` = 0.258822, `000000037_gompertz` = 0.242274, `000000038_gompertz` = 0.347614, `000000039_gompertz` = 0.29439, `000000040_gompertz` = 1.14346, `000000041_gompertz` = 0.135087, `000000042_gompertz` = 0.119971, `000000043_gompertz` = 0.314016, `000000044_gompertz` = 0.0979661, `000000045_gompertz` = 0.135296, `000000046_gompertz` = 0.260949, `000000047_gompertz` = 0.50742, `000000049_gompertz` = 1.83785, `000000050_gompertz` = 0.183739, `000000051_gompertz` = 0.119605, `000000052_gompertz` = 0.166286, -`000000053_gompertz` = 0.375928, `000000054_gompertz` = 0.16, `000000055_gompertz` = 0.378692, `000000056_gompertz` = 0.198193, `000000057_gompertz` = 0.854231, `000000058_gompertz` = 0.113677, `000000059_gompertz` = 0.0460489, `000000060_gompertz` = 0.26119, `000000061_gompertz` = 0.349783, `000000062_gompertz` = 0.155674, `000000063_gompertz` = 0.25708, `000000065_gompertz` = 0.862409, `000000066_gompertz` = 0.252748, `000000067_gompertz` = 1.27322, `000000068_gompertz` = 0.30646, `000000069_gompertz` = 0.102607, +`000000053_gompertz` = 0.375928, `000000054_gompertz` = 0.16, `000000055_gompertz` = 0.378693, `000000056_gompertz` = 0.198193, `000000057_gompertz` = 0.854231, `000000058_gompertz` = 0.113677, `000000059_gompertz` = 0.0460489, `000000060_gompertz` = 0.26119, `000000061_gompertz` = 0.349783, `000000062_gompertz` = 0.155674, `000000063_gompertz` = 0.25708, `000000065_gompertz` = 0.862409, `000000066_gompertz` = 0.252748, `000000067_gompertz` = 1.27322, `000000068_gompertz` = 0.306461, `000000069_gompertz` = 0.102607, `000000071_gompertz` = 0.882485, `000000072_gompertz` = 0.738937, `000000074_gompertz` = 0.2907, `000000075_gompertz` = 0.428083, `000000076_gompertz` = 0.325723, `000000077_gompertz` = 0.260432, `000000078_gompertz` = 0.331494, `000000079_gompertz` = 1.0526, `000000080_gompertz` = 0.616152, `000000081_gompertz` = 0.183109, `000000082_gompertz` = 0.184165, `000000083_gompertz` = 0.141392, `000000084_gompertz` = 0.324602, `000000085_gompertz` = 0.366267, `000000086_gompertz` = 0.672032, `000000087_gompertz` = 0.274923, `000000088_gompertz` = 0.283306, `000000089_gompertz` = 0.252262, `000000090_gompertz` = 0.244424, `000000091_gompertz` = 0.109766, `000000092_gompertz` = 0.192248, `000000093_gompertz` = 0.156249, `000000094_gompertz` = 0.392504, `000000095_gompertz` = 0.171986, `000000096_gompertz` = 0.217738, `000000097_gompertz` = 0.548714, `000000098_gompertz` = 0.431485, `000000100_gompertz` = 0.298434)" diff --git a/tests/testthat/_snaps/hc/fullyleft.csv b/tests/testthat/_snaps/hc/fullyleft.csv new file mode 100644 index 000000000..8e26e7da6 --- /dev/null +++ b/tests/testthat/_snaps/hc/fullyleft.csv @@ -0,0 +1,2 @@ +dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples +average,0.05,0.0267647,0,0.0462203,0.0462203,1,parametric,10,1,numeric(0) diff --git a/tests/testthat/_snaps/hc/hc_cis.csv b/tests/testthat/_snaps/hc/hc_cis.csv index 289bc8bfb..03732a7a9 100644 --- a/tests/testthat/_snaps/hc/hc_cis.csv +++ b/tests/testthat/_snaps/hc/hc_cis.csv @@ -16,7 +16,7 @@ average,0.05,1.68118,0.682856,0.916053,3.47924,1,parametric,1000,1,"c(`000000001 `000000253_lnorm` = 0.957097, `000000254_lnorm` = 1.71972, `000000255_lnorm` = 1.246, `000000256_lnorm` = 1.64064, `000000257_lnorm` = 1.85754, `000000258_lnorm` = 2.32517, `000000259_lnorm` = 1.53654, `000000260_lnorm` = 4.93482, `000000261_lnorm` = 2.92566, `000000262_lnorm` = 1.80187, `000000263_lnorm` = 1.30003, `000000264_lnorm` = 3.32539, `000000265_lnorm` = 1.00911, `000000266_lnorm` = 1.3714, `000000267_lnorm` = 1.49066, `000000268_lnorm` = 1.16181, `000000269_lnorm` = 2.17011, `000000270_lnorm` = 1.93628, `000000271_lnorm` = 1.93382, `000000272_lnorm` = 1.56229, `000000273_lnorm` = 1.934, `000000274_lnorm` = 1.48945, `000000275_lnorm` = 1.5608, `000000276_lnorm` = 2.76426, `000000277_lnorm` = 1.41112, `000000278_lnorm` = 3.0299, `000000279_lnorm` = 1.20218, `000000280_lnorm` = 1.17921, `000000281_lnorm` = 3.31634, `000000282_lnorm` = 2.2934, `000000283_lnorm` = 1.75066, `000000284_lnorm` = 2.23803, `000000285_lnorm` = 1.73284, `000000286_lnorm` = 2.27553, `000000287_lnorm` = 1.06919, `000000288_lnorm` = 2.22348, `000000289_lnorm` = 1.43162, `000000290_lnorm` = 2.38861, `000000291_lnorm` = 1.9776, `000000292_lnorm` = 1.75615, `000000293_lnorm` = 1.51279, `000000294_lnorm` = 4.17684, `000000295_lnorm` = 1.10022, `000000296_lnorm` = 3.42715, `000000297_lnorm` = 1.28569, `000000298_lnorm` = 1.91589, `000000299_lnorm` = 1.14508, `000000300_lnorm` = 1.36318, `000000301_lnorm` = 1.23333, `000000302_lnorm` = 1.07115, `000000303_lnorm` = 1.85, `000000304_lnorm` = 2.22285, `000000305_lnorm` = 1.22099, `000000306_lnorm` = 0.769899, -`000000307_lnorm` = 2.26783, `000000308_lnorm` = 2.76718, `000000309_lnorm` = 2.80311, `000000310_lnorm` = 1.7925, `000000311_lnorm` = 1.50201, `000000312_lnorm` = 2.33447, `000000313_lnorm` = 1.51844, `000000314_lnorm` = 1.49481, `000000315_lnorm` = 2.28878, `000000316_lnorm` = 2.50457, `000000317_lnorm` = 1.49334, `000000318_lnorm` = 1.2303, `000000319_lnorm` = 2.97667, `000000320_lnorm` = 2.11936, `000000321_lnorm` = 1.49001, `000000322_lnorm` = 1.68884, `000000323_lnorm` = 1.43209, `000000324_lnorm` = 1.93249, +`000000307_lnorm` = 2.26783, `000000308_lnorm` = 2.76718, `000000309_lnorm` = 2.80311, `000000310_lnorm` = 1.7925, `000000311_lnorm` = 1.50201, `000000312_lnorm` = 2.33447, `000000313_lnorm` = 1.51844, `000000314_lnorm` = 1.49481, `000000315_lnorm` = 2.28877, `000000316_lnorm` = 2.50457, `000000317_lnorm` = 1.49334, `000000318_lnorm` = 1.2303, `000000319_lnorm` = 2.97667, `000000320_lnorm` = 2.11936, `000000321_lnorm` = 1.49001, `000000322_lnorm` = 1.68884, `000000323_lnorm` = 1.43209, `000000324_lnorm` = 1.93249, `000000325_lnorm` = 1.48784, `000000326_lnorm` = 2.98808, `000000327_lnorm` = 2.30993, `000000328_lnorm` = 2.99877, `000000329_lnorm` = 1.741, `000000330_lnorm` = 1.88757, `000000331_lnorm` = 2.04144, `000000332_lnorm` = 1.25144, `000000333_lnorm` = 1.57907, `000000334_lnorm` = 1.00788, `000000335_lnorm` = 1.2126, `000000336_lnorm` = 1.9552, `000000337_lnorm` = 2.82747, `000000338_lnorm` = 1.90187, `000000339_lnorm` = 1.42327, `000000340_lnorm` = 1.43656, `000000341_lnorm` = 1.09695, `000000342_lnorm` = 1.33248, `000000343_lnorm` = 1.19027, `000000344_lnorm` = 1.97184, `000000345_lnorm` = 1.77387, `000000346_lnorm` = 1.07525, `000000347_lnorm` = 2.13797, `000000348_lnorm` = 2.16009, `000000349_lnorm` = 2.2232, `000000350_lnorm` = 2.71378, `000000351_lnorm` = 1.83288, `000000352_lnorm` = 2.48059, `000000353_lnorm` = 1.04259, `000000354_lnorm` = 1.55659, `000000355_lnorm` = 2.4289, `000000356_lnorm` = 3.13694, `000000357_lnorm` = 1.00274, `000000358_lnorm` = 1.32141, `000000359_lnorm` = 1.9265, `000000360_lnorm` = 1.34318, `000000361_lnorm` = 1.42568, `000000362_lnorm` = 1.01439, `000000363_lnorm` = 1.49849, `000000364_lnorm` = 2.22677, `000000365_lnorm` = 1.62129, `000000366_lnorm` = 2.04696, `000000367_lnorm` = 1.18602, `000000368_lnorm` = 1.20377, `000000369_lnorm` = 1.2206, `000000370_lnorm` = 1.90947, `000000371_lnorm` = 1.13543, `000000372_lnorm` = 1.6593, `000000373_lnorm` = 1.46798, `000000374_lnorm` = 1.57448, `000000375_lnorm` = 1.85693, `000000376_lnorm` = 1.4851, `000000377_lnorm` = 1.42378, `000000378_lnorm` = 1.59598, @@ -46,7 +46,7 @@ average,0.05,1.68118,0.682856,0.916053,3.47924,1,parametric,1000,1,"c(`000000001 `000000793_lnorm` = 1.38939, `000000794_lnorm` = 1.73823, `000000795_lnorm` = 1.93236, `000000796_lnorm` = 2.27247, `000000797_lnorm` = 1.9506, `000000798_lnorm` = 2.79071, `000000799_lnorm` = 1.85945, `000000800_lnorm` = 1.697, `000000801_lnorm` = 1.20041, `000000802_lnorm` = 2.30994, `000000803_lnorm` = 2.28004, `000000804_lnorm` = 2.12277, `000000805_lnorm` = 1.40852, `000000806_lnorm` = 2.70247, `000000807_lnorm` = 0.952191, `000000808_lnorm` = 1.76159, `000000809_lnorm` = 1.55078, `000000810_lnorm` = 1.46163, `000000811_lnorm` = 2.11149, `000000812_lnorm` = 1.11352, `000000813_lnorm` = 2.7389, `000000814_lnorm` = 1.51083, `000000815_lnorm` = 1.2664, `000000816_lnorm` = 1.60513, `000000817_lnorm` = 1.05833, `000000818_lnorm` = 1.68812, `000000819_lnorm` = 2.66027, `000000820_lnorm` = 1.65418, `000000821_lnorm` = 1.08778, `000000822_lnorm` = 1.33578, `000000823_lnorm` = 1.09943, `000000824_lnorm` = 1.50982, `000000825_lnorm` = 1.619, `000000826_lnorm` = 2.30469, `000000827_lnorm` = 0.855125, `000000828_lnorm` = 2.42884, `000000829_lnorm` = 1.38089, `000000830_lnorm` = 4.4522, `000000831_lnorm` = 1.66964, `000000832_lnorm` = 1.85568, `000000833_lnorm` = 1.08886, `000000834_lnorm` = 0.921413, `000000835_lnorm` = 1.46622, `000000836_lnorm` = 2.73844, `000000837_lnorm` = 1.58314, `000000838_lnorm` = 1.38034, `000000839_lnorm` = 4.41954, `000000840_lnorm` = 0.943256, `000000841_lnorm` = 2.27984, `000000842_lnorm` = 0.912846, `000000843_lnorm` = 3.55196, `000000844_lnorm` = 1.1334, `000000845_lnorm` = 1.32162, `000000846_lnorm` = 1.15393, -`000000847_lnorm` = 1.98562, `000000848_lnorm` = 2.20511, `000000849_lnorm` = 1.54514, `000000850_lnorm` = 2.42929, `000000851_lnorm` = 4.14374, `000000852_lnorm` = 1.43422, `000000853_lnorm` = 1.86874, `000000854_lnorm` = 2.12603, `000000855_lnorm` = 1.61319, `000000856_lnorm` = 2.90886, `000000857_lnorm` = 1.78374, `000000858_lnorm` = 2.71821, `000000859_lnorm` = 2.36495, `000000860_lnorm` = 1.34749, `000000861_lnorm` = 2.34658, `000000862_lnorm` = 1.52777, `000000863_lnorm` = 0.600718, `000000864_lnorm` = 1.09026, +`000000847_lnorm` = 1.98562, `000000848_lnorm` = 2.20511, `000000849_lnorm` = 1.54514, `000000850_lnorm` = 2.42929, `000000851_lnorm` = 4.14374, `000000852_lnorm` = 1.43422, `000000853_lnorm` = 1.86874, `000000854_lnorm` = 2.12603, `000000855_lnorm` = 1.61319, `000000856_lnorm` = 2.90886, `000000857_lnorm` = 1.78374, `000000858_lnorm` = 2.71821, `000000859_lnorm` = 2.36495, `000000860_lnorm` = 1.34749, `000000861_lnorm` = 2.34658, `000000862_lnorm` = 1.52777, `000000863_lnorm` = 0.600719, `000000864_lnorm` = 1.09026, `000000865_lnorm` = 2.03663, `000000866_lnorm` = 1.49139, `000000867_lnorm` = 1.12194, `000000868_lnorm` = 1.07614, `000000869_lnorm` = 1.8528, `000000870_lnorm` = 2.95831, `000000871_lnorm` = 2.98388, `000000872_lnorm` = 2.99172, `000000873_lnorm` = 2.63005, `000000874_lnorm` = 2.71377, `000000875_lnorm` = 2.88341, `000000876_lnorm` = 1.53379, `000000877_lnorm` = 1.38716, `000000878_lnorm` = 1.82626, `000000879_lnorm` = 2.14879, `000000880_lnorm` = 1.45224, `000000881_lnorm` = 2.03255, `000000882_lnorm` = 1.23025, `000000883_lnorm` = 4.04123, `000000884_lnorm` = 1.87984, `000000885_lnorm` = 0.920501, `000000886_lnorm` = 1.39447, `000000887_lnorm` = 2.25379, `000000888_lnorm` = 1.17532, `000000889_lnorm` = 1.54539, `000000890_lnorm` = 1.16774, `000000891_lnorm` = 1.62573, `000000892_lnorm` = 0.973674, `000000893_lnorm` = 1.10345, `000000894_lnorm` = 1.55087, `000000895_lnorm` = 1.43027, `000000896_lnorm` = 0.962508, `000000897_lnorm` = 2.10172, `000000898_lnorm` = 1.45381, `000000899_lnorm` = 2.50912, `000000900_lnorm` = 0.829115, `000000901_lnorm` = 1.49204, `000000902_lnorm` = 1.97533, `000000903_lnorm` = 1.08147, `000000904_lnorm` = 1.12325, `000000905_lnorm` = 1.646, `000000906_lnorm` = 0.996106, `000000907_lnorm` = 3.10322, `000000908_lnorm` = 1.11549, `000000909_lnorm` = 1.86724, `000000910_lnorm` = 1.93593, `000000911_lnorm` = 0.86112, `000000912_lnorm` = 2.97445, `000000913_lnorm` = 2.62286, `000000914_lnorm` = 3.12933, `000000915_lnorm` = 1.27296, `000000916_lnorm` = 1.42102, `000000917_lnorm` = 1.6307, `000000918_lnorm` = 3.45913, diff --git a/tests/testthat/_snaps/hc/hc_cis_level08.csv b/tests/testthat/_snaps/hc/hc_cis_level08.csv index e8093cdb1..b3a66798c 100644 --- a/tests/testthat/_snaps/hc/hc_cis_level08.csv +++ b/tests/testthat/_snaps/hc/hc_cis_level08.csv @@ -16,7 +16,7 @@ average,0.05,1.68118,0.682856,1.11342,2.76013,1,parametric,1000,1,"c(`000000001_ `000000253_lnorm` = 0.957097, `000000254_lnorm` = 1.71972, `000000255_lnorm` = 1.246, `000000256_lnorm` = 1.64064, `000000257_lnorm` = 1.85754, `000000258_lnorm` = 2.32517, `000000259_lnorm` = 1.53654, `000000260_lnorm` = 4.93482, `000000261_lnorm` = 2.92566, `000000262_lnorm` = 1.80187, `000000263_lnorm` = 1.30003, `000000264_lnorm` = 3.32539, `000000265_lnorm` = 1.00911, `000000266_lnorm` = 1.3714, `000000267_lnorm` = 1.49066, `000000268_lnorm` = 1.16181, `000000269_lnorm` = 2.17011, `000000270_lnorm` = 1.93628, `000000271_lnorm` = 1.93382, `000000272_lnorm` = 1.56229, `000000273_lnorm` = 1.934, `000000274_lnorm` = 1.48945, `000000275_lnorm` = 1.5608, `000000276_lnorm` = 2.76426, `000000277_lnorm` = 1.41112, `000000278_lnorm` = 3.0299, `000000279_lnorm` = 1.20218, `000000280_lnorm` = 1.17921, `000000281_lnorm` = 3.31634, `000000282_lnorm` = 2.2934, `000000283_lnorm` = 1.75066, `000000284_lnorm` = 2.23803, `000000285_lnorm` = 1.73284, `000000286_lnorm` = 2.27553, `000000287_lnorm` = 1.06919, `000000288_lnorm` = 2.22348, `000000289_lnorm` = 1.43162, `000000290_lnorm` = 2.38861, `000000291_lnorm` = 1.9776, `000000292_lnorm` = 1.75615, `000000293_lnorm` = 1.51279, `000000294_lnorm` = 4.17684, `000000295_lnorm` = 1.10022, `000000296_lnorm` = 3.42715, `000000297_lnorm` = 1.28569, `000000298_lnorm` = 1.91589, `000000299_lnorm` = 1.14508, `000000300_lnorm` = 1.36318, `000000301_lnorm` = 1.23333, `000000302_lnorm` = 1.07115, `000000303_lnorm` = 1.85, `000000304_lnorm` = 2.22285, `000000305_lnorm` = 1.22099, `000000306_lnorm` = 0.769899, -`000000307_lnorm` = 2.26783, `000000308_lnorm` = 2.76718, `000000309_lnorm` = 2.80311, `000000310_lnorm` = 1.7925, `000000311_lnorm` = 1.50201, `000000312_lnorm` = 2.33447, `000000313_lnorm` = 1.51844, `000000314_lnorm` = 1.49481, `000000315_lnorm` = 2.28878, `000000316_lnorm` = 2.50457, `000000317_lnorm` = 1.49334, `000000318_lnorm` = 1.2303, `000000319_lnorm` = 2.97667, `000000320_lnorm` = 2.11936, `000000321_lnorm` = 1.49001, `000000322_lnorm` = 1.68884, `000000323_lnorm` = 1.43209, `000000324_lnorm` = 1.93249, +`000000307_lnorm` = 2.26783, `000000308_lnorm` = 2.76718, `000000309_lnorm` = 2.80311, `000000310_lnorm` = 1.7925, `000000311_lnorm` = 1.50201, `000000312_lnorm` = 2.33447, `000000313_lnorm` = 1.51844, `000000314_lnorm` = 1.49481, `000000315_lnorm` = 2.28877, `000000316_lnorm` = 2.50457, `000000317_lnorm` = 1.49334, `000000318_lnorm` = 1.2303, `000000319_lnorm` = 2.97667, `000000320_lnorm` = 2.11936, `000000321_lnorm` = 1.49001, `000000322_lnorm` = 1.68884, `000000323_lnorm` = 1.43209, `000000324_lnorm` = 1.93249, `000000325_lnorm` = 1.48784, `000000326_lnorm` = 2.98808, `000000327_lnorm` = 2.30993, `000000328_lnorm` = 2.99877, `000000329_lnorm` = 1.741, `000000330_lnorm` = 1.88757, `000000331_lnorm` = 2.04144, `000000332_lnorm` = 1.25144, `000000333_lnorm` = 1.57907, `000000334_lnorm` = 1.00788, `000000335_lnorm` = 1.2126, `000000336_lnorm` = 1.9552, `000000337_lnorm` = 2.82747, `000000338_lnorm` = 1.90187, `000000339_lnorm` = 1.42327, `000000340_lnorm` = 1.43656, `000000341_lnorm` = 1.09695, `000000342_lnorm` = 1.33248, `000000343_lnorm` = 1.19027, `000000344_lnorm` = 1.97184, `000000345_lnorm` = 1.77387, `000000346_lnorm` = 1.07525, `000000347_lnorm` = 2.13797, `000000348_lnorm` = 2.16009, `000000349_lnorm` = 2.2232, `000000350_lnorm` = 2.71378, `000000351_lnorm` = 1.83288, `000000352_lnorm` = 2.48059, `000000353_lnorm` = 1.04259, `000000354_lnorm` = 1.55659, `000000355_lnorm` = 2.4289, `000000356_lnorm` = 3.13694, `000000357_lnorm` = 1.00274, `000000358_lnorm` = 1.32141, `000000359_lnorm` = 1.9265, `000000360_lnorm` = 1.34318, `000000361_lnorm` = 1.42568, `000000362_lnorm` = 1.01439, `000000363_lnorm` = 1.49849, `000000364_lnorm` = 2.22677, `000000365_lnorm` = 1.62129, `000000366_lnorm` = 2.04696, `000000367_lnorm` = 1.18602, `000000368_lnorm` = 1.20377, `000000369_lnorm` = 1.2206, `000000370_lnorm` = 1.90947, `000000371_lnorm` = 1.13543, `000000372_lnorm` = 1.6593, `000000373_lnorm` = 1.46798, `000000374_lnorm` = 1.57448, `000000375_lnorm` = 1.85693, `000000376_lnorm` = 1.4851, `000000377_lnorm` = 1.42378, `000000378_lnorm` = 1.59598, @@ -46,7 +46,7 @@ average,0.05,1.68118,0.682856,1.11342,2.76013,1,parametric,1000,1,"c(`000000001_ `000000793_lnorm` = 1.38939, `000000794_lnorm` = 1.73823, `000000795_lnorm` = 1.93236, `000000796_lnorm` = 2.27247, `000000797_lnorm` = 1.9506, `000000798_lnorm` = 2.79071, `000000799_lnorm` = 1.85945, `000000800_lnorm` = 1.697, `000000801_lnorm` = 1.20041, `000000802_lnorm` = 2.30994, `000000803_lnorm` = 2.28004, `000000804_lnorm` = 2.12277, `000000805_lnorm` = 1.40852, `000000806_lnorm` = 2.70247, `000000807_lnorm` = 0.952191, `000000808_lnorm` = 1.76159, `000000809_lnorm` = 1.55078, `000000810_lnorm` = 1.46163, `000000811_lnorm` = 2.11149, `000000812_lnorm` = 1.11352, `000000813_lnorm` = 2.7389, `000000814_lnorm` = 1.51083, `000000815_lnorm` = 1.2664, `000000816_lnorm` = 1.60513, `000000817_lnorm` = 1.05833, `000000818_lnorm` = 1.68812, `000000819_lnorm` = 2.66027, `000000820_lnorm` = 1.65418, `000000821_lnorm` = 1.08778, `000000822_lnorm` = 1.33578, `000000823_lnorm` = 1.09943, `000000824_lnorm` = 1.50982, `000000825_lnorm` = 1.619, `000000826_lnorm` = 2.30469, `000000827_lnorm` = 0.855125, `000000828_lnorm` = 2.42884, `000000829_lnorm` = 1.38089, `000000830_lnorm` = 4.4522, `000000831_lnorm` = 1.66964, `000000832_lnorm` = 1.85568, `000000833_lnorm` = 1.08886, `000000834_lnorm` = 0.921413, `000000835_lnorm` = 1.46622, `000000836_lnorm` = 2.73844, `000000837_lnorm` = 1.58314, `000000838_lnorm` = 1.38034, `000000839_lnorm` = 4.41954, `000000840_lnorm` = 0.943256, `000000841_lnorm` = 2.27984, `000000842_lnorm` = 0.912846, `000000843_lnorm` = 3.55196, `000000844_lnorm` = 1.1334, `000000845_lnorm` = 1.32162, `000000846_lnorm` = 1.15393, -`000000847_lnorm` = 1.98562, `000000848_lnorm` = 2.20511, `000000849_lnorm` = 1.54514, `000000850_lnorm` = 2.42929, `000000851_lnorm` = 4.14374, `000000852_lnorm` = 1.43422, `000000853_lnorm` = 1.86874, `000000854_lnorm` = 2.12603, `000000855_lnorm` = 1.61319, `000000856_lnorm` = 2.90886, `000000857_lnorm` = 1.78374, `000000858_lnorm` = 2.71821, `000000859_lnorm` = 2.36495, `000000860_lnorm` = 1.34749, `000000861_lnorm` = 2.34658, `000000862_lnorm` = 1.52777, `000000863_lnorm` = 0.600718, `000000864_lnorm` = 1.09026, +`000000847_lnorm` = 1.98562, `000000848_lnorm` = 2.20511, `000000849_lnorm` = 1.54514, `000000850_lnorm` = 2.42929, `000000851_lnorm` = 4.14374, `000000852_lnorm` = 1.43422, `000000853_lnorm` = 1.86874, `000000854_lnorm` = 2.12603, `000000855_lnorm` = 1.61319, `000000856_lnorm` = 2.90886, `000000857_lnorm` = 1.78374, `000000858_lnorm` = 2.71821, `000000859_lnorm` = 2.36495, `000000860_lnorm` = 1.34749, `000000861_lnorm` = 2.34658, `000000862_lnorm` = 1.52777, `000000863_lnorm` = 0.600719, `000000864_lnorm` = 1.09026, `000000865_lnorm` = 2.03663, `000000866_lnorm` = 1.49139, `000000867_lnorm` = 1.12194, `000000868_lnorm` = 1.07614, `000000869_lnorm` = 1.8528, `000000870_lnorm` = 2.95831, `000000871_lnorm` = 2.98388, `000000872_lnorm` = 2.99172, `000000873_lnorm` = 2.63005, `000000874_lnorm` = 2.71377, `000000875_lnorm` = 2.88341, `000000876_lnorm` = 1.53379, `000000877_lnorm` = 1.38716, `000000878_lnorm` = 1.82626, `000000879_lnorm` = 2.14879, `000000880_lnorm` = 1.45224, `000000881_lnorm` = 2.03255, `000000882_lnorm` = 1.23025, `000000883_lnorm` = 4.04123, `000000884_lnorm` = 1.87984, `000000885_lnorm` = 0.920501, `000000886_lnorm` = 1.39447, `000000887_lnorm` = 2.25379, `000000888_lnorm` = 1.17532, `000000889_lnorm` = 1.54539, `000000890_lnorm` = 1.16774, `000000891_lnorm` = 1.62573, `000000892_lnorm` = 0.973674, `000000893_lnorm` = 1.10345, `000000894_lnorm` = 1.55087, `000000895_lnorm` = 1.43027, `000000896_lnorm` = 0.962508, `000000897_lnorm` = 2.10172, `000000898_lnorm` = 1.45381, `000000899_lnorm` = 2.50912, `000000900_lnorm` = 0.829115, `000000901_lnorm` = 1.49204, `000000902_lnorm` = 1.97533, `000000903_lnorm` = 1.08147, `000000904_lnorm` = 1.12325, `000000905_lnorm` = 1.646, `000000906_lnorm` = 0.996106, `000000907_lnorm` = 3.10322, `000000908_lnorm` = 1.11549, `000000909_lnorm` = 1.86724, `000000910_lnorm` = 1.93593, `000000911_lnorm` = 0.86112, `000000912_lnorm` = 2.97445, `000000913_lnorm` = 2.62286, `000000914_lnorm` = 3.12933, `000000915_lnorm` = 1.27296, `000000916_lnorm` = 1.42102, `000000917_lnorm` = 1.6307, `000000918_lnorm` = 3.45913, diff --git a/tests/testthat/_snaps/hc/partialeft.csv b/tests/testthat/_snaps/hc/partialeft.csv new file mode 100644 index 000000000..14b95452c --- /dev/null +++ b/tests/testthat/_snaps/hc/partialeft.csv @@ -0,0 +1,2 @@ +dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples +lnorm,0.05,1.31771,NA,NA,NA,1,parametric,0,NA,numeric(0) diff --git a/tests/testthat/_snaps/hc/partialeftfull.csv b/tests/testthat/_snaps/hc/partialeftfull.csv new file mode 100644 index 000000000..bf2d067af --- /dev/null +++ b/tests/testthat/_snaps/hc/partialeftfull.csv @@ -0,0 +1,2 @@ +dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples +lnorm,0.05,1.83148,0.798459,0.945173,3.2476,1,parametric,10,1,numeric(0) diff --git a/tests/testthat/_snaps/hc/partialeftnonpara.csv b/tests/testthat/_snaps/hc/partialeftnonpara.csv new file mode 100644 index 000000000..20a00ef9e --- /dev/null +++ b/tests/testthat/_snaps/hc/partialeftnonpara.csv @@ -0,0 +1,2 @@ +dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples +lnorm,0.05,1.31771,0.360883,0.716321,1.81154,1,non-parametric,10,1,numeric(0) diff --git a/tests/testthat/_snaps/predict/pred_cis.csv b/tests/testthat/_snaps/predict/pred_cis.csv index 82be1a8f6..731271e00 100644 --- a/tests/testthat/_snaps/predict/pred_cis.csv +++ b/tests/testthat/_snaps/predict/pred_cis.csv @@ -90,11 +90,11 @@ average,0.88,53.0729,13.2196,37.4577,76.0711,1,parametric,10,1,numeric(0) average,0.89,55.7779,14.1741,39.1039,80.5633,1,parametric,10,1,numeric(0) average,0.9,58.8136,15.2974,40.9198,85.7395,1,parametric,10,1,numeric(0) average,0.91,62.2636,16.6457,42.9533,91.7803,1,parametric,10,1,numeric(0) -average,0.92,66.2464,18.3047,45.2624,98.9849,1,parametric,10,1,numeric(0) +average,0.92,66.2464,18.3046,45.2624,98.9849,1,parametric,10,1,numeric(0) average,0.93,70.9363,20.4117,47.8675,107.823,1,parametric,10,1,numeric(0) average,0.94,76.6047,23.2033,50.8284,119.092,1,parametric,10,1,numeric(0) average,0.95,83.7044,27.1235,54.4206,134.268,1,parametric,10,1,numeric(0) -average,0.96,93.067,33.1168,58.9674,156.395,1,parametric,10,1,numeric(0) +average,0.96,93.067,33.1167,58.9674,156.395,1,parametric,10,1,numeric(0) average,0.97,106.456,43.5908,65.1123,192.96,1,parametric,10,1,numeric(0) average,0.98,128.602,66.8453,74.431,268.383,1,parametric,10,1,numeric(0) average,0.99,180.146,156.616,92.7806,534.267,1,parametric,10,1,numeric(0) diff --git a/tests/testthat/_snaps/print.md b/tests/testthat/_snaps/print.md index 1275e5944..66c8d9fe9 100644 --- a/tests/testthat/_snaps/print.md +++ b/tests/testthat/_snaps/print.md @@ -19,7 +19,7 @@ meanlog 0.623899 sdlog 1.31089 - Parameters estimated from 28 rows of left (2.4) censored, unequally weighted and rescaled (8.408) data. + Parameters estimated from 28 rows of inconsistently censored, unequally weighted and rescaled (8.408) data. # summary fitdists with inconsistently censored data diff --git a/tests/testthat/_snaps/weibull/hc_anona.csv b/tests/testthat/_snaps/weibull/hc_anona.csv index 646875e94..62585ca26 100644 --- a/tests/testthat/_snaps/weibull/hc_anona.csv +++ b/tests/testthat/_snaps/weibull/hc_anona.csv @@ -1,5 +1,5 @@ dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples -average,0.05,6.42593,15.7252,0.700779,53.8366,1,parametric,1000,1,"c(`000000001_weibull` = 19.5331, `000000002_weibull` = 3.50237, `000000003_weibull` = 4.40539, `000000004_weibull` = 8.44417, `000000005_weibull` = 40.9936, `000000006_weibull` = 17.6807, `000000007_weibull` = 5.57319, `000000008_weibull` = 43.9998, `000000009_weibull` = 2.57976, `000000010_weibull` = 5.23002, `000000011_weibull` = 8.07911, `000000012_weibull` = 5.01415, `000000013_weibull` = 4.07884, `000000014_weibull` = 3.04445, `000000015_weibull` = 6.10087, `000000016_weibull` = 2.21551, `000000017_weibull` = 14.4184, +average,0.05,6.42593,15.7252,0.700779,53.8366,1,parametric,1000,1,"c(`000000001_weibull` = 19.5331, `000000002_weibull` = 3.50237, `000000003_weibull` = 4.40539, `000000004_weibull` = 8.44417, `000000005_weibull` = 40.9936, `000000006_weibull` = 17.6807, `000000007_weibull` = 5.57319, `000000008_weibull` = 43.9998, `000000009_weibull` = 2.57976, `000000010_weibull` = 5.23002, `000000011_weibull` = 8.07911, `000000012_weibull` = 5.01415, `000000013_weibull` = 4.07884, `000000014_weibull` = 3.04445, `000000015_weibull` = 6.10087, `000000016_weibull` = 2.21552, `000000017_weibull` = 14.4184, `000000018_weibull` = 19.3822, `000000019_weibull` = 8.63474, `000000020_weibull` = 8.64451, `000000021_weibull` = 3.8992, `000000022_weibull` = 15.5584, `000000023_weibull` = 9.03457, `000000024_weibull` = 1.29008, `000000025_weibull` = 22.3785, `000000026_weibull` = 24.1325, `000000027_weibull` = 3.70208, `000000028_weibull` = 11.4905, `000000029_weibull` = 40.4752, `000000030_weibull` = 26.3224, `000000031_weibull` = 22.5898, `000000032_weibull` = 35.578, `000000033_weibull` = 0.763847, `000000034_weibull` = 6.62819, `000000035_weibull` = 5.91055, `000000036_weibull` = 7.85492, `000000037_weibull` = 16.9274, `000000038_weibull` = 13.8314, `000000039_weibull` = 3.60487, `000000040_weibull` = 2.39172, `000000041_weibull` = 7.35896, `000000042_weibull` = 15.659, `000000043_weibull` = 75.3306, `000000044_weibull` = 26.3684, `000000045_weibull` = 22.3269, `000000046_weibull` = 33.0258, `000000047_weibull` = 10.0165, `000000048_weibull` = 2.14456, `000000049_weibull` = 2.60983, `000000050_weibull` = 5.91748, `000000051_weibull` = 16.2137, `000000052_weibull` = 2.84679, `000000053_weibull` = 86.756, `000000054_weibull` = 7.54035, `000000055_weibull` = 3.97361, `000000056_weibull` = 46.5391, `000000057_weibull` = 1.13562, `000000058_weibull` = 9.83459, `000000059_weibull` = 25.256, `000000060_weibull` = 28.5201, `000000061_weibull` = 2.29067, `000000062_weibull` = 2.89851, `000000063_weibull` = 13.054, `000000064_weibull` = 6.09376, `000000065_weibull` = 8.04456, `000000066_weibull` = 6.73045, `000000067_weibull` = 42.9916, `000000068_weibull` = 9.31959, @@ -9,7 +9,7 @@ average,0.05,6.42593,15.7252,0.700779,53.8366,1,parametric,1000,1,"c(`000000001_ `000000120_weibull` = 4.44526, `000000121_weibull` = 2.98823, `000000122_weibull` = 7.56639, `000000123_weibull` = 26.8841, `000000124_weibull` = 9.39364, `000000125_weibull` = 13.0359, `000000126_weibull` = 5.72898, `000000127_weibull` = 8.1963, `000000128_weibull` = 21.5161, `000000129_weibull` = 4.52517, `000000130_weibull` = 6.24429, `000000131_weibull` = 1.58898, `000000132_weibull` = 8.30927, `000000133_weibull` = 5.38344, `000000134_weibull` = 10.1527, `000000135_weibull` = 5.81332, `000000136_weibull` = 0.536, `000000137_weibull` = 1.29951, `000000138_weibull` = 70.4598, `000000139_weibull` = 4.5218, `000000140_weibull` = 21.6146, `000000141_weibull` = 3.35853, `000000142_weibull` = 16.6267, `000000143_weibull` = 6.14599, `000000144_weibull` = 9.08013, `000000145_weibull` = 1.86929, `000000146_weibull` = 0.223709, `000000147_weibull` = 2.16602, `000000148_weibull` = 6.83188, `000000149_weibull` = 8.64161, `000000150_weibull` = 10.0088, `000000151_weibull` = 9.28437, `000000152_weibull` = 0.340506, `000000153_weibull` = 10.6452, `000000154_weibull` = 6.50586, `000000155_weibull` = 28.2793, `000000156_weibull` = 3.38084, `000000157_weibull` = 40.4067, `000000158_weibull` = 5.30406, `000000159_weibull` = 11.2295, `000000160_weibull` = 9.52455, `000000161_weibull` = 4.97173, `000000162_weibull` = 2.37949, `000000163_weibull` = 7.09773, `000000164_weibull` = 17.0816, `000000165_weibull` = 14.4958, `000000166_weibull` = 2.64117, `000000167_weibull` = 7.71315, `000000168_weibull` = 3.82515, `000000169_weibull` = 15.1812, `000000170_weibull` = 30.7656, -`000000171_weibull` = 92.2867, `000000172_weibull` = 63.871, `000000173_weibull` = 24.312, `000000174_weibull` = 0.712989, `000000175_weibull` = 9.70749, `000000176_weibull` = 6.05038, `000000177_weibull` = 7.88639, `000000178_weibull` = 4.43079, `000000179_weibull` = 13.4615, `000000180_weibull` = 9.501, `000000181_weibull` = 38.8943, `000000182_weibull` = 11.0954, `000000183_weibull` = 9.27302, `000000184_weibull` = 4.25854, `000000185_weibull` = 93.3952, `000000186_weibull` = 15.5652, `000000187_weibull` = 39.1772, +`000000171_weibull` = 92.2867, `000000172_weibull` = 63.871, `000000173_weibull` = 24.312, `000000174_weibull` = 0.712989, `000000175_weibull` = 9.70749, `000000176_weibull` = 6.05038, `000000177_weibull` = 7.88639, `000000178_weibull` = 4.43079, `000000179_weibull` = 13.4615, `000000180_weibull` = 9.501, `000000181_weibull` = 38.8943, `000000182_weibull` = 11.0954, `000000183_weibull` = 9.27304, `000000184_weibull` = 4.25854, `000000185_weibull` = 93.3952, `000000186_weibull` = 15.5652, `000000187_weibull` = 39.1772, `000000188_weibull` = 26.6589, `000000189_weibull` = 11.7129, `000000190_weibull` = 1.55133, `000000191_weibull` = 17.8172, `000000192_weibull` = 3.16555, `000000193_weibull` = 1.09582, `000000194_weibull` = 0.888257, `000000195_weibull` = 2.11508, `000000196_weibull` = 10.838, `000000197_weibull` = 3.27186, `000000198_weibull` = 22.6642, `000000199_weibull` = 0.621174, `000000200_weibull` = 5.66405, `000000201_weibull` = 5.161, `000000202_weibull` = 9.22598, `000000203_weibull` = 5.47799, `000000204_weibull` = 30.7631, `000000205_weibull` = 22.0846, `000000206_weibull` = 7.74121, `000000207_weibull` = 51.2734, `000000208_weibull` = 26.0558, `000000209_weibull` = 11.8084, `000000210_weibull` = 25.3367, `000000211_weibull` = 1.47333, `000000212_weibull` = 5.2519, `000000213_weibull` = 2.78534, `000000214_weibull` = 11.5703, `000000215_weibull` = 3.51625, `000000216_weibull` = 3.49188, `000000217_weibull` = 28.7613, `000000218_weibull` = 7.91703, `000000219_weibull` = 10.5716, `000000220_weibull` = 4.28306, `000000221_weibull` = 11.8531, `000000222_weibull` = 7.44154, `000000223_weibull` = 3.765, `000000224_weibull` = 14.7505, `000000225_weibull` = 19.7469, `000000226_weibull` = 86.9182, `000000227_weibull` = 7.47854, `000000228_weibull` = 3.75788, `000000229_weibull` = 43.5514, `000000230_weibull` = 2.74848, `000000231_weibull` = 52.9375, `000000232_weibull` = 9.81075, `000000233_weibull` = 1.98022, `000000234_weibull` = 11.5546, `000000235_weibull` = 1.3808, `000000236_weibull` = 3.58995, `000000237_weibull` = 13.5264, `000000238_weibull` = 19.9423, @@ -40,9 +40,9 @@ average,0.05,6.42593,15.7252,0.700779,53.8366,1,parametric,1000,1,"c(`000000001_ `000000647_weibull` = 2.60604, `000000648_weibull` = 7.44617, `000000649_weibull` = 19.6147, `000000650_weibull` = 6.01965, `000000651_weibull` = 1.1712, `000000652_weibull` = 2.61556, `000000653_weibull` = 15.1736, `000000654_weibull` = 3.53789, `000000655_weibull` = 2.01071, `000000656_weibull` = 7.14453, `000000657_weibull` = 73.5397, `000000658_weibull` = 4.80654, `000000659_weibull` = 14.6031, `000000660_weibull` = 12.6076, `000000661_weibull` = 10.1935, `000000662_weibull` = 3.97837, `000000663_weibull` = 3.30814, `000000664_weibull` = 1.6816, `000000665_weibull` = 8.13837, `000000666_weibull` = 3.67347, `000000667_weibull` = 13.284, `000000668_weibull` = 16.4613, `000000669_weibull` = 0.623811, `000000670_weibull` = 4.89493, `000000671_weibull` = 7.08077, `000000672_weibull` = 43.5005, `000000673_weibull` = 7.4239, `000000674_weibull` = 7.0047, `000000675_weibull` = 23.4011, `000000676_weibull` = 28.0393, `000000677_weibull` = 2.98204, `000000678_weibull` = 14.4043, `000000679_weibull` = 6.58211, `000000680_weibull` = 23.3226, `000000681_weibull` = 36.596, `000000682_weibull` = 17.0606, `000000683_weibull` = 6.7984, `000000684_weibull` = 9.2242, `000000685_weibull` = 15.4452, `000000686_weibull` = 0.821804, `000000687_weibull` = 6.42025, `000000688_weibull` = 13.6097, `000000689_weibull` = 19.5224, `000000690_weibull` = 9.93553, `000000691_weibull` = 9, `000000692_weibull` = 10.1461, `000000693_weibull` = 13.122, `000000694_weibull` = 6.38611, `000000695_weibull` = 17.9711, `000000696_weibull` = 1.08286, `000000697_weibull` = 8.59671, -`000000698_weibull` = 4.30025, `000000699_weibull` = 9.57069, `000000700_weibull` = 0.438171, `000000701_weibull` = 7.41393, `000000702_weibull` = 56.4949, `000000703_weibull` = 1.06607, `000000704_weibull` = 8.62138, `000000705_weibull` = 24.0734, `000000706_weibull` = 1.95334, `000000707_weibull` = 2.0732, `000000708_weibull` = 39.2267, `000000709_weibull` = 8.00883, `000000710_weibull` = 20.4688, `000000711_weibull` = 13.4883, `000000712_weibull` = 1.61293, `000000713_weibull` = 0.451758, `000000714_weibull` = 6.71567, +`000000698_weibull` = 4.30025, `000000699_weibull` = 9.57069, `000000700_weibull` = 0.438171, `000000701_weibull` = 7.41393, `000000702_weibull` = 56.4948, `000000703_weibull` = 1.06607, `000000704_weibull` = 8.62138, `000000705_weibull` = 24.0734, `000000706_weibull` = 1.95334, `000000707_weibull` = 2.0732, `000000708_weibull` = 39.2267, `000000709_weibull` = 8.00883, `000000710_weibull` = 20.4688, `000000711_weibull` = 13.4883, `000000712_weibull` = 1.61293, `000000713_weibull` = 0.451758, `000000714_weibull` = 6.71567, `000000715_weibull` = 9.29388, `000000716_weibull` = 8.7899, `000000717_weibull` = 1.88459, `000000718_weibull` = 15.6741, `000000719_weibull` = 13.5505, `000000720_weibull` = 1.44377, `000000721_weibull` = 33.0385, `000000722_weibull` = 2.14696, `000000723_weibull` = 2.71093, `000000724_weibull` = 9.36616, `000000725_weibull` = 16.8236, `000000726_weibull` = 10.5243, `000000727_weibull` = 1.62647, `000000728_weibull` = 1.49607, `000000729_weibull` = 7.4276, `000000730_weibull` = 27.0418, `000000731_weibull` = 17.4308, -`000000732_weibull` = 3.35695, `000000733_weibull` = 26.041, `000000734_weibull` = 0.89897, `000000735_weibull` = 1.17058, `000000736_weibull` = 1.52257, `000000737_weibull` = 6.0438, `000000738_weibull` = 27.2462, `000000739_weibull` = 6.00222, `000000740_weibull` = 4.53184, `000000741_weibull` = 2.96897, `000000742_weibull` = 31.6336, `000000743_weibull` = 11.9778, `000000744_weibull` = 9.00836, `000000745_weibull` = 20.5272, `000000746_weibull` = 7.58279, `000000747_weibull` = 8.17714, `000000748_weibull` = 76.374, +`000000732_weibull` = 3.35695, `000000733_weibull` = 26.041, `000000734_weibull` = 0.89897, `000000735_weibull` = 1.17058, `000000736_weibull` = 1.52257, `000000737_weibull` = 6.04379, `000000738_weibull` = 27.2462, `000000739_weibull` = 6.00222, `000000740_weibull` = 4.53184, `000000741_weibull` = 2.96897, `000000742_weibull` = 31.6336, `000000743_weibull` = 11.9778, `000000744_weibull` = 9.00836, `000000745_weibull` = 20.5272, `000000746_weibull` = 7.58279, `000000747_weibull` = 8.17714, `000000748_weibull` = 76.374, `000000749_weibull` = 42.0792, `000000750_weibull` = 16.0415, `000000751_weibull` = 12.324, `000000752_weibull` = 9.68108, `000000753_weibull` = 1.47791, `000000754_weibull` = 5.09777, `000000755_weibull` = 1.80216, `000000756_weibull` = 0.538356, `000000757_weibull` = 1.40222, `000000758_weibull` = 6.7286, `000000759_weibull` = 9.69449, `000000760_weibull` = 6.86486, `000000761_weibull` = 33.397, `000000762_weibull` = 5.53447, `000000763_weibull` = 5.52698, `000000764_weibull` = 8.51302, `000000765_weibull` = 23.3549, `000000766_weibull` = 16.0331, `000000767_weibull` = 39.0041, `000000768_weibull` = 19.1596, `000000769_weibull` = 23.9332, `000000770_weibull` = 9.24828, `000000771_weibull` = 4.96577, `000000772_weibull` = 29.5363, `000000773_weibull` = 5.6763, `000000774_weibull` = 5.08218, `000000775_weibull` = 13.4413, `000000776_weibull` = 9.30593, `000000777_weibull` = 4.34439, `000000778_weibull` = 0.241665, `000000779_weibull` = 3.9396, `000000780_weibull` = 5.11002, `000000781_weibull` = 14.4892, `000000782_weibull` = 5.86105, `000000783_weibull` = 24.1607, `000000784_weibull` = 12.3159, `000000785_weibull` = 2.30014, `000000786_weibull` = 7.50377, `000000787_weibull` = 2.54884, `000000788_weibull` = 23.4568, `000000789_weibull` = 4.75188, `000000790_weibull` = 13.9528, `000000791_weibull` = 1.848, `000000792_weibull` = 16.6305, `000000793_weibull` = 5.42751, `000000794_weibull` = 1.45093, `000000795_weibull` = 10.8402, `000000796_weibull` = 7.97346, `000000797_weibull` = 3.88768, `000000798_weibull` = 1.27946, `000000799_weibull` = 0.667591, diff --git a/tests/testthat/test-censor.R b/tests/testthat/test-censor.R index b877da807..4ca63ecea 100644 --- a/tests/testthat/test-censor.R +++ b/tests/testthat/test-censor.R @@ -12,17 +12,39 @@ # See the License for the specific language governing permissions and # limitations under the License. -test_that("censor", { - rlang::local_options(lifecycle_verbosity = "quiet") +test_that("ssd_censor only add right by default", { + data <- ssddata::ccme_boron + data$right <- data$Conc + expect_identical(ssd_censor_data(ssddata::ccme_boron), data) +}) - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") +test_that("ssd_censor use existing right", { + data <- ssddata::ccme_boron + data$right2 <- data$Conc + expect_identical(ssd_censor_data(data, right = "right2"), data) +}) - expect_false(is_censored(fits)) +test_that("ssd_censor use existing right and left", { + data <- ssddata::ccme_boron + data$right2 <- data$Conc + data$left3 <- data$Conc + expect_identical(ssd_censor_data(data, left = "left3", right = "right2"), data) +}) - # need to have example censored data +test_that("ssd_censor no rows", { data <- ssddata::ccme_boron - data$Right <- data$Conc - data$Conc <- 0 - fits <- ssd_fit_dists(data, right = "Right", dists = c("gamma", "llogis", "lnorm")) - expect_true(is_censored(fits)) + data$right <- data$Conc + expect_identical(ssd_censor_data(ssddata::ccme_boron[0,]), data[0,]) +}) + +test_that("ssd_censor c(2.5, Inf)", { + expect_snapshot_data(ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, Inf)), "boron_25") +}) + +test_that("ssd_censor c(0, 10)", { + expect_snapshot_data(ssd_censor_data(ssddata::ccme_boron, censoring = c(0, 10)), "boron_10") +}) + +test_that("ssd_censor c(2.5, 10)", { + expect_snapshot_data(ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, 10)), "boron_2510") }) diff --git a/tests/testthat/test-censored.R b/tests/testthat/test-censored.R index a80c14e29..e8037fb17 100644 --- a/tests/testthat/test-censored.R +++ b/tests/testthat/test-censored.R @@ -68,3 +68,29 @@ test_that("ssd_is_censored TRUE fitdists censored", { fits <- ssd_fit_dists(data, right = "Right", dists = c("gamma", "llogis", "lnorm")) expect_true(ssd_is_censored(fits)) }) + +test_that("ssd_is_censored TRUE fitdists multiple", { + data <- ssddata::ccme_boron + data$right <- data$Conc + data$Conc[c(3,6,8)] <- NA + + fits <- ssd_fit_dists(data, dists = "lnorm", right = "right") + expect_true(ssd_is_censored(fits)) +}) + + +test_that("censor", { + rlang::local_options(lifecycle_verbosity = "quiet") + + fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") + + expect_false(is_censored(fits)) + + # need to have example censored data + data <- ssddata::ccme_boron + data$Right <- data$Conc + data$Conc <- 0 + fits <- ssd_fit_dists(data, right = "Right", dists = c("gamma", "llogis", "lnorm")) + expect_true(is_censored(fits)) +}) + diff --git a/tests/testthat/test-estimates.R b/tests/testthat/test-estimates.R index 5c920b0d1..a3ef6d4f9 100644 --- a/tests/testthat/test-estimates.R +++ b/tests/testthat/test-estimates.R @@ -22,7 +22,7 @@ test_that("estimates", { test_that("estimates all_estimates = TRUE", { fits <- ssd_fit_dists(ssddata::ccme_boron) - + estimates <- estimates(fits, all_estimates = TRUE) expect_type(estimates, "list") expect_snapshot_output(print(estimates)) diff --git a/tests/testthat/test-gof.R b/tests/testthat/test-gof.R index 1620eef56..7d8a7df41 100644 --- a/tests/testthat/test-gof.R +++ b/tests/testthat/test-gof.R @@ -25,13 +25,13 @@ test_that("gof", { test_that("gof censored same parameters2", { data <- ssddata::ccme_boron data$right <- data$Conc - data$Conc[c(3,6,8)] <- NA + data$Conc[c(3, 6, 8)] <- NA fits <- ssd_fit_dists(data, right = "right", dists = c("llogis", "lnorm")) - + gof_statistic <- ssd_gof(fits) expect_snapshot_data(gof_statistic, "gof_statistic2") - + gof <- ssd_gof(fits, pvalue = TRUE) expect_snapshot_data(gof, "gof2") }) @@ -39,13 +39,13 @@ test_that("gof censored same parameters2", { test_that("gof censored same parameters5", { data <- ssddata::ccme_boron data$right <- data$Conc - data$Conc[c(3,6,8)] <- NA - + data$Conc[c(3, 6, 8)] <- NA + fits <- ssd_fit_dists(data, right = "right", dists = c("llogis_llogis", "lnorm_lnorm")) - + gof_statistic <- ssd_gof(fits) expect_snapshot_data(gof_statistic, "gof_statistic5") - + gof <- ssd_gof(fits, pvalue = TRUE) expect_snapshot_data(gof, "gof5") }) @@ -53,13 +53,13 @@ test_that("gof censored same parameters5", { test_that("gof censored same diff parameters", { data <- ssddata::ccme_boron data$right <- data$Conc - data$Conc[c(3,6,8)] <- NA - + data$Conc[c(3, 6, 8)] <- NA + fits <- ssd_fit_dists(data, right = "right", dists = c("llogis", "lnorm_lnorm")) - + gof_statistic <- ssd_gof(fits) expect_snapshot_data(gof_statistic, "gof_statisticn") - + gof <- ssd_gof(fits, pvalue = TRUE) expect_snapshot_data(gof, "gofn") }) diff --git a/tests/testthat/test-gompertz.R b/tests/testthat/test-gompertz.R index bf8d7ccc7..59552abb1 100644 --- a/tests/testthat/test-gompertz.R +++ b/tests/testthat/test-gompertz.R @@ -25,7 +25,9 @@ test_that("bootstrap gompertz with problem data", { data <- data.frame(Conc = ssd_rgompertz(6, location = 0.6, shape = 0.07)) fit <- ssdtools::ssd_fit_dists(data, dists = "gompertz") set.seed(99) - hc <- ssd_hc(fit, ci = TRUE, nboot = 100, min_pboot = 0.8, ci_method = "weighted_arithmetic", multi_est = FALSE, - samples = TRUE) + hc <- ssd_hc(fit, + ci = TRUE, nboot = 100, min_pboot = 0.8, ci_method = "weighted_arithmetic", multi_est = FALSE, + samples = TRUE + ) expect_snapshot_data(hc, "hc_prob") }) diff --git a/tests/testthat/test-hc-burrlioz.R b/tests/testthat/test-hc-burrlioz.R index a632e27b5..a5b1ef970 100644 --- a/tests/testthat/test-hc-burrlioz.R +++ b/tests/testthat/test-hc-burrlioz.R @@ -49,7 +49,7 @@ test_that("ssd_hc currently errors with burrIII3", { fit <- ssd_fit_burrlioz(data) expect_identical(names(fit), "burrIII3") set.seed(47) - #FIXME: currently errors - also hp + # FIXME: currently errors - also hp expect_error(hc_burrIII3 <- ssd_hc(fit, nboot = 10, ci = TRUE, min_pboot = 0)) }) diff --git a/tests/testthat/test-hc-root.R b/tests/testthat/test-hc-root.R index d78309738..6c138f862 100644 --- a/tests/testthat/test-hc-root.R +++ b/tests/testthat/test-hc-root.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -21,7 +21,7 @@ test_that("hc multi_ci lnorm", { hc_multi <- ssd_hc(fits, average = TRUE, ci_method = "multi_fixed") expect_identical(hc_dist$est, hc_average$est) expect_equal(hc_multi, hc_average) - + testthat::expect_snapshot({ hc_multi }) @@ -42,8 +42,8 @@ test_that("hc multi_ci all", { test_that("hc multi_ci all multiple hcs", { fits <- ssd_fit_dists(ssddata::ccme_boron) set.seed(102) - hc_average <- ssd_hc(fits, proportion = c(5,10)/100, average = TRUE, ci_method = "weighted_arithmetic", multi_est = FALSE) - hc_multi <- ssd_hc(fits, proportion = c(5,10)/100, average = TRUE, ci_method = "multi_fixed") + hc_average <- ssd_hc(fits, proportion = c(5, 10) / 100, average = TRUE, ci_method = "weighted_arithmetic", multi_est = FALSE) + hc_multi <- ssd_hc(fits, proportion = c(5, 10) / 100, average = TRUE, ci_method = "multi_fixed") expect_equal(hc_average$est, c(1.24151480646654, 2.37337090704541), tolerance = 1e-6) expect_equal(hc_multi$est, c(1.2567737470831, 2.38164080837643), tolerance = 1e-6) testthat::expect_snapshot({ @@ -54,9 +54,9 @@ test_that("hc multi_ci all multiple hcs", { test_that("hc multi_ci all multiple hcs cis", { fits <- ssd_fit_dists(ssddata::ccme_boron) set.seed(102) - hc_average <- ssd_hc(fits, proportion = c(5,10)/100, average = TRUE, ci_method = "weighted_arithmetic", multi_est = FALSE, nboot = 10, ci = TRUE) + hc_average <- ssd_hc(fits, proportion = c(5, 10) / 100, average = TRUE, ci_method = "weighted_arithmetic", multi_est = FALSE, nboot = 10, ci = TRUE) set.seed(105) - hc_multi <- ssd_hc(fits, proportion = c(5,10)/100, average = TRUE, ci_method = "multi_fixed", nboot = 10, ci = TRUE) + hc_multi <- ssd_hc(fits, proportion = c(5, 10) / 100, average = TRUE, ci_method = "multi_fixed", nboot = 10, ci = TRUE) expect_equal(hc_average$est, c(1.24151480646654, 2.37337090704541), tolerance = 1e-6) expect_equal(hc_multi$est, c(1.2567737470831, 2.38164080837643), tolerance = 1e-6) testthat::expect_snapshot({ @@ -72,15 +72,15 @@ test_that("hc multi_ci lnorm ci", { hc_average <- ssd_hc(fits, average = TRUE, ci = TRUE, nboot = 100, ci_method = "weighted_arithmetic", multi_est = FALSE) set.seed(102) hc_multi <- ssd_hc(fits, average = TRUE, ci_method = "multi_fixed", ci = TRUE, nboot = 100) - + testthat::expect_snapshot({ hc_average }) - + testthat::expect_snapshot({ hc_multi }) - + hc_dist$dist <- NULL hc_average$dist <- NULL expect_identical(hc_dist, hc_average) diff --git a/tests/testthat/test-hc.R b/tests/testthat/test-hc.R index d7d5ebebc..d882ee6ea 100644 --- a/tests/testthat/test-hc.R +++ b/tests/testthat/test-hc.R @@ -23,7 +23,7 @@ test_that("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 + 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") @@ -32,7 +32,7 @@ test_that("hc estimate with censored data same number of 2parameters", { 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 + 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") @@ -41,27 +41,26 @@ test_that("hc estimate with censored data same number of 5parameters", { 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 + 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_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")) @@ -71,7 +70,6 @@ test_that("ssd_hc list handles zero length list", { }) 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")) @@ -82,21 +80,20 @@ test_that("ssd_hc list works null values handles zero length list", { }) test_that("ssd_hc list works multiple percent values", { - - hc <- ssd_hc(list("lnorm" = NULL), proportion = c(1, 99)/100) + 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_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) + 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_identical(hc$proportion, 50.5 / 100) expect_equal(hc$dist, "lnorm") expect_equal(hc$est, 1.01261234261044) expect_identical(hc$se, NA_real_) @@ -113,31 +110,28 @@ test_that("ssd_hc list works specified values", { }) 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_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) + 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_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")) @@ -148,52 +142,46 @@ test_that("ssd_hc fitdists works zero length percent", { }) 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) + + 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) + + 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") @@ -201,8 +189,10 @@ test_that("ssd_hc fitdists averages", { }) test_that("ssd_hc fitdists correctly averages", { - fits <- ssd_fit_dists(ssddata::aims_molybdenum_marine, dists = c("lgumbel", "lnorm_lnorm"), - min_pmix = 0) + 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.69271009251), tolerance = 1e-6) expect_equal(hc$wt, c(0.0968427088339105, 0.90315729116609)) @@ -211,25 +201,22 @@ test_that("ssd_hc fitdists correctly averages", { }) 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) + + 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) + + 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") @@ -237,7 +224,6 @@ test_that("ssd_hc fitdists not average", { }) 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") @@ -246,29 +232,26 @@ test_that("ssd_hc fitdists correct for rescaling", { }) 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 @@ -277,7 +260,7 @@ test_that("ssd_hc doesn't calculate cis with inconsistent censoring", { 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( @@ -294,11 +277,47 @@ test_that("ssd_hc works with fully left censored data", { fits <- ssd_fit_dists(data, right = "Conc2", dists = c("lnorm", "llogis")) set.seed(10) hc <- ssd_hc(fits, ci = TRUE, nboot = 10, ci_method = "weighted_arithmetic") - expect_equal(hc$se, 0.000753288708572757, tolerance = 1e-6) + expect_snapshot_data(hc, "fullyleft") }) -test_that("ssd_hc not work partially censored even if all same left", { +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 inconsistently 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") + hc <- ssd_hc(fits, ci = TRUE, nboot = 10, average = FALSE) + expect_snapshot_data(hc, "partialeftfull") + expect_gt(hc$ucl, hc$est) +}) + +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 @@ -311,7 +330,6 @@ test_that("ssd_hc not work partially censored even if all same left", { }) test_that("ssd_hc doesn't works with inconsisently censored data", { - data <- ssddata::ccme_boron data$Conc2 <- data$Conc data$Conc <- 0 @@ -325,13 +343,12 @@ test_that("ssd_hc doesn't works with inconsisently 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) @@ -375,7 +392,6 @@ test_that("ssd_hc calculates cis in parallel with two distributions", { }) 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 @@ -388,7 +404,6 @@ test_that("ssd_hc doesn't calculate cis with unequally weighted data", { }) 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") @@ -432,7 +447,6 @@ test_that("ssd_hc cis with non-convergence", { }) 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) @@ -443,14 +457,13 @@ test_that("ssd_hc cis with error and multiple dists", { 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" + 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") @@ -468,7 +481,6 @@ test_that("ssd_hc parametric and non-parametric small sample size", { }) 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) @@ -476,7 +488,6 @@ test_that("ssd_hc_burrlioz gets estimates with invpareto", { }) test_that("ssd_hc_burrlioz gets estimates with burrIII3", { - set.seed(99) data <- data.frame(Conc = ssd_rburrIII3(30)) fit <- ssd_fit_burrlioz(data) @@ -487,26 +498,24 @@ test_that("ssd_hc_burrlioz gets estimates with 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 + 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") + 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") @@ -515,98 +524,111 @@ test_that("ssd_hc passing all boots ccme_chloride lnorm_lnorm", { 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_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv", - "data_000000003_multi.csv", "estimates_000000000_multi.rds", - "estimates_000000001_multi.rds", "estimates_000000002_multi.rds", - "estimates_000000003_multi.rds")) + expect_identical(list.files(dir), c( + "data_000000000_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv", + "data_000000003_multi.csv", "estimates_000000000_multi.rds", + "estimates_000000001_multi.rds", "estimates_000000002_multi.rds", + "estimates_000000003_multi.rds" + )) data <- read.csv(file.path(dir, "data_000000000_multi.csv")) expect_snapshot_data(hc, "hc_save_to1data") boot1 <- read.csv(file.path(dir, "data_000000001_multi.csv")) expect_snapshot_data(hc, "hc_save_to1") ests <- readRDS(file.path(dir, "estimates_000000000_multi.rds")) ests1 <- readRDS(file.path(dir, "estimates_000000001_multi.rds")) - + expect_identical(names(ests), names(ests1)) - expect_identical(names(ests), c("burrIII3.weight", "burrIII3.shape1", "burrIII3.shape2", "burrIII3.scale", - "gamma.weight", "gamma.shape", "gamma.scale", "gompertz.weight", - "gompertz.location", "gompertz.shape", "invpareto.weight", "invpareto.shape", - "invpareto.scale", "lgumbel.weight", "lgumbel.locationlog", "lgumbel.scalelog", - "llogis.weight", "llogis.locationlog", "llogis.scalelog", "llogis_llogis.weight", - "llogis_llogis.locationlog1", "llogis_llogis.scalelog1", "llogis_llogis.locationlog2", - "llogis_llogis.scalelog2", "llogis_llogis.pmix", "lnorm.weight", - "lnorm.meanlog", "lnorm.sdlog", "lnorm_lnorm.weight", "lnorm_lnorm.meanlog1", - "lnorm_lnorm.sdlog1", "lnorm_lnorm.meanlog2", "lnorm_lnorm.sdlog2", - "lnorm_lnorm.pmix", "weibull.weight", "weibull.shape", "weibull.scale" + expect_identical(names(ests), c( + "burrIII3.weight", "burrIII3.shape1", "burrIII3.shape2", "burrIII3.scale", + "gamma.weight", "gamma.shape", "gamma.scale", "gompertz.weight", + "gompertz.location", "gompertz.shape", "invpareto.weight", "invpareto.shape", + "invpareto.scale", "lgumbel.weight", "lgumbel.locationlog", "lgumbel.scalelog", + "llogis.weight", "llogis.locationlog", "llogis.scalelog", "llogis_llogis.weight", + "llogis_llogis.locationlog1", "llogis_llogis.scalelog1", "llogis_llogis.locationlog2", + "llogis_llogis.scalelog2", "llogis_llogis.pmix", "lnorm.weight", + "lnorm.meanlog", "lnorm.sdlog", "lnorm_lnorm.weight", "lnorm_lnorm.meanlog1", + "lnorm_lnorm.sdlog1", "lnorm_lnorm.meanlog2", "lnorm_lnorm.sdlog2", + "lnorm_lnorm.pmix", "weibull.weight", "weibull.shape", "weibull.scale" )) }) 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")) + 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"))) + 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_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv", - "data_000000003_multi.csv", "estimates_000000000_multi.rds", - "estimates_000000001_multi.rds", "estimates_000000002_multi.rds", - "estimates_000000003_multi.rds")) + expect_identical(list.files(dir), c( + "data_000000000_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv", + "data_000000003_multi.csv", "estimates_000000000_multi.rds", + "estimates_000000001_multi.rds", "estimates_000000002_multi.rds", + "estimates_000000003_multi.rds" + )) boot1 <- read.csv(file.path(dir, "data_000000001_multi.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_multi.csv", "data_000000001_multi.csv", "estimates_000000000_multi.rds", - "estimates_000000001_multi.rds")) + expect_identical(list.files(dir), c( + "data_000000000_multi.csv", "data_000000001_multi.csv", "estimates_000000000_multi.rds", + "estimates_000000001_multi.rds" + )) boot1 <- read.csv(file.path(dir, "data_000000001_multi.csv")) fit1 <- ssd_fit_dists(boot1, dist = "lnorm", left = "left", right = "right", weight = "weight") est <- ssd_hc(fit1)$est @@ -616,16 +638,20 @@ test_that("ssd_hc save_to lnorm 1", { 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_multi.csv", "data_000000001_multi.csv", "estimates_000000000_multi.rds", - "estimates_000000001_multi.rds")) + expect_identical(list.files(dir), c( + "data_000000000_multi.csv", "data_000000001_multi.csv", "estimates_000000000_multi.rds", + "estimates_000000001_multi.rds" + )) boot <- read.csv(file.path(dir, "data_000000001_multi.csv")) hc2 <- ssd_hc(fits, nboot = 1, ci = TRUE, ci_method = "multi_fixed", save_to = dir) - expect_identical(list.files(dir), c("data_000000000_multi.csv", "data_000000001_multi.csv", "estimates_000000000_multi.rds", - "estimates_000000001_multi.rds")) + expect_identical(list.files(dir), c( + "data_000000000_multi.csv", "data_000000001_multi.csv", "estimates_000000000_multi.rds", + "estimates_000000001_multi.rds" + )) boot2 <- read.csv(file.path(dir, "data_000000001_multi.csv")) expect_snapshot_data(boot, "hc_boot1_replace") expect_snapshot_data(boot2, "hc_boot2_replace") @@ -633,11 +659,11 @@ test_that("ssd_hc save_to replaces", { 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") @@ -645,11 +671,11 @@ test_that("ssd_hc fix_weight", { 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") @@ -657,28 +683,31 @@ test_that("ssd_hc multiple values", { 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")) + 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" + 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" )) }) @@ -711,7 +740,7 @@ test_that("hc multis match", { 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) @@ -721,33 +750,33 @@ test_that("hc multis match", { 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) + 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) diff --git a/tests/testthat/test-hcp-root.R b/tests/testthat/test-hcp-root.R index 100e4ddce..ad9263fd6 100644 --- a/tests/testthat/test-hcp-root.R +++ b/tests/testthat/test-hcp-root.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -17,11 +17,11 @@ test_that("hp is hc conc = 1 ci_method = 'multi_fixed'", { fits <- ssd_fit_dists(ssddata::ccme_boron) conc <- 1 hp_multi <- ssd_hp(fits, conc = conc, average = TRUE, ci_method = "multi_fixed") - hc_multi <- ssd_hc(fits, proportion = hp_multi$est/100, average = TRUE, ci_method = "multi_fixed") + hc_multi <- ssd_hc(fits, proportion = hp_multi$est / 100, average = TRUE, ci_method = "multi_fixed") expect_equal(hc_multi$est, 1) - for(i in 1:10) { + for (i in 1:10) { hp_multi <- ssd_hp(fits, conc = hc_multi$est, average = TRUE, ci_method = "multi_fixed") - hc_multi <- ssd_hc(fits, proportion = hp_multi$est/100, average = TRUE, ci_method = "multi_fixed") + hc_multi <- ssd_hc(fits, proportion = hp_multi$est / 100, average = TRUE, ci_method = "multi_fixed") } expect_equal(hc_multi$est, 1) }) @@ -30,11 +30,11 @@ test_that("hp is hc conc = 10 ci_method = 'multi_fixed'", { fits <- ssd_fit_dists(ssddata::ccme_boron) conc <- 10 hp_multi <- ssd_hp(fits, conc = conc, average = TRUE, ci_method = "multi_fixed") - hc_multi <- ssd_hc(fits, proportion = hp_multi$est/100, average = TRUE, ci_method = "multi_fixed") + hc_multi <- ssd_hc(fits, proportion = hp_multi$est / 100, average = TRUE, ci_method = "multi_fixed") expect_equal(hc_multi$est, 10.00000012176) - for(i in 1:10) { + for (i in 1:10) { hp_multi <- ssd_hp(fits, conc = hc_multi$est, average = TRUE, ci_method = "multi_fixed") - hc_multi <- ssd_hc(fits, proportion = hp_multi$est/100, average = TRUE, ci_method = "multi_fixed") + hc_multi <- ssd_hc(fits, proportion = hp_multi$est / 100, average = TRUE, ci_method = "multi_fixed") } expect_equal(hc_multi$est, 10) }) diff --git a/tests/testthat/test-hp-burrlioz.R b/tests/testthat/test-hp-burrlioz.R index 6ea639d01..f726f86d3 100644 --- a/tests/testthat/test-hp-burrlioz.R +++ b/tests/testthat/test-hp-burrlioz.R @@ -42,7 +42,7 @@ test_that("ssd_hp_burrlioz currently errors!", { fit <- ssd_fit_burrlioz(data) expect_identical(names(fit), "burrIII3") set.seed(47) - #FIXME: currently errors! + # FIXME: currently errors! expect_error(hp_burrIII3 <- ssd_hp(fit, nboot = 10, ci = TRUE, min_pboot = 0)) }) @@ -53,8 +53,8 @@ test_that("ssd_hp_burrlioz gets estimates with burrIII3 parametric", { expect_identical(names(fit), "burrIII3") set.seed(49) hp_burrIII3 <- ssd_hp(fit, - nboot = 10, ci = TRUE, min_pboot = 0, - parametric = TRUE, samples = TRUE + nboot = 10, ci = TRUE, min_pboot = 0, + parametric = TRUE, samples = TRUE ) expect_snapshot_data(hp_burrIII3, "hp_burrIII3_parametric") }) diff --git a/tests/testthat/test-hp-root.R b/tests/testthat/test-hp-root.R index 23517e9fb..ecc9db17e 100644 --- a/tests/testthat/test-hp-root.R +++ b/tests/testthat/test-hp-root.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -14,7 +14,6 @@ # limitations under the License. test_that("hp multi_ci lnorm", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") set.seed(102) hp_dist <- ssd_hp(fits, average = FALSE, ci_method = "weighted_arithmetic") @@ -24,7 +23,7 @@ test_that("hp multi_ci lnorm", { expect_equal(hp_multi, hp_average) expect_equal(hp_average$est, 1.9543030195088, tolerance = 1e-5) expect_equal(hp_multi$est, 1.95430301950878, tolerance = 1e-5) - + testthat::expect_snapshot({ hp_multi }) @@ -51,15 +50,15 @@ test_that("hp multi_ci lnorm ci", { hp_average <- ssd_hp(fits, average = TRUE, ci = TRUE, nboot = 100, ci_method = "weighted_arithmetic", multi_est = TRUE) set.seed(102) hp_multi <- ssd_hp(fits, average = TRUE, ci_method = "multi_fixed", ci = TRUE, nboot = 100) - + testthat::expect_snapshot({ hp_average }) - + testthat::expect_snapshot({ hp_multi }) - + hp_dist$dist <- NULL hp_average$dist <- NULL expect_equal(hp_dist, hp_average) diff --git a/tests/testthat/test-hp.R b/tests/testthat/test-hp.R index 3a44a2db3..c26c45b29 100644 --- a/tests/testthat/test-hp.R +++ b/tests/testthat/test-hp.R @@ -13,7 +13,6 @@ # limitations under the License. test_that("hp", { - fits <- ssd_fit_dists(ssddata::ccme_boron) set.seed(102) @@ -23,7 +22,6 @@ test_that("hp", { }) test_that("hp fitdists works with zero length conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, numeric(0)) @@ -37,7 +35,6 @@ test_that("hp fitdists works with zero length conc", { }) test_that("hp fitdist works with missing conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, NA_real_) @@ -46,7 +43,6 @@ test_that("hp fitdist works with missing conc", { }) test_that("hp fitdist works with 0 conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, 0) @@ -55,7 +51,6 @@ test_that("hp fitdist works with 0 conc", { }) test_that("hp fitdist works with negative conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, -1) @@ -64,7 +59,6 @@ test_that("hp fitdist works with negative conc", { }) test_that("hp fitdist works with -Inf conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, -Inf) @@ -73,7 +67,6 @@ test_that("hp fitdist works with -Inf conc", { }) test_that("hp fitdist works with Inf conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, Inf) @@ -82,7 +75,6 @@ test_that("hp fitdist works with Inf conc", { }) test_that("hp fitdists works reasonable conc", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, 1) @@ -91,7 +83,6 @@ test_that("hp fitdists works reasonable conc", { }) test_that("hp fitdists works with multiple concs", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") hp <- ssd_hp(fits, c(2.5, 1), ci_method = "multi_fixed") @@ -100,7 +91,6 @@ test_that("hp fitdists works with multiple concs", { }) test_that("hp fitdists works with cis", { - fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") set.seed(10) @@ -110,7 +100,6 @@ test_that("hp fitdists works with cis", { }) test_that("hp fitdists works with multiple dists", { - fits <- ssd_fit_dists(ssddata::ccme_boron) hp <- ssd_hp(fits, 1) @@ -119,7 +108,6 @@ test_that("hp fitdists works with multiple dists", { }) test_that("hp fitdists works not average multiple dists", { - fits <- ssd_fit_dists(ssddata::ccme_boron) hp <- ssd_hp(fits, 1, average = FALSE) @@ -131,13 +119,13 @@ test_that("hp fitdists gives different answer with model averaging as hc not sam data <- ssddata::aims_molybdenum_marine fits_lgumbel <- ssd_fit_dists(data, dists = "lgumbel") - expect_equal(ssd_hp(fits_lgumbel, ssd_hc(fits_lgumbel, proportion = 5/100)$est)$est, 5) + expect_equal(ssd_hp(fits_lgumbel, ssd_hc(fits_lgumbel, proportion = 5 / 100)$est)$est, 5) fits_lnorm_lnorm <- ssd_fit_dists(data, dists = "lnorm_lnorm") - expect_equal(ssd_hp(fits_lnorm_lnorm, ssd_hc(fits_lnorm_lnorm, proportion = 5/100)$est)$est, 5) + expect_equal(ssd_hp(fits_lnorm_lnorm, ssd_hc(fits_lnorm_lnorm, proportion = 5 / 100)$est)$est, 5) fits_both <- ssd_fit_dists(data, dists = c("lgumbel", "lnorm_lnorm"), min_pmix = 0) - expect_equal(ssd_hp(fits_both, ssd_hc(fits_both, proportion = 5/100, ci_method = "weighted_arithmetic", multi_est = FALSE)$est)$est, 4.59185244765045) + expect_equal(ssd_hp(fits_both, ssd_hc(fits_both, proportion = 5 / 100, ci_method = "weighted_arithmetic", multi_est = FALSE)$est)$est, 4.59185244765045) }) test_that("ssd_hp fitdists correct for rescaling", { @@ -149,7 +137,6 @@ test_that("ssd_hp fitdists correct for rescaling", { }) test_that("hp fitdists with no fitdists", { - x <- list() class(x) <- c("fitdists") hp <- ssd_hp(x, 1) @@ -177,7 +164,6 @@ test_that("ssd_hp doesn't calculate cis with inconsistent censoring", { }) test_that("ssd_hp same with equally weighted data", { - data <- ssddata::ccme_boron data$Weight <- rep(1, nrow(data)) fits <- ssd_fit_dists(data, weight = "Weight", dists = "lnorm") @@ -227,7 +213,6 @@ test_that("ssd_hp calculates cis in parallel with two distributions", { }) test_that("ssd_hp doesn't calculate cis with unequally weighted data", { - data <- ssddata::ccme_boron data$Weight <- rep(1, nrow(data)) data$Weight[1] <- 2 @@ -240,7 +225,6 @@ test_that("ssd_hp doesn't calculate cis with unequally weighted data", { }) test_that("ssd_hp 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") @@ -270,7 +254,6 @@ test_that("ssd_hp effect with higher weight two distributions", { }) test_that("ssd_hp 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) @@ -285,7 +268,6 @@ test_that("ssd_hp cis with non-convergence", { }) test_that("ssd_hp 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) @@ -306,7 +288,6 @@ test_that("ssd_hp cis with error and multiple dists", { }) test_that("ssd_hp with 1 bootstrap", { - fit <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm") set.seed(10) hp <- ssd_hp(fit, 1, ci = TRUE, nboot = 1, ci_method = "weighted_arithmetic", samples = TRUE) @@ -315,11 +296,11 @@ test_that("ssd_hp with 1 bootstrap", { test_that("ssd_hp fix_weight", { fits <- ssd_fit_dists(ssddata::ccme_boron, dist = c("lnorm", "lgumbel")) - + set.seed(102) hc_unfix <- ssd_hp(fits, nboot = 100, ci = TRUE, ci_method = "multi_free", samples = TRUE) expect_snapshot_data(hc_unfix, "hc_unfix") - + set.seed(102) hc_fix <- ssd_hp(fits, nboot = 100, ci = TRUE, ci_method = "multi_fixed", samples = TRUE) expect_snapshot_data(hc_fix, "hc_fix") @@ -335,7 +316,7 @@ test_that("hp multis match", { hp_ff <- ssd_hp(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_samples") set.seed(102) hp_tt <- ssd_hp(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = TRUE, ci_method = "multi_fixed") - + expect_identical(hp_tf$est, hp_tt$est) expect_identical(hp_ft$est, hp_ff$est) expect_identical(hp_ft$se, hp_tt$se) @@ -345,15 +326,17 @@ test_that("hp multis match", { test_that("hp weighted bootie", { fits <- ssd_fit_dists(ssddata::ccme_boron) set.seed(102) - hp_weighted2 <- ssd_hp(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_samples", - samples = TRUE) + hp_weighted2 <- ssd_hp(fits, + ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_samples", + samples = TRUE + ) set.seed(102) hp_unweighted2 <- ssd_hp(fits, ci = TRUE, nboot = 10, average = TRUE, multi_est = FALSE, ci_method = "weighted_arithmetic", samples = TRUE) - + expect_identical(hp_weighted2$est, hp_unweighted2$est) expect_identical(length(hp_weighted2$samples[[1]]), 11L) expect_identical(length(hp_unweighted2$samples[[1]]), 60L) - + expect_snapshot_boot_data(hp_weighted2, "hp_weighted2") expect_snapshot_boot_data(hp_unweighted2, "hp_unweighted2") }) diff --git a/tests/testthat/test-invpareto.R b/tests/testthat/test-invpareto.R index 0f7e5568d..a23a56370 100644 --- a/tests/testthat/test-invpareto.R +++ b/tests/testthat/test-invpareto.R @@ -45,7 +45,8 @@ test_that("invpareto initial shape is MLEs", { fit <- ssd_fit_dists(data, dists = "invpareto") expect_equal( estimates(fit), - list(invpareto.weight = 1, invpareto.scale = 1.03299515712949, invpareto.shape = 4.14668077241)) + list(invpareto.weight = 1, invpareto.scale = 1.03299515712949, invpareto.shape = 4.14668077241) + ) }) test_that("invpareto unbiased scale estimator small n", { @@ -119,5 +120,6 @@ test_that("invpareto with extreme data", { fit99r <- ssd_fit_dists(data, dists = "invpareto", rescale = TRUE) expect_equal( estimates(fit99r), - list(invpareto.weight = 1, invpareto.scale = 1.03020756694085, invpareto.shape = 26.0278618888664)) + list(invpareto.weight = 1, invpareto.scale = 1.03020756694085, invpareto.shape = 26.0278618888664) + ) }) diff --git a/tests/testthat/test-lnorm-lnorm.R b/tests/testthat/test-lnorm-lnorm.R index 5f1359d17..686a450e5 100644 --- a/tests/testthat/test-lnorm-lnorm.R +++ b/tests/testthat/test-lnorm-lnorm.R @@ -44,14 +44,14 @@ test_that("ssd_rlnorm_lnorm allows reversed distributions", { test_that("lnorm_lnorm positive q with extreme distribution", { expect_equal(qlnorm_lnorm_ssd(0.05, - meanlog1 = -10.39362, sdlog1 = 0.399835, - meanlog2 = -4.76721, sdlog2 = 2.583824, pmix = 0.1308133 + meanlog1 = -10.39362, sdlog1 = 0.399835, + meanlog2 = -4.76721, sdlog2 = 2.583824, pmix = 0.1308133 ), 2.49076867209839e-05) }) test_that("lnorm_lnorm positive q with extreme large distribution", { expect_equal(qlnorm_lnorm_ssd(0.99, - meanlog1 = -4.76721, sdlog1 = 0.399835, - meanlog2 = 100.39362, sdlog2 = 2.583824, pmix = 0.1308133 + meanlog1 = -4.76721, sdlog1 = 0.399835, + meanlog2 = 100.39362, sdlog2 = 2.583824, pmix = 0.1308133 ), 1.41684268426224e+46) }) diff --git a/tests/testthat/test-multi.R b/tests/testthat/test-multi.R index 4cd1e51ca..0deeb14bc 100644 --- a/tests/testthat/test-multi.R +++ b/tests/testthat/test-multi.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -19,12 +19,16 @@ test_that("multi", { expect_equal(ssd_qmulti(0.75), 1.96303108415826) set.seed(42) expect_equal(ssd_rmulti(2), c(3.93912428813385, 4.62130564767823)) - - expect_equal(ssd_qmulti(ssd_pmulti(c(0, 0.1, 0.5, 0.9, 0.99))), - c(0, 0.1, 0.5, 0.9, 0.99), tolerance = 1e-5) - - expect_equal(ssd_pmulti(ssd_qmulti(c(0, 0.1, 0.5, 0.9, 0.99))), - c(0, 0.1, 0.5, 0.9, 0.99), tolerance = 1e-6) + + expect_equal(ssd_qmulti(ssd_pmulti(c(0, 0.1, 0.5, 0.9, 0.99))), + c(0, 0.1, 0.5, 0.9, 0.99), + tolerance = 1e-5 + ) + + expect_equal(ssd_pmulti(ssd_qmulti(c(0, 0.1, 0.5, 0.9, 0.99))), + c(0, 0.1, 0.5, 0.9, 0.99), + tolerance = 1e-6 + ) }) test_that("ssd_pmulti", { @@ -37,11 +41,11 @@ test_that("ssd_pmulti", { pone <- 0.0389879276872944 expect_equal(.ssd_pmulti_fitdists(1, fit), pone, tolerance = 1e-6) expect_equal(.ssd_pmulti_fitdists(10000, fit), 0.999954703139271, tolerance = 1e-6) - expect_equal(.ssd_pmulti_fitdists(c(1,2), fit), c(pone, 0.0830184001863268), tolerance = 1e-6) - expect_equal(.ssd_pmulti_fitdists(c(1,NA), fit), c(pone, NA), tolerance = 1e-6) - expect_equal(.ssd_pmulti_fitdists(1, fit, lower.tail = FALSE), 1-pone, tolerance = 1e-6) + expect_equal(.ssd_pmulti_fitdists(c(1, 2), fit), c(pone, 0.0830184001863268), tolerance = 1e-6) + expect_equal(.ssd_pmulti_fitdists(c(1, NA), fit), c(pone, NA), tolerance = 1e-6) + expect_equal(.ssd_pmulti_fitdists(1, fit, lower.tail = FALSE), 1 - pone, tolerance = 1e-6) expect_equal(.ssd_pmulti_fitdists(1, fit, log.p = TRUE), log(pone), tolerance = 1e-6) - expect_equal(.ssd_pmulti_fitdists(1, fit, lower.tail = FALSE, log.p = TRUE), log(1-pone), tolerance = 1e-6) + expect_equal(.ssd_pmulti_fitdists(1, fit, lower.tail = FALSE, log.p = TRUE), log(1 - pone), tolerance = 1e-6) }) test_that("ssd_pmulti weights", { @@ -118,18 +122,20 @@ test_that("ssd_rmulti", { test_that("ssd_rmulti all", { set.seed(99) - n100 <- ssd_rmulti(n = 100, - burrIII3.weight = 1/10, - gamma.weight = 1/10, - gompertz.weight = 1/10, - invpareto.weight = 1/10, - lgumbel.weight = 1/10, - llogis.weight = 1/10, - llogis_llogis.weight = 1/10, - lnorm.weight = 1/10, - lnorm_lnorm.weight = 1/10, - weibull.weight = 1/10) - + n100 <- ssd_rmulti( + n = 100, + burrIII3.weight = 1 / 10, + gamma.weight = 1 / 10, + gompertz.weight = 1 / 10, + invpareto.weight = 1 / 10, + lgumbel.weight = 1 / 10, + llogis.weight = 1 / 10, + llogis_llogis.weight = 1 / 10, + lnorm.weight = 1 / 10, + lnorm_lnorm.weight = 1 / 10, + weibull.weight = 1 / 10 + ) + expect_identical(length(n100), 100L) expect_equal(min(n100), 0.00207737078515415) expect_equal(max(n100), 1.58073733537801) @@ -137,7 +143,7 @@ test_that("ssd_rmulti all", { }) test_that("ssd_emulti", { - estimates <- ssd_emulti() + estimates <- ssd_emulti() expect_snapshot(estimates) args <- estimates args$q <- 1 diff --git a/tests/testthat/test-plot-data.R b/tests/testthat/test-plot-data.R index db672b9a5..92a183d36 100644 --- a/tests/testthat/test-plot-data.R +++ b/tests/testthat/test-plot-data.R @@ -17,6 +17,8 @@ test_that("ssd_plot_data ccme_boron", { }) test_that("ssd_plot_data ccme_boron color", { - expect_snapshot_plot(ssd_plot_data(ssddata::ccme_boron, color = "Group", label = "Species", trans = "identity", - shift_x = 1, add_x = 10), "ccme_boron2") + expect_snapshot_plot(ssd_plot_data(ssddata::ccme_boron, + color = "Group", label = "Species", trans = "identity", + shift_x = 1, add_x = 10 + ), "ccme_boron2") }) diff --git a/tests/testthat/test-predict.R b/tests/testthat/test-predict.R index 431d8bd0b..79052c9d6 100644 --- a/tests/testthat/test-predict.R +++ b/tests/testthat/test-predict.R @@ -13,20 +13,16 @@ # limitations under the License. test_that("predict", { - - fits <- ssd_fit_dists(ssddata::ccme_boron) - + pred <- predict(fits, ci_method = "weighted_samples", multi_est = FALSE) expect_s3_class(pred, "tbl") expect_snapshot_data(pred, "pred_dists") }) test_that("predict cis", { - - fits <- ssd_fit_dists(ssddata::ccme_boron) - + set.seed(10) pred <- predict(fits, ci = TRUE, nboot = 10L, ci_method = "weighted_arithmetic", multi_est = FALSE) expect_s3_class(pred, "tbl") @@ -34,23 +30,21 @@ test_that("predict cis", { }) test_that("predict not average", { - fits <- ssd_fit_dists(ssddata::ccme_boron) - + expect_true(is.fitdists(fits)) - + pred <- predict(fits, average = FALSE, ci_method = "weighted_samples") expect_s3_class(pred, "tbl") expect_snapshot_data(pred, "pred_notaverage") }) test_that("predict cis fitburrlioz", { - fits <- ssd_fit_burrlioz(ssddata::ccme_boron) - + expect_true(is.fitdists(fits)) set.seed(10) - + pred <- predict(fits, ci = TRUE, nboot = 10L) expect_s3_class(pred, "tbl") expect_snapshot_data(pred, "pred_cis_burrlioz") @@ -58,25 +52,26 @@ test_that("predict cis fitburrlioz", { test_that("predict matches ssd_hc with and without average", { - data <- ssddata::ccme_glyphosate - + use_dists <- c("lnorm", "llogis", "lgumbel", "weibull", "gamma", "lnorm_lnorm") - - fit <- ssd_fit_dists(data = data, - left = 'Conc', dists = use_dists, - silent = TRUE, reweight = FALSE, min_pmix = 0, - computable = TRUE, at_boundary_ok = FALSE, rescale = FALSE) - + + fit <- ssd_fit_dists( + data = data, + left = "Conc", dists = use_dists, + silent = TRUE, reweight = FALSE, min_pmix = 0, + computable = TRUE, at_boundary_ok = FALSE, rescale = FALSE + ) + ave5 <- ssd_hc(fit, multi_est = FALSE) multi5 <- ssd_hc(fit, multi_est = TRUE) - + expect_snapshot_data(ave5, "ave5") expect_snapshot_data(multi5, "multi5") - + pred_multi <- predict(fit, ci = FALSE, multi_est = TRUE) pred_ave <- predict(fit, ci = FALSE, multi_est = FALSE) - - expect_identical(pred_ave[pred_ave$proportion == 0.05,]$est, ave5$est) - expect_identical(pred_multi[pred_ave$proportion == 0.05,]$est, multi5$est) + + expect_identical(pred_ave[pred_ave$proportion == 0.05, ]$est, ave5$est) + expect_identical(pred_multi[pred_ave$proportion == 0.05, ]$est, multi5$est) }) diff --git a/tests/testthat/test-ssd-min-pmix.R b/tests/testthat/test-ssd-min-pmix.R index db1758e5a..4ffcee7bd 100644 --- a/tests/testthat/test-ssd-min-pmix.R +++ b/tests/testthat/test-ssd-min-pmix.R @@ -5,7 +5,7 @@ test_that("ssd_min_pmix", { chk::expect_chk_error(ssd_min_pmix(10.5)) expect_identical(ssd_min_pmix(1), 0.5) expect_identical(ssd_min_pmix(2L), 0.5) - expect_identical(ssd_min_pmix(9), 1/3) + expect_identical(ssd_min_pmix(9), 1 / 3) expect_identical(ssd_min_pmix(10), 0.3) expect_identical(ssd_min_pmix(15), 0.2) expect_identical(ssd_min_pmix(20), 0.15) diff --git a/tests/testthat/test-summary.R b/tests/testthat/test-summary.R index 3265ac379..1c627ec68 100644 --- a/tests/testthat/test-summary.R +++ b/tests/testthat/test-summary.R @@ -25,6 +25,31 @@ test_that("summary fitdists", { expect_identical(summary$unequal, FALSE) }) +test_that("summary partially left censored", { + data <- ssddata::ccme_boron + data$right <- data$Conc + data$Conc[c(3,6,8)] <- NA + + fits <- ssd_fit_dists(data, dists = "lnorm", right = "right") + summary <- summary(fits) + expect_s3_class(summary, "summary_fitdists") + expect_identical(names(summary), c("fits", "censoring", "nrow", "rescaled", "weighted", "unequal", "min_pmix")) + expect_identical(summary$censoring, c(NA_real_, NA_real_)) + expect_identical(summary$nrow, 28L) + expect_equal(summary$min_pmix, 0.107142857) + expect_identical(summary$rescaled, 1) + expect_identical(summary$weighted, 1) + expect_identical(summary$unequal, FALSE) +}) + +test_that("summary partiaally right censored", { + data <- ssddata::ccme_boron + data$right <- data$Conc + data$right[c(3,6,8)] <- NA + + expect_error(ssd_fit_dists(data, dists = "lnorm", right = "right"), "^Distributions cannot currently be fitted to right censored data\\.$") +}) + test_that("summary fitdists with multiple dists", { data <- ssddata::ccme_boron fits <- ssd_fit_dists(data, rescale = TRUE) @@ -38,7 +63,7 @@ test_that("summary fitdists with multiple dists", { expect_identical(summary$unequal, FALSE) }) -test_that("summary fitdists with censored, rescaled, unequally weighted data", { +test_that("summary fitdists with partially censored, rescaled, unequally weighted data", { data <- ssddata::ccme_boron data$Mass <- seq_len(nrow(data)) data$Other <- data$Conc @@ -47,13 +72,29 @@ test_that("summary fitdists with censored, rescaled, unequally weighted data", { summary <- summary(fits) expect_s3_class(summary, "summary_fitdists") expect_identical(names(summary), c("fits", "censoring", "nrow", "rescaled", "weighted", "unequal", "min_pmix")) - expect_equal(summary$censoring, c(2.4, Inf)) + expect_equal(summary$censoring, c(NA_real_, NA_real_)) expect_identical(summary$nrow, 28L) expect_equal(summary$rescaled, 8.40832920383116) expect_identical(summary$weighted, 28) expect_identical(summary$unequal, TRUE) }) +test_that("summary fitdists with left censored, rescaled, unequally weighted data", { + data <- ssddata::ccme_boron + data$Mass <- seq_len(nrow(data)) + data$Other <- data$Conc + data <- ssd_censor_data(data, right = "Other", censoring = c(2.5, Inf)) + fits <- ssd_fit_dists(data, right = "Other", weight = "Mass", rescale = TRUE, dists = "lnorm") + summary <- summary(fits) + expect_s3_class(summary, "summary_fitdists") + expect_identical(names(summary), c("fits", "censoring", "nrow", "rescaled", "weighted", "unequal", "min_pmix")) + expect_equal(summary$censoring, c(2.5, Inf)) + expect_identical(summary$nrow, 28L) + expect_equal(summary$rescaled, 13.2947358003083) + expect_identical(summary$weighted, 28) + expect_identical(summary$unequal, TRUE) +}) + test_that("summary weighted if equal weights but not 1", { data <- ssddata::ccme_boron data$Mass <- 2 diff --git a/tests/testthat/test-weighted.R b/tests/testthat/test-weighted.R index 66cd3ae3d..88e66fc61 100644 --- a/tests/testthat/test-weighted.R +++ b/tests/testthat/test-weighted.R @@ -1,65 +1,70 @@ test_that("weighted errors", { data <- ssddata::ccme_boron - + data$Weight <- 1 data$Weight[rank(data$Conc) > 6] <- 0 - - expect_error(ssd_fit_dists(data, dists="lnorm", weight = "Weight"), - "^`data` has 22 rows with zero weight in 'Weight'\\.$") + + expect_error( + ssd_fit_dists(data, dists = "lnorm", weight = "Weight"), + "^`data` has 22 rows with zero weight in 'Weight'\\.$" + ) data$Weight[rank(data$Conc) > 6] <- -1 - - expect_error(ssd_fit_dists(data, dists="lnorm", weight = "Weight"), - "^`data\\$Weight` must have values between 0 and Inf\\.$") - + + expect_error( + ssd_fit_dists(data, dists = "lnorm", weight = "Weight"), + "^`data\\$Weight` must have values between 0 and Inf\\.$" + ) + data$Weight[rank(data$Conc) > 6] <- Inf - - expect_warning(expect_error(ssd_fit_dists(data, dists="lnorm", weight = "Weight"), - "^All distributions failed to fit\\.$")) - + + expect_warning(expect_error( + ssd_fit_dists(data, dists = "lnorm", weight = "Weight"), + "^All distributions failed to fit\\.$" + )) }) - + test_that("weighted works", { data <- ssddata::ccme_boron - + data$Weight <- 1 - data$Weight[rank(data$Conc) > 6] <- 1/10 - - fitall <- ssd_fit_dists(data, dists="lnorm") + data$Weight[rank(data$Conc) > 6] <- 1 / 10 + + fitall <- ssd_fit_dists(data, dists = "lnorm") hcall <- ssd_hc(fitall) expect_snapshot_data(hcall, "hcall") - - fit1 <- ssd_fit_dists(subset(data, Weight == 1), dists="lnorm") + + fit1 <- ssd_fit_dists(subset(data, Weight == 1), dists = "lnorm") hc1 <- ssd_hc(fit1) expect_snapshot_data(hc1, "hc1") - - fit1w <- ssd_fit_dists(subset(data, Weight == 1), dists="lnorm", weight = "Weight") + + fit1w <- ssd_fit_dists(subset(data, Weight == 1), dists = "lnorm", weight = "Weight") hc1w <- ssd_hc(fit1w) expect_snapshot_data(hc1w, "hc1w") - - fitallw10 <- ssd_fit_dists(data, dists="lnorm", weight = "Weight") + + fitallw10 <- ssd_fit_dists(data, dists = "lnorm", weight = "Weight") hcallw10 <- ssd_hc(fitallw10) expect_snapshot_data(hcallw10, "hcallw10") - - data$Weight[rank(data$Conc) > 6] <- 1/100 - - fitallw100 <- ssd_fit_dists(data, dists="lnorm", weight = "Weight") + + data$Weight[rank(data$Conc) > 6] <- 1 / 100 + + fitallw100 <- ssd_fit_dists(data, dists = "lnorm", weight = "Weight") hcallw100 <- ssd_hc(fitallw100) expect_snapshot_data(hcallw100, "hcallw100") - - data$Weight[rank(data$Conc) > 6] <- 1/1000 - - fitallw1000 <- ssd_fit_dists(data, dists="lnorm", weight = "Weight") + + data$Weight[rank(data$Conc) > 6] <- 1 / 1000 + + fitallw1000 <- ssd_fit_dists(data, dists = "lnorm", weight = "Weight") hcallw1000 <- ssd_hc(fitallw1000) expect_snapshot_data(hcallw1000, "hcallw1000") }) test_that("weighted2", { data <- ssddata::ccme_boron - + data$Weight <- 2 - fit2 <- ssd_fit_dists(data, dists="lnorm", weight = "Weight") + fit2 <- ssd_fit_dists(data, dists = "lnorm", weight = "Weight") hc2 <- ssd_hc(fit2) expect_snapshot_data(hc2, "hc2") }) diff --git a/tests/testthat/test-zzz-unstable.R b/tests/testthat/test-zzz-unstable.R index d804fbb2d..81ac2f009 100644 --- a/tests/testthat/test-zzz-unstable.R +++ b/tests/testthat/test-zzz-unstable.R @@ -1,4 +1,4 @@ -# Copyright 2023 Australian Government Department of +# Copyright 2023 Australian Government Department of # Climate Change, Energy, the Environment and Water # # Licensed under the Apache License, Version 2.0 (the "License"); @@ -12,35 +12,39 @@ # 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("weibull is unstable", { - data <- data.frame(Conc = c(868.24508, - 1713.82388, - 3161.70678, - 454.65412, - 3971.75890, - 37.69471, - 262.14053, - 363.20288, - 1940.43277, - 3218.05296, - 77.48251, - 1214.70521, - 1329.27005, - 1108.05761, - 339.91458, - 437.52104)) - - fits <- ssd_fit_dists(data=data, - left = 'Conc', dists = c('gamma', 'weibull'), - silent = TRUE, reweight = FALSE, min_pmix = 0, nrow = 6L, - computable = TRUE, at_boundary_ok = FALSE, rescale = FALSE) - + data <- data.frame(Conc = c( + 868.24508, + 1713.82388, + 3161.70678, + 454.65412, + 3971.75890, + 37.69471, + 262.14053, + 363.20288, + 1940.43277, + 3218.05296, + 77.48251, + 1214.70521, + 1329.27005, + 1108.05761, + 339.91458, + 437.52104 + )) + + fits <- ssd_fit_dists( + data = data, + left = "Conc", dists = c("gamma", "weibull"), + silent = TRUE, reweight = FALSE, min_pmix = 0, nrow = 6L, + computable = TRUE, at_boundary_ok = FALSE, rescale = FALSE + ) + # not sure why weibull dropping on some linux on github actions and windows # on other folks machines testthat::skip_on_ci() testthat::skip_on_cran() - expect_identical(names(fits), c('gamma', 'weibull')) + expect_identical(names(fits), c("gamma", "weibull")) }) test_that("hc multi_ci lnorm default 100", { @@ -48,13 +52,15 @@ test_that("hc multi_ci lnorm default 100", { set.seed(102) hc_average <- ssd_hc(fits, average = TRUE, ci = TRUE, nboot = 100, ci_method = "weighted_arithmetic", multi_est = FALSE, samples = TRUE) set.seed(102) - hc_multi <- ssd_hc(fits, average = TRUE, ci_method = "multi_free", ci = TRUE, nboot = 100, - min_pboot = 0.8, samples = TRUE) - + hc_multi <- ssd_hc(fits, + average = TRUE, ci_method = "multi_free", ci = TRUE, nboot = 100, + min_pboot = 0.8, samples = TRUE + ) + testthat::expect_snapshot({ hc_average }) - + # not sure why hc multi_ci is different on windows # ══ Failed tests ════════════════════════════════════════════════════════════════ # ── Failure ('test-hc-root.R:77:3'): hc multi_ci lnorm default 100 ───────────────── @@ -65,7 +71,7 @@ test_that("hc multi_ci lnorm default 100", { # # - 1 average 5 1.26 0.781 0.331 3.25 1 parametric 100 0.86 # + 1 average 5 1.26 0.769 0.410 3.25 1 parametric 100 0.86 - testthat::skip_on_ci() + testthat::skip_on_ci() testthat::skip_on_cran() testthat::expect_snapshot({ hc_multi @@ -77,13 +83,15 @@ test_that("hp multi_ci lnorm default 100", { set.seed(102) hp_average <- ssd_hp(fits, average = TRUE, ci = TRUE, nboot = 100, ci_method = "weighted_arithmetic", samples = TRUE) set.seed(102) - hp_multi <- ssd_hp(fits, average = TRUE, ci_method = "multi_free", ci = TRUE, nboot = 100, - min_pboot = 0.8, samples = TRUE) - + hp_multi <- ssd_hp(fits, + average = TRUE, ci_method = "multi_free", ci = TRUE, nboot = 100, + min_pboot = 0.8, samples = TRUE + ) + testthat::expect_snapshot({ hp_average }) - testthat::skip_on_ci() + testthat::skip_on_ci() testthat::skip_on_cran() # ── Failure ('test-hp-root.R:79:3'): hp multi_ci lnorm default 100 ───────────────── # Snapshot of code has changed: @@ -102,11 +110,11 @@ 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 @@ -153,10 +161,10 @@ test_that("sgompertz with initial values still unstable!", { )) set.seed(10) fit <- ssd_fit_dists(data, dists = "gompertz") - + sdata <- data.frame(left = x, right = x, weight = 1) pars <- estimates(fit$gompertz) - + expect_snapshot({ set.seed(94) ssdtools:::sgompertz(sdata) @@ -177,289 +185,294 @@ test_that("sgompertz cant even fit some values", { skip_on_ci() # as incredibly unstable skip_on_cran() x <- c(160, 800, 840, 1500, 8200, 12800, 22000, 38000, 60900, 63000) - expect_snapshot({ - ssdtools:::sgompertz(data.frame(left = x, right = x)) - ssdtools:::sgompertz(data.frame(left = rep(x,10), right = rep(x,10))) - ssdtools:::sgompertz(data.frame(left = x, right = x), pars = c(12800, 1)) - ssdtools:::sgompertz(data.frame(left = x / 12800, right = x / 12800)) - }, - error = TRUE) + expect_snapshot( + { + ssdtools:::sgompertz(data.frame(left = x, right = x)) + ssdtools:::sgompertz(data.frame(left = rep(x, 10), right = rep(x, 10))) + ssdtools:::sgompertz(data.frame(left = x, right = x), pars = c(12800, 1)) + ssdtools:::sgompertz(data.frame(left = x / 12800, right = x / 12800)) + }, + error = TRUE + ) }) test_that("sgompertz cant even initialize lots of values", { skip_on_ci() skip_on_cran() - x <- c(38.696580321462, 41.0167488906729, 39.5529154651536, 40.1225506655899, - 38.2675196410126, 35.2169221089071, 37.8367285461107, 40.1377838232664, - 37.5027912166191, 38.427368967798, 40.710857244717, 39.2107558513928, - 38.8104318203955, 36.6782721298192, 39.1189629457727, 38.5038356599761, - 40.9769905762875, 38.1358534539971, 37.677578277466, 37.0006299402988, - 41.7135839580738, 40.1519559493184, 40.0672365990623, 39.5592247806773, - 38.1637058572353, 39.8666688362276, 39.2503685118675, 38.9778749012123, - 40.0217426884973, 37.5351699713108, 39.7893579120294, 39.2387926187296, - 37.7044952991609, 37.8928752489645, 37.0090499173894, 38.4507445786794, - 38.620077736605, 39.6020315346104, 39.7810679774789, 40.8150835920557, - 37.9464980122296, 39.4069904913645, 38.0669287189795, 38.3441834518077, - 38.1993919655101, 40.1628716902171, 40.0281770769124, 38.6956745583115, - 39.6542719125524, 38.6088455182132, 39.8179004699168, 37.9230414720193, - 39.867477710758, 38.9955567243247, 38.0169207342366, 40.3342027787477, - 37.7344362972903, 38.6796129938263, 39.0965409517453, 41.46005663726, - 37.0773600128194, 39.2487948784459, 39.2885683350943, 39.155662491164, - 39.4144380892284, 37.8015034174506, 38.0318253811457, 39.2495131564861, - 39.4079230863217, 37.8069359589137, 39.2240112827973, 39.7992027228957, - 40.1464446475361, 38.0392748572373, 39.8704415381996, 37.0709840973726, - 39.7109649144627, 34.6158405583583, 38.773189207226, 39.5879964831782, - 37.2915278476584, 37.1687398705238, 39.8124336176356, 39.7309887182915, - 40.4249042880422, 37.7747514337286, 39.5078848285084, 40.0854650060604, - 38.4641772660282, 39.9580684236498, 39.0505656140191, 40.1090371065684, - 40.2837137147484, 41.1777634956717, 37.1366808219419, 39.4525678965893, - 38.6350146755692, 39.4979063158441, 41.3036446602384, 39.6926374930186, - 40.3183234220183, 40.1679706298231, 39.701995572475, 38.6869017750228, - 41.2896407864841, 38.7183693797009, 39.1452025170707, 38.3908637314772, - 41.2694527496005, 38.8136900728032, 37.7645647745729, 36.5631366265512, - 37.3667105678707, 41.7000277404458, 39.2707121440988, 36.6203610922647, - 37.8168390843906, 38.0149455298419, 37.4344504136931, 39.4168634517092, - 39.1022303484451, 40.7262981012178, 38.9244902124375, 39.7804365259938, - 40.071593416537, 40.5326032455288, 40.2967188132833, 39.4709850594384, - 39.7026879735608, 40.6767766734202, 39.8820157568733, 40.0306774727645, - 39.206490542215, 37.7995176031058, 38.0305899072524, 41.2535959663767, - 39.360970436801, 39.2050302399161, 37.9355199051284, 40.2662286603004, - 41.121798879367, 37.1609962328165, 38.6466582748848, 38.8967782665257, - 38.0404802796349, 38.376580403419, 38.6255759391397, 39.6073952243451, - 37.6347924690042, 38.5132173119731, 38.8501436804498, 38.493737010245, - 38.7589123929684, 39.7035807090811, 38.365423731158, 41.1023575551406, - 39.4693407341018, 40.3775002176367, 40.0539303648849, 39.2793192634062, - 38.8511551647368, 39.9553561650541, 38.2424584004309, 38.5571856715353, - 37.8348991198805, 37.3717962287677, 39.4730584952921, 41.523488762831, - 36.8499803076413, 38.013422735112, 37.4816695828213, 39.2621838289677, - 38.9515538223032, 40.5502903474796, 39.1161030671012, 38.7945616870771, - 40.2421942935249, 37.7346372472926, 39.1187706618842, 39.909833942905, - 38.6548900463434, 34.9715389178589, 37.2873000101342, 37.9002061587514, - 38.4975034197695, 42.1873757727254, 41.0764975000072, 38.7088995905531, - 40.4662521529921, 40.9236134619865, 39.9786610218703, 39.0344464667416, - 40.9923603178017, 38.226765970102, 36.0570644546613, 39.0610525309774, - 39.378249772003, 39.8481492104, 38.8128557727509, 38.176560083666, - 40.0109623940278, 38.365527279527, 41.4821313110713, 39.1562765062432, - 38.6689781368494, 38.5153323903582, 38.9094460830558, 38.9146080159054, - 39.5126736350809, 38.3551624615048, 39.2900471815049, 38.9872820902618, - 40.4027625099742, 36.9621287876883, 40.3027289972827, 38.9177530641325, - 38.8024677096201, 39.328858624352, 42.0770757806993, 38.1205541479795, - 38.4547674083091, 39.1200982288705, 38.4720192141187, 39.8322429488103, - 39.2862024373929, 39.7692289574389, 36.9552457155791, 38.8208389772751, - 38.7085456704407, 38.179565545474, 38.9552962537617, 37.3170576915214, - 37.9089935034163, 37.5515170524905, 40.8640899715991, 39.3977532271903, - 40.6965393740808, 39.2099251528595, 40.3877351534164, 39.1571163215197, - 38.8843000082186, 40.069135734553, 39.4155507502797, 40.0688390962823, - 40.3694309505709, 38.0979381141079, 37.9653373751348, 39.7406945731137, - 39.7319153561436, 41.0223207682689, 37.8004542927769, 40.2310555662633, - 38.1240358129045, 38.2175347747922, 39.023415223749, 40.5585975447541, - 37.0757803798169, 39.9840704053012, 37.1122869994015, 38.5234948115884, - 39.1109096684222, 37.9292146217095, 38.8120641499639, 38.6725491967401, - 38.4777632732966, 38.9945754893693, 39.541485148896, 39.133974747476, - 38.2834898683667, 40.9802975141706, 39.3374507245175, 41.6661446806449, - 38.4237943886002, 38.7813433440326, 39.9318339470732, 39.5304112157869, - 37.2920210101965, 38.0332942356899, 42.1930139607762, 36.9890596297174, - 39.9769160489512, 38.794454639375, 39.1341805428692, 40.484820544408, - 39.6219550690723, 37.5200194925331, 37.7870770544869, 39.12031371933, - 38.4395308986709, 39.1954131708967, 39.6642750370098, 39.7739948549039, - 39.6011260967852, 38.6108656218676, 37.9154461005623, 38.8064624106545, - 39.0597191615577, 35.5776144023631, 38.8748850476323, 43.9305705918234, - 39.266027724492, 39.870215450819, 38.9148252560285, 38.8287721885671, - 39.2737788275155, 39.4992532278209, 38.9122960388864, 37.9985552244301, - 38.4433361268137, 37.9872056270947, 38.7829483316692, 40.4326071359729, - 37.9718170571938, 37.3173504684119, 38.1041306072045, 39.431650255724, - 39.6501134004123, 38.1962116855106, 40.2125593103105, 39.3300592733259, - 38.4694436891443, 35.6018487136551, 37.7234340243789, 38.8416133651824, - 40.1036196591042, 38.9598798772033, 40.3085817328287, 41.4975558278974, - 38.2865459584346, 41.8260921139512, 40.3253160043853, 39.7726849675659, - 37.5924692740547, 38.7610139093328, 37.2307592557815, 38.1224433823566, - 39.7533625422114, 40.1702289131378, 39.5139069991125, 37.3763796206379, - 43.6767194233294, 42.7980876063979, 40.0101004177844, 38.8045660097627, - 38.7978864220019, 40.5196025015914, 39.6050801057401, 36.6941692064994, - 40.2364242866681, 39.4308687797026, 36.1352625034067, 36.1265011734934, - 40.326010741649, 41.3851869206732, 40.5747815072407, 40.1788259184253, - 38.2380334879549, 34.0096690608054, 39.6929204766898, 39.9515741913088, - 40.0041634169937, 37.9582791534962, 38.0335887840459, 39.1062032236527, - 37.6651696793937, 39.6881044797558, 38.2690967830217, 40.130457062569, - 38.6410808902146, 38.4676289901882, 39.1019005252714, 40.7213285577585, - 37.9573767374336, 39.1183670846963, 38.3822026549756, 37.3646233094306, - 39.1826303020084, 40.3572843581489, 38.442314623214, 38.5553027604022, - 39.6068870521211, 39.8729613160067, 41.7122087547397, 40.0776416898586, - 40.4393696960347, 39.3605590996253, 40.3260086548734, 40.1258507614127, - 40.5186441923711, 38.9809155324387, 39.3394540102295, 39.975869633627, - 40.3111919605064, 39.2163094429044, 38.8435899278059, 37.5259541950718, - 36.963412513099, 39.7647281175532, 38.2778393335243, 38.9592447313249, - 39.6832211664062, 39.8169965656146, 40.0571342866911, 40.0657728205233, - 38.6334828058099, 40.2254110586556, 38.2941124576558, 39.7633820426071, - 39.8812043275032, 39.5252167453337, 39.4841351687756, 37.0507474924108, - 38.7234247192162, 39.6575948859279, 39.1826805828978, 38.0705317267602, - 39.0896781744083, 40.4065177824407, 39.5646604953766, 39.3100515376255, - 37.275038659114, 38.6217194765214, 39.5715251327988, 39.4358964492531, - 37.8979324139364, 38.6842025210972, 38.9891069614657, 37.2435957040697, - 39.4319370959362, 41.5303368473785, 39.2115622666226, 39.9039055064095, - 38.5075815201747, 40.5302469191966, 39.7047799842818, 37.967366956652, - 38.6211561846939, 40.4203269847067, 40.0927676792246, 37.6352896940885, - 38.6602688775301, 40.1228354733954, 39.0484204031229, 40.241195037659, - 37.9075743603001, 40.7096672855678, 40.2063979484382, 39.2988183828229, - 38.7236306765055, 40.085046989671, 40.3864093200838, 39.2525922864072, - 39.9833207861838, 39.4752029274992, 40.0888611984398, 38.8364314332866, - 40.1768350426331, 37.6862394739334, 39.4665248116624, 37.899832276708, - 40.3210047661294, 39.3284191247637, 38.2903729699707, 37.0554029584125, - 38.0839523676974, 39.9998786189738, 39.2720100897009, 38.3885928001302, - 40.9884814635961, 39.3736999451426, 39.0688349733752, 39.9805351538551, - 38.2612231198234, 38.7808257073468, 40.4321639089165, 39.1925831801429, - 38.161657993717, 39.4815364089669, 37.9936299742363, 38.1919733752425, - 39.4634006258866, 40.6826647651456, 39.2383948920205, 38.8211139465359, - 40.2361715640083, 39.2523254442209, 39.5614236208388, 36.3210627879153, - 38.7634574724226, 39.9781094519548, 38.5720737088932, 39.0956252849711, - 37.8334966329441, 37.2993457418318, 39.2514702470121, 39.8392558245568, - 39.174775800502, 37.9748873577388, 43.8236675072905, 39.3897077144617, - 37.5759557282776, 38.1069173479354, 37.4120299079579, 38.5163313919706, - 38.8562534471793, 39.082731249183, 37.8123965517173, 38.6467206368035, - 39.2624233039125, 38.0444904972806, 37.9813830943846, 38.9982977458439, - 38.6337006206239, 36.0640324459786, 36.7986312761523, 38.020967310967, - 40.7379364843796, 38.9806446447468, 38.6883329974466, 34.8276810946894, - 37.7929643219164, 38.1936819030646, 38.8225376463523, 37.4761433823238, - 38.5121448430208, 38.4575246789265, 38.858997572675, 38.359586766349, - 39.558288704952, 40.4853848472591, 38.694323054342, 36.1844952800459, - 38.4853690819966, 38.78881539253, 38.0197707602212, 37.7443143743366, - 39.9711873308084, 38.9706104261925, 39.0769035054312, 39.459235288767, - 36.7812361757565, 38.2369113062318, 39.3662625142971, 37.8482625397072, - 38.6782247139701, 38.9567192145898, 38.2620419120765, 41.0626686610858, - 38.6156436251503, 39.250379171601, 39.349946545355, 40.6275731605698, - 37.9005995605111, 40.205914365087, 41.6982665619521, 39.3723235483688, - 40.0347807170072, 39.497473475581, 38.6590218187837, 39.8843213213189, - 38.6132703135293, 38.4280487105962, 38.5378818511143, 38.603135494208, - 38.7561959541377, 39.3929216926093, 41.3597504191791, 38.6118918667787, - 36.8411548739743, 39.3803349413986, 40.8109456694036, 39.3423162229158, - 38.9459848320317, 39.4991104107462, 38.058197568962, 38.7725871889095, - 39.1770615285156, 39.8193567350056, 38.2684201372059, 36.9811216392299, - 40.1769004167604, 39.0216375952443, 40.9455713612591, 37.7742379317281, - 38.7805197184278, 39.2973602139325, 41.0202595055836, 37.5888276948441, - 39.6559437124032, 37.7993924072458, 36.8680224413153, 38.3929408217845, - 39.313511789542, 36.8665331958893, 38.2182703654236, 38.8439109398027, - 39.4111744274711, 39.9253017127809, 36.9237891082507, 36.7600893992139, - 39.2855930848628, 39.2835843453872, 39.4129188137863, 37.9364834955805, - 38.1476606393185, 37.2076006841655, 40.2747876086838, 37.9022020669638, - 39.4325003205913, 37.951115432256, 37.807971401276, 40.2969281026145, - 40.6730841209068, 39.2893414371149, 40.2741852515657, 39.764396697977, - 38.4038572501277, 40.4955100450384, 39.7324796415345, 39.0789568290801, - 39.0947744940562, 37.2667626452727, 40.9708061054478, 38.9398447906209, - 38.6126752576927, 39.8159974079398, 39.4177867561836, 38.9876024433841, - 40.794214437606, 43.7562402030798, 38.6701756334505, 38.1621099177722, - 36.575698535627, 38.255188055226, 38.1033459720734, 37.0581351999275, - 38.9359368996426, 39.7852493973811, 38.0872674708902, 41.8639370009924, - 38.7447411439498, 39.3585499531425, 40.0256335982602, 38.6181510326272, - 38.0178649059027, 38.1157132909286, 39.3558163810008, 38.8346645264899, - 38.85461630796, 37.7248992534766, 38.863487092451, 39.015068997087, - 40.0055219390627, 40.7027278313135, 39.5188006642669, 38.4928451553392, - 39.1378385498179, 39.6115900842645, 37.8781421399288, 40.9844328121185, - 39.403769365946, 40.0298671793341, 38.2239750135394, 39.7267400648407, - 38.9995438518202, 40.2611538311266, 38.786793482844, 38.5653605190023, - 33.9244604815106, 39.0096557979905, 40.6528672876171, 38.9818158286068, - 38.8463968269336, 38.7436678863884, 37.975594403403, 38.4882244002132, - 39.0343156180594, 46.9928676186891, 36.7781819074398, 39.8144638174003, - 37.980464890335, 37.4564703569339, 40.1163325974914, 35.9871069681064, - 39.68729235871, 40.630771351219, 38.9099007667918, 40.2818723062924, - 40.4676556821653, 38.7747729933048, 38.9150973439876, 39.617266449505, - 39.4126917827044, 38.8209524150646, 39.324579360117, 39.9107839860635, - 40.0575447194271, 37.7686134706386, 39.2038472037554, 39.9940352077302, - 37.3140594722784, 38.4796372751327, 39.6443079640486, 37.9232220261437, - 41.2997001245465, 40.2407151320583, 37.5953456462041, 37.3782024981871, - 39.4965108566101, 39.4310973372514, 40.9415421333551, 40.1267239148112, - 39.0104802393511, 37.111403415285, 39.4666748528947, 37.6312986043052, - 38.6648640776781, 39.4654162004083, 38.1723846390448, 38.7118913128723, - 40.0394733411325, 40.1645364404523, 36.9445065042129, 38.6590138575, - 37.2416738810632, 40.8946855580023, 38.9770037695946, 38.3977538832488, - 39.4790250089449, 38.8075342559101, 39.2942139588824, 38.7240025841883, - 38.8017025369415, 39.7585470282626, 39.5489808587065, 39.345956911995, - 38.2287491973915, 39.0688696265457, 40.9548119905498, 38.7066227587173, - 39.7386257214213, 40.129347373272, 41.4727756099533, 38.6855838540641, - 39.7716702263939, 38.1691490705021, 40.292963019468, 39.6551387204093, - 37.7531674165233, 38.7341956955806, 40.3685159751057, 38.0860567609003, - 36.7305575128597, 37.530216757303, 35.8354709111472, 40.9933140599827, - 38.0035814661196, 37.3354421128419, 36.8080737129569, 41.0985219440893, - 38.8561139413136, 42.903710361809, 36.9954831637788, 38.531922153057, - 42.2836921318667, 37.0028061885742, 40.6513942308223, 38.2096983818343, - 38.0482194132477, 39.2607049466359, 38.8390235574544, 39.8576879080886, - 37.8832792184292, 39.0034043277092, 38.684011442933, 38.9912312777927, - 37.9757361394685, 41.3907600446042, 38.9312371532292, 37.7618971984968, - 38.2894211481052, 39.6733277972708, 38.5658494550534, 40.1974937022928, - 37.1473457893721, 38.8622864319329, 39.2725836058167, 38.0170971971996, - 39.4898615875341, 39.366227898738, 37.339521745044, 38.8300803583305, - 38.3411729217755, 39.1683817957122, 41.3070611199184, 38.4063260784734, - 37.1340103791155, 39.362318928735, 40.5828795465779, 39.0971648173104, - 39.3735811927919, 39.6792065372198, 40.3357320097854, 39.1127942705966, - 38.8025678690956, 37.8528074490416, 40.3571246143704, 38.7236270643344, - 39.3210878255258, 39.3417836462455, 37.7601030846554, 37.6883694697397, - 39.5267272790581, 39.5195867118307, 43.0981559093668, 38.5628045416694, - 38.1033275237512, 38.9833325135889, 37.8376076319414, 40.3895047883752, - 37.3392863875083, 40.1192750487477, 37.8712505040228, 38.9730977144904, - 38.7251809129993, 38.2959345065107, 38.765551878725, 36.5523814941017, - 37.6999611725533, 40.112733295656, 38.8344276124878, 38.0256017350531, - 40.8845820706635, 38.9226965106381, 37.2666634962291, 37.4203744638208, - 40.7378152062249, 40.8809097806334, 38.6737692719535, 38.4747024652618, - 39.3519738258198, 38.1086558072326, 38.8262025252141, 38.8373266870745, - 40.6298259732028, 39.1767597684894, 35.8714031826228, 37.8534957833254, - 37.7758645229045, 38.6631612922978, 38.7814973623979, 38.7338820404997, - 39.0129989805106, 40.4871344567191, 39.8975251703063, 39.0078634209895, - 39.2167315605367, 37.8803375793005, 40.3696161718203, 38.0337019843631, - 38.7984476541142, 37.7595575940074, 38.6179730389926, 40.1986912298922, - 41.2895593320579, 39.5060525497241, 39.0963392390911, 39.7313543995007, - 38.8336169806451, 37.6823969764853, 39.3499446203202, 39.2649140853913, - 38.0163632001511, 38.5959614053762, 40.2572217266411, 38.171698458165, - 40.3008014086158, 39.6543735088728, 39.1815990861773, 39.8472544670532, - 38.5977216059802, 39.9663605289933, 37.6893473908978, 38.8481549984134, - 43.3766565048559, 39.3698770455496, 39.9415844625127, 39.5231925912406, - 38.9189010640608, 37.0281041611697, 40.0940027447682, 39.5025949414688, - 38.5149025776659, 40.1824657973457, 38.0594927655381, 37.3226089383971, - 38.9757562397551, 39.4950417133679, 39.6859282232682, 39.7454876662063, - 39.4851308978089, 40.1056769983355, 39.1589104415128, 39.0712831485648, - 39.5607393847756, 39.0644583320816, 39.2515448674571, 39.3032359408323, - 40.5479515450476, 39.6250139600485, 38.028139621913, 37.2285955574899, - 37.2508387258539, 40.3846682207918, 38.636712625128, 39.4270502893468, - 38.2057349544891, 40.4668369658496, 40.63076070518, 36.2667783526517, - 38.5107950647274, 38.3743339825504, 37.7012252335452, 41.2805510262182, - 38.4371011894573, 36.0375810764541, 37.7269181932527, 39.383489843013, - 37.785445612894, 39.2808598910424, 40.5804682220679, 39.4633266713821, - 40.9186377094679, 38.5959854428001, 38.3403967366083, 38.7686849587232, - 38.3341640787877, 37.3980950685274, 35.6839274550542, 37.1841982128791, - 39.3041223888912, 40.1800681285293, 38.5546795002772, 40.6649714235597, - 39.3908892554947, 40.5295797705759, 41.2123065166508, 42.7254305446572, - 38.4949631251763, 40.4935161618346, 38.5312798612271, 39.3479141908363, - 37.8583779286256, 39.3390670518522, 35.0475174766598, 39.3317121842063, - 39.291630780152, 39.8698771514366, 37.9858500799512, 40.8999515676964, - 38.0316622823605, 38.8489839517514, 37.4775721757, 37.1104504954058, - 39.8063713445244, 38.570827029856, 37.9436998244667, 39.8823824999909, - 39.0937021503757, 40.090613185766, 39.6700607263025, 35.9614086936976, - 38.1220240490322, 40.2313461100113, 38.493376737973, 37.8703435212788, - 37.8464499387457, 37.2716605807549, 38.6150991186386, 39.1517243082324, - 38.523443553638, 39.0255090270453, 38.5536830415702, 39.3734321577177, - 40.3498997970709, 39.5379777035583, 36.2140501511744, 41.5758157855067, - 39.371964604603, 38.4613550203525, 39.6530348500717, 36.2748047281009, - 38.2783274778123, 38.6522833139846, 38.1808211976449, 38.2513083309745, - 38.7109089141367, 39.7641821203552, 40.0028365411157, 38.1187417657084 + x <- c( + 38.696580321462, 41.0167488906729, 39.5529154651536, 40.1225506655899, + 38.2675196410126, 35.2169221089071, 37.8367285461107, 40.1377838232664, + 37.5027912166191, 38.427368967798, 40.710857244717, 39.2107558513928, + 38.8104318203955, 36.6782721298192, 39.1189629457727, 38.5038356599761, + 40.9769905762875, 38.1358534539971, 37.677578277466, 37.0006299402988, + 41.7135839580738, 40.1519559493184, 40.0672365990623, 39.5592247806773, + 38.1637058572353, 39.8666688362276, 39.2503685118675, 38.9778749012123, + 40.0217426884973, 37.5351699713108, 39.7893579120294, 39.2387926187296, + 37.7044952991609, 37.8928752489645, 37.0090499173894, 38.4507445786794, + 38.620077736605, 39.6020315346104, 39.7810679774789, 40.8150835920557, + 37.9464980122296, 39.4069904913645, 38.0669287189795, 38.3441834518077, + 38.1993919655101, 40.1628716902171, 40.0281770769124, 38.6956745583115, + 39.6542719125524, 38.6088455182132, 39.8179004699168, 37.9230414720193, + 39.867477710758, 38.9955567243247, 38.0169207342366, 40.3342027787477, + 37.7344362972903, 38.6796129938263, 39.0965409517453, 41.46005663726, + 37.0773600128194, 39.2487948784459, 39.2885683350943, 39.155662491164, + 39.4144380892284, 37.8015034174506, 38.0318253811457, 39.2495131564861, + 39.4079230863217, 37.8069359589137, 39.2240112827973, 39.7992027228957, + 40.1464446475361, 38.0392748572373, 39.8704415381996, 37.0709840973726, + 39.7109649144627, 34.6158405583583, 38.773189207226, 39.5879964831782, + 37.2915278476584, 37.1687398705238, 39.8124336176356, 39.7309887182915, + 40.4249042880422, 37.7747514337286, 39.5078848285084, 40.0854650060604, + 38.4641772660282, 39.9580684236498, 39.0505656140191, 40.1090371065684, + 40.2837137147484, 41.1777634956717, 37.1366808219419, 39.4525678965893, + 38.6350146755692, 39.4979063158441, 41.3036446602384, 39.6926374930186, + 40.3183234220183, 40.1679706298231, 39.701995572475, 38.6869017750228, + 41.2896407864841, 38.7183693797009, 39.1452025170707, 38.3908637314772, + 41.2694527496005, 38.8136900728032, 37.7645647745729, 36.5631366265512, + 37.3667105678707, 41.7000277404458, 39.2707121440988, 36.6203610922647, + 37.8168390843906, 38.0149455298419, 37.4344504136931, 39.4168634517092, + 39.1022303484451, 40.7262981012178, 38.9244902124375, 39.7804365259938, + 40.071593416537, 40.5326032455288, 40.2967188132833, 39.4709850594384, + 39.7026879735608, 40.6767766734202, 39.8820157568733, 40.0306774727645, + 39.206490542215, 37.7995176031058, 38.0305899072524, 41.2535959663767, + 39.360970436801, 39.2050302399161, 37.9355199051284, 40.2662286603004, + 41.121798879367, 37.1609962328165, 38.6466582748848, 38.8967782665257, + 38.0404802796349, 38.376580403419, 38.6255759391397, 39.6073952243451, + 37.6347924690042, 38.5132173119731, 38.8501436804498, 38.493737010245, + 38.7589123929684, 39.7035807090811, 38.365423731158, 41.1023575551406, + 39.4693407341018, 40.3775002176367, 40.0539303648849, 39.2793192634062, + 38.8511551647368, 39.9553561650541, 38.2424584004309, 38.5571856715353, + 37.8348991198805, 37.3717962287677, 39.4730584952921, 41.523488762831, + 36.8499803076413, 38.013422735112, 37.4816695828213, 39.2621838289677, + 38.9515538223032, 40.5502903474796, 39.1161030671012, 38.7945616870771, + 40.2421942935249, 37.7346372472926, 39.1187706618842, 39.909833942905, + 38.6548900463434, 34.9715389178589, 37.2873000101342, 37.9002061587514, + 38.4975034197695, 42.1873757727254, 41.0764975000072, 38.7088995905531, + 40.4662521529921, 40.9236134619865, 39.9786610218703, 39.0344464667416, + 40.9923603178017, 38.226765970102, 36.0570644546613, 39.0610525309774, + 39.378249772003, 39.8481492104, 38.8128557727509, 38.176560083666, + 40.0109623940278, 38.365527279527, 41.4821313110713, 39.1562765062432, + 38.6689781368494, 38.5153323903582, 38.9094460830558, 38.9146080159054, + 39.5126736350809, 38.3551624615048, 39.2900471815049, 38.9872820902618, + 40.4027625099742, 36.9621287876883, 40.3027289972827, 38.9177530641325, + 38.8024677096201, 39.328858624352, 42.0770757806993, 38.1205541479795, + 38.4547674083091, 39.1200982288705, 38.4720192141187, 39.8322429488103, + 39.2862024373929, 39.7692289574389, 36.9552457155791, 38.8208389772751, + 38.7085456704407, 38.179565545474, 38.9552962537617, 37.3170576915214, + 37.9089935034163, 37.5515170524905, 40.8640899715991, 39.3977532271903, + 40.6965393740808, 39.2099251528595, 40.3877351534164, 39.1571163215197, + 38.8843000082186, 40.069135734553, 39.4155507502797, 40.0688390962823, + 40.3694309505709, 38.0979381141079, 37.9653373751348, 39.7406945731137, + 39.7319153561436, 41.0223207682689, 37.8004542927769, 40.2310555662633, + 38.1240358129045, 38.2175347747922, 39.023415223749, 40.5585975447541, + 37.0757803798169, 39.9840704053012, 37.1122869994015, 38.5234948115884, + 39.1109096684222, 37.9292146217095, 38.8120641499639, 38.6725491967401, + 38.4777632732966, 38.9945754893693, 39.541485148896, 39.133974747476, + 38.2834898683667, 40.9802975141706, 39.3374507245175, 41.6661446806449, + 38.4237943886002, 38.7813433440326, 39.9318339470732, 39.5304112157869, + 37.2920210101965, 38.0332942356899, 42.1930139607762, 36.9890596297174, + 39.9769160489512, 38.794454639375, 39.1341805428692, 40.484820544408, + 39.6219550690723, 37.5200194925331, 37.7870770544869, 39.12031371933, + 38.4395308986709, 39.1954131708967, 39.6642750370098, 39.7739948549039, + 39.6011260967852, 38.6108656218676, 37.9154461005623, 38.8064624106545, + 39.0597191615577, 35.5776144023631, 38.8748850476323, 43.9305705918234, + 39.266027724492, 39.870215450819, 38.9148252560285, 38.8287721885671, + 39.2737788275155, 39.4992532278209, 38.9122960388864, 37.9985552244301, + 38.4433361268137, 37.9872056270947, 38.7829483316692, 40.4326071359729, + 37.9718170571938, 37.3173504684119, 38.1041306072045, 39.431650255724, + 39.6501134004123, 38.1962116855106, 40.2125593103105, 39.3300592733259, + 38.4694436891443, 35.6018487136551, 37.7234340243789, 38.8416133651824, + 40.1036196591042, 38.9598798772033, 40.3085817328287, 41.4975558278974, + 38.2865459584346, 41.8260921139512, 40.3253160043853, 39.7726849675659, + 37.5924692740547, 38.7610139093328, 37.2307592557815, 38.1224433823566, + 39.7533625422114, 40.1702289131378, 39.5139069991125, 37.3763796206379, + 43.6767194233294, 42.7980876063979, 40.0101004177844, 38.8045660097627, + 38.7978864220019, 40.5196025015914, 39.6050801057401, 36.6941692064994, + 40.2364242866681, 39.4308687797026, 36.1352625034067, 36.1265011734934, + 40.326010741649, 41.3851869206732, 40.5747815072407, 40.1788259184253, + 38.2380334879549, 34.0096690608054, 39.6929204766898, 39.9515741913088, + 40.0041634169937, 37.9582791534962, 38.0335887840459, 39.1062032236527, + 37.6651696793937, 39.6881044797558, 38.2690967830217, 40.130457062569, + 38.6410808902146, 38.4676289901882, 39.1019005252714, 40.7213285577585, + 37.9573767374336, 39.1183670846963, 38.3822026549756, 37.3646233094306, + 39.1826303020084, 40.3572843581489, 38.442314623214, 38.5553027604022, + 39.6068870521211, 39.8729613160067, 41.7122087547397, 40.0776416898586, + 40.4393696960347, 39.3605590996253, 40.3260086548734, 40.1258507614127, + 40.5186441923711, 38.9809155324387, 39.3394540102295, 39.975869633627, + 40.3111919605064, 39.2163094429044, 38.8435899278059, 37.5259541950718, + 36.963412513099, 39.7647281175532, 38.2778393335243, 38.9592447313249, + 39.6832211664062, 39.8169965656146, 40.0571342866911, 40.0657728205233, + 38.6334828058099, 40.2254110586556, 38.2941124576558, 39.7633820426071, + 39.8812043275032, 39.5252167453337, 39.4841351687756, 37.0507474924108, + 38.7234247192162, 39.6575948859279, 39.1826805828978, 38.0705317267602, + 39.0896781744083, 40.4065177824407, 39.5646604953766, 39.3100515376255, + 37.275038659114, 38.6217194765214, 39.5715251327988, 39.4358964492531, + 37.8979324139364, 38.6842025210972, 38.9891069614657, 37.2435957040697, + 39.4319370959362, 41.5303368473785, 39.2115622666226, 39.9039055064095, + 38.5075815201747, 40.5302469191966, 39.7047799842818, 37.967366956652, + 38.6211561846939, 40.4203269847067, 40.0927676792246, 37.6352896940885, + 38.6602688775301, 40.1228354733954, 39.0484204031229, 40.241195037659, + 37.9075743603001, 40.7096672855678, 40.2063979484382, 39.2988183828229, + 38.7236306765055, 40.085046989671, 40.3864093200838, 39.2525922864072, + 39.9833207861838, 39.4752029274992, 40.0888611984398, 38.8364314332866, + 40.1768350426331, 37.6862394739334, 39.4665248116624, 37.899832276708, + 40.3210047661294, 39.3284191247637, 38.2903729699707, 37.0554029584125, + 38.0839523676974, 39.9998786189738, 39.2720100897009, 38.3885928001302, + 40.9884814635961, 39.3736999451426, 39.0688349733752, 39.9805351538551, + 38.2612231198234, 38.7808257073468, 40.4321639089165, 39.1925831801429, + 38.161657993717, 39.4815364089669, 37.9936299742363, 38.1919733752425, + 39.4634006258866, 40.6826647651456, 39.2383948920205, 38.8211139465359, + 40.2361715640083, 39.2523254442209, 39.5614236208388, 36.3210627879153, + 38.7634574724226, 39.9781094519548, 38.5720737088932, 39.0956252849711, + 37.8334966329441, 37.2993457418318, 39.2514702470121, 39.8392558245568, + 39.174775800502, 37.9748873577388, 43.8236675072905, 39.3897077144617, + 37.5759557282776, 38.1069173479354, 37.4120299079579, 38.5163313919706, + 38.8562534471793, 39.082731249183, 37.8123965517173, 38.6467206368035, + 39.2624233039125, 38.0444904972806, 37.9813830943846, 38.9982977458439, + 38.6337006206239, 36.0640324459786, 36.7986312761523, 38.020967310967, + 40.7379364843796, 38.9806446447468, 38.6883329974466, 34.8276810946894, + 37.7929643219164, 38.1936819030646, 38.8225376463523, 37.4761433823238, + 38.5121448430208, 38.4575246789265, 38.858997572675, 38.359586766349, + 39.558288704952, 40.4853848472591, 38.694323054342, 36.1844952800459, + 38.4853690819966, 38.78881539253, 38.0197707602212, 37.7443143743366, + 39.9711873308084, 38.9706104261925, 39.0769035054312, 39.459235288767, + 36.7812361757565, 38.2369113062318, 39.3662625142971, 37.8482625397072, + 38.6782247139701, 38.9567192145898, 38.2620419120765, 41.0626686610858, + 38.6156436251503, 39.250379171601, 39.349946545355, 40.6275731605698, + 37.9005995605111, 40.205914365087, 41.6982665619521, 39.3723235483688, + 40.0347807170072, 39.497473475581, 38.6590218187837, 39.8843213213189, + 38.6132703135293, 38.4280487105962, 38.5378818511143, 38.603135494208, + 38.7561959541377, 39.3929216926093, 41.3597504191791, 38.6118918667787, + 36.8411548739743, 39.3803349413986, 40.8109456694036, 39.3423162229158, + 38.9459848320317, 39.4991104107462, 38.058197568962, 38.7725871889095, + 39.1770615285156, 39.8193567350056, 38.2684201372059, 36.9811216392299, + 40.1769004167604, 39.0216375952443, 40.9455713612591, 37.7742379317281, + 38.7805197184278, 39.2973602139325, 41.0202595055836, 37.5888276948441, + 39.6559437124032, 37.7993924072458, 36.8680224413153, 38.3929408217845, + 39.313511789542, 36.8665331958893, 38.2182703654236, 38.8439109398027, + 39.4111744274711, 39.9253017127809, 36.9237891082507, 36.7600893992139, + 39.2855930848628, 39.2835843453872, 39.4129188137863, 37.9364834955805, + 38.1476606393185, 37.2076006841655, 40.2747876086838, 37.9022020669638, + 39.4325003205913, 37.951115432256, 37.807971401276, 40.2969281026145, + 40.6730841209068, 39.2893414371149, 40.2741852515657, 39.764396697977, + 38.4038572501277, 40.4955100450384, 39.7324796415345, 39.0789568290801, + 39.0947744940562, 37.2667626452727, 40.9708061054478, 38.9398447906209, + 38.6126752576927, 39.8159974079398, 39.4177867561836, 38.9876024433841, + 40.794214437606, 43.7562402030798, 38.6701756334505, 38.1621099177722, + 36.575698535627, 38.255188055226, 38.1033459720734, 37.0581351999275, + 38.9359368996426, 39.7852493973811, 38.0872674708902, 41.8639370009924, + 38.7447411439498, 39.3585499531425, 40.0256335982602, 38.6181510326272, + 38.0178649059027, 38.1157132909286, 39.3558163810008, 38.8346645264899, + 38.85461630796, 37.7248992534766, 38.863487092451, 39.015068997087, + 40.0055219390627, 40.7027278313135, 39.5188006642669, 38.4928451553392, + 39.1378385498179, 39.6115900842645, 37.8781421399288, 40.9844328121185, + 39.403769365946, 40.0298671793341, 38.2239750135394, 39.7267400648407, + 38.9995438518202, 40.2611538311266, 38.786793482844, 38.5653605190023, + 33.9244604815106, 39.0096557979905, 40.6528672876171, 38.9818158286068, + 38.8463968269336, 38.7436678863884, 37.975594403403, 38.4882244002132, + 39.0343156180594, 46.9928676186891, 36.7781819074398, 39.8144638174003, + 37.980464890335, 37.4564703569339, 40.1163325974914, 35.9871069681064, + 39.68729235871, 40.630771351219, 38.9099007667918, 40.2818723062924, + 40.4676556821653, 38.7747729933048, 38.9150973439876, 39.617266449505, + 39.4126917827044, 38.8209524150646, 39.324579360117, 39.9107839860635, + 40.0575447194271, 37.7686134706386, 39.2038472037554, 39.9940352077302, + 37.3140594722784, 38.4796372751327, 39.6443079640486, 37.9232220261437, + 41.2997001245465, 40.2407151320583, 37.5953456462041, 37.3782024981871, + 39.4965108566101, 39.4310973372514, 40.9415421333551, 40.1267239148112, + 39.0104802393511, 37.111403415285, 39.4666748528947, 37.6312986043052, + 38.6648640776781, 39.4654162004083, 38.1723846390448, 38.7118913128723, + 40.0394733411325, 40.1645364404523, 36.9445065042129, 38.6590138575, + 37.2416738810632, 40.8946855580023, 38.9770037695946, 38.3977538832488, + 39.4790250089449, 38.8075342559101, 39.2942139588824, 38.7240025841883, + 38.8017025369415, 39.7585470282626, 39.5489808587065, 39.345956911995, + 38.2287491973915, 39.0688696265457, 40.9548119905498, 38.7066227587173, + 39.7386257214213, 40.129347373272, 41.4727756099533, 38.6855838540641, + 39.7716702263939, 38.1691490705021, 40.292963019468, 39.6551387204093, + 37.7531674165233, 38.7341956955806, 40.3685159751057, 38.0860567609003, + 36.7305575128597, 37.530216757303, 35.8354709111472, 40.9933140599827, + 38.0035814661196, 37.3354421128419, 36.8080737129569, 41.0985219440893, + 38.8561139413136, 42.903710361809, 36.9954831637788, 38.531922153057, + 42.2836921318667, 37.0028061885742, 40.6513942308223, 38.2096983818343, + 38.0482194132477, 39.2607049466359, 38.8390235574544, 39.8576879080886, + 37.8832792184292, 39.0034043277092, 38.684011442933, 38.9912312777927, + 37.9757361394685, 41.3907600446042, 38.9312371532292, 37.7618971984968, + 38.2894211481052, 39.6733277972708, 38.5658494550534, 40.1974937022928, + 37.1473457893721, 38.8622864319329, 39.2725836058167, 38.0170971971996, + 39.4898615875341, 39.366227898738, 37.339521745044, 38.8300803583305, + 38.3411729217755, 39.1683817957122, 41.3070611199184, 38.4063260784734, + 37.1340103791155, 39.362318928735, 40.5828795465779, 39.0971648173104, + 39.3735811927919, 39.6792065372198, 40.3357320097854, 39.1127942705966, + 38.8025678690956, 37.8528074490416, 40.3571246143704, 38.7236270643344, + 39.3210878255258, 39.3417836462455, 37.7601030846554, 37.6883694697397, + 39.5267272790581, 39.5195867118307, 43.0981559093668, 38.5628045416694, + 38.1033275237512, 38.9833325135889, 37.8376076319414, 40.3895047883752, + 37.3392863875083, 40.1192750487477, 37.8712505040228, 38.9730977144904, + 38.7251809129993, 38.2959345065107, 38.765551878725, 36.5523814941017, + 37.6999611725533, 40.112733295656, 38.8344276124878, 38.0256017350531, + 40.8845820706635, 38.9226965106381, 37.2666634962291, 37.4203744638208, + 40.7378152062249, 40.8809097806334, 38.6737692719535, 38.4747024652618, + 39.3519738258198, 38.1086558072326, 38.8262025252141, 38.8373266870745, + 40.6298259732028, 39.1767597684894, 35.8714031826228, 37.8534957833254, + 37.7758645229045, 38.6631612922978, 38.7814973623979, 38.7338820404997, + 39.0129989805106, 40.4871344567191, 39.8975251703063, 39.0078634209895, + 39.2167315605367, 37.8803375793005, 40.3696161718203, 38.0337019843631, + 38.7984476541142, 37.7595575940074, 38.6179730389926, 40.1986912298922, + 41.2895593320579, 39.5060525497241, 39.0963392390911, 39.7313543995007, + 38.8336169806451, 37.6823969764853, 39.3499446203202, 39.2649140853913, + 38.0163632001511, 38.5959614053762, 40.2572217266411, 38.171698458165, + 40.3008014086158, 39.6543735088728, 39.1815990861773, 39.8472544670532, + 38.5977216059802, 39.9663605289933, 37.6893473908978, 38.8481549984134, + 43.3766565048559, 39.3698770455496, 39.9415844625127, 39.5231925912406, + 38.9189010640608, 37.0281041611697, 40.0940027447682, 39.5025949414688, + 38.5149025776659, 40.1824657973457, 38.0594927655381, 37.3226089383971, + 38.9757562397551, 39.4950417133679, 39.6859282232682, 39.7454876662063, + 39.4851308978089, 40.1056769983355, 39.1589104415128, 39.0712831485648, + 39.5607393847756, 39.0644583320816, 39.2515448674571, 39.3032359408323, + 40.5479515450476, 39.6250139600485, 38.028139621913, 37.2285955574899, + 37.2508387258539, 40.3846682207918, 38.636712625128, 39.4270502893468, + 38.2057349544891, 40.4668369658496, 40.63076070518, 36.2667783526517, + 38.5107950647274, 38.3743339825504, 37.7012252335452, 41.2805510262182, + 38.4371011894573, 36.0375810764541, 37.7269181932527, 39.383489843013, + 37.785445612894, 39.2808598910424, 40.5804682220679, 39.4633266713821, + 40.9186377094679, 38.5959854428001, 38.3403967366083, 38.7686849587232, + 38.3341640787877, 37.3980950685274, 35.6839274550542, 37.1841982128791, + 39.3041223888912, 40.1800681285293, 38.5546795002772, 40.6649714235597, + 39.3908892554947, 40.5295797705759, 41.2123065166508, 42.7254305446572, + 38.4949631251763, 40.4935161618346, 38.5312798612271, 39.3479141908363, + 37.8583779286256, 39.3390670518522, 35.0475174766598, 39.3317121842063, + 39.291630780152, 39.8698771514366, 37.9858500799512, 40.8999515676964, + 38.0316622823605, 38.8489839517514, 37.4775721757, 37.1104504954058, + 39.8063713445244, 38.570827029856, 37.9436998244667, 39.8823824999909, + 39.0937021503757, 40.090613185766, 39.6700607263025, 35.9614086936976, + 38.1220240490322, 40.2313461100113, 38.493376737973, 37.8703435212788, + 37.8464499387457, 37.2716605807549, 38.6150991186386, 39.1517243082324, + 38.523443553638, 39.0255090270453, 38.5536830415702, 39.3734321577177, + 40.3498997970709, 39.5379777035583, 36.2140501511744, 41.5758157855067, + 39.371964604603, 38.4613550203525, 39.6530348500717, 36.2748047281009, + 38.2783274778123, 38.6522833139846, 38.1808211976449, 38.2513083309745, + 38.7109089141367, 39.7641821203552, 40.0028365411157, 38.1187417657084 + ) + expect_snapshot( + { + set.seed(99) + ssdtools:::sgompertz(data.frame(left = x, right = x)) + set.seed(99) + ssd_fit_dists(data.frame(Conc = x), dists = "gompertz") + set.seed(100) + ssdtools:::sgompertz(data.frame(left = x, right = x)) + set.seed(100) + ssd_fit_dists(data.frame(Conc = x), dists = "gompertz") + set.seed(131) + ssd_fit_dists(data.frame(Conc = x), dists = "gompertz") + }, + error = TRUE ) - expect_snapshot({ - set.seed(99) - ssdtools:::sgompertz(data.frame(left = x, right = x)) - set.seed(99) - ssd_fit_dists(data.frame(Conc = x), dists = "gompertz") - set.seed(100) - ssdtools:::sgompertz(data.frame(left = x, right = x)) - set.seed(100) - ssd_fit_dists(data.frame(Conc = x), dists = "gompertz") - set.seed(131) - ssd_fit_dists(data.frame(Conc = x), dists = "gompertz") - }, - error = TRUE) }) test_that("ssd_hc cis with error", { skip_on_ci() skip_on_cran() - + 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) @@ -476,7 +489,7 @@ test_that("ssd_hc cis with error", { test_that("ssd_hc comparable parametric and non-parametric big sample size", { skip_on_ci() skip_on_cran() - + set.seed(99) data <- data.frame(Conc = ssd_rlnorm(10000, 2, 1)) fit <- ssd_fit_dists(data, dists = "lnorm") @@ -491,7 +504,7 @@ test_that("ssd_hc comparable parametric and non-parametric big sample size", { test_that("ssd_hp cis with error", { skip_on_ci() skip_on_cran() - + 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) @@ -508,7 +521,7 @@ test_that("ssd_hp cis with error", { test_that("ssd_hp comparable parametric and non-parametric big sample size", { skip_on_ci() skip_on_cran() - + set.seed(99) data <- data.frame(Conc = ssd_rlnorm(10000, 2, 1)) fit <- ssd_fit_dists(data, dists = "lnorm") @@ -523,7 +536,7 @@ test_that("ssd_hp comparable parametric and non-parametric big sample size", { test_that("plot geoms", { skip_on_ci() skip_on_cran() - + 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)) + @@ -539,7 +552,7 @@ test_that("plot geoms", { test_that("ssd_plot censored data", { skip_on_ci() skip_on_cran() - + data <- ssddata::ccme_boron data$Other <- data$Conc * 2 expect_snapshot_plot(ssd_plot(data, boron_pred, right = "Other"), "boron_cens_pred_ribbon") @@ -548,7 +561,7 @@ test_that("ssd_plot censored data", { test_that("invpareto with extreme data", { skip_on_ci() skip_on_cran() - + data <- data.frame(Conc = c( 2.48892649039671, 2.5258371156749, 2.51281264491458, 2.49866046657748, 2.56572740160664, 2.49440006912093, 2.4817062813665, @@ -576,9 +589,9 @@ test_that("invpareto with extreme data", { 2.52987952199996, 2.58987810707128, 2.46777896999791, 2.51447342615507, 2.48618482994608, 2.51794970929166, 2.49716394702713, 2.49218587262049 )) - + fit99 <- ssd_fit_dists(data, dists = "invpareto") - + expect_equal( estimates(fit99), list(invpareto.weight = 1, invpareto.scale = 2.61422138795731, invpareto.shape = 26.0278618888663) @@ -588,36 +601,40 @@ test_that("invpareto with extreme data", { test_that("not all estimates if fail", { skip_on_ci() skip_on_cran() - + dir <- withr::local_tempdir() - + fit <- ssd_fit_dists(ssddata::ccme_boron, dists = c("lnorm", "lnorm_lnorm")) set.seed(49) - hc <- ssd_hc(fit, nboot = 10, ci = TRUE, ci_method = "multi_fixed", - parametric = TRUE, save_to = dir, min_pboot = 0.8, samples = TRUE) + hc <- ssd_hc(fit, + nboot = 10, ci = TRUE, ci_method = "multi_fixed", + parametric = TRUE, save_to = dir, min_pboot = 0.8, samples = TRUE + ) expect_snapshot_data(hc, "hc_notallestimates") - expect_identical(list.files(dir), c("data_000000000_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv", - "data_000000003_multi.csv", "data_000000004_multi.csv", "data_000000005_multi.csv", - "data_000000006_multi.csv", "data_000000007_multi.csv", "data_000000008_multi.csv", - "data_000000009_multi.csv", "data_000000010_multi.csv", "estimates_000000000_multi.rds", - "estimates_000000001_multi.rds", "estimates_000000002_multi.rds", - "estimates_000000003_multi.rds", "estimates_000000004_multi.rds", - "estimates_000000005_multi.rds", "estimates_000000006_multi.rds", - "estimates_000000007_multi.rds", "estimates_000000008_multi.rds", - "estimates_000000009_multi.rds", "estimates_000000010_multi.rds")) + expect_identical(list.files(dir), c( + "data_000000000_multi.csv", "data_000000001_multi.csv", "data_000000002_multi.csv", + "data_000000003_multi.csv", "data_000000004_multi.csv", "data_000000005_multi.csv", + "data_000000006_multi.csv", "data_000000007_multi.csv", "data_000000008_multi.csv", + "data_000000009_multi.csv", "data_000000010_multi.csv", "estimates_000000000_multi.rds", + "estimates_000000001_multi.rds", "estimates_000000002_multi.rds", + "estimates_000000003_multi.rds", "estimates_000000004_multi.rds", + "estimates_000000005_multi.rds", "estimates_000000006_multi.rds", + "estimates_000000007_multi.rds", "estimates_000000008_multi.rds", + "estimates_000000009_multi.rds", "estimates_000000010_multi.rds" + )) }) test_that("lnorm_lnorm fits anonb", { skip_on_ci() skip_on_cran() - + set.seed(99) data <- ssddata::anon_b fit <- ssd_fit_dists(data, - dists = c("lnorm_lnorm"), - at_boundary_ok = FALSE, min_pmix = 0.05 + dists = c("lnorm_lnorm"), + at_boundary_ok = FALSE, min_pmix = 0.05 ) - + tidy <- tidy(fit) expect_snapshot_data(tidy, "tidy_anonb") expect_snapshot_plot(ssd_plot(data, predict(fit), ci = FALSE), "plot_anonb") @@ -626,261 +643,263 @@ test_that("lnorm_lnorm fits anonb", { test_that("lnorm_lnorm non-bimodal 1000 data", { skip_on_ci() skip_on_cran() - + data <- data.frame(Conc = c( - 11.6635934627129, 11.3655834538171, 11.8239438136152, 11.4457330597547, - 11.2733838979158, 11.6555694734405, 11.6077458629663, 11.6253179146231, - 11.7565586590195, 11.1887570445131, 11.6730568277929, 11.4120070711133, - 11.6824326010276, 11.3911357792784, 12.0706441525969, 11.2155412831347, - 11.3821410267404, 11.3267141623621, 11.6076784146829, 11.3209976317701, - 11.2959562378299, 11.6786188036454, 11.6046588017454, 11.7499647941354, - 11.4831512412866, 11.8286883023093, 11.7007855177161, 11.6125285414713, - 11.4368552322619, 11.677278735656, 11.2591724516819, 11.2122991922597, - 11.2014592283697, 11.6757643041424, 11.3976039512326, 11.4064992756645, - 11.6084844857244, 11.2659904100175, 11.4887603755147, 11.3465556328527, - 11.6709507658488, 11.4442961944266, 11.6860922015911, 11.3337180713638, - 11.4934336220037, 11.4237641215403, 11.2597374132061, 11.1767350574449, - 11.5249429055911, 11.2922544242571, 11.3860745867636, 11.5766005475934, - 11.2628237130449, 11.6146165920334, 11.4175020113036, 11.3195033621875, - 11.1710952560318, 11.6597792510826, 11.4868152191465, 11.5721318552201, - 11.6486854013223, 11.6404214031175, 11.4738473838758, 11.0370114162703, - 11.5306291118776, 11.7547581342576, 11.1729582778396, 11.5752263994969, - 11.2468730281413, 11.7327251393004, 11.6517053064323, 11.5377269190321, - 11.7274750442181, 11.8998204906137, 11.6746453028613, 11.7144040978644, - 11.3885625929466, 11.4727695225601, 11.5211563372212, 11.8779053238367, - 11.5235380529653, 11.7352073567185, 11.778095222296, 11.5565087399718, - 11.4303811869928, 11.411039568203, 11.7936208857429, 11.2632318149877, - 11.4183636452509, 11.5450923312535, 11.5304172016656, 11.3564668458882, - 11.3097786542072, 11.2559960803643, 11.1900205330239, 11.3179458681654, - 11.5468393692064, 11.6109598609785, 11.4397968689957, 11.5829306616596, - 11.4265533991304, 11.4037107783255, 11.6231069350061, 11.4476147809259, - 11.315857500714, 11.192073498525, 11.1450028934144, 11.4763778673496, - 11.3303593182416, 11.795851315237, 11.3154135776636, 11.504446981381, - 11.3686452517911, 11.0681174567049, 11.9482203553029, 11.4990621721172, - 11.7700827893035, 11.153277291342, 11.4103274908523, 11.362014739247, - 11.3370793845089, 10.9490041292355, 11.5709887438907, 11.2392472207936, - 11.4457697378538, 11.5518564381783, 11.1668497234251, 11.660217248224, - 11.5408481305805, 11.3596525221312, 11.7088443068689, 11.0985982119481, - 11.6344343224953, 11.5835918466228, 11.6707241606893, 11.4873075231587, - 11.6871951877657, 11.3561777270116, 11.0926984591504, 11.6670973459339, - 11.4743776164222, 11.4012126214713, 11.1670799989037, 11.3895862238313, - 11.4619188035051, 11.7438466838695, 11.7789086710159, 11.8254153257148, - 11.5350198406344, 11.614146101765, 11.5037937949341, 11.7594749216344, - 11.7232424558103, 11.4901038034287, 11.457497322123, 11.4701475688988, - 11.3495747129771, 11.4768364004515, 11.3536264552173, 11.6967872920671, - 11.5958239935742, 11.8102460795176, 11.5285720139981, 11.5636360422529, - 11.2391302305836, 11.6400828524342, 11.3649992872627, 11.7739800561355, - 11.9514605248261, 11.8948860243831, 11.3298148207664, 11.3913235205135, - 11.2842354326543, 11.5345139189297, 11.0970243900149, 11.7031563986728, - 11.6634306349493, 11.9092830544344, 11.5869287303179, 11.7564461328616, - 11.150172788247, 11.4822541140239, 11.4044323999418, 11.7430862177697, - 11.4674029907269, 11.6087102680844, 11.0224410790094, 11.1429072494759, - 11.1440714332214, 11.4429296944542, 11.5110545367456, 11.6902834560434, - 11.975232188303, 11.3484533650323, 11.5902139993436, 11.6936184805547, - 11.2156665797036, 11.5367845942098, 11.457685987964, 11.326091672857, - 11.54310696694, 11.6318253757251, 11.4672564829417, 11.2753353731344, - 11.5442624404976, 11.4998938095082, 11.7680718084146, 11.4432553497958, - 11.7656381805778, 11.6559051931419, 11.2711880476245, 11.6412415650511, - 11.5685922662603, 11.5506412075912, 11.3513987873333, 11.3315276655562, - 11.335640654208, 11.681285272101, 11.5589662365603, 11.1828140877568, - 11.5312581724757, 11.5432002402202, 11.7912888955701, 11.4905985999693, - 11.1259591802745, 11.4610350884183, 11.7991160364597, 11.579099060573, - 11.33449302326, 11.2554336598017, 11.4512378707303, 11.7226621454134, - 11.3527354290433, 11.6705425125658, 11.5563556191945, 11.7308586023113, - 11.9851397182973, 11.075885463439, 11.2080718893369, 11.4368799211954, - 11.5632546318052, 11.6634278624019, 11.318215841977, 11.4880779444713, - 11.6701760414542, 11.7900454830006, 11.4305509189927, 11.4005711273461, - 11.493397563551, 11.3671831886506, 11.5455573847742, 11.455219607115, - 11.3765307074504, 11.5322198186407, 11.7234429342707, 11.4913195141207, - 11.5800460407405, 11.5015183797711, 11.600345452303, 11.671105482069, - 11.9009180552352, 11.3047838103508, 11.243053789483, 11.3132995190247, - 11.1839945545923, 11.5467528309238, 11.4624123336534, 11.4384084755489, - 11.7624832869299, 11.4972069873588, 11.6718416090489, 11.5565193860913, - 11.6854937630156, 11.486887701755, 11.2245408284927, 11.4223163757767, - 11.6183353030888, 11.4781731819334, 11.4180676231011, 11.5222391679401, - 10.9874586119541, 11.6315015151944, 11.6259231476061, 11.5246942987034, - 11.3790143669854, 11.6091093097247, 11.8458505048798, 11.3956132241971, - 11.4334989846648, 12.0107090576645, 11.58889471641, 11.8485588211996, - 11.6912962865302, 11.3443567873428, 11.4889742885729, 11.7353556032995, - 11.3458181845925, 11.5360487979571, 11.572996307097, 11.3900889967152, - 11.3871286159282, 11.6394988106606, 11.6672892268697, 11.2499719224047, - 11.4355438444653, 11.4146461074679, 11.5830061909034, 11.356416701344, - 11.5194114268155, 11.4461730977868, 11.7555819598489, 11.757108193106, - 11.6621065583231, 11.838582610051, 11.7632074437835, 11.3465420858875, - 11.5844207003211, 11.1705821018384, 11.4142931889118, 11.6952187675352, - 11.5853093436653, 11.3754738036731, 11.4897478077412, 11.6808486866119, - 11.7782359379539, 11.4098989033173, 11.5147654815493, 11.9203595355564, - 11.7863398442806, 11.6085439373772, 11.3748020550406, 11.5107499518156, - 11.4459430122029, 11.8864880814917, 11.3910504966753, 11.7608068035471, - 11.2010926856702, 11.2525270439525, 11.6862467158833, 11.732921172069, - 11.2587015436406, 11.9648080240531, 11.2853204109666, 11.5145507471921, - 11.4761721195894, 11.3591745195689, 11.6041308327816, 11.8698306010401, - 11.6899433491951, 11.3939731110365, 11.5342338112757, 11.7752406163456, - 11.435729513263, 11.3188712646992, 11.3365988682073, 11.6485204521932, - 11.480686518043, 11.2799874465089, 11.4116754417375, 11.4545426647885, - 11.5745481350434, 11.1966656568524, 11.6975132142541, 11.6431448445814, - 11.2517604231283, 11.1486491517404, 11.6991734787903, 11.2241659658642, - 11.4952691898267, 11.5740123918133, 11.3536512948081, 11.5378236053867, - 11.5105640641999, 11.8221701602153, 11.2923902515628, 11.53180649897, - 11.3691594548817, 11.6175646316642, 11.4053269282246, 11.234768393995, - 11.641542054491, 11.7999676522794, 11.5257062424203, 11.5059110405551, - 11.6617696764003, 11.3226243854653, 11.4880248762229, 11.7337176970954, - 11.2155495826891, 11.6517450661497, 11.6021018262328, 11.3877604077526, - 11.639890502846, 11.7809973315967, 11.3515596489177, 11.3761078301294, - 11.4971577458201, 11.7264688656258, 11.4937265193511, 12.0486431731611, - 11.4285135930375, 11.5266970229313, 11.6897298607594, 11.1325756698399, - 11.3610403083483, 11.271158595137, 11.5987031218919, 11.2413020872383, - 11.6922042998872, 11.0622291689558, 11.0493045662671, 11.7886726028345, - 11.356875041002, 11.222682110044, 11.1729481428879, 12.050179976782, - 11.3691912771854, 11.1729814065191, 11.6134550080208, 11.3668928620368, - 11.2789813760573, 11.858752849499, 11.1277127982319, 11.2254664041385, - 11.6425437286932, 11.5189911033846, 11.72792415931, 11.3460373137601, - 11.4266246813696, 11.6145883108721, 11.4040865639135, 10.9397029690441, - 11.9355220072695, 11.5659683736315, 11.2595351388416, 11.7264552315149, - 11.4250232833136, 11.8505002503181, 11.6736025315652, 11.6358341743864, - 11.4848620300854, 11.0658566253791, 11.7433762718265, 11.368863939374, - 12.0430882282277, 11.1478992722267, 11.6529116138211, 11.4386231562301, - 11.4699978508074, 11.3949217618572, 11.4546511662623, 11.6224432553423, - 11.4421481785793, 11.657180874398, 12.8288174569032, 11.6252568763014, - 11.491598965489, 11.5122204443171, 11.1946277176765, 11.3371665039755, - 11.8219395858959, 11.4177551579925, 11.817401786082, 10.9066865497524, - 11.6292423316714, 11.4345661115386, 11.5146335760661, 11.2164818600078, - 11.6462007756576, 11.5594553161589, 11.2777294045852, 11.4064561143383, - 11.403296101097, 11.1942695626537, 11.2069796841188, 11.5108806250445, - 11.4903700781168, 11.4412637072806, 11.7367046978334, 11.4415759938265, - 11.461789360977, 11.5025221397458, 11.6741375647481, 11.6318730203337, - 11.8724788742072, 11.3411139466139, 11.193895333642, 11.5090212617708, - 11.4766156814582, 11.3025257977669, 11.6887687898236, 11.9785619762261, - 11.5832745795798, 11.5638848196105, 11.6373626595557, 11.5346618451343, - 11.8053599896049, 11.7866836352087, 11.6656448470497, 11.6767793846651, - 11.4386961150224, 11.6601979255714, 11.6835301301195, 11.1916085178821, - 11.3638143635823, 11.5384570024637, 11.5021355520758, 11.728807679399, - 10.984378479658, 11.7213214603164, 10.7461781085464, 11.3870533808756, - 11.6264922619532, 11.5206029097705, 11.3075447476347, 11.5292525213332, - 11.4474539160496, 11.1784758708234, 11.3896979535097, 11.719541623793, - 11.6053073443453, 11.518232072859, 11.3712640382737, 11.6098940705145, - 11.5382560364661, 11.7993666879693, 11.6324840910319, 11.4481893420571, - 11.541204261907, 11.5773112599797, 11.5737901104302, 11.4341925128839, - 11.4793732048958, 11.6786469969964, 11.779820125404, 11.531459246292, - 11.2534419833243, 11.5242285802331, 11.7505344377909, 11.2561748020822, - 11.4661314501832, 11.4760530705387, 11.4506126062349, 11.3963732165445, - 11.4312630670097, 11.3557616131191, 11.5823565060607, 11.5363888326256, - 11.4917903826409, 11.5703392588785, 11.4208903235975, 11.3264983504393, - 11.4339118777607, 11.6207177601068, 12.0732854180863, 11.3485270565549, - 11.7214183450559, 11.3500282028636, 11.2190693389911, 11.2069248306124, - 11.6847250769785, 11.7484631837051, 11.3928718561409, 11.0483431329695, - 11.0632555553734, 11.3484711276532, 11.3540665678888, 11.424901501236, - 11.3772438391331, 11.3402755457535, 11.6658488666932, 11.801777190057, - 11.2024789759482, 11.2178942545725, 11.4553053426658, 11.7871905188347, - 11.4981479663863, 11.327302970811, 11.4159310930165, 11.5560442202663, - 11.7365037432332, 11.3378278539107, 11.8208625963249, 11.6497566272874, - 11.5075152494812, 11.5215250880463, 11.2812669600297, 11.310753285262, - 11.9620678652502, 11.3590587863734, 11.3898381131715, 11.2529331118846, - 11.2362185790092, 11.385351174977, 11.5744685353361, 11.4856804686762, - 11.913912055332, 11.3767849155427, 11.8094735607357, 11.1508024267808, - 11.8106804361006, 11.5470001967063, 11.3952593838908, 11.2484965135934, - 11.1152705518813, 11.5389406080853, 11.7634503537939, 11.4291028317061, - 11.3276572999105, 11.4930118360099, 11.5469649014856, 11.5169350020809, - 11.3285353226113, 11.2780234904709, 11.440289000834, 11.220111220716, - 11.6368461254189, 11.3373985461442, 11.5729909942026, 11.5627913514537, - 11.896010438462, 12.1378927192053, 11.2661668881932, 11.6500397905937, - 11.9456515880464, 11.6036046289927, 11.2617034688574, 11.2041718173304, - 11.7846555949065, 11.7468241221256, 11.5711643637382, 11.4605756512852, - 11.6855846792033, 11.610560314245, 11.4023298726094, 11.5935010737646, - 11.4794267316669, 11.4177936724899, 11.3170444087192, 11.4297981291346, - 11.5846912793348, 11.5361273182454, 11.2836990730896, 11.7129292407643, - 11.3682617291422, 11.5788574326573, 11.3656467657476, 11.4105589568224, - 11.6329782469737, 11.7741760320124, 11.5877677859266, 11.4614478490663, - 11.8922989610443, 11.4769174598707, 11.5473094994925, 11.8164122469798, - 11.3965297469094, 11.7060351811225, 11.9160697996983, 12.2091231955421, - 11.4513840897352, 11.9190686799799, 11.5716373917844, 11.4552839479779, - 11.2069385588086, 11.2352938786398, 11.4799962344234, 11.1715703387231, - 11.5951806551894, 11.4965967805174, 11.9066684684352, 12.085620305792, - 11.6762460737526, 11.5003622406498, 11.2467259944484, 11.3576209222196, - 11.5538967776043, 11.6021728438367, 11.4017677191272, 11.6541203471886, - 11.5179908661979, 11.3731766103249, 11.284667844589, 11.277379710151, - 11.6083662721441, 11.4137354186957, 10.8955839097348, 11.6128481523168, - 10.9414889550394, 11.500934449099, 11.4032494506259, 11.3414275766532, - 11.6103518032939, 11.4489716827269, 11.4521528606091, 11.4586955357924, - 11.0442737725854, 11.4024077316865, 11.4530826810189, 11.2142229985889, - 11.3211367494156, 11.7695143207915, 11.6801094326193, 11.378714542138, - 11.5894285425463, 11.4535592112896, 11.5189077909302, 11.905529468508, - 11.7308595111171, 11.1561241580823, 11.5396607072055, 11.5670558138667, - 11.5866534877845, 11.4899696625367, 10.7606650890848, 11.4623034225546, - 11.4829861663367, 11.531027241558, 11.1284027924671, 11.3789406141285, - 11.7180842406464, 11.248060386135, 11.8557680503442, 11.4749711791423, - 11.7731267020686, 11.4451020052469, 11.5536039362763, 11.2295030702308, - 11.4439680242462, 11.3599366494965, 11.2375779084626, 11.4027090068517, - 11.4674002049422, 11.6107908879673, 11.3646653036025, 11.3525677125419, - 11.6956920927681, 11.5949761789213, 11.4279470409673, 11.628194983154, - 11.3797989564061, 11.4537211190876, 11.544720822699, 11.3477447726164, - 11.5106910979557, 11.2705155562627, 11.5419354593303, 11.6002427009366, - 11.3617284216845, 11.4545380023049, 11.5559785868196, 11.2827575037312, - 11.4923949055435, 11.4670902548463, 11.7775808724294, 11.7524650925602, - 11.5232395955812, 11.7716348213617, 11.3129441491383, 11.9184159519933, - 11.4651302298193, 11.4828115364529, 11.4921553448102, 11.4840394509425, - 11.4795329119155, 11.3557617727837, 11.1990802135024, 11.555895890632, - 11.5665334157256, 11.9608405697218, 11.0906137231452, 11.4738335300962, - 11.5552267798845, 11.4917532448646, 11.4767501205378, 11.309257136722, - 11.8330397760739, 11.2452007264035, 11.5626653665188, 11.6615348431299, - 11.4036383205713, 11.9206466284402, 11.4028117349485, 11.232335830704, - 11.5710019223606, 11.2323436049941, 11.0986236955492, 11.7618238628064, - 11.3445348352561, 11.378093136043, 11.5381912190455, 11.282570495449, - 11.3186759511659, 11.4117838917907, 11.6227635225452, 11.7844213221872, - 11.5671587969278, 11.458922182513, 11.4032992701995, 11.5491884538217, - 11.2758671228542, 11.6770897492982, 11.6342313067151, 11.1237574188463, - 11.6031081273673, 12.1290653063871, 11.4778345922648, 11.3583463804655, - 11.3266052031506, 11.7246123353123, 11.4647737955044, 11.5883332972292, - 11.4248310030985, 11.3713918308266, 11.2041509548359, 11.617616628905, - 11.3759381668148, 11.3305920225639, 11.6871369457011, 11.6303021419011, - 11.4931674583361, 11.0922966074434, 11.2490842937364, 10.9403583083204, - 11.1716989237958, 11.4292855836507, 11.6236233194597, 11.5989208423244, - 11.2147889962406, 11.625607143598, 11.8748838328963, 11.5414934062674, - 11.6259439615824, 11.3364532857374, 11.8227344400673, 11.7111666222959, - 11.3727104334305, 11.7078155455392, 11.5544569070194, 11.6021540153749, - 11.573369065866, 10.8581859655439, 11.6615357936139, 11.6074293122824, - 11.3800328287919, 11.8608121046055, 10.8695335671074, 11.4549460213617, - 11.6732793086444, 11.6280582434249, 11.7938110746401, 11.2759355094693, - 11.7333174374389, 11.5124908292672, 11.5116966042338, 11.2557414497685, - 11.111003192477, 11.7723687553069, 11.5311536361956, 11.415675250247, - 11.434958888026, 11.5764304335137, 11.3184428704269, 11.5925005193847, - 11.6606221243124, 11.6799864503813, 11.6680624812246, 11.6323392171622, - 11.6205668223306, 11.2743893579799, 11.3038169041637, 11.2516179608122, - 11.0913550278671, 11.5183036046645, 11.6088540037091, 11.4237385957101, - 11.7411183714493, 11.5268255736499, 11.5514313428383, 11.4939244996735, - 11.478671143305, 11.5506137782508, 11.4838342763386, 11.9082590797765, - 10.960554474782, 11.4510734836701, 11.594720494906, 11.6435287600618, - 11.4730994130636, 11.6753147493462, 11.0704918909154, 11.3363906264414, - 11.4069381361204, 11.3390189388972, 11.7394581174949, 11.5025933598415, - 11.5091568374427, 11.8189657846627, 11.6762535202989, 11.4862855869735, - 11.5191142470272, 11.4087780398663, 11.5361396738411, 11.3477626341929, - 11.3295447034612, 11.6461819581215, 11.3160562372171, 11.9732839905477, - 11.2597545419879, 11.6483236285684, 11.6659329899876, 11.3375985127992, - 11.5652927769658, 11.5402126667346, 11.5246347656743, 11.3790534415256, - 11.3504467491437, 11.9006774473653, 11.2998434728114, 11.294215001317, - 11.0352592725904, 11.5442750193934, 11.9540286929111, 11.5849472177449, - 11.8695269797079, 11.2221940781463, 11.5391494901798, 11.7652998758852, - 11.7152214736869, 11.6161349733777, 11.3455362974154, 11.3697013696593, - 11.6159930311664, 11.5192522836597, 11.3626732407949, 11.7915655615128, - 10.8468085570926, 11.5051760134024, 11.3931245756523, 11.6445146662936, - 11.3470732268861, 11.6515019252136, 11.5141257439709, 11.2773011669151, - 11.3032998105644, 11.7571007839257, 11.3544692125066, 11.5818232930408, - 11.0839805881239, 11.8582789073051, 11.5997729156958, 11.5897058738691, - 11.4193569373722, 11.8678858552685, 11.6051915096343, 11.3371558507094, - 11.3210764775439, 11.3670660935708, 10.9736909230005, 11.5134036283058, - 11.7378869878075, 11.6101540643963, 11.5960760408688, 11.5398373831802, - 11.6921293527264, 11.0056293583308, 11.3779618825627, 11.4358858630188, - 11.3398108548088, 11.500395429923, 11.6290788048495, 11.4534379910937, - 11.3973526125132, 11.8090228812056, 11.4349697688751, 11.4120105561733, - 11.2768023713792, 11.6479180048227, 11.8538348852147, 11.2816551787507, - 11.5483270246353, 11.5002183838825, 11.3020898934751, 11.5115149415805, - 11.2017560031151, 11.352225955946, 11.6826296693967, 11.8553332139932, - 11.9042883574032, 11.0560549115389, 11.1767099828818, 11.421709850191, - 11.702545464272, 11.7485923966285, 11.8047860348248, 11.4448541804893, + 11.6635934627129, 11.3655834538171, 11.8239438136152, 11.4457330597547, + 11.2733838979158, 11.6555694734405, 11.6077458629663, 11.6253179146231, + 11.7565586590195, 11.1887570445131, 11.6730568277929, 11.4120070711133, + 11.6824326010276, 11.3911357792784, 12.0706441525969, 11.2155412831347, + 11.3821410267404, 11.3267141623621, 11.6076784146829, 11.3209976317701, + 11.2959562378299, 11.6786188036454, 11.6046588017454, 11.7499647941354, + 11.4831512412866, 11.8286883023093, 11.7007855177161, 11.6125285414713, + 11.4368552322619, 11.677278735656, 11.2591724516819, 11.2122991922597, + 11.2014592283697, 11.6757643041424, 11.3976039512326, 11.4064992756645, + 11.6084844857244, 11.2659904100175, 11.4887603755147, 11.3465556328527, + 11.6709507658488, 11.4442961944266, 11.6860922015911, 11.3337180713638, + 11.4934336220037, 11.4237641215403, 11.2597374132061, 11.1767350574449, + 11.5249429055911, 11.2922544242571, 11.3860745867636, 11.5766005475934, + 11.2628237130449, 11.6146165920334, 11.4175020113036, 11.3195033621875, + 11.1710952560318, 11.6597792510826, 11.4868152191465, 11.5721318552201, + 11.6486854013223, 11.6404214031175, 11.4738473838758, 11.0370114162703, + 11.5306291118776, 11.7547581342576, 11.1729582778396, 11.5752263994969, + 11.2468730281413, 11.7327251393004, 11.6517053064323, 11.5377269190321, + 11.7274750442181, 11.8998204906137, 11.6746453028613, 11.7144040978644, + 11.3885625929466, 11.4727695225601, 11.5211563372212, 11.8779053238367, + 11.5235380529653, 11.7352073567185, 11.778095222296, 11.5565087399718, + 11.4303811869928, 11.411039568203, 11.7936208857429, 11.2632318149877, + 11.4183636452509, 11.5450923312535, 11.5304172016656, 11.3564668458882, + 11.3097786542072, 11.2559960803643, 11.1900205330239, 11.3179458681654, + 11.5468393692064, 11.6109598609785, 11.4397968689957, 11.5829306616596, + 11.4265533991304, 11.4037107783255, 11.6231069350061, 11.4476147809259, + 11.315857500714, 11.192073498525, 11.1450028934144, 11.4763778673496, + 11.3303593182416, 11.795851315237, 11.3154135776636, 11.504446981381, + 11.3686452517911, 11.0681174567049, 11.9482203553029, 11.4990621721172, + 11.7700827893035, 11.153277291342, 11.4103274908523, 11.362014739247, + 11.3370793845089, 10.9490041292355, 11.5709887438907, 11.2392472207936, + 11.4457697378538, 11.5518564381783, 11.1668497234251, 11.660217248224, + 11.5408481305805, 11.3596525221312, 11.7088443068689, 11.0985982119481, + 11.6344343224953, 11.5835918466228, 11.6707241606893, 11.4873075231587, + 11.6871951877657, 11.3561777270116, 11.0926984591504, 11.6670973459339, + 11.4743776164222, 11.4012126214713, 11.1670799989037, 11.3895862238313, + 11.4619188035051, 11.7438466838695, 11.7789086710159, 11.8254153257148, + 11.5350198406344, 11.614146101765, 11.5037937949341, 11.7594749216344, + 11.7232424558103, 11.4901038034287, 11.457497322123, 11.4701475688988, + 11.3495747129771, 11.4768364004515, 11.3536264552173, 11.6967872920671, + 11.5958239935742, 11.8102460795176, 11.5285720139981, 11.5636360422529, + 11.2391302305836, 11.6400828524342, 11.3649992872627, 11.7739800561355, + 11.9514605248261, 11.8948860243831, 11.3298148207664, 11.3913235205135, + 11.2842354326543, 11.5345139189297, 11.0970243900149, 11.7031563986728, + 11.6634306349493, 11.9092830544344, 11.5869287303179, 11.7564461328616, + 11.150172788247, 11.4822541140239, 11.4044323999418, 11.7430862177697, + 11.4674029907269, 11.6087102680844, 11.0224410790094, 11.1429072494759, + 11.1440714332214, 11.4429296944542, 11.5110545367456, 11.6902834560434, + 11.975232188303, 11.3484533650323, 11.5902139993436, 11.6936184805547, + 11.2156665797036, 11.5367845942098, 11.457685987964, 11.326091672857, + 11.54310696694, 11.6318253757251, 11.4672564829417, 11.2753353731344, + 11.5442624404976, 11.4998938095082, 11.7680718084146, 11.4432553497958, + 11.7656381805778, 11.6559051931419, 11.2711880476245, 11.6412415650511, + 11.5685922662603, 11.5506412075912, 11.3513987873333, 11.3315276655562, + 11.335640654208, 11.681285272101, 11.5589662365603, 11.1828140877568, + 11.5312581724757, 11.5432002402202, 11.7912888955701, 11.4905985999693, + 11.1259591802745, 11.4610350884183, 11.7991160364597, 11.579099060573, + 11.33449302326, 11.2554336598017, 11.4512378707303, 11.7226621454134, + 11.3527354290433, 11.6705425125658, 11.5563556191945, 11.7308586023113, + 11.9851397182973, 11.075885463439, 11.2080718893369, 11.4368799211954, + 11.5632546318052, 11.6634278624019, 11.318215841977, 11.4880779444713, + 11.6701760414542, 11.7900454830006, 11.4305509189927, 11.4005711273461, + 11.493397563551, 11.3671831886506, 11.5455573847742, 11.455219607115, + 11.3765307074504, 11.5322198186407, 11.7234429342707, 11.4913195141207, + 11.5800460407405, 11.5015183797711, 11.600345452303, 11.671105482069, + 11.9009180552352, 11.3047838103508, 11.243053789483, 11.3132995190247, + 11.1839945545923, 11.5467528309238, 11.4624123336534, 11.4384084755489, + 11.7624832869299, 11.4972069873588, 11.6718416090489, 11.5565193860913, + 11.6854937630156, 11.486887701755, 11.2245408284927, 11.4223163757767, + 11.6183353030888, 11.4781731819334, 11.4180676231011, 11.5222391679401, + 10.9874586119541, 11.6315015151944, 11.6259231476061, 11.5246942987034, + 11.3790143669854, 11.6091093097247, 11.8458505048798, 11.3956132241971, + 11.4334989846648, 12.0107090576645, 11.58889471641, 11.8485588211996, + 11.6912962865302, 11.3443567873428, 11.4889742885729, 11.7353556032995, + 11.3458181845925, 11.5360487979571, 11.572996307097, 11.3900889967152, + 11.3871286159282, 11.6394988106606, 11.6672892268697, 11.2499719224047, + 11.4355438444653, 11.4146461074679, 11.5830061909034, 11.356416701344, + 11.5194114268155, 11.4461730977868, 11.7555819598489, 11.757108193106, + 11.6621065583231, 11.838582610051, 11.7632074437835, 11.3465420858875, + 11.5844207003211, 11.1705821018384, 11.4142931889118, 11.6952187675352, + 11.5853093436653, 11.3754738036731, 11.4897478077412, 11.6808486866119, + 11.7782359379539, 11.4098989033173, 11.5147654815493, 11.9203595355564, + 11.7863398442806, 11.6085439373772, 11.3748020550406, 11.5107499518156, + 11.4459430122029, 11.8864880814917, 11.3910504966753, 11.7608068035471, + 11.2010926856702, 11.2525270439525, 11.6862467158833, 11.732921172069, + 11.2587015436406, 11.9648080240531, 11.2853204109666, 11.5145507471921, + 11.4761721195894, 11.3591745195689, 11.6041308327816, 11.8698306010401, + 11.6899433491951, 11.3939731110365, 11.5342338112757, 11.7752406163456, + 11.435729513263, 11.3188712646992, 11.3365988682073, 11.6485204521932, + 11.480686518043, 11.2799874465089, 11.4116754417375, 11.4545426647885, + 11.5745481350434, 11.1966656568524, 11.6975132142541, 11.6431448445814, + 11.2517604231283, 11.1486491517404, 11.6991734787903, 11.2241659658642, + 11.4952691898267, 11.5740123918133, 11.3536512948081, 11.5378236053867, + 11.5105640641999, 11.8221701602153, 11.2923902515628, 11.53180649897, + 11.3691594548817, 11.6175646316642, 11.4053269282246, 11.234768393995, + 11.641542054491, 11.7999676522794, 11.5257062424203, 11.5059110405551, + 11.6617696764003, 11.3226243854653, 11.4880248762229, 11.7337176970954, + 11.2155495826891, 11.6517450661497, 11.6021018262328, 11.3877604077526, + 11.639890502846, 11.7809973315967, 11.3515596489177, 11.3761078301294, + 11.4971577458201, 11.7264688656258, 11.4937265193511, 12.0486431731611, + 11.4285135930375, 11.5266970229313, 11.6897298607594, 11.1325756698399, + 11.3610403083483, 11.271158595137, 11.5987031218919, 11.2413020872383, + 11.6922042998872, 11.0622291689558, 11.0493045662671, 11.7886726028345, + 11.356875041002, 11.222682110044, 11.1729481428879, 12.050179976782, + 11.3691912771854, 11.1729814065191, 11.6134550080208, 11.3668928620368, + 11.2789813760573, 11.858752849499, 11.1277127982319, 11.2254664041385, + 11.6425437286932, 11.5189911033846, 11.72792415931, 11.3460373137601, + 11.4266246813696, 11.6145883108721, 11.4040865639135, 10.9397029690441, + 11.9355220072695, 11.5659683736315, 11.2595351388416, 11.7264552315149, + 11.4250232833136, 11.8505002503181, 11.6736025315652, 11.6358341743864, + 11.4848620300854, 11.0658566253791, 11.7433762718265, 11.368863939374, + 12.0430882282277, 11.1478992722267, 11.6529116138211, 11.4386231562301, + 11.4699978508074, 11.3949217618572, 11.4546511662623, 11.6224432553423, + 11.4421481785793, 11.657180874398, 12.8288174569032, 11.6252568763014, + 11.491598965489, 11.5122204443171, 11.1946277176765, 11.3371665039755, + 11.8219395858959, 11.4177551579925, 11.817401786082, 10.9066865497524, + 11.6292423316714, 11.4345661115386, 11.5146335760661, 11.2164818600078, + 11.6462007756576, 11.5594553161589, 11.2777294045852, 11.4064561143383, + 11.403296101097, 11.1942695626537, 11.2069796841188, 11.5108806250445, + 11.4903700781168, 11.4412637072806, 11.7367046978334, 11.4415759938265, + 11.461789360977, 11.5025221397458, 11.6741375647481, 11.6318730203337, + 11.8724788742072, 11.3411139466139, 11.193895333642, 11.5090212617708, + 11.4766156814582, 11.3025257977669, 11.6887687898236, 11.9785619762261, + 11.5832745795798, 11.5638848196105, 11.6373626595557, 11.5346618451343, + 11.8053599896049, 11.7866836352087, 11.6656448470497, 11.6767793846651, + 11.4386961150224, 11.6601979255714, 11.6835301301195, 11.1916085178821, + 11.3638143635823, 11.5384570024637, 11.5021355520758, 11.728807679399, + 10.984378479658, 11.7213214603164, 10.7461781085464, 11.3870533808756, + 11.6264922619532, 11.5206029097705, 11.3075447476347, 11.5292525213332, + 11.4474539160496, 11.1784758708234, 11.3896979535097, 11.719541623793, + 11.6053073443453, 11.518232072859, 11.3712640382737, 11.6098940705145, + 11.5382560364661, 11.7993666879693, 11.6324840910319, 11.4481893420571, + 11.541204261907, 11.5773112599797, 11.5737901104302, 11.4341925128839, + 11.4793732048958, 11.6786469969964, 11.779820125404, 11.531459246292, + 11.2534419833243, 11.5242285802331, 11.7505344377909, 11.2561748020822, + 11.4661314501832, 11.4760530705387, 11.4506126062349, 11.3963732165445, + 11.4312630670097, 11.3557616131191, 11.5823565060607, 11.5363888326256, + 11.4917903826409, 11.5703392588785, 11.4208903235975, 11.3264983504393, + 11.4339118777607, 11.6207177601068, 12.0732854180863, 11.3485270565549, + 11.7214183450559, 11.3500282028636, 11.2190693389911, 11.2069248306124, + 11.6847250769785, 11.7484631837051, 11.3928718561409, 11.0483431329695, + 11.0632555553734, 11.3484711276532, 11.3540665678888, 11.424901501236, + 11.3772438391331, 11.3402755457535, 11.6658488666932, 11.801777190057, + 11.2024789759482, 11.2178942545725, 11.4553053426658, 11.7871905188347, + 11.4981479663863, 11.327302970811, 11.4159310930165, 11.5560442202663, + 11.7365037432332, 11.3378278539107, 11.8208625963249, 11.6497566272874, + 11.5075152494812, 11.5215250880463, 11.2812669600297, 11.310753285262, + 11.9620678652502, 11.3590587863734, 11.3898381131715, 11.2529331118846, + 11.2362185790092, 11.385351174977, 11.5744685353361, 11.4856804686762, + 11.913912055332, 11.3767849155427, 11.8094735607357, 11.1508024267808, + 11.8106804361006, 11.5470001967063, 11.3952593838908, 11.2484965135934, + 11.1152705518813, 11.5389406080853, 11.7634503537939, 11.4291028317061, + 11.3276572999105, 11.4930118360099, 11.5469649014856, 11.5169350020809, + 11.3285353226113, 11.2780234904709, 11.440289000834, 11.220111220716, + 11.6368461254189, 11.3373985461442, 11.5729909942026, 11.5627913514537, + 11.896010438462, 12.1378927192053, 11.2661668881932, 11.6500397905937, + 11.9456515880464, 11.6036046289927, 11.2617034688574, 11.2041718173304, + 11.7846555949065, 11.7468241221256, 11.5711643637382, 11.4605756512852, + 11.6855846792033, 11.610560314245, 11.4023298726094, 11.5935010737646, + 11.4794267316669, 11.4177936724899, 11.3170444087192, 11.4297981291346, + 11.5846912793348, 11.5361273182454, 11.2836990730896, 11.7129292407643, + 11.3682617291422, 11.5788574326573, 11.3656467657476, 11.4105589568224, + 11.6329782469737, 11.7741760320124, 11.5877677859266, 11.4614478490663, + 11.8922989610443, 11.4769174598707, 11.5473094994925, 11.8164122469798, + 11.3965297469094, 11.7060351811225, 11.9160697996983, 12.2091231955421, + 11.4513840897352, 11.9190686799799, 11.5716373917844, 11.4552839479779, + 11.2069385588086, 11.2352938786398, 11.4799962344234, 11.1715703387231, + 11.5951806551894, 11.4965967805174, 11.9066684684352, 12.085620305792, + 11.6762460737526, 11.5003622406498, 11.2467259944484, 11.3576209222196, + 11.5538967776043, 11.6021728438367, 11.4017677191272, 11.6541203471886, + 11.5179908661979, 11.3731766103249, 11.284667844589, 11.277379710151, + 11.6083662721441, 11.4137354186957, 10.8955839097348, 11.6128481523168, + 10.9414889550394, 11.500934449099, 11.4032494506259, 11.3414275766532, + 11.6103518032939, 11.4489716827269, 11.4521528606091, 11.4586955357924, + 11.0442737725854, 11.4024077316865, 11.4530826810189, 11.2142229985889, + 11.3211367494156, 11.7695143207915, 11.6801094326193, 11.378714542138, + 11.5894285425463, 11.4535592112896, 11.5189077909302, 11.905529468508, + 11.7308595111171, 11.1561241580823, 11.5396607072055, 11.5670558138667, + 11.5866534877845, 11.4899696625367, 10.7606650890848, 11.4623034225546, + 11.4829861663367, 11.531027241558, 11.1284027924671, 11.3789406141285, + 11.7180842406464, 11.248060386135, 11.8557680503442, 11.4749711791423, + 11.7731267020686, 11.4451020052469, 11.5536039362763, 11.2295030702308, + 11.4439680242462, 11.3599366494965, 11.2375779084626, 11.4027090068517, + 11.4674002049422, 11.6107908879673, 11.3646653036025, 11.3525677125419, + 11.6956920927681, 11.5949761789213, 11.4279470409673, 11.628194983154, + 11.3797989564061, 11.4537211190876, 11.544720822699, 11.3477447726164, + 11.5106910979557, 11.2705155562627, 11.5419354593303, 11.6002427009366, + 11.3617284216845, 11.4545380023049, 11.5559785868196, 11.2827575037312, + 11.4923949055435, 11.4670902548463, 11.7775808724294, 11.7524650925602, + 11.5232395955812, 11.7716348213617, 11.3129441491383, 11.9184159519933, + 11.4651302298193, 11.4828115364529, 11.4921553448102, 11.4840394509425, + 11.4795329119155, 11.3557617727837, 11.1990802135024, 11.555895890632, + 11.5665334157256, 11.9608405697218, 11.0906137231452, 11.4738335300962, + 11.5552267798845, 11.4917532448646, 11.4767501205378, 11.309257136722, + 11.8330397760739, 11.2452007264035, 11.5626653665188, 11.6615348431299, + 11.4036383205713, 11.9206466284402, 11.4028117349485, 11.232335830704, + 11.5710019223606, 11.2323436049941, 11.0986236955492, 11.7618238628064, + 11.3445348352561, 11.378093136043, 11.5381912190455, 11.282570495449, + 11.3186759511659, 11.4117838917907, 11.6227635225452, 11.7844213221872, + 11.5671587969278, 11.458922182513, 11.4032992701995, 11.5491884538217, + 11.2758671228542, 11.6770897492982, 11.6342313067151, 11.1237574188463, + 11.6031081273673, 12.1290653063871, 11.4778345922648, 11.3583463804655, + 11.3266052031506, 11.7246123353123, 11.4647737955044, 11.5883332972292, + 11.4248310030985, 11.3713918308266, 11.2041509548359, 11.617616628905, + 11.3759381668148, 11.3305920225639, 11.6871369457011, 11.6303021419011, + 11.4931674583361, 11.0922966074434, 11.2490842937364, 10.9403583083204, + 11.1716989237958, 11.4292855836507, 11.6236233194597, 11.5989208423244, + 11.2147889962406, 11.625607143598, 11.8748838328963, 11.5414934062674, + 11.6259439615824, 11.3364532857374, 11.8227344400673, 11.7111666222959, + 11.3727104334305, 11.7078155455392, 11.5544569070194, 11.6021540153749, + 11.573369065866, 10.8581859655439, 11.6615357936139, 11.6074293122824, + 11.3800328287919, 11.8608121046055, 10.8695335671074, 11.4549460213617, + 11.6732793086444, 11.6280582434249, 11.7938110746401, 11.2759355094693, + 11.7333174374389, 11.5124908292672, 11.5116966042338, 11.2557414497685, + 11.111003192477, 11.7723687553069, 11.5311536361956, 11.415675250247, + 11.434958888026, 11.5764304335137, 11.3184428704269, 11.5925005193847, + 11.6606221243124, 11.6799864503813, 11.6680624812246, 11.6323392171622, + 11.6205668223306, 11.2743893579799, 11.3038169041637, 11.2516179608122, + 11.0913550278671, 11.5183036046645, 11.6088540037091, 11.4237385957101, + 11.7411183714493, 11.5268255736499, 11.5514313428383, 11.4939244996735, + 11.478671143305, 11.5506137782508, 11.4838342763386, 11.9082590797765, + 10.960554474782, 11.4510734836701, 11.594720494906, 11.6435287600618, + 11.4730994130636, 11.6753147493462, 11.0704918909154, 11.3363906264414, + 11.4069381361204, 11.3390189388972, 11.7394581174949, 11.5025933598415, + 11.5091568374427, 11.8189657846627, 11.6762535202989, 11.4862855869735, + 11.5191142470272, 11.4087780398663, 11.5361396738411, 11.3477626341929, + 11.3295447034612, 11.6461819581215, 11.3160562372171, 11.9732839905477, + 11.2597545419879, 11.6483236285684, 11.6659329899876, 11.3375985127992, + 11.5652927769658, 11.5402126667346, 11.5246347656743, 11.3790534415256, + 11.3504467491437, 11.9006774473653, 11.2998434728114, 11.294215001317, + 11.0352592725904, 11.5442750193934, 11.9540286929111, 11.5849472177449, + 11.8695269797079, 11.2221940781463, 11.5391494901798, 11.7652998758852, + 11.7152214736869, 11.6161349733777, 11.3455362974154, 11.3697013696593, + 11.6159930311664, 11.5192522836597, 11.3626732407949, 11.7915655615128, + 10.8468085570926, 11.5051760134024, 11.3931245756523, 11.6445146662936, + 11.3470732268861, 11.6515019252136, 11.5141257439709, 11.2773011669151, + 11.3032998105644, 11.7571007839257, 11.3544692125066, 11.5818232930408, + 11.0839805881239, 11.8582789073051, 11.5997729156958, 11.5897058738691, + 11.4193569373722, 11.8678858552685, 11.6051915096343, 11.3371558507094, + 11.3210764775439, 11.3670660935708, 10.9736909230005, 11.5134036283058, + 11.7378869878075, 11.6101540643963, 11.5960760408688, 11.5398373831802, + 11.6921293527264, 11.0056293583308, 11.3779618825627, 11.4358858630188, + 11.3398108548088, 11.500395429923, 11.6290788048495, 11.4534379910937, + 11.3973526125132, 11.8090228812056, 11.4349697688751, 11.4120105561733, + 11.2768023713792, 11.6479180048227, 11.8538348852147, 11.2816551787507, + 11.5483270246353, 11.5002183838825, 11.3020898934751, 11.5115149415805, + 11.2017560031151, 11.352225955946, 11.6826296693967, 11.8553332139932, + 11.9042883574032, 11.0560549115389, 11.1767099828818, 11.421709850191, + 11.702545464272, 11.7485923966285, 11.8047860348248, 11.4448541804893, 11.4705435703147, 11.716935272144, 10.9954029806633, 11.1256601239288 )) - fit <- ssd_fit_dists(data = data, dists = 'lnorm_lnorm', at_boundary_ok=TRUE, - min_pmix = 0) + fit <- ssd_fit_dists( + data = data, dists = "lnorm_lnorm", at_boundary_ok = TRUE, + min_pmix = 0 + ) tidy <- tidy(fit) expect_snapshot_data(tidy, "tidy_lnorm_lnorm_uni1000", digits = 3) }) @@ -888,261 +907,261 @@ test_that("lnorm_lnorm non-bimodal 1000 data", { test_that("lnorm_lnorm non-bimodal 1000 data", { skip_on_ci() skip_on_cran() - + data <- data.frame(Conc = c( - 11.6635934627129, 11.3655834538171, 11.8239438136152, 11.4457330597547, - 11.2733838979158, 11.6555694734405, 11.6077458629663, 11.6253179146231, - 11.7565586590195, 11.1887570445131, 11.6730568277929, 11.4120070711133, - 11.6824326010276, 11.3911357792784, 12.0706441525969, 11.2155412831347, - 11.3821410267404, 11.3267141623621, 11.6076784146829, 11.3209976317701, - 11.2959562378299, 11.6786188036454, 11.6046588017454, 11.7499647941354, - 11.4831512412866, 11.8286883023093, 11.7007855177161, 11.6125285414713, - 11.4368552322619, 11.677278735656, 11.2591724516819, 11.2122991922597, - 11.2014592283697, 11.6757643041424, 11.3976039512326, 11.4064992756645, - 11.6084844857244, 11.2659904100175, 11.4887603755147, 11.3465556328527, - 11.6709507658488, 11.4442961944266, 11.6860922015911, 11.3337180713638, - 11.4934336220037, 11.4237641215403, 11.2597374132061, 11.1767350574449, - 11.5249429055911, 11.2922544242571, 11.3860745867636, 11.5766005475934, - 11.2628237130449, 11.6146165920334, 11.4175020113036, 11.3195033621875, - 11.1710952560318, 11.6597792510826, 11.4868152191465, 11.5721318552201, - 11.6486854013223, 11.6404214031175, 11.4738473838758, 11.0370114162703, - 11.5306291118776, 11.7547581342576, 11.1729582778396, 11.5752263994969, - 11.2468730281413, 11.7327251393004, 11.6517053064323, 11.5377269190321, - 11.7274750442181, 11.8998204906137, 11.6746453028613, 11.7144040978644, - 11.3885625929466, 11.4727695225601, 11.5211563372212, 11.8779053238367, - 11.5235380529653, 11.7352073567185, 11.778095222296, 11.5565087399718, - 11.4303811869928, 11.411039568203, 11.7936208857429, 11.2632318149877, - 11.4183636452509, 11.5450923312535, 11.5304172016656, 11.3564668458882, - 11.3097786542072, 11.2559960803643, 11.1900205330239, 11.3179458681654, - 11.5468393692064, 11.6109598609785, 11.4397968689957, 11.5829306616596, - 11.4265533991304, 11.4037107783255, 11.6231069350061, 11.4476147809259, - 11.315857500714, 11.192073498525, 11.1450028934144, 11.4763778673496, - 11.3303593182416, 11.795851315237, 11.3154135776636, 11.504446981381, - 11.3686452517911, 11.0681174567049, 11.9482203553029, 11.4990621721172, - 11.7700827893035, 11.153277291342, 11.4103274908523, 11.362014739247, - 11.3370793845089, 10.9490041292355, 11.5709887438907, 11.2392472207936, - 11.4457697378538, 11.5518564381783, 11.1668497234251, 11.660217248224, - 11.5408481305805, 11.3596525221312, 11.7088443068689, 11.0985982119481, - 11.6344343224953, 11.5835918466228, 11.6707241606893, 11.4873075231587, - 11.6871951877657, 11.3561777270116, 11.0926984591504, 11.6670973459339, - 11.4743776164222, 11.4012126214713, 11.1670799989037, 11.3895862238313, - 11.4619188035051, 11.7438466838695, 11.7789086710159, 11.8254153257148, - 11.5350198406344, 11.614146101765, 11.5037937949341, 11.7594749216344, - 11.7232424558103, 11.4901038034287, 11.457497322123, 11.4701475688988, - 11.3495747129771, 11.4768364004515, 11.3536264552173, 11.6967872920671, - 11.5958239935742, 11.8102460795176, 11.5285720139981, 11.5636360422529, - 11.2391302305836, 11.6400828524342, 11.3649992872627, 11.7739800561355, - 11.9514605248261, 11.8948860243831, 11.3298148207664, 11.3913235205135, - 11.2842354326543, 11.5345139189297, 11.0970243900149, 11.7031563986728, - 11.6634306349493, 11.9092830544344, 11.5869287303179, 11.7564461328616, - 11.150172788247, 11.4822541140239, 11.4044323999418, 11.7430862177697, - 11.4674029907269, 11.6087102680844, 11.0224410790094, 11.1429072494759, - 11.1440714332214, 11.4429296944542, 11.5110545367456, 11.6902834560434, - 11.975232188303, 11.3484533650323, 11.5902139993436, 11.6936184805547, - 11.2156665797036, 11.5367845942098, 11.457685987964, 11.326091672857, - 11.54310696694, 11.6318253757251, 11.4672564829417, 11.2753353731344, - 11.5442624404976, 11.4998938095082, 11.7680718084146, 11.4432553497958, - 11.7656381805778, 11.6559051931419, 11.2711880476245, 11.6412415650511, - 11.5685922662603, 11.5506412075912, 11.3513987873333, 11.3315276655562, - 11.335640654208, 11.681285272101, 11.5589662365603, 11.1828140877568, - 11.5312581724757, 11.5432002402202, 11.7912888955701, 11.4905985999693, - 11.1259591802745, 11.4610350884183, 11.7991160364597, 11.579099060573, - 11.33449302326, 11.2554336598017, 11.4512378707303, 11.7226621454134, - 11.3527354290433, 11.6705425125658, 11.5563556191945, 11.7308586023113, - 11.9851397182973, 11.075885463439, 11.2080718893369, 11.4368799211954, - 11.5632546318052, 11.6634278624019, 11.318215841977, 11.4880779444713, - 11.6701760414542, 11.7900454830006, 11.4305509189927, 11.4005711273461, - 11.493397563551, 11.3671831886506, 11.5455573847742, 11.455219607115, - 11.3765307074504, 11.5322198186407, 11.7234429342707, 11.4913195141207, - 11.5800460407405, 11.5015183797711, 11.600345452303, 11.671105482069, - 11.9009180552352, 11.3047838103508, 11.243053789483, 11.3132995190247, - 11.1839945545923, 11.5467528309238, 11.4624123336534, 11.4384084755489, - 11.7624832869299, 11.4972069873588, 11.6718416090489, 11.5565193860913, - 11.6854937630156, 11.486887701755, 11.2245408284927, 11.4223163757767, - 11.6183353030888, 11.4781731819334, 11.4180676231011, 11.5222391679401, - 10.9874586119541, 11.6315015151944, 11.6259231476061, 11.5246942987034, - 11.3790143669854, 11.6091093097247, 11.8458505048798, 11.3956132241971, - 11.4334989846648, 12.0107090576645, 11.58889471641, 11.8485588211996, - 11.6912962865302, 11.3443567873428, 11.4889742885729, 11.7353556032995, - 11.3458181845925, 11.5360487979571, 11.572996307097, 11.3900889967152, - 11.3871286159282, 11.6394988106606, 11.6672892268697, 11.2499719224047, - 11.4355438444653, 11.4146461074679, 11.5830061909034, 11.356416701344, - 11.5194114268155, 11.4461730977868, 11.7555819598489, 11.757108193106, - 11.6621065583231, 11.838582610051, 11.7632074437835, 11.3465420858875, - 11.5844207003211, 11.1705821018384, 11.4142931889118, 11.6952187675352, - 11.5853093436653, 11.3754738036731, 11.4897478077412, 11.6808486866119, - 11.7782359379539, 11.4098989033173, 11.5147654815493, 11.9203595355564, - 11.7863398442806, 11.6085439373772, 11.3748020550406, 11.5107499518156, - 11.4459430122029, 11.8864880814917, 11.3910504966753, 11.7608068035471, - 11.2010926856702, 11.2525270439525, 11.6862467158833, 11.732921172069, - 11.2587015436406, 11.9648080240531, 11.2853204109666, 11.5145507471921, - 11.4761721195894, 11.3591745195689, 11.6041308327816, 11.8698306010401, - 11.6899433491951, 11.3939731110365, 11.5342338112757, 11.7752406163456, - 11.435729513263, 11.3188712646992, 11.3365988682073, 11.6485204521932, - 11.480686518043, 11.2799874465089, 11.4116754417375, 11.4545426647885, - 11.5745481350434, 11.1966656568524, 11.6975132142541, 11.6431448445814, - 11.2517604231283, 11.1486491517404, 11.6991734787903, 11.2241659658642, - 11.4952691898267, 11.5740123918133, 11.3536512948081, 11.5378236053867, - 11.5105640641999, 11.8221701602153, 11.2923902515628, 11.53180649897, - 11.3691594548817, 11.6175646316642, 11.4053269282246, 11.234768393995, - 11.641542054491, 11.7999676522794, 11.5257062424203, 11.5059110405551, - 11.6617696764003, 11.3226243854653, 11.4880248762229, 11.7337176970954, - 11.2155495826891, 11.6517450661497, 11.6021018262328, 11.3877604077526, - 11.639890502846, 11.7809973315967, 11.3515596489177, 11.3761078301294, - 11.4971577458201, 11.7264688656258, 11.4937265193511, 12.0486431731611, - 11.4285135930375, 11.5266970229313, 11.6897298607594, 11.1325756698399, - 11.3610403083483, 11.271158595137, 11.5987031218919, 11.2413020872383, - 11.6922042998872, 11.0622291689558, 11.0493045662671, 11.7886726028345, - 11.356875041002, 11.222682110044, 11.1729481428879, 12.050179976782, - 11.3691912771854, 11.1729814065191, 11.6134550080208, 11.3668928620368, - 11.2789813760573, 11.858752849499, 11.1277127982319, 11.2254664041385, - 11.6425437286932, 11.5189911033846, 11.72792415931, 11.3460373137601, - 11.4266246813696, 11.6145883108721, 11.4040865639135, 10.9397029690441, - 11.9355220072695, 11.5659683736315, 11.2595351388416, 11.7264552315149, - 11.4250232833136, 11.8505002503181, 11.6736025315652, 11.6358341743864, - 11.4848620300854, 11.0658566253791, 11.7433762718265, 11.368863939374, - 12.0430882282277, 11.1478992722267, 11.6529116138211, 11.4386231562301, - 11.4699978508074, 11.3949217618572, 11.4546511662623, 11.6224432553423, - 11.4421481785793, 11.657180874398, 12.8288174569032, 11.6252568763014, - 11.491598965489, 11.5122204443171, 11.1946277176765, 11.3371665039755, - 11.8219395858959, 11.4177551579925, 11.817401786082, 10.9066865497524, - 11.6292423316714, 11.4345661115386, 11.5146335760661, 11.2164818600078, - 11.6462007756576, 11.5594553161589, 11.2777294045852, 11.4064561143383, - 11.403296101097, 11.1942695626537, 11.2069796841188, 11.5108806250445, - 11.4903700781168, 11.4412637072806, 11.7367046978334, 11.4415759938265, - 11.461789360977, 11.5025221397458, 11.6741375647481, 11.6318730203337, - 11.8724788742072, 11.3411139466139, 11.193895333642, 11.5090212617708, - 11.4766156814582, 11.3025257977669, 11.6887687898236, 11.9785619762261, - 11.5832745795798, 11.5638848196105, 11.6373626595557, 11.5346618451343, - 11.8053599896049, 11.7866836352087, 11.6656448470497, 11.6767793846651, - 11.4386961150224, 11.6601979255714, 11.6835301301195, 11.1916085178821, - 11.3638143635823, 11.5384570024637, 11.5021355520758, 11.728807679399, - 10.984378479658, 11.7213214603164, 10.7461781085464, 11.3870533808756, - 11.6264922619532, 11.5206029097705, 11.3075447476347, 11.5292525213332, - 11.4474539160496, 11.1784758708234, 11.3896979535097, 11.719541623793, - 11.6053073443453, 11.518232072859, 11.3712640382737, 11.6098940705145, - 11.5382560364661, 11.7993666879693, 11.6324840910319, 11.4481893420571, - 11.541204261907, 11.5773112599797, 11.5737901104302, 11.4341925128839, - 11.4793732048958, 11.6786469969964, 11.779820125404, 11.531459246292, - 11.2534419833243, 11.5242285802331, 11.7505344377909, 11.2561748020822, - 11.4661314501832, 11.4760530705387, 11.4506126062349, 11.3963732165445, - 11.4312630670097, 11.3557616131191, 11.5823565060607, 11.5363888326256, - 11.4917903826409, 11.5703392588785, 11.4208903235975, 11.3264983504393, - 11.4339118777607, 11.6207177601068, 12.0732854180863, 11.3485270565549, - 11.7214183450559, 11.3500282028636, 11.2190693389911, 11.2069248306124, - 11.6847250769785, 11.7484631837051, 11.3928718561409, 11.0483431329695, - 11.0632555553734, 11.3484711276532, 11.3540665678888, 11.424901501236, - 11.3772438391331, 11.3402755457535, 11.6658488666932, 11.801777190057, - 11.2024789759482, 11.2178942545725, 11.4553053426658, 11.7871905188347, - 11.4981479663863, 11.327302970811, 11.4159310930165, 11.5560442202663, - 11.7365037432332, 11.3378278539107, 11.8208625963249, 11.6497566272874, - 11.5075152494812, 11.5215250880463, 11.2812669600297, 11.310753285262, - 11.9620678652502, 11.3590587863734, 11.3898381131715, 11.2529331118846, - 11.2362185790092, 11.385351174977, 11.5744685353361, 11.4856804686762, - 11.913912055332, 11.3767849155427, 11.8094735607357, 11.1508024267808, - 11.8106804361006, 11.5470001967063, 11.3952593838908, 11.2484965135934, - 11.1152705518813, 11.5389406080853, 11.7634503537939, 11.4291028317061, - 11.3276572999105, 11.4930118360099, 11.5469649014856, 11.5169350020809, - 11.3285353226113, 11.2780234904709, 11.440289000834, 11.220111220716, - 11.6368461254189, 11.3373985461442, 11.5729909942026, 11.5627913514537, - 11.896010438462, 12.1378927192053, 11.2661668881932, 11.6500397905937, - 11.9456515880464, 11.6036046289927, 11.2617034688574, 11.2041718173304, - 11.7846555949065, 11.7468241221256, 11.5711643637382, 11.4605756512852, - 11.6855846792033, 11.610560314245, 11.4023298726094, 11.5935010737646, - 11.4794267316669, 11.4177936724899, 11.3170444087192, 11.4297981291346, - 11.5846912793348, 11.5361273182454, 11.2836990730896, 11.7129292407643, - 11.3682617291422, 11.5788574326573, 11.3656467657476, 11.4105589568224, - 11.6329782469737, 11.7741760320124, 11.5877677859266, 11.4614478490663, - 11.8922989610443, 11.4769174598707, 11.5473094994925, 11.8164122469798, - 11.3965297469094, 11.7060351811225, 11.9160697996983, 12.2091231955421, - 11.4513840897352, 11.9190686799799, 11.5716373917844, 11.4552839479779, - 11.2069385588086, 11.2352938786398, 11.4799962344234, 11.1715703387231, - 11.5951806551894, 11.4965967805174, 11.9066684684352, 12.085620305792, - 11.6762460737526, 11.5003622406498, 11.2467259944484, 11.3576209222196, - 11.5538967776043, 11.6021728438367, 11.4017677191272, 11.6541203471886, - 11.5179908661979, 11.3731766103249, 11.284667844589, 11.277379710151, - 11.6083662721441, 11.4137354186957, 10.8955839097348, 11.6128481523168, - 10.9414889550394, 11.500934449099, 11.4032494506259, 11.3414275766532, - 11.6103518032939, 11.4489716827269, 11.4521528606091, 11.4586955357924, - 11.0442737725854, 11.4024077316865, 11.4530826810189, 11.2142229985889, - 11.3211367494156, 11.7695143207915, 11.6801094326193, 11.378714542138, - 11.5894285425463, 11.4535592112896, 11.5189077909302, 11.905529468508, - 11.7308595111171, 11.1561241580823, 11.5396607072055, 11.5670558138667, - 11.5866534877845, 11.4899696625367, 10.7606650890848, 11.4623034225546, - 11.4829861663367, 11.531027241558, 11.1284027924671, 11.3789406141285, - 11.7180842406464, 11.248060386135, 11.8557680503442, 11.4749711791423, - 11.7731267020686, 11.4451020052469, 11.5536039362763, 11.2295030702308, - 11.4439680242462, 11.3599366494965, 11.2375779084626, 11.4027090068517, - 11.4674002049422, 11.6107908879673, 11.3646653036025, 11.3525677125419, - 11.6956920927681, 11.5949761789213, 11.4279470409673, 11.628194983154, - 11.3797989564061, 11.4537211190876, 11.544720822699, 11.3477447726164, - 11.5106910979557, 11.2705155562627, 11.5419354593303, 11.6002427009366, - 11.3617284216845, 11.4545380023049, 11.5559785868196, 11.2827575037312, - 11.4923949055435, 11.4670902548463, 11.7775808724294, 11.7524650925602, - 11.5232395955812, 11.7716348213617, 11.3129441491383, 11.9184159519933, - 11.4651302298193, 11.4828115364529, 11.4921553448102, 11.4840394509425, - 11.4795329119155, 11.3557617727837, 11.1990802135024, 11.555895890632, - 11.5665334157256, 11.9608405697218, 11.0906137231452, 11.4738335300962, - 11.5552267798845, 11.4917532448646, 11.4767501205378, 11.309257136722, - 11.8330397760739, 11.2452007264035, 11.5626653665188, 11.6615348431299, - 11.4036383205713, 11.9206466284402, 11.4028117349485, 11.232335830704, - 11.5710019223606, 11.2323436049941, 11.0986236955492, 11.7618238628064, - 11.3445348352561, 11.378093136043, 11.5381912190455, 11.282570495449, - 11.3186759511659, 11.4117838917907, 11.6227635225452, 11.7844213221872, - 11.5671587969278, 11.458922182513, 11.4032992701995, 11.5491884538217, - 11.2758671228542, 11.6770897492982, 11.6342313067151, 11.1237574188463, - 11.6031081273673, 12.1290653063871, 11.4778345922648, 11.3583463804655, - 11.3266052031506, 11.7246123353123, 11.4647737955044, 11.5883332972292, - 11.4248310030985, 11.3713918308266, 11.2041509548359, 11.617616628905, - 11.3759381668148, 11.3305920225639, 11.6871369457011, 11.6303021419011, - 11.4931674583361, 11.0922966074434, 11.2490842937364, 10.9403583083204, - 11.1716989237958, 11.4292855836507, 11.6236233194597, 11.5989208423244, - 11.2147889962406, 11.625607143598, 11.8748838328963, 11.5414934062674, - 11.6259439615824, 11.3364532857374, 11.8227344400673, 11.7111666222959, - 11.3727104334305, 11.7078155455392, 11.5544569070194, 11.6021540153749, - 11.573369065866, 10.8581859655439, 11.6615357936139, 11.6074293122824, - 11.3800328287919, 11.8608121046055, 10.8695335671074, 11.4549460213617, - 11.6732793086444, 11.6280582434249, 11.7938110746401, 11.2759355094693, - 11.7333174374389, 11.5124908292672, 11.5116966042338, 11.2557414497685, - 11.111003192477, 11.7723687553069, 11.5311536361956, 11.415675250247, - 11.434958888026, 11.5764304335137, 11.3184428704269, 11.5925005193847, - 11.6606221243124, 11.6799864503813, 11.6680624812246, 11.6323392171622, - 11.6205668223306, 11.2743893579799, 11.3038169041637, 11.2516179608122, - 11.0913550278671, 11.5183036046645, 11.6088540037091, 11.4237385957101, - 11.7411183714493, 11.5268255736499, 11.5514313428383, 11.4939244996735, - 11.478671143305, 11.5506137782508, 11.4838342763386, 11.9082590797765, - 10.960554474782, 11.4510734836701, 11.594720494906, 11.6435287600618, - 11.4730994130636, 11.6753147493462, 11.0704918909154, 11.3363906264414, - 11.4069381361204, 11.3390189388972, 11.7394581174949, 11.5025933598415, - 11.5091568374427, 11.8189657846627, 11.6762535202989, 11.4862855869735, - 11.5191142470272, 11.4087780398663, 11.5361396738411, 11.3477626341929, - 11.3295447034612, 11.6461819581215, 11.3160562372171, 11.9732839905477, - 11.2597545419879, 11.6483236285684, 11.6659329899876, 11.3375985127992, - 11.5652927769658, 11.5402126667346, 11.5246347656743, 11.3790534415256, - 11.3504467491437, 11.9006774473653, 11.2998434728114, 11.294215001317, - 11.0352592725904, 11.5442750193934, 11.9540286929111, 11.5849472177449, - 11.8695269797079, 11.2221940781463, 11.5391494901798, 11.7652998758852, - 11.7152214736869, 11.6161349733777, 11.3455362974154, 11.3697013696593, - 11.6159930311664, 11.5192522836597, 11.3626732407949, 11.7915655615128, - 10.8468085570926, 11.5051760134024, 11.3931245756523, 11.6445146662936, - 11.3470732268861, 11.6515019252136, 11.5141257439709, 11.2773011669151, - 11.3032998105644, 11.7571007839257, 11.3544692125066, 11.5818232930408, - 11.0839805881239, 11.8582789073051, 11.5997729156958, 11.5897058738691, - 11.4193569373722, 11.8678858552685, 11.6051915096343, 11.3371558507094, - 11.3210764775439, 11.3670660935708, 10.9736909230005, 11.5134036283058, - 11.7378869878075, 11.6101540643963, 11.5960760408688, 11.5398373831802, - 11.6921293527264, 11.0056293583308, 11.3779618825627, 11.4358858630188, - 11.3398108548088, 11.500395429923, 11.6290788048495, 11.4534379910937, - 11.3973526125132, 11.8090228812056, 11.4349697688751, 11.4120105561733, - 11.2768023713792, 11.6479180048227, 11.8538348852147, 11.2816551787507, - 11.5483270246353, 11.5002183838825, 11.3020898934751, 11.5115149415805, - 11.2017560031151, 11.352225955946, 11.6826296693967, 11.8553332139932, - 11.9042883574032, 11.0560549115389, 11.1767099828818, 11.421709850191, - 11.702545464272, 11.7485923966285, 11.8047860348248, 11.4448541804893, + 11.6635934627129, 11.3655834538171, 11.8239438136152, 11.4457330597547, + 11.2733838979158, 11.6555694734405, 11.6077458629663, 11.6253179146231, + 11.7565586590195, 11.1887570445131, 11.6730568277929, 11.4120070711133, + 11.6824326010276, 11.3911357792784, 12.0706441525969, 11.2155412831347, + 11.3821410267404, 11.3267141623621, 11.6076784146829, 11.3209976317701, + 11.2959562378299, 11.6786188036454, 11.6046588017454, 11.7499647941354, + 11.4831512412866, 11.8286883023093, 11.7007855177161, 11.6125285414713, + 11.4368552322619, 11.677278735656, 11.2591724516819, 11.2122991922597, + 11.2014592283697, 11.6757643041424, 11.3976039512326, 11.4064992756645, + 11.6084844857244, 11.2659904100175, 11.4887603755147, 11.3465556328527, + 11.6709507658488, 11.4442961944266, 11.6860922015911, 11.3337180713638, + 11.4934336220037, 11.4237641215403, 11.2597374132061, 11.1767350574449, + 11.5249429055911, 11.2922544242571, 11.3860745867636, 11.5766005475934, + 11.2628237130449, 11.6146165920334, 11.4175020113036, 11.3195033621875, + 11.1710952560318, 11.6597792510826, 11.4868152191465, 11.5721318552201, + 11.6486854013223, 11.6404214031175, 11.4738473838758, 11.0370114162703, + 11.5306291118776, 11.7547581342576, 11.1729582778396, 11.5752263994969, + 11.2468730281413, 11.7327251393004, 11.6517053064323, 11.5377269190321, + 11.7274750442181, 11.8998204906137, 11.6746453028613, 11.7144040978644, + 11.3885625929466, 11.4727695225601, 11.5211563372212, 11.8779053238367, + 11.5235380529653, 11.7352073567185, 11.778095222296, 11.5565087399718, + 11.4303811869928, 11.411039568203, 11.7936208857429, 11.2632318149877, + 11.4183636452509, 11.5450923312535, 11.5304172016656, 11.3564668458882, + 11.3097786542072, 11.2559960803643, 11.1900205330239, 11.3179458681654, + 11.5468393692064, 11.6109598609785, 11.4397968689957, 11.5829306616596, + 11.4265533991304, 11.4037107783255, 11.6231069350061, 11.4476147809259, + 11.315857500714, 11.192073498525, 11.1450028934144, 11.4763778673496, + 11.3303593182416, 11.795851315237, 11.3154135776636, 11.504446981381, + 11.3686452517911, 11.0681174567049, 11.9482203553029, 11.4990621721172, + 11.7700827893035, 11.153277291342, 11.4103274908523, 11.362014739247, + 11.3370793845089, 10.9490041292355, 11.5709887438907, 11.2392472207936, + 11.4457697378538, 11.5518564381783, 11.1668497234251, 11.660217248224, + 11.5408481305805, 11.3596525221312, 11.7088443068689, 11.0985982119481, + 11.6344343224953, 11.5835918466228, 11.6707241606893, 11.4873075231587, + 11.6871951877657, 11.3561777270116, 11.0926984591504, 11.6670973459339, + 11.4743776164222, 11.4012126214713, 11.1670799989037, 11.3895862238313, + 11.4619188035051, 11.7438466838695, 11.7789086710159, 11.8254153257148, + 11.5350198406344, 11.614146101765, 11.5037937949341, 11.7594749216344, + 11.7232424558103, 11.4901038034287, 11.457497322123, 11.4701475688988, + 11.3495747129771, 11.4768364004515, 11.3536264552173, 11.6967872920671, + 11.5958239935742, 11.8102460795176, 11.5285720139981, 11.5636360422529, + 11.2391302305836, 11.6400828524342, 11.3649992872627, 11.7739800561355, + 11.9514605248261, 11.8948860243831, 11.3298148207664, 11.3913235205135, + 11.2842354326543, 11.5345139189297, 11.0970243900149, 11.7031563986728, + 11.6634306349493, 11.9092830544344, 11.5869287303179, 11.7564461328616, + 11.150172788247, 11.4822541140239, 11.4044323999418, 11.7430862177697, + 11.4674029907269, 11.6087102680844, 11.0224410790094, 11.1429072494759, + 11.1440714332214, 11.4429296944542, 11.5110545367456, 11.6902834560434, + 11.975232188303, 11.3484533650323, 11.5902139993436, 11.6936184805547, + 11.2156665797036, 11.5367845942098, 11.457685987964, 11.326091672857, + 11.54310696694, 11.6318253757251, 11.4672564829417, 11.2753353731344, + 11.5442624404976, 11.4998938095082, 11.7680718084146, 11.4432553497958, + 11.7656381805778, 11.6559051931419, 11.2711880476245, 11.6412415650511, + 11.5685922662603, 11.5506412075912, 11.3513987873333, 11.3315276655562, + 11.335640654208, 11.681285272101, 11.5589662365603, 11.1828140877568, + 11.5312581724757, 11.5432002402202, 11.7912888955701, 11.4905985999693, + 11.1259591802745, 11.4610350884183, 11.7991160364597, 11.579099060573, + 11.33449302326, 11.2554336598017, 11.4512378707303, 11.7226621454134, + 11.3527354290433, 11.6705425125658, 11.5563556191945, 11.7308586023113, + 11.9851397182973, 11.075885463439, 11.2080718893369, 11.4368799211954, + 11.5632546318052, 11.6634278624019, 11.318215841977, 11.4880779444713, + 11.6701760414542, 11.7900454830006, 11.4305509189927, 11.4005711273461, + 11.493397563551, 11.3671831886506, 11.5455573847742, 11.455219607115, + 11.3765307074504, 11.5322198186407, 11.7234429342707, 11.4913195141207, + 11.5800460407405, 11.5015183797711, 11.600345452303, 11.671105482069, + 11.9009180552352, 11.3047838103508, 11.243053789483, 11.3132995190247, + 11.1839945545923, 11.5467528309238, 11.4624123336534, 11.4384084755489, + 11.7624832869299, 11.4972069873588, 11.6718416090489, 11.5565193860913, + 11.6854937630156, 11.486887701755, 11.2245408284927, 11.4223163757767, + 11.6183353030888, 11.4781731819334, 11.4180676231011, 11.5222391679401, + 10.9874586119541, 11.6315015151944, 11.6259231476061, 11.5246942987034, + 11.3790143669854, 11.6091093097247, 11.8458505048798, 11.3956132241971, + 11.4334989846648, 12.0107090576645, 11.58889471641, 11.8485588211996, + 11.6912962865302, 11.3443567873428, 11.4889742885729, 11.7353556032995, + 11.3458181845925, 11.5360487979571, 11.572996307097, 11.3900889967152, + 11.3871286159282, 11.6394988106606, 11.6672892268697, 11.2499719224047, + 11.4355438444653, 11.4146461074679, 11.5830061909034, 11.356416701344, + 11.5194114268155, 11.4461730977868, 11.7555819598489, 11.757108193106, + 11.6621065583231, 11.838582610051, 11.7632074437835, 11.3465420858875, + 11.5844207003211, 11.1705821018384, 11.4142931889118, 11.6952187675352, + 11.5853093436653, 11.3754738036731, 11.4897478077412, 11.6808486866119, + 11.7782359379539, 11.4098989033173, 11.5147654815493, 11.9203595355564, + 11.7863398442806, 11.6085439373772, 11.3748020550406, 11.5107499518156, + 11.4459430122029, 11.8864880814917, 11.3910504966753, 11.7608068035471, + 11.2010926856702, 11.2525270439525, 11.6862467158833, 11.732921172069, + 11.2587015436406, 11.9648080240531, 11.2853204109666, 11.5145507471921, + 11.4761721195894, 11.3591745195689, 11.6041308327816, 11.8698306010401, + 11.6899433491951, 11.3939731110365, 11.5342338112757, 11.7752406163456, + 11.435729513263, 11.3188712646992, 11.3365988682073, 11.6485204521932, + 11.480686518043, 11.2799874465089, 11.4116754417375, 11.4545426647885, + 11.5745481350434, 11.1966656568524, 11.6975132142541, 11.6431448445814, + 11.2517604231283, 11.1486491517404, 11.6991734787903, 11.2241659658642, + 11.4952691898267, 11.5740123918133, 11.3536512948081, 11.5378236053867, + 11.5105640641999, 11.8221701602153, 11.2923902515628, 11.53180649897, + 11.3691594548817, 11.6175646316642, 11.4053269282246, 11.234768393995, + 11.641542054491, 11.7999676522794, 11.5257062424203, 11.5059110405551, + 11.6617696764003, 11.3226243854653, 11.4880248762229, 11.7337176970954, + 11.2155495826891, 11.6517450661497, 11.6021018262328, 11.3877604077526, + 11.639890502846, 11.7809973315967, 11.3515596489177, 11.3761078301294, + 11.4971577458201, 11.7264688656258, 11.4937265193511, 12.0486431731611, + 11.4285135930375, 11.5266970229313, 11.6897298607594, 11.1325756698399, + 11.3610403083483, 11.271158595137, 11.5987031218919, 11.2413020872383, + 11.6922042998872, 11.0622291689558, 11.0493045662671, 11.7886726028345, + 11.356875041002, 11.222682110044, 11.1729481428879, 12.050179976782, + 11.3691912771854, 11.1729814065191, 11.6134550080208, 11.3668928620368, + 11.2789813760573, 11.858752849499, 11.1277127982319, 11.2254664041385, + 11.6425437286932, 11.5189911033846, 11.72792415931, 11.3460373137601, + 11.4266246813696, 11.6145883108721, 11.4040865639135, 10.9397029690441, + 11.9355220072695, 11.5659683736315, 11.2595351388416, 11.7264552315149, + 11.4250232833136, 11.8505002503181, 11.6736025315652, 11.6358341743864, + 11.4848620300854, 11.0658566253791, 11.7433762718265, 11.368863939374, + 12.0430882282277, 11.1478992722267, 11.6529116138211, 11.4386231562301, + 11.4699978508074, 11.3949217618572, 11.4546511662623, 11.6224432553423, + 11.4421481785793, 11.657180874398, 12.8288174569032, 11.6252568763014, + 11.491598965489, 11.5122204443171, 11.1946277176765, 11.3371665039755, + 11.8219395858959, 11.4177551579925, 11.817401786082, 10.9066865497524, + 11.6292423316714, 11.4345661115386, 11.5146335760661, 11.2164818600078, + 11.6462007756576, 11.5594553161589, 11.2777294045852, 11.4064561143383, + 11.403296101097, 11.1942695626537, 11.2069796841188, 11.5108806250445, + 11.4903700781168, 11.4412637072806, 11.7367046978334, 11.4415759938265, + 11.461789360977, 11.5025221397458, 11.6741375647481, 11.6318730203337, + 11.8724788742072, 11.3411139466139, 11.193895333642, 11.5090212617708, + 11.4766156814582, 11.3025257977669, 11.6887687898236, 11.9785619762261, + 11.5832745795798, 11.5638848196105, 11.6373626595557, 11.5346618451343, + 11.8053599896049, 11.7866836352087, 11.6656448470497, 11.6767793846651, + 11.4386961150224, 11.6601979255714, 11.6835301301195, 11.1916085178821, + 11.3638143635823, 11.5384570024637, 11.5021355520758, 11.728807679399, + 10.984378479658, 11.7213214603164, 10.7461781085464, 11.3870533808756, + 11.6264922619532, 11.5206029097705, 11.3075447476347, 11.5292525213332, + 11.4474539160496, 11.1784758708234, 11.3896979535097, 11.719541623793, + 11.6053073443453, 11.518232072859, 11.3712640382737, 11.6098940705145, + 11.5382560364661, 11.7993666879693, 11.6324840910319, 11.4481893420571, + 11.541204261907, 11.5773112599797, 11.5737901104302, 11.4341925128839, + 11.4793732048958, 11.6786469969964, 11.779820125404, 11.531459246292, + 11.2534419833243, 11.5242285802331, 11.7505344377909, 11.2561748020822, + 11.4661314501832, 11.4760530705387, 11.4506126062349, 11.3963732165445, + 11.4312630670097, 11.3557616131191, 11.5823565060607, 11.5363888326256, + 11.4917903826409, 11.5703392588785, 11.4208903235975, 11.3264983504393, + 11.4339118777607, 11.6207177601068, 12.0732854180863, 11.3485270565549, + 11.7214183450559, 11.3500282028636, 11.2190693389911, 11.2069248306124, + 11.6847250769785, 11.7484631837051, 11.3928718561409, 11.0483431329695, + 11.0632555553734, 11.3484711276532, 11.3540665678888, 11.424901501236, + 11.3772438391331, 11.3402755457535, 11.6658488666932, 11.801777190057, + 11.2024789759482, 11.2178942545725, 11.4553053426658, 11.7871905188347, + 11.4981479663863, 11.327302970811, 11.4159310930165, 11.5560442202663, + 11.7365037432332, 11.3378278539107, 11.8208625963249, 11.6497566272874, + 11.5075152494812, 11.5215250880463, 11.2812669600297, 11.310753285262, + 11.9620678652502, 11.3590587863734, 11.3898381131715, 11.2529331118846, + 11.2362185790092, 11.385351174977, 11.5744685353361, 11.4856804686762, + 11.913912055332, 11.3767849155427, 11.8094735607357, 11.1508024267808, + 11.8106804361006, 11.5470001967063, 11.3952593838908, 11.2484965135934, + 11.1152705518813, 11.5389406080853, 11.7634503537939, 11.4291028317061, + 11.3276572999105, 11.4930118360099, 11.5469649014856, 11.5169350020809, + 11.3285353226113, 11.2780234904709, 11.440289000834, 11.220111220716, + 11.6368461254189, 11.3373985461442, 11.5729909942026, 11.5627913514537, + 11.896010438462, 12.1378927192053, 11.2661668881932, 11.6500397905937, + 11.9456515880464, 11.6036046289927, 11.2617034688574, 11.2041718173304, + 11.7846555949065, 11.7468241221256, 11.5711643637382, 11.4605756512852, + 11.6855846792033, 11.610560314245, 11.4023298726094, 11.5935010737646, + 11.4794267316669, 11.4177936724899, 11.3170444087192, 11.4297981291346, + 11.5846912793348, 11.5361273182454, 11.2836990730896, 11.7129292407643, + 11.3682617291422, 11.5788574326573, 11.3656467657476, 11.4105589568224, + 11.6329782469737, 11.7741760320124, 11.5877677859266, 11.4614478490663, + 11.8922989610443, 11.4769174598707, 11.5473094994925, 11.8164122469798, + 11.3965297469094, 11.7060351811225, 11.9160697996983, 12.2091231955421, + 11.4513840897352, 11.9190686799799, 11.5716373917844, 11.4552839479779, + 11.2069385588086, 11.2352938786398, 11.4799962344234, 11.1715703387231, + 11.5951806551894, 11.4965967805174, 11.9066684684352, 12.085620305792, + 11.6762460737526, 11.5003622406498, 11.2467259944484, 11.3576209222196, + 11.5538967776043, 11.6021728438367, 11.4017677191272, 11.6541203471886, + 11.5179908661979, 11.3731766103249, 11.284667844589, 11.277379710151, + 11.6083662721441, 11.4137354186957, 10.8955839097348, 11.6128481523168, + 10.9414889550394, 11.500934449099, 11.4032494506259, 11.3414275766532, + 11.6103518032939, 11.4489716827269, 11.4521528606091, 11.4586955357924, + 11.0442737725854, 11.4024077316865, 11.4530826810189, 11.2142229985889, + 11.3211367494156, 11.7695143207915, 11.6801094326193, 11.378714542138, + 11.5894285425463, 11.4535592112896, 11.5189077909302, 11.905529468508, + 11.7308595111171, 11.1561241580823, 11.5396607072055, 11.5670558138667, + 11.5866534877845, 11.4899696625367, 10.7606650890848, 11.4623034225546, + 11.4829861663367, 11.531027241558, 11.1284027924671, 11.3789406141285, + 11.7180842406464, 11.248060386135, 11.8557680503442, 11.4749711791423, + 11.7731267020686, 11.4451020052469, 11.5536039362763, 11.2295030702308, + 11.4439680242462, 11.3599366494965, 11.2375779084626, 11.4027090068517, + 11.4674002049422, 11.6107908879673, 11.3646653036025, 11.3525677125419, + 11.6956920927681, 11.5949761789213, 11.4279470409673, 11.628194983154, + 11.3797989564061, 11.4537211190876, 11.544720822699, 11.3477447726164, + 11.5106910979557, 11.2705155562627, 11.5419354593303, 11.6002427009366, + 11.3617284216845, 11.4545380023049, 11.5559785868196, 11.2827575037312, + 11.4923949055435, 11.4670902548463, 11.7775808724294, 11.7524650925602, + 11.5232395955812, 11.7716348213617, 11.3129441491383, 11.9184159519933, + 11.4651302298193, 11.4828115364529, 11.4921553448102, 11.4840394509425, + 11.4795329119155, 11.3557617727837, 11.1990802135024, 11.555895890632, + 11.5665334157256, 11.9608405697218, 11.0906137231452, 11.4738335300962, + 11.5552267798845, 11.4917532448646, 11.4767501205378, 11.309257136722, + 11.8330397760739, 11.2452007264035, 11.5626653665188, 11.6615348431299, + 11.4036383205713, 11.9206466284402, 11.4028117349485, 11.232335830704, + 11.5710019223606, 11.2323436049941, 11.0986236955492, 11.7618238628064, + 11.3445348352561, 11.378093136043, 11.5381912190455, 11.282570495449, + 11.3186759511659, 11.4117838917907, 11.6227635225452, 11.7844213221872, + 11.5671587969278, 11.458922182513, 11.4032992701995, 11.5491884538217, + 11.2758671228542, 11.6770897492982, 11.6342313067151, 11.1237574188463, + 11.6031081273673, 12.1290653063871, 11.4778345922648, 11.3583463804655, + 11.3266052031506, 11.7246123353123, 11.4647737955044, 11.5883332972292, + 11.4248310030985, 11.3713918308266, 11.2041509548359, 11.617616628905, + 11.3759381668148, 11.3305920225639, 11.6871369457011, 11.6303021419011, + 11.4931674583361, 11.0922966074434, 11.2490842937364, 10.9403583083204, + 11.1716989237958, 11.4292855836507, 11.6236233194597, 11.5989208423244, + 11.2147889962406, 11.625607143598, 11.8748838328963, 11.5414934062674, + 11.6259439615824, 11.3364532857374, 11.8227344400673, 11.7111666222959, + 11.3727104334305, 11.7078155455392, 11.5544569070194, 11.6021540153749, + 11.573369065866, 10.8581859655439, 11.6615357936139, 11.6074293122824, + 11.3800328287919, 11.8608121046055, 10.8695335671074, 11.4549460213617, + 11.6732793086444, 11.6280582434249, 11.7938110746401, 11.2759355094693, + 11.7333174374389, 11.5124908292672, 11.5116966042338, 11.2557414497685, + 11.111003192477, 11.7723687553069, 11.5311536361956, 11.415675250247, + 11.434958888026, 11.5764304335137, 11.3184428704269, 11.5925005193847, + 11.6606221243124, 11.6799864503813, 11.6680624812246, 11.6323392171622, + 11.6205668223306, 11.2743893579799, 11.3038169041637, 11.2516179608122, + 11.0913550278671, 11.5183036046645, 11.6088540037091, 11.4237385957101, + 11.7411183714493, 11.5268255736499, 11.5514313428383, 11.4939244996735, + 11.478671143305, 11.5506137782508, 11.4838342763386, 11.9082590797765, + 10.960554474782, 11.4510734836701, 11.594720494906, 11.6435287600618, + 11.4730994130636, 11.6753147493462, 11.0704918909154, 11.3363906264414, + 11.4069381361204, 11.3390189388972, 11.7394581174949, 11.5025933598415, + 11.5091568374427, 11.8189657846627, 11.6762535202989, 11.4862855869735, + 11.5191142470272, 11.4087780398663, 11.5361396738411, 11.3477626341929, + 11.3295447034612, 11.6461819581215, 11.3160562372171, 11.9732839905477, + 11.2597545419879, 11.6483236285684, 11.6659329899876, 11.3375985127992, + 11.5652927769658, 11.5402126667346, 11.5246347656743, 11.3790534415256, + 11.3504467491437, 11.9006774473653, 11.2998434728114, 11.294215001317, + 11.0352592725904, 11.5442750193934, 11.9540286929111, 11.5849472177449, + 11.8695269797079, 11.2221940781463, 11.5391494901798, 11.7652998758852, + 11.7152214736869, 11.6161349733777, 11.3455362974154, 11.3697013696593, + 11.6159930311664, 11.5192522836597, 11.3626732407949, 11.7915655615128, + 10.8468085570926, 11.5051760134024, 11.3931245756523, 11.6445146662936, + 11.3470732268861, 11.6515019252136, 11.5141257439709, 11.2773011669151, + 11.3032998105644, 11.7571007839257, 11.3544692125066, 11.5818232930408, + 11.0839805881239, 11.8582789073051, 11.5997729156958, 11.5897058738691, + 11.4193569373722, 11.8678858552685, 11.6051915096343, 11.3371558507094, + 11.3210764775439, 11.3670660935708, 10.9736909230005, 11.5134036283058, + 11.7378869878075, 11.6101540643963, 11.5960760408688, 11.5398373831802, + 11.6921293527264, 11.0056293583308, 11.3779618825627, 11.4358858630188, + 11.3398108548088, 11.500395429923, 11.6290788048495, 11.4534379910937, + 11.3973526125132, 11.8090228812056, 11.4349697688751, 11.4120105561733, + 11.2768023713792, 11.6479180048227, 11.8538348852147, 11.2816551787507, + 11.5483270246353, 11.5002183838825, 11.3020898934751, 11.5115149415805, + 11.2017560031151, 11.352225955946, 11.6826296693967, 11.8553332139932, + 11.9042883574032, 11.0560549115389, 11.1767099828818, 11.421709850191, + 11.702545464272, 11.7485923966285, 11.8047860348248, 11.4448541804893, 11.4705435703147, 11.716935272144, 10.9954029806633, 11.1256601239288 )) set.seed(100) - fit <- ssd_fit_dists(data = data, dists = 'lnorm_lnorm', at_boundary_ok=TRUE, min_pmix = 3/nrow(data)) + fit <- ssd_fit_dists(data = data, dists = "lnorm_lnorm", at_boundary_ok = TRUE, min_pmix = 3 / nrow(data)) tidy <- tidy(fit) expect_snapshot_data(tidy, "tidy_lnorm_lnorm_uni1000_3n", digits = 6) }) diff --git a/vignettes/articles/confidence-intervals.Rmd b/vignettes/articles/confidence-intervals.Rmd index d9dc8c367..6f67084ce 100644 --- a/vignettes/articles/confidence-intervals.Rmd +++ b/vignettes/articles/confidence-intervals.Rmd @@ -146,13 +146,13 @@ However, the lower confidence interval obtained using the weighted arithmetic me library(ggplot2) # library(ggpubr) p1 <- ggplot(compare_dat, aes(method, ucl, fill = method)) + - geom_bar(stat="identity", position=position_dodge()) + + geom_bar(stat = "identity", position = position_dodge()) + theme_classic() + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) p2 <- ggplot(compare_dat, aes(method, lcl, fill = method)) + - geom_bar(stat="identity", position=position_dodge()) + + geom_bar(stat = "identity", position = position_dodge()) + theme_classic() + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) # ggarrange(p1, p2,common.legend = TRUE) ``` @@ -164,10 +164,10 @@ This means that the weighted bootstrap method is ~ `r round(t2["elapsed"]/t4["el ```{r fig.width=7,fig.height=5} p3 <- ggplot(compare_dat, aes(method, time, fill = method)) + - geom_bar(stat="identity", position=position_dodge()) + - ylab("Elapsed time (seconds)") + - theme_classic() + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + geom_bar(stat = "identity", position = position_dodge()) + + ylab("Elapsed time (seconds)") + + theme_classic() + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) p3 ``` diff --git a/vignettes/distributions.Rmd b/vignettes/distributions.Rmd index 4c25bed31..cad96d896 100644 --- a/vignettes/distributions.Rmd +++ b/vignettes/distributions.Rmd @@ -124,28 +124,29 @@ The probability density function, ${f_X}(x;b,c,k)$ and cumulative distribution f

Sample Burr probability density and cumulative distribution functions

```{r echo=FALSE} -f<-function(x,b,c,k){ -z1<-(b/x)^(c-1);z2<-(b/x)^c -y<-(b*c*k/x^2)*z1/(1+z2)^(k+1) -return(y) +f <- function(x, b, c, k) { + z1 <- (b / x)^(c - 1) + z2 <- (b / x)^c + y <- (b * c * k / x^2) * z1 / (1 + z2)^(k + 1) + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,f(conc,1,3,5),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733") -lines(conc,f(conc,1,1,2),col="#F2A61C") -lines(conc,f(conc,1,2,2),col="#1CADF2") -lines(conc,f(conc,1,2,5),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, f(conc, 1, 3, 5), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733") +lines(conc, f(conc, 1, 1, 2), col = "#F2A61C") +lines(conc, f(conc, 1, 2, 2), col = "#1CADF2") +lines(conc, f(conc, 1, 2, 5), col = "#1F1CF2") -F<-function(x,b,c,k){ -z2<-(b/x)^c -y<-1/(1+z2)^k -return(y) +F <- function(x, b, c, k) { + z2 <- (b / x)^c + y <- 1 / (1 + z2)^k + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,F(conc,1,3,5),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733") -lines(conc,F(conc,1,1,2),col="#F2A61C") -lines(conc,F(conc,1,2,2),col="#1CADF2") -lines(conc,F(conc,1,2,5),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, F(conc, 1, 3, 5), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733") +lines(conc, F(conc, 1, 1, 2), col = "#F2A61C") +lines(conc, F(conc, 1, 2, 2), col = "#1CADF2") +lines(conc, F(conc, 1, 2, 5), col = "#1F1CF2") ``` While the Burr type III distribution was adopted as the default distribution in Burrlioz, it is well known (e.g., Tadikamalla (1980)) that the Burr III distribution is related to several other theoretical distributions, some of @@ -194,30 +195,37 @@ that defines the weighting of the two distributions in the ‘mixture.’

Sample lognormal mixture probability density and cumulative distribution functions

```{r echo=FALSE} -f<-function(x,m1,s1,m2,s2,p){ -y<-p*dlnorm(x,m1,s1)+(1-p)*dlnorm(x,m2,s2) -return(y) +f <- function(x, m1, s1, m2, s2, p) { + y <- p * dlnorm(x, m1, s1) + (1 - p) * dlnorm(x, m2, s2) + return(y) } -conc<-seq(0,5,by=0.0025) -m1=1;s1=.2;m2=1.8;s2=1.5;p=0.25 -plot(conc,f(conc,m1,s1,m2,s2,p),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,f(conc,0.09,0.5,1,0.08,0.9),col="#F2A61C") -lines(conc,f(conc,0.5,0.5,1,0.08,0.9),col="#1CADF2") -lines(conc,f(conc,0.7,1.5,0.5,0.1,.7),col="#1F1CF2") - -F<-function(x,m1,s1,m2,s2,p){ -y<-p*plnorm(x,m1,s1)+(1-p)*plnorm(x,m2,s2) -return(y) +conc <- seq(0, 5, by = 0.0025) +m1 <- 1 +s1 <- .2 +m2 <- 1.8 +s2 <- 1.5 +p <- 0.25 +plot(conc, f(conc, m1, s1, m2, s2, p), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, f(conc, 0.09, 0.5, 1, 0.08, 0.9), col = "#F2A61C") +lines(conc, f(conc, 0.5, 0.5, 1, 0.08, 0.9), col = "#1CADF2") +lines(conc, f(conc, 0.7, 1.5, 0.5, 0.1, .7), col = "#1F1CF2") + +F <- function(x, m1, s1, m2, s2, p) { + y <- p * plnorm(x, m1, s1) + (1 - p) * plnorm(x, m2, s2) + return(y) } -conc<-seq(0,10,by=0.0025) -m1=1;s1=.2;m2=1.8;s2=1.5;p=0.25 -plot(conc,F(conc,m1,s1,m2,s2,p),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,F(conc,0.09,0.5,1,0.08,0.9),col="#F2A61C") -lines(conc,F(conc,0.5,0.5,1,0.08,0.9),col="#1CADF2") -lines(conc,F(conc,0.7,1.5,0.5,0.1,.7),col="#1F1CF2") - +conc <- seq(0, 10, by = 0.0025) +m1 <- 1 +s1 <- .2 +m2 <- 1.8 +s2 <- 1.5 +p <- 0.25 +plot(conc, F(conc, m1, s1, m2, s2, p), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, F(conc, 0.09, 0.5, 1, 0.08, 0.9), col = "#F2A61C") +lines(conc, F(conc, 0.5, 0.5, 1, 0.08, 0.9), col = "#1CADF2") +lines(conc, F(conc, 0.7, 1.5, 0.5, 0.1, .7), col = "#1F1CF2") ```
As can be see from the plot above, the mixture distributions provide a highly flexible means of modelling *bimodality* in an emprical SSD. This happens, for example, when the toxicity data for some toxicant include both animal and plant species, or there are different modes of action operating. Unfortunately, this increased flexibilty comes with a high penalty in the model-averaging process. The combination of small sample sizes and a high parameter count (typically 5 or more) means that mixture distributions will be down-weighted - even when they do a good job at describing the data. For this reason, when attempting to model bimodal data, we suggest looking at the fit using the default set of distributions and then examining the fit with just one of either the log-normal mixture or the log-logistic mixture. Keep in mind that this should only be done if the sample size is not pathologically small. As a guide, Prof. David Fox recommends as an *absolute minimum* $n \ge 3k + 1$ but preferably $n \ge 5k + 1$ where $k$ is the number of model parameters. @@ -302,20 +310,27 @@ The lognormal distribution was selected as the starting distribution given the d

Sample lognormal probability density and cumulative distribution functions

```{r echo=FALSE} -conc<-seq(0,10,by=0.005) -m1=1;s1=.2;m2=1.8;s2=1.5;p=0.25 -plot(conc,dlnorm(conc,m1,s1),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,dlnorm(conc,0.4,2),col="#F2A61C") -lines(conc,dlnorm(conc,m1*2,s1),col="#1CADF2") -lines(conc,dlnorm(conc,0.9,1.5),col="#1F1CF2") - -conc<-seq(0,10,by=0.005) -m1=1;s1=.2;m2=1.8;s2=1.5;p=0.25 -plot(conc,plnorm(conc,m1,s1),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,plnorm(conc,0.4,2),col="#F2A61C") -lines(conc,plnorm(conc,m1*2,s1),col="#1CADF2") -lines(conc,plnorm(conc,0.9,1.5),col="#1F1CF2") - +conc <- seq(0, 10, by = 0.005) +m1 <- 1 +s1 <- .2 +m2 <- 1.8 +s2 <- 1.5 +p <- 0.25 +plot(conc, dlnorm(conc, m1, s1), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, dlnorm(conc, 0.4, 2), col = "#F2A61C") +lines(conc, dlnorm(conc, m1 * 2, s1), col = "#1CADF2") +lines(conc, dlnorm(conc, 0.9, 1.5), col = "#1F1CF2") + +conc <- seq(0, 10, by = 0.005) +m1 <- 1 +s1 <- .2 +m2 <- 1.8 +s2 <- 1.5 +p <- 0.25 +plot(conc, plnorm(conc, m1, s1), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, plnorm(conc, 0.4, 2), col = "#F2A61C") +lines(conc, plnorm(conc, m1 * 2, s1), col = "#1CADF2") +lines(conc, plnorm(conc, 0.9, 1.5), col = "#1F1CF2") ``` #### Log-logistic distribution @@ -368,28 +383,29 @@ We included it because it has wider tails than the log-normal and because it is

Sample Log-logistic probability density and cumulative distribution functions

```{r echo=FALSE} -f<-function(x,a,b){ -z1<-(x/a)^(b-1);z2<-(x/a)^b -y<-(b/a)*z1/(1+z2)^2 -return(y) +f <- function(x, a, b) { + z1 <- (x / a)^(b - 1) + z2 <- (x / a)^b + y <- (b / a) * z1 / (1 + z2)^2 + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,f(conc,3.2,3.5),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1.1)) -lines(conc,f(conc,1.5,1.5),col="#F2A61C") -lines(conc,f(conc,1,1),col="#1CADF2") -lines(conc,f(conc,1,4),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, f(conc, 3.2, 3.5), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.1)) +lines(conc, f(conc, 1.5, 1.5), col = "#F2A61C") +lines(conc, f(conc, 1, 1), col = "#1CADF2") +lines(conc, f(conc, 1, 4), col = "#1F1CF2") -F<-function(x,a,b){ -z2<-(x/a)^(-b) -y<-1/(1+z2) -return(y) +F <- function(x, a, b) { + z2 <- (x / a)^(-b) + y <- 1 / (1 + z2) + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,F(conc,3.2,3.5),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1.1)) -lines(conc,F(conc,1.5,1.5),col="#F2A61C") -lines(conc,F(conc,1,1),col="#1CADF2") -lines(conc,F(conc,1,4),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, F(conc, 3.2, 3.5), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.1)) +lines(conc, F(conc, 1.5, 1.5), col = "#F2A61C") +lines(conc, F(conc, 1, 1), col = "#1CADF2") +lines(conc, F(conc, 1, 4), col = "#1F1CF2") ``` @@ -419,18 +435,17 @@ The gamma distribution can be fitted using `ssdtools` by supplying the string "

Sample gamma probability density and cumulative distribution functions

```{r echo=FALSE} - -conc<-seq(0,10,by=0.005) -plot(conc,dgamma(conc,5,5),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1.1)) -lines(conc,dgamma(conc,4,1),col="#F2A61C") -lines(conc,dgamma(conc,0.9,1),col="#1CADF2") -lines(conc,dgamma(conc,2,1.),col="#1F1CF2") - -conc<-seq(0,10,by=0.005) -plot(conc,pgamma(conc,5,5),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1.1)) -lines(conc,pgamma(conc,4,1),col="#F2A61C") -lines(conc,pgamma(conc,0.9,1),col="#1CADF2") -lines(conc,pgamma(conc,2,1.),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, dgamma(conc, 5, 5), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.1)) +lines(conc, dgamma(conc, 4, 1), col = "#F2A61C") +lines(conc, dgamma(conc, 0.9, 1), col = "#1CADF2") +lines(conc, dgamma(conc, 2, 1.), col = "#1F1CF2") + +conc <- seq(0, 10, by = 0.005) +plot(conc, pgamma(conc, 5, 5), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.1)) +lines(conc, pgamma(conc, 4, 1), col = "#F2A61C") +lines(conc, pgamma(conc, 0.9, 1), col = "#1CADF2") +lines(conc, pgamma(conc, 2, 1.), col = "#1F1CF2") ```
@@ -461,28 +476,27 @@ The two-parameter log-gumbel distribution has the following *pdf* and *cdf*:

Sample log-Gumbel probability density and cumulative distribution functions

```{r echo=FALSE} - -f<-function(x,a,b){ -y<-b*exp(-(a*x)^(-b))/(a^b*x^(b+1)) -return(y) +f <- function(x, a, b) { + y <- b * exp(-(a * x)^(-b)) / (a^b * x^(b + 1)) + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,f(conc,0.2,5),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1.1)) -lines(conc,f(conc,0.5,1.5),col="#F2A61C") -lines(conc,f(conc,1,2),col="#1CADF2") -lines(conc,f(conc,10,.5),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, f(conc, 0.2, 5), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.1)) +lines(conc, f(conc, 0.5, 1.5), col = "#F2A61C") +lines(conc, f(conc, 1, 2), col = "#1CADF2") +lines(conc, f(conc, 10, .5), col = "#1F1CF2") -F<-function(x,a,b){ -y<-exp(-(a*x)^(-b)) -return(y) +F <- function(x, a, b) { + y <- exp(-(a * x)^(-b)) + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,F(conc,0.2,5),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1.1)) -lines(conc,F(conc,0.5,1.5),col="#F2A61C") -lines(conc,F(conc,1,2),col="#1CADF2") -lines(conc,F(conc,10,.5),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, F(conc, 0.2, 5), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.1)) +lines(conc, F(conc, 0.5, 1.5), col = "#F2A61C") +lines(conc, F(conc, 1, 2), col = "#1CADF2") +lines(conc, F(conc, 10, .5), col = "#1F1CF2") ```
@@ -525,27 +539,27 @@ The second parameterisation in which the *product* $b\eta$ in the formulae above

Sample Gompertz probability density and cumulative distribution functions

```{r echo=FALSE} -f<-function(x,n,b){ -y<-n*b*exp(n+b*x-n*exp(b*x)) -return(y) +f <- function(x, n, b) { + y <- n * b * exp(n + b * x - n * exp(b * x)) + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,f(conc,0.089,1.25),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,2)) -lines(conc,f(conc,0.001,3.5),col="#F2A61C") -lines(conc,f(conc,0.0005,1.1),col="#1CADF2") -lines(conc,f(conc,0.01,5),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, f(conc, 0.089, 1.25), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 2)) +lines(conc, f(conc, 0.001, 3.5), col = "#F2A61C") +lines(conc, f(conc, 0.0005, 1.1), col = "#1CADF2") +lines(conc, f(conc, 0.01, 5), col = "#1F1CF2") -F<-function(x,n,b){ -y<-1-exp(-n*exp(b*x-1)) -return(y) +F <- function(x, n, b) { + y <- 1 - exp(-n * exp(b * x - 1)) + return(y) } -conc<-seq(0,10,by=0.005) -plot(conc,F(conc,0.089,1.25),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,F(conc,0.001,3.5),col="#F2A61C") -lines(conc,F(conc,0.0005,1.1),col="#1CADF2") -lines(conc,F(conc,0.01,5),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, F(conc, 0.089, 1.25), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, F(conc, 0.001, 3.5), col = "#F2A61C") +lines(conc, F(conc, 0.0005, 1.1), col = "#1CADF2") +lines(conc, F(conc, 0.01, 5), col = "#1F1CF2") ``` The Gompertz distribution is available in `ssdtools`, however parameter estimation can be somewhat unstable [@fox_methodologies_2021], and for this reason it is not currently included in the default set. @@ -577,17 +591,17 @@ The Weibull distribution can be fitted in `ssdtools` by supplying the string `w

Sample Weibull probability density and cumulative distribution functions

```{r echo=FALSE} -conc<-seq(0,10,by=0.005) -plot(conc,dweibull(conc,4.321,4.949),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,dweibull(conc,0.838,0.911),col="#F2A61C") -lines(conc,dweibull(conc,1,1.546),col="#1CADF2") -lines(conc,dweibull(conc,17.267,7.219),col="#1F1CF2") - -conc<-seq(0,10,by=0.005) -plot(conc,pweibull(conc,4.321,4.949),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,pweibull(conc,0.838,0.911),col="#F2A61C") -lines(conc,pweibull(conc,1,1.546),col="#1CADF2") -lines(conc,pweibull(conc,17.267,7.219),col="#1F1CF2") +conc <- seq(0, 10, by = 0.005) +plot(conc, dweibull(conc, 4.321, 4.949), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, dweibull(conc, 0.838, 0.911), col = "#F2A61C") +lines(conc, dweibull(conc, 1, 1.546), col = "#1CADF2") +lines(conc, dweibull(conc, 17.267, 7.219), col = "#1F1CF2") + +conc <- seq(0, 10, by = 0.005) +plot(conc, pweibull(conc, 4.321, 4.949), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, pweibull(conc, 0.838, 0.911), col = "#F2A61C") +lines(conc, pweibull(conc, 1, 1.546), col = "#1CADF2") +lines(conc, pweibull(conc, 17.267, 7.219), col = "#1F1CF2") ``` @@ -650,18 +664,17 @@ Because it is *bounded*, the North American version of the (Inverse)Pareto distr

Sample North American Pareto probability density and cumulative distribution functions

```{r echo=FALSE} -conc<-seq(0,10,by=0.005) -plot(conc,extraDistr::dpareto(conc,3,2),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1.5)) -lines(conc,extraDistr::dpareto(conc,0.838,0.911),col="#F2A61C") -lines(conc,extraDistr::dpareto(conc,4,4),col="#1CADF2") -lines(conc,extraDistr::dpareto(conc,10,7),col="#1F1CF2") - -conc<-seq(0,10,by=0.005) -plot(conc,extraDistr::ppareto(conc,3,2),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,extraDistr::ppareto(conc,0.838,0.911),col="#F2A61C") -lines(conc,extraDistr::ppareto(conc,4,4),col="#1CADF2") -lines(conc,extraDistr::ppareto(conc,10,7),col="#1F1CF2") - +conc <- seq(0, 10, by = 0.005) +plot(conc, extraDistr::dpareto(conc, 3, 2), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1.5)) +lines(conc, extraDistr::dpareto(conc, 0.838, 0.911), col = "#F2A61C") +lines(conc, extraDistr::dpareto(conc, 4, 4), col = "#1CADF2") +lines(conc, extraDistr::dpareto(conc, 10, 7), col = "#1F1CF2") + +conc <- seq(0, 10, by = 0.005) +plot(conc, extraDistr::ppareto(conc, 3, 2), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, extraDistr::ppareto(conc, 0.838, 0.911), col = "#F2A61C") +lines(conc, extraDistr::ppareto(conc, 4, 4), col = "#1CADF2") +lines(conc, extraDistr::ppareto(conc, 10, 7), col = "#1F1CF2") ```
We see from the *pdf* plots that the @@ -669,28 +682,27 @@ lines(conc,extraDistr::ppareto(conc,10,7),col="#1F1CF2")

Sample North American inverse Pareto probability density and cumulative distribution functions

```{r echo=FALSE} - -f<-function(x,a,b){ -y<-a*(b^a)*x^(a-1) -return(y) +f <- function(x, a, b) { + y <- a * (b^a) * x^(a - 1) + return(y) } -conc<-seq(0,10,by=0.001) -plot(conc,f(conc,5,0.1),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,0.5)) -lines(conc,f(conc,3,0.1),col="#F2A61C") -lines(conc,f(conc,0.5,0.1),col="#1CADF2") -lines(conc,f(conc,0.1,0.1),col="#1F1CF2") +conc <- seq(0, 10, by = 0.001) +plot(conc, f(conc, 5, 0.1), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 0.5)) +lines(conc, f(conc, 3, 0.1), col = "#F2A61C") +lines(conc, f(conc, 0.5, 0.1), col = "#1CADF2") +lines(conc, f(conc, 0.1, 0.1), col = "#1F1CF2") -F<-function(x,a,b){ -y<-(b*x)^a -return(y) +F <- function(x, a, b) { + y <- (b * x)^a + return(y) } -conc<-seq(0,10,by=0.001) -plot(conc,F(conc,5,0.1),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,F(conc,3,0.1),col="#F2A61C") -lines(conc,F(conc,0.5,0.1),col="#1CADF2") -lines(conc,F(conc,0.1,0.1),col="#1F1CF2") +conc <- seq(0, 10, by = 0.001) +plot(conc, F(conc, 5, 0.1), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, F(conc, 3, 0.1), col = "#F2A61C") +lines(conc, F(conc, 0.5, 0.1), col = "#1CADF2") +lines(conc, F(conc, 0.1, 0.1), col = "#1F1CF2") ``` @@ -724,36 +736,33 @@ We note in passing that *both* versions of these Pareto and inverse Pareto distr

Sample European Pareto probability density and cumulative distribution functions

```{r echo=FALSE} - -conc<-seq(0,10,by=0.005) -plot(conc,actuar::dpareto(conc,1,1),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,actuar::dpareto(conc,2,3),col="#F2A61C") -lines(conc,actuar::dpareto(conc,0.5,1),col="#1CADF2") -lines(conc,actuar::dpareto(conc,10.5,6.5),col="#1F1CF2") - -conc<-seq(0,10,by=0.005) -plot(conc,actuar::ppareto(conc,1,1),type="l",ylab="Cumulative probability",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,actuar::ppareto(conc,2,3),col="#F2A61C") -lines(conc,actuar::ppareto(conc,0.5,1),col="#1CADF2") -lines(conc,actuar::ppareto(conc,10.5,6.5),col="#1F1CF2") - +conc <- seq(0, 10, by = 0.005) +plot(conc, actuar::dpareto(conc, 1, 1), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, actuar::dpareto(conc, 2, 3), col = "#F2A61C") +lines(conc, actuar::dpareto(conc, 0.5, 1), col = "#1CADF2") +lines(conc, actuar::dpareto(conc, 10.5, 6.5), col = "#1F1CF2") + +conc <- seq(0, 10, by = 0.005) +plot(conc, actuar::ppareto(conc, 1, 1), type = "l", ylab = "Cumulative probability", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, actuar::ppareto(conc, 2, 3), col = "#F2A61C") +lines(conc, actuar::ppareto(conc, 0.5, 1), col = "#1CADF2") +lines(conc, actuar::ppareto(conc, 10.5, 6.5), col = "#1F1CF2") ```

Sample European inverse Pareto probability density and cumulative distribution functions

```{r echo=FALSE,fig.align='center',fig.width=7,fig.height=5} - -conc<-seq(0,10,by=0.001) -plot(conc,actuar::dinvpareto(conc,1,1),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,0.8)) -lines(conc,actuar::dinvpareto(conc,1,3),col="#F2A61C") -lines(conc,actuar::dinvpareto(conc,10,0.1),col="#1CADF2") -lines(conc,actuar::dinvpareto(conc,2.045,0.98),col="#1F1CF2") - -conc<-seq(0,10,by=0.001) -plot(conc,actuar::pinvpareto(conc,1,1),type="l",ylab="Probability density",xlab="Concentration",col="#FF5733",ylim=c(0,1)) -lines(conc,actuar::pinvpareto(conc,1,3),col="#F2A61C") -lines(conc,actuar::pinvpareto(conc,10,0.1),col="#1CADF2") -lines(conc,actuar::pinvpareto(conc,2.045,0.98),col="#1F1CF2") +conc <- seq(0, 10, by = 0.001) +plot(conc, actuar::dinvpareto(conc, 1, 1), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 0.8)) +lines(conc, actuar::dinvpareto(conc, 1, 3), col = "#F2A61C") +lines(conc, actuar::dinvpareto(conc, 10, 0.1), col = "#1CADF2") +lines(conc, actuar::dinvpareto(conc, 2.045, 0.98), col = "#1F1CF2") + +conc <- seq(0, 10, by = 0.001) +plot(conc, actuar::pinvpareto(conc, 1, 1), type = "l", ylab = "Probability density", xlab = "Concentration", col = "#FF5733", ylim = c(0, 1)) +lines(conc, actuar::pinvpareto(conc, 1, 3), col = "#F2A61C") +lines(conc, actuar::pinvpareto(conc, 10, 0.1), col = "#1CADF2") +lines(conc, actuar::pinvpareto(conc, 2.045, 0.98), col = "#1F1CF2") ``` diff --git a/vignettes/model-averaging.Rmd b/vignettes/model-averaging.Rmd index dd95903e9..bd050a3f9 100644 --- a/vignettes/model-averaging.Rmd +++ b/vignettes/model-averaging.Rmd @@ -102,39 +102,35 @@ The *weighted average* acknowledges that the elements in the computation are ```{r echo=FALSE,warning=FALSE, message=FALSE,class.output="scroll-100"} -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) - print(samp) +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +print(samp) # knitr::kable(samp,caption="Some toxicity data (concentrations)") ``` Now, suppose we have only two possibilities for fitting an SSD - both lognormal distributions. Model 1 is the LN(-1.067,0.414) distribution while Model 2 is the LN(-0.387,0.617) distribution. A plot of the empirical *cdf* and Models 1 and 2 is shown below. ```{r echo=FALSE,fig.cap="Emprirical cdf (black); Model 1(green); and Model 2 (blue)", fig.width=7,fig.height=4.5} -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -samp<-sort(samp) -plot(ecdf(samp),main="Empirical and fitted SSDs",xlab="Concentration",ylab="Probability") -xx<-seq(0.01,3,by=0.01) -lines(xx,plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10]))),col= "#77d408" ) -lines(xx,plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15]))),col="#08afd4") -#lines(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +samp <- sort(samp) +plot(ecdf(samp), main = "Empirical and fitted SSDs", xlab = "Concentration", ylab = "Probability") +xx <- seq(0.01, 3, by = 0.01) +lines(xx, plnorm(xx, meanlog = mean(log(samp[1:10])), sd = sd(log(samp[1:10]))), col = "#77d408") +lines(xx, plnorm(xx, meanlog = mean(log(samp[5:15])), sd = sd(log(samp[5:15]))), col = "#08afd4") +# lines(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ # 0.5581*plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10])))) ,col="#d40830") - - ```
We see that Model 1 fits well in the lower, left region and poorly in the upper region, while the reverse is true for Model 2. So using *either* Model 1 **or** Model 2 is going to result in a poor fit overall. However, the obvious thing to do is to **combine** both models. We could just try using 50% of Model 1 and 50% of Model 2, but that may be sub-optimal. It turns out that the best fit is obtained by using 44% of Model 1 and 56% of Model 2. Redrawing the plot and adding the *weighted average* of Models 1 and 2 is shown below. ```{r echo=FALSE,fig.cap="Empirical cdf (black); Model 1(green); Model 2 (blue); and averaged Model (red)",fig.width=7,fig.height=4.5} -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -samp<-sort(samp) -plot(ecdf(samp),main="Empirical and fitted SSDs",xlab="Concentration",ylab="Probability") -xx<-seq(0.01,3,by=0.01) -lines(xx,plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10]))),col= "#77d408" ) -lines(xx,plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15]))),col="#08afd4") -lines(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ - 0.5581*plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10])))) ,col="#d40830") - - +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +samp <- sort(samp) +plot(ecdf(samp), main = "Empirical and fitted SSDs", xlab = "Concentration", ylab = "Probability") +xx <- seq(0.01, 3, by = 0.01) +lines(xx, plnorm(xx, meanlog = mean(log(samp[1:10])), sd = sd(log(samp[1:10]))), col = "#77d408") +lines(xx, plnorm(xx, meanlog = mean(log(samp[5:15])), sd = sd(log(samp[5:15]))), col = "#08afd4") +lines(xx, (0.4419 * plnorm(xx, meanlog = mean(log(samp[5:15])), sd = sd(log(samp[5:15]))) + + 0.5581 * plnorm(xx, meanlog = mean(log(samp[1:10])), sd = sd(log(samp[1:10])))), col = "#d40830") ```
Clearly the strategy has worked - we now have an excellent fitting SSD.What about estimation of an *HC20*? @@ -142,28 +138,29 @@ lines(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15]))) ```{r, echo=TRUE} # Model 1 HC20 -cat("Model 1 HC20 =",qlnorm(0.2,-1.067,0.414)) +cat("Model 1 HC20 =", qlnorm(0.2, -1.067, 0.414)) # Model 2 HC20 -cat("Model 2 HC20 =",qlnorm(0.2,-0.387,0.617)) +cat("Model 2 HC20 =", qlnorm(0.2, -0.387, 0.617)) ``` What about the averaged distribution? An intuitively appealing approach would be to apply the same weights to the individual *HC20* values as was applied to the respective models. That is `0.44*0.2428209 + 0.56*0.4040243 = 0.33`. So our model-averaged *HC20* estimate is 0.33. As a check, we can determine the *fraction affected* at concentration = 0.33 - it should of course be 20%. Let's take a look at the plot. ```{r echo=FALSE,fig.width=7,fig.height=5} -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -samp<-sort(samp) -xx<-seq(0.01,3,by=0.01) - - -plot(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ - 0.5581*plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10])))) , - col="#d40830",type="l",xlab="Concentration",ylab="Probability") -segments(0.33,-1,0.33,0.292,col="blue",lty=21) -segments(-1,0.292,0.33,0.292,col="blue",lty=21) -mtext("0.3",side=2,at=0.3,cex=0.8,col="blue") -mtext("0.33",side=1,at=0.33,cex=0.8,col="blue") +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +samp <- sort(samp) +xx <- seq(0.01, 3, by = 0.01) + + +plot(xx, (0.4419 * plnorm(xx, meanlog = mean(log(samp[5:15])), sd = sd(log(samp[5:15]))) + + 0.5581 * plnorm(xx, meanlog = mean(log(samp[1:10])), sd = sd(log(samp[1:10])))), +col = "#d40830", type = "l", xlab = "Concentration", ylab = "Probability" +) +segments(0.33, -1, 0.33, 0.292, col = "blue", lty = 21) +segments(-1, 0.292, 0.33, 0.292, col = "blue", lty = 21) +mtext("0.3", side = 2, at = 0.3, cex = 0.8, col = "blue") +mtext("0.33", side = 1, at = 0.33, cex = 0.8, col = "blue") ``` Something's wrong - the fraction affected at concentration 0.33 is 30% - **not the required 20%**. This issue is taken up in the next section @@ -193,26 +190,26 @@ If you need a visual demonstration, we can plot $G\left( x \right)$ and the *inv ```{r echo=FALSE, fig.width=8,fig.height=6} -t<-seq(0.01,0.99,by=0.001) +t <- seq(0.01, 0.99, by = 0.001) - -F<-0.4419*qlnorm(t,-1.067,0.414) + 0.5581*qlnorm(t,-0.387,0.617) -plot(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ - 0.5581*plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10])))) , - col="#d40830",type="l",xlab="Concentration",ylab="Probability") +F <- 0.4419 * qlnorm(t, -1.067, 0.414) + 0.5581 * qlnorm(t, -0.387, 0.617) -lines(F,t,col="#51c157",lwd=1.75) +plot(xx, (0.4419 * plnorm(xx, meanlog = mean(log(samp[5:15])), sd = sd(log(samp[5:15]))) + + 0.5581 * plnorm(xx, meanlog = mean(log(samp[1:10])), sd = sd(log(samp[1:10])))), +col = "#d40830", type = "l", xlab = "Concentration", ylab = "Probability" +) -segments(-1,0.2,0.34,0.2,col="black",lty=21,lwd=2) -segments(0.28,0.2,0.28,-1,col="red",lty=21,lwd=2) -segments(0.34,0.2,0.34,-1,col="#51c157",lty=21,lwd=2) -segments(1.12,-1,1.12,0.9,col="grey",lty=21,lwd=1.7) +lines(F, t, col = "#51c157", lwd = 1.75) -text(0.25,0.6,"Correct MA-SSD",col="red",cex=0.75) -text(0.75,0.4,"Erroneous MA-SSD",col="#51c157",cex=0.75) -mtext("1.12",side=1,at=1.12,cex=0.8,col="grey") +segments(-1, 0.2, 0.34, 0.2, col = "black", lty = 21, lwd = 2) +segments(0.28, 0.2, 0.28, -1, col = "red", lty = 21, lwd = 2) +segments(0.34, 0.2, 0.34, -1, col = "#51c157", lty = 21, lwd = 2) +segments(1.12, -1, 1.12, 0.9, col = "grey", lty = 21, lwd = 1.7) +text(0.25, 0.6, "Correct MA-SSD", col = "red", cex = 0.75) +text(0.75, 0.4, "Erroneous MA-SSD", col = "#51c157", cex = 0.75) +mtext("1.12", side = 1, at = 1.12, cex = 0.8, col = "grey") ``` Clearly, the two functions are **not** the same and thus *HCx* values derived from each will nearly always be different (as indicated by the positions of the vertical red and green dashed lines in the Figure above corresponding to the 2 values of the *HC20*). (Note: The two curves do cross over at a concentration of about 1.12 corresponding to the 90^th^ percentile, but in the region of ecotoxicological interest, there is no such cross-over and so the two approaches will **always** yield different *HCx* values with this difference → 0 as x → 0).

WE next discuss the use of a model-averaged SSD to obtain the *correct* model-averaged *HCx*. @@ -260,27 +257,26 @@ This is a little more complex, although we'll try to provide a non-mathematical

This time, we'll look at fitting a gamma, lognormal, and pareto distribution to our sample data: ```{r echo=FALSE,warning=FALSE, results="markup",message=FALSE,class.output="scroll-100"} -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) - print(samp) +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +print(samp) # knitr::kable(samp,caption="Some toxicity data (concentrations)") ```
The adequacy (or otherwise) of a fitted model can be assessed using a variety of numerical measures known as **goodness-of-fit** or GoF statistics. These are invariably based on a measure of discrepancy between the emprical data and the hypothesized model. Common GoF statistics used to test whether the hypothesis of some specified theoretical probability distribution is plausible for a given data set include: *Kolmogorov-Smirnov test; Anderson-Darling test; Shapiro-Wilk test;and Cramer-von Mises test*. [The Cramer-von Mises](https://en.wikipedia.org/wiki/Cram%C3%A9r%E2%80%93von_Mises_criterion) test is a good choice and is readily performed using the `cvm.test()` function in the `goftest` package in `R` as follows: ```{r, echo=TRUE,results='hide',warning=FALSE,message=FALSE} -dat<-data.frame(Conc=c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59)) +dat <- data.frame(Conc = c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59)) library(goftest) -library(EnvStats) # this is required for the Pareto cdf (ppareto) +library(EnvStats) # this is required for the Pareto cdf (ppareto) # Examine the fit for the gamma distribution (NB: parameters estimated from the data) -cvm.test(dat$Conc,null = "pgamma",shape = 2.0591977,scale = 0.3231032,estimated = TRUE) +cvm.test(dat$Conc, null = "pgamma", shape = 2.0591977, scale = 0.3231032, estimated = TRUE) # Examine the fit for the lognormal distribution (NB: parameters estimated from the data) -cvm.test(dat$Conc,null = "plnorm",meanlog=-0.6695120,sd=0.7199573,estimated = TRUE) +cvm.test(dat$Conc, null = "plnorm", meanlog = -0.6695120, sd = 0.7199573, estimated = TRUE) # Examine the fit for the Pareto distribution (NB: parameters estimated from the data) -cvm.test(dat$Conc,null = "ppareto",location = 0.1800000,shape = 0.9566756,estimated = TRUE) - +cvm.test(dat$Conc, null = "ppareto", location = 0.1800000, shape = 0.9566756, estimated = TRUE) ``` ``` @@ -319,17 +315,15 @@ From this output and using a level of significance of $p = 0.05$, we see that no ```{r echo=FALSE,fig.cap="Emprirical cdf (black); lognormal (green); gamma (blue); and Pareeto (red)", fig.width=7,fig.height=4.5} library(EnvStats) -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -samp<-sort(samp) -plot(ecdf(samp),main="Empirical and fitted SSDs",xlab="Concentration",ylab="Probability") -xx<-seq(0.01,3,by=0.01) -lines(xx,plnorm(xx,meanlog=-0.6695120,sd=0.7199573),col= "#77d408" ) -lines(xx,pgamma(xx,shape = 2.0591977,scale = 0.3231032),col="#08afd4") -lines(xx,ppareto(xx, location = 0.1800000,shape = 0.9566756),col="red") -#lines(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +samp <- sort(samp) +plot(ecdf(samp), main = "Empirical and fitted SSDs", xlab = "Concentration", ylab = "Probability") +xx <- seq(0.01, 3, by = 0.01) +lines(xx, plnorm(xx, meanlog = -0.6695120, sd = 0.7199573), col = "#77d408") +lines(xx, pgamma(xx, shape = 2.0591977, scale = 0.3231032), col = "#08afd4") +lines(xx, ppareto(xx, location = 0.1800000, shape = 0.9566756), col = "red") +# lines(xx,(0.4419*plnorm(xx,meanlog=mean(log(samp[5:15])),sd=sd(log(samp[5:15])))+ # 0.5581*plnorm(xx,meanlog=mean(log(samp[1:10])),sd=sd(log(samp[1:10])))) ,col="#d40830") - - ```

@@ -348,27 +342,27 @@ where $k$ is the number of model parameters and $\ell$ is the *likelihood* for t ```{r, echo=TRUE} -sum(log(dgamma(dat$Conc,shape = 2.0591977,scale = 0.3231032))) -sum(log(dlnorm(dat$Conc, meanlog = -0.6695120,sdlog = 0.7199573))) -sum(log(EnvStats::dpareto(dat$Conc,location = 0.1800000, shape=0.9566756))) +sum(log(dgamma(dat$Conc, shape = 2.0591977, scale = 0.3231032))) +sum(log(dlnorm(dat$Conc, meanlog = -0.6695120, sdlog = 0.7199573))) +sum(log(EnvStats::dpareto(dat$Conc, location = 0.1800000, shape = 0.9566756))) ``` From which the *AIC* values readily follow: ```{r echo=FALSE,results='markup'} -dat<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -k<-2 # number of parameters for each of the distributions +dat <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +k <- 2 # number of parameters for each of the distributions # Gamma distribution -aic1<-2*k-2*sum(log(dgamma(dat,shape = 2.0591977,scale = 0.3231032))) -cat("AIC for gamma distribution =",aic1,"\n") +aic1 <- 2 * k - 2 * sum(log(dgamma(dat, shape = 2.0591977, scale = 0.3231032))) +cat("AIC for gamma distribution =", aic1, "\n") # lognormal distribution -aic2<-2*k-2*sum(log(dlnorm(dat, meanlog = -0.6695120,sdlog = 0.7199573))) -cat("AIC for lognormal distribution =",aic2,"\n") +aic2 <- 2 * k - 2 * sum(log(dlnorm(dat, meanlog = -0.6695120, sdlog = 0.7199573))) +cat("AIC for lognormal distribution =", aic2, "\n") # Pareto distribution -aic3<-2*k-2*sum(log(EnvStats::dpareto(dat,location = 0.1800000, shape=0.9566756))) -cat("AIC for Pareto distribution =",aic3,"\n") +aic3 <- 2 * k - 2 * sum(log(EnvStats::dpareto(dat, location = 0.1800000, shape = 0.9566756))) +cat("AIC for Pareto distribution =", aic3, "\n") ```

@@ -391,25 +385,27 @@ where $AI{C_0}$ is the *AIC* for the **best-fitting** model (i.e.$AI{C_0} = \mat ```{r echo=TRUE,results='hide'} -dat<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -aic<-NULL -k<-2 # number of parameters for each of the distributions +dat <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +aic <- NULL +k <- 2 # number of parameters for each of the distributions -aic[1]<-2*k-2*sum(log(dgamma(dat,shape = 2.0591977,scale = 0.3231032))) # Gamma distribution +aic[1] <- 2 * k - 2 * sum(log(dgamma(dat, shape = 2.0591977, scale = 0.3231032))) # Gamma distribution -aic[2]<-2*k-2*sum(log(dlnorm(dat, meanlog = -0.6695120,sdlog = 0.7199573))) # lognormal distribution +aic[2] <- 2 * k - 2 * sum(log(dlnorm(dat, meanlog = -0.6695120, sdlog = 0.7199573))) # lognormal distribution -aic[3]<-2*k-2*sum(log(EnvStats::dpareto(dat,location = 0.1800000, shape=0.9566756))) # Pareto distribution +aic[3] <- 2 * k - 2 * sum(log(EnvStats::dpareto(dat, location = 0.1800000, shape = 0.9566756))) # Pareto distribution -delta<-aic-min(aic) # compute the delta values +delta <- aic - min(aic) # compute the delta values -aic.w<-exp(-0.5*delta); aic.w<-round(aic.w/sum(aic.w),4) - -cat(" AIC weight for gamma distribution =",aic.w[1],"\n", - "AIC weight for lognormal distribution =",aic.w[2],"\n", - "AIC weight for pareto distribution =",aic.w[3],"\n") +aic.w <- exp(-0.5 * delta) +aic.w <- round(aic.w / sum(aic.w), 4) +cat( + " AIC weight for gamma distribution =", aic.w[1], "\n", + "AIC weight for lognormal distribution =", aic.w[2], "\n", + "AIC weight for pareto distribution =", aic.w[3], "\n" +) ``` ``` AIC weight for gamma distribution = 0.1191 @@ -421,18 +417,17 @@ cat(" AIC weight for gamma distribution =",aic.w[1],"\n", Finally, let's look at the fitted *model-averaged SSD*: ```{r echo=FALSE,fig.cap="Empirical cdf (black) and model-averaged fit (magenta)",fig.width=8,fig.height=5} -samp<-c(1.73,0.57,0.33,0.28,0.3,0.29,2.15,0.8,0.76,0.54,0.42,0.83,0.21,0.18,0.59) -samp<-sort(samp) -plot(ecdf(samp),main="Empirical and fitted SSDs",xlab="Concentration",ylab="Probability") -xx<-seq(0.01,3,by=0.005) - -lines(xx,plnorm(xx,meanlog=-0.6695120,sd=0.7199573),col= "#959495",lty=2 ) -lines(xx,pgamma(xx,shape = 2.0591977,scale = 0.3231032),col="#959495",lty=3) -lines(xx,ppareto(xx, location = 0.1800000,shape = 0.9566756),col="#959495",lty=4) -lines(xx,0.1191*pgamma(xx,shape = 2.0591977,scale = 0.3231032) + - 0.3985*plnorm(xx,meanlog=-0.6695120,sd=0.7199573) + - 0.4824*ppareto(xx, location = 0.1800000,shape= 0.9566756),col="#FF33D5",lwd=1.5) - +samp <- c(1.73, 0.57, 0.33, 0.28, 0.3, 0.29, 2.15, 0.8, 0.76, 0.54, 0.42, 0.83, 0.21, 0.18, 0.59) +samp <- sort(samp) +plot(ecdf(samp), main = "Empirical and fitted SSDs", xlab = "Concentration", ylab = "Probability") +xx <- seq(0.01, 3, by = 0.005) + +lines(xx, plnorm(xx, meanlog = -0.6695120, sd = 0.7199573), col = "#959495", lty = 2) +lines(xx, pgamma(xx, shape = 2.0591977, scale = 0.3231032), col = "#959495", lty = 3) +lines(xx, ppareto(xx, location = 0.1800000, shape = 0.9566756), col = "#959495", lty = 4) +lines(xx, 0.1191 * pgamma(xx, shape = 2.0591977, scale = 0.3231032) + + 0.3985 * plnorm(xx, meanlog = -0.6695120, sd = 0.7199573) + + 0.4824 * ppareto(xx, location = 0.1800000, shape = 0.9566756), col = "#FF33D5", lwd = 1.5) ``` As can be seen from the figure above, the model-averaged fit provides a very good fit to the empirical data. diff --git a/vignettes/small-sample-bias.pdf b/vignettes/small-sample-bias.pdf new file mode 100644 index 000000000..5cbdf7f97 Binary files /dev/null and b/vignettes/small-sample-bias.pdf differ diff --git a/vignettes/small-sample-bias.pdf.asis b/vignettes/small-sample-bias.pdf.asis new file mode 100644 index 000000000..16a48f217 --- /dev/null +++ b/vignettes/small-sample-bias.pdf.asis @@ -0,0 +1,6 @@ +%\VignetteIndexEntry{Small sample bias in estimates} +%\VignetteEngine{R.rsp::asis} +%\VignetteKeyword{PDF} +%\VignetteKeyword{HTML} +%\VignetteKeyword{vignette} +%\VignetteKeyword{package} diff --git a/vignettes/ssdtools.Rmd b/vignettes/ssdtools.Rmd index 6e02fbf4f..372296975 100644 --- a/vignettes/ssdtools.Rmd +++ b/vignettes/ssdtools.Rmd @@ -197,7 +197,7 @@ The hazard/protection concentrations can be obtained using the ssd_hc function, ```{r, cache=TRUE} set.seed(99) -boron_hc5 <- ssd_hc(fits, proportion = 0.05, ci = TRUE) +boron_hc5 <- ssd_hc(fits, proportion = 0.05, ci = TRUE) print(boron_hc5) boron_pc <- ssd_hp(fits, conc = boron_hc5$est, ci = TRUE) print(boron_pc) @@ -209,11 +209,11 @@ If the `right` argument in `ssd_fit_dists()` is different to the `left` argument Let's make some example censored data. ```{r} -example_dat <- ssddata::ccme_boron |> - dplyr::mutate(left=Conc, right=Conc) +example_dat <- ssddata::ccme_boron |> + dplyr::mutate(left = Conc, right = Conc) -left_censored_example <- example_dat -left_censored_example$left[c(3,6,8)] <- NA +left_censored_example <- example_dat +left_censored_example$left[c(3, 6, 8)] <- NA ``` There are less goodness-of-fit statistics available for @@ -225,9 +225,10 @@ However, if all the models have the same number of parameters, the `AIC` `delta` For this reason, `ssdtools` only permits the analysis of censored data using two-parameter models. We can call only the default two parameter models using `ssd_dists_bcanz(n = 2)`. ```{r, eval = TRUE} -left_censored_dists <- ssd_fit_dists(left_censored_example, - dists = ssd_dists_bcanz(n = 2), - left = "left", right = "right") +left_censored_dists <- ssd_fit_dists(left_censored_example, + dists = ssd_dists_bcanz(n = 2), + left = "left", right = "right" +) ssd_hc(left_censored_dists, average = FALSE) ssd_hc(left_censored_dists) ssd_gof(left_censored_dists) @@ -247,11 +248,12 @@ ssd_plot(left_censored_example, left_censored_pred, Note that `ssdtools` doesn't currently support right censored data: ```{r, eval = TRUE} -right_censored_example <- example_dat -right_censored_example$right[c(3,6,8)] <- NA -right_censored_dists <- try(ssd_fit_dists(right_censored_example, - dists = ssd_dists_bcanz(n = 2), - left = "left", right = "right")) +right_censored_example <- example_dat +right_censored_example$right[c(3, 6, 8)] <- NA +right_censored_dists <- try(ssd_fit_dists(right_censored_example, + dists = ssd_dists_bcanz(n = 2), + left = "left", right = "right" +)) ``` diff --git a/vignettestatic/small-sample-bias.Rmd b/vignettestatic/small-sample-bias.Rmd new file mode 100644 index 000000000..2b62671e4 --- /dev/null +++ b/vignettestatic/small-sample-bias.Rmd @@ -0,0 +1,816 @@ +--- +title: "Small sample bias in estimates" +author: "sstools Team" +date: '`r format(Sys.time(), "%Y-%m-%d")`' +output: pdf_document +vignette: > + %\VignetteIndexEntry{Small sample bias in estimates} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, + fig.width = 6, + fig.height = 6) + +library(ggplot2) +library(mle.tools) +library(reshape2) +library(ssdtools) + +nsim <- 1000 # number of simulations for effect of bias correction +``` + +## Introduction + +### What is the issue + +The *ssdtools* package uses the method of Maximum Likelihood (ML) to estimate parameters for each distribution that is fit to the data. Statistical theory +says that maximum likelihood estimators are asymptotically unbiased, but does +not guarantee performance in small samples. + +For example, consider the CCME silver data that ships with *ssdtools*. + +```{r warning=FALSE, message=FALSE} +Ag <- ssddata::ccme_silver +Ag$ecdf <- (rank(Ag$Conc)+.25)/(nrow(Ag)+.5) +Ag +``` + +Let us fit a log-normal distribution to the Ag endpoint data and estimate the parameters: + +```{r warning=FALSE, message=FALSE} +fit <- ssd_fit_dists(Ag, dist="lnorm") +fit +``` + +For most distributions, the MLE must be found numerically by iterative +methods, but the log-normal distribution has easily computed estimators. + +The *meanlog* parameter shown above represents the mean of the concentrations +on the (natural) logarithmic scale and we can easily reproduce +this value: + +```{r } +mean(log(Ag$Conc)) +``` + +The *sdlog* parameter represents the standard deviation on the logarithmic scale, but +the direct computation of the standard deviation gives a slightly different +result: + +```{r } +sd(log(Ag$Conc)) +``` + + +It turns out that in small samples, the MLE of the standard deviation +for a log-normal distribution has a negative bias, i.e. the MLE tends to be +smaller than the underlying true parameter value. The cause of this bias +is found by comparing the formula for the MLE of the standard deviation +and the traditional estimator for the standard deviation: + +$$ \widehat{\sigma}_{MLE} = \sqrt{\frac{\sum{(Y_i-\overline{Y})^2}}{{n}}}$$ +$$ \widehat{\sigma}_{traditional} = \sqrt{\frac{\sum{(Y_i-\overline{Y})^2}}{{n-1}}}$$ + +where $n$ is the sample size, $Y_i$ are the $\log(concentrations)$, and +$\overline{Y}$ is the sample mean concentration again on the logarithmic scale. + +We notice that the MLE uses a divisor of $n$ while the traditional +method uses a divisor of $n-1$. Hence the MLE has a negative bias and its value +is +`r round(estimates(fit)$lnorm.sdlog/sd(log(Ag$Conc)),2)`x the +usual estimator for $\sigma$ which is +$\sqrt{\frac{n-1}{n}}$ = +`r round(sqrt((nrow(Ag)-1)/(nrow(Ag))),2)` evaluated at $n$ = `r nrow(Ag)` . + +As the sample size +increases the absolute size of the bias will get smaller and smaller, i.e., +if $n=20$, then the MLE estimator is `r round(sqrt((20-1)/(20)),2)`x the traditional +estimator for $\sigma$ +which is neglible given the uncertainties in the actual end points. + +Conversly, as the sample size decreases, the absolute size of the bias could become quite large, i.e., +if $n=4$, then the MLE is `r round(sqrt((4-1)/(4)),2)`x the traditional estimator. But +if you are fitting a species sensitivity distribution to only 4 data values, +perhaps concern about bias in MLE is misplaced. Australian guidelines recommend a minimum sample size of 8 species. + +## What is the impact on the HCx value? +If the standard deviation is underestimated, then the tails of the +distribution will be pulled inwards and the HCx values will tend +to be larger compared to the case where the standard deviation is not deflated +as shown in the following plot: + +```{r echo=FALSE,message=FALSE, warning=FALSE} +MLEcurve <- data.frame(logConc=seq(-3,3,.1), source="MLE") +MLEcurve$density <- pnorm(MLEcurve$logConc, mean=estimates(fit)$lnorm.meanlog, + sd= estimates(fit)$lnorm.sdlog) +REGcurve <- data.frame(logConc=seq(-3,3,.1), source="Corrected SD") +REGcurve$density <- pnorm(REGcurve$logConc, + mean=estimates(fit)$lnorm.meanlog, + sd= sd(log(Ag$Conc))) +plotdata <- rbind(MLEcurve, REGcurve) +ggplot(data=plotdata, aes(x=logConc, y=density))+ + ggtitle( "Comparing the estimated cumulative density computed using \nMLE and bias-corrected SD", + subtitle=paste("Ag CCME data with n=",nrow(Ag),sep=""))+ + geom_line(aes(color=source, linetype=source))+ + geom_hline(yintercept=.05)+ + ylab("Cumulative probabiity")+ + xlab("log(Concentration) \n Horizontal line represents the HC5")+ + geom_point(data=Ag, aes(x=log(Conc),y=ecdf)) + + +``` + +```{r echo=FALSE} +# compute the HC5 from the two fit +MLE.HC5.log <- qnorm(.05,mean=estimates(fit)$lnorm.meanlog, sd= estimates(fit)$lnorm.sdlog) +MLE.HC5 <- exp(MLE.HC5.log) +REG.HC5.log <- qnorm(.05,mean=estimates(fit)$lnorm.meanlog, sd= sd(log(Ag$Conc)) ) +REG.HC5 <- exp(REG.HC5.log) + +MLE.HC1.log <- qnorm(.01,mean=estimates(fit)$lnorm.meanlog, sd= estimates(fit)$lnorm.sdlog) +MLE.HC1 <- exp(MLE.HC1.log) +REG.HC1.log <- qnorm(.01,mean=estimates(fit)$lnorm.meanlog, sd= sd(log(Ag$Conc)) ) +REG.HC1 <- exp(REG.HC1.log) + + +``` + +The HC5 estimated from the MLE fit is `r round(MLE.HC5.log,2)` on the logarithmic concentrations +scale or `r round(MLE.HC5,3)` on the concentration scale. +The HC5 estimated after correcting the standard deviation for small sample bias is +`r round(REG.HC5.log,2)` on the logarithmic concentrations +scale or `r round(REG.HC5,3)` on the concentration scale. +The ratio of HC5 values +is `r round(REG.HC5/MLE.HC5,2)`x on the concentration scale, i.e. +the estimated HC5 from the MLE is `r round(MLE.HC5/REG.HC5,1)`x larger than the HC5 computed using the bias correction. + +The differences between the HCx computed from the MLE fit and using the corrected +standard deviation will become more pronounced for small HCx values. For example, +the HC1 estimated from the MLE fit is `r round(MLE.HC1,3)` +and the HC1 estimated using the corrected standard deviation +is `r round(REG.HC1,3)` on the concentration scale. +The ratio of the HC1 values +is `r round(REG.HC1/MLE.HC1,2)`x on the concentrations scale, i.e. +the estimated HC1 from the MLE is `r round(MLE.HC1/REG.HC1,1)`x larger than the HC5 computed using the bias correction. + + +## What can be done? +A similar concernalso occurs with other distributions. Howeve, except for a few distributions, +such as the normal distribution, analytical expressions for the MLE +and for unbiased estimators do not exist. The *mle.tools* package from CRAN +provides a method that numerically corrects the bias after the fit is completed. + +### Bias correction using Cox-Snell method - log-normal distribution + +For example, again using the Ag log-normal fit we have: +```{r } +# apply the Cox and Snell (1968) bias correction using mle.tools. +# what is the density function +norm.pdf <- quote(1 / (sqrt(2 * pi) * sigma) * exp(-0.5 / sigma ^ 2 * (x - mu) ^ 2)) +norm.pdf + +# what is the log(density) function (ignoring constants) +log.norm.pdf <- quote(- log(sigma) - 0.5 / sigma ^ 2 * (x - mu) ^ 2) +log.norm.pdf + + +bias.correct <- coxsnell.bc(density = norm.pdf, + logdensity = log.norm.pdf, + n = length(Ag$Conc), + parms = c("mu", "sigma"), + mle = c(estimates(fit)$lnorm.meanlog, + estimates(fit)$lnorm.sdlog), + lower = '-Inf', upper = 'Inf') +bias.correct + +``` + +The biased corrected value for the standard deviation is +`r round(bias.correct$mle.b["sigma"],2)` which is comparable +to the standard deviation of the log(concentration) found +earlier of `r round(sd(log(Ag$Conc)),2)`. + + +A small simulation study was conducted to investigate the effect of sample size +on the bias correction and effects of the small-sample bias in the estimates +of HC5 and HC1. For this simulation study, it was assumed that a log-normal +distribution represented the distribution of endpoints among species with a mean of 0 +and a standard deviation of 1 (on the logarithmic scale). These values are arbitrary, but +any log-normal distribution can be rescaled (e.g. by changing units) to have this mean +and standard deviation. + +Simulated data sets at various sample sizes were generated, the MLE and bias-corrected estimates +were obtained and these were used to estimate the HC5 and HC1 on the $\log()$ and anti-log scales. The average +value of each response was then computed and plotted vs. the actual parameter values based +on the known mean and standard deviation (shown in the plot below as a black horizontal line). +For example, for a log-normal distribution with a mean +of 0 and a standard deviation of 1 on the log-scale, the $log(HC5)$ is the 0.05 quantile +of the normal distribution or `r round(qnorm(.05, 0, 1),3)`. + +A plot of the results is: + +```{r message=FALSE, warning=FALSE, include=FALSE} +# Simulation study to estimate effect of small sample bias on estimates of HC5 and HC1 +# Use a normal distribution +set.seed(964544) + +mu <- 0 +sd <- 1 + +sample.sizes <- c(6, 8, 10, 12, 15, 20, 25, 30, 50) + +res <- plyr::ldply(sample.sizes, function(n, mu, sd, nsim=1000){ + fits <- plyr::ldply(1:nsim, function(sim, n, mu, sd){ + + fit <- NULL + while(is.null(fit)) { + try({ + # generate sample of size n from a normal distribution with specified mean and variance + df <- data.frame(Conc= exp(rnorm(n, mean=mu, sd=sd))) + + # find the mle using ssd tools + fit <- ssd_fit_dists(df, dist="lnorm") + }, silent=TRUE) + } + + # find the bias corrected estimates + norm.pdf <- quote(1 / (sqrt(2 * pi) * sigma) * exp(-0.5 / sigma ^ 2 * (x - mu) ^ 2)) + # what is the log(density) function (ignoring constants) + log.norm.pdf <- quote(- log(sigma) - 0.5 / sigma ^ 2 * (x - mu) ^ 2) + log.norm.pdf + + bias.correct <- coxsnell.bc(density = norm.pdf, + logdensity = log.norm.pdf, + n = n, + parms = c("mu", "sigma"), + mle = c(estimates(fit)$lnorm.meanlog, + estimates(fit)$lnorm.sdlog), + lower = '-Inf', upper = 'Inf') + + # find the hc5 and hc1 using the MLE and bias corrected values + # compute the HC5 from the two fit + actual.HC5.log <- qnorm(.05, mean=mu, sd=sd) + actual.HC1.log <- qnorm(.01, mean=mu, sd=sd) + actual.HC5 <- exp(actual.HC5.log) + actual.HC1 <- exp(actual.HC1.log) + MLE.HC5.log <- qnorm(.05,mean=estimates(fit)$lnorm.meanlog, sd= estimates(fit)$lnorm.sdlog) + MLE.HC5 <- exp(MLE.HC5.log) + BC.HC5.log <- qnorm(.05,mean=bias.correct$mle.bc["mu"], + sd =bias.correct$mle.bc["sigma"] ) + BC.HC5 <- exp(BC.HC5.log) + + MLE.HC1.log <- qnorm(.01,mean=estimates(fit)$lnorm.meanlog, sd= estimates(fit)$lnorm.sdlog) + MLE.HC1 <- exp(MLE.HC1.log) + BC.HC1.log <- qnorm(.01,mean=bias.correct$mle.bc["mu"], + sd =bias.correct$mle.bc["sigma"] ) + BC.HC1 <- exp(BC.HC1.log) + + data.frame(n=n, sim=sim, mu=mu, sd=sd, + mle.meanlog=estimates(fit)$lnorm.meanlog, + mle.sdlog =estimates(fit)$lnorm.sdlog, + bc.meanlog = bias.correct$mle.bc["mu"], + bc.sdlog = bias.correct$mle.bc["sigma"], + actual.HC5.log, + actual.HC5, + actual.HC1.log, + actual.HC1, + MLE.HC5.log = MLE.HC5.log, + MLE.HC5, + BC.HC5.log, + BC.HC5, + MLE.HC1.log, + MLE.HC1, + BC.HC1.log, + BC.HC1) + }, n=n, mu=mu, sd=sd) + fits +}, mu=mu, sd=sd, nsim=nsim) + +head(res) +# summarize the output from the simulation +res.summary <- plyr::ddply(res,"n", plyr::summarize, + n=mean(n), + nsims=max(sim), + mu=mean(mu), + sd=mean(sd), + mean.mle.meanlog= mean(mle.meanlog), + mean.mle.sdlog = mean(mle.sdlog), + mean.bc.meanlog = mean(bc.meanlog), + mean.bc.sdlog = mean(bc.sdlog), + actual.HC5.log = mean(actual.HC5.log), + actual.HC1.log = mean(actual.HC1.log), + mean.mle.HC5.log= mean(MLE.HC5.log), + mean.mle.HC1.log= mean(MLE.HC1.log), + mean.bc.HC5.log = mean(BC.HC5.log), + mean.bc.HC1.log = mean(BC.HC1.log), + mean.mle.HC5 = mean(MLE.HC5), + mean.mle.HC1 = mean(MLE.HC1), + mean.bc.HC5 = mean(BC.HC5), + mean.bc.HC1 = mean(BC.HC1) + + ) +res.summary + + +plotdata <- reshape2::melt(res.summary, + id.vars="n", + value.name="value", + variable.name="Measure") +plotdata$Measure <- as.character(plotdata$Measure) +unique(plotdata$Measure) +str(plotdata) + +plotdata$parameter <- car::recode(plotdata$Measure, + " 'mean.mle.meanlog'='Mean of log(Conc)'; + 'mean.bc.meanlog' ='Mean of log(Conc)'; + 'mean.mle.sdlog' ='SD of log(Conc)'; + 'mean.bc.sdlog' ='SD of log(Conc)'; + 'mean.mle.HC5.log'='log(HC)'; + 'mean.mle.HC1.log'='log(HC)'; + 'mean.bc.HC5.log' ='log(HC)'; + 'mean.bc.HC1.log' ='log(HC)'; + 'mean.mle.HC5' ='actual HC'; + 'mean.mle.HC1' ='actual HC'; + 'mean.bc.HC5' ='actual HC'; + 'mean.bc.HC1' ='actual HC'; + + ") + +plotdata$method <- car::recode(plotdata$Measure, + "'mean.mle.meanlog'='MLE'; + 'mean.bc.meanlog' ='BC'; + 'mean.mle.sdlog' ='MLE'; + 'mean.bc.sdlog' ='BC'; + 'mean.mle.HC5.log'='MLE'; + 'mean.mle.HC1.log'='MLE'; + 'mean.bc.HC5.log' ='BC'; + 'mean.bc.HC1.log' ='BC'; + 'mean.mle.HC5' ='MLE'; + 'mean.mle.HC1' ='MLE'; + 'mean.bc.HC5' ='BC'; + 'mean.bc.HC1' ='BC'; + + ") + +plotdata$HC <- car::recode(plotdata$Measure, + "'mean.mle.HC5.log'='HC5'; + 'mean.mle.HC1.log'='HC1'; + 'mean.bc.HC5.log' ='HC5'; + 'mean.bc.HC1.log' ='HC1'; + 'mean.mle.HC5' ='HC5'; + 'mean.mle.HC1' ='HC1'; + 'mean.bc.HC5' ='HC5'; + 'mean.bc.HC1' ='HC1'; + + else='NA'; + ") + +head(plotdata) + +xtabs(~Measure+parameter, data=plotdata, exclude=NULL, na.action=na.pass) +xtabs(~Measure+method , data=plotdata, exclude=NULL, na.action=na.pass) + +select <- grepl("meanlog", plotdata$Measure) | + grepl("sdlog" , plotdata$Measure) | + grepl("mle.HC5.log", plotdata$Measure) | + grepl("mle.HC1.log", plotdata$Measure) | + grepl("bc.HC5.log", plotdata$Measure) | + grepl("bc.HC1.log", plotdata$Measure) | + grepl("mle.HC5", plotdata$Measure) | + grepl("mle.HC1", plotdata$Measure) | + grepl("bc.HC5", plotdata$Measure) | + grepl("bc.HC1", plotdata$Measure) + +plotdata[select,] + +true.parms <- data.frame(parameter=c("Mean of log(Conc)", + "SD of log(Conc)", + "log(HC)", + "log(HC)", + "actual HC", + 'actual HC'), + value=c(0,1,qnorm(.05, mu, sd), qnorm(.01, mu, sd), exp(qnorm(.05, mu, sd)), exp(qnorm(.01, mu, sd))), + linetype=c("solid","solid","dashed","solid","dashed","solid"), stringsAsFactors=FALSE) +true.parms + +simplot <- ggplot(data=plotdata[select,], aes(x=n, y=value,color=method, linetype=HC))+ + ggtitle("Performance of mle and bias corrected estimators", + subtitle=paste("Log-normal distribution with mean= ", mu, ' and sd =',sd,' on the log() scale',sep=""))+ + geom_point(position=position_jitter(w=0.4))+ + geom_line( position=position_jitter(w=0.4))+ + facet_wrap(~parameter, ncol=2,scales="free")+ + geom_hline(data=true.parms, aes(yintercept=value), linetype=true.parms$linetype)+ + xlab("Sample size")+ + scale_linetype_discrete(na.value="solid", breaks=c("HC1","HC5"), ) +``` +```{r echo=FALSE, message=FALSE, warning=FALSE} +simplot +``` + +The MLE is unbiased for the mean of the log-normal distribution (bottom left plot) - +the apparent deviations from the true value of 0 are very small (note the scale +on the $Y$ axis) and simply simulation artefacts. + +The MLE for the standard deviation +is biased downwards (lower right plot) and the bias become smaller with +increasing sample size (the curve for the mean of the MLE estimate of the +standard deviation increases and approaches the true value of 0). The bias-correction for the +standard deviation is effective for all but the smallest sample sizes. + +The estimated $\log{HC}$ (upper right plot) based on the MLE is biased upwards (i.e. larger) than the true +values but the bias declines with sample size (as expected). The +estimate of the $\log{HC}$ based on the bias-corrected estimates performs well +(close to the true value) except at very small sample sizes. + +Finally, the estimated $HC1$ and $HC5$ values are again biased upwards (upper left plot). +This bias consists of two parts + +1. bias in the underlying estimates of the parameters +of the distribution +2. non-linear tranformation bias, i.e. the mean of a function of the parameter values is +not equal to the function evaluated at the mean of the parameter values. For example, the +HC5 is found as the anti-log of the 5$^{th}$ percentile of the normal distribution. Suppose +we have two simulation results where the estimated 5$^{th}$ percentile of the fitted normal distribution +were $-1.8$ and $-1.5$. The mean of the estimated 5$^th$ percentile is $\frac{-1.8+(-1.5)}{2}=-1.65$ and +is unbiased for the actual percentile value of $-1.645$. However, the actual HC5 is found as the anti-log +of the two individual estimates, i.e. $\exp(-1.8)=0.165$ and $\exp(-1.6)=.223$ whose mean is 0.194, but +the anti-log of the average, $exp(-1.65)=.192$ which is not the same value. + +The total bias does not appear to be large except in the case of very small sample sizes. + +### Bias correction using Cox-Snell method - gamma distribution + +We can also apply this to other distributions such as the gamma +distribution. If we fit a gamma distribution to the +Ag data we obtain: +```{r warnings=FALSE, message=FALSE} +fit.gamma <- ssd_fit_dists(Ag, dist="gamma") +fit.gamma +``` +The bias corrected estimates are: +```{r } +# apply the Cox and Snell (1968) bias correction using mle.tools. +# what is the density function +gamma.pdf <- quote(1 /(scale ^ shape * gamma(shape)) * x ^ (shape - 1) * exp(-x / scale)) +gamma.pdf + +# what is the log(density) functiong ingoring constants +log.gamma.pdf <- quote(-shape * log(scale) - lgamma(shape) + shape * log(x) - + x / scale) +log.gamma.pdf + +bias.correct.gamma <- coxsnell.bc(density = gamma.pdf, + logdensity = log.gamma.pdf, + n = length(Ag$Conc), + parms = c("shape", "scale"), + mle = c(estimates(fit.gamma)$gamma.shape, + estimates(fit.gamma)$gamma.scale), + lower = 0, upper = 'Inf') +bias.correct.gamma + +``` + +The two cumulative density functions are: + +```{r echo=FALSE,message=FALSE, warning=FALSE} +MLEcurve <- data.frame(logConc=seq(-5,3,.1), source="MLE") +MLEcurve$density <- pgamma(exp(MLEcurve$logConc), + shape=estimates(fit.gamma)$gamma.shape, + scale=estimates(fit.gamma)$gamma.scale) +REGcurve <- data.frame(logConc=seq(-5,3,.1), source="Bias corrected") +REGcurve$density <- pgamma(exp(REGcurve$logConc), + shape=bias.correct.gamma$mle.bc["shape"], + scale=bias.correct.gamma$mle.bc["scale"]) +plotdata <- rbind(MLEcurve, REGcurve) +ggplot(data=plotdata, aes(x=logConc, y=density))+ + ggtitle( "Comparing the estimated cumulative gamma density \nusing MLE and bias correction", + subtitle=paste("Ag CCME data with n=",nrow(Ag), + ' and gamma fit',sep=""))+ + geom_line(aes(color=source, linetype=source))+ + geom_hline(yintercept=.05)+ + xlab("log(Concentration) \n Horizontal line represents the HC5")+ + ylab("Cumulative probability")+ + geom_point(data=Ag, aes(x=log(Conc),y=ecdf)) + +``` + +```{r echo=FALSE} +# compute the HC5 from the two fit +MLE.gamma.HC5.log <- log(qgamma(.05, + shape=estimates(fit.gamma)$gamma.shape, + scale=estimates(fit.gamma)$gamma.scale)) +MLE.gamma.HC5 <- exp(MLE.gamma.HC5.log) +REG.gamma.HC5.log <- log(qgamma(.05, + shape=bias.correct.gamma$mle.bc["shape"], + scale=bias.correct.gamma$mle.bc["scale"])) +REG.gamma.HC5 <- exp(REG.gamma.HC5.log) + +MLE.gamma.HC1.log <- log(qgamma(.01, + shape=estimates(fit.gamma)$gamma.shape, + scale=estimates(fit.gamma)$gamma.scale)) +MLE.gamma.HC1 <- exp(MLE.gamma.HC1.log) +REG.gamma.HC1.log <- log(qgamma(.01, + shape=bias.correct.gamma$mle.bc["shape"], + scale=bias.correct.gamma$mle.bc["scale"])) +REG.gamma.HC1 <- exp(REG.gamma.HC1.log) + + +``` + +The HC5 estimated from the MLE.gamma fit is `r round(MLE.gamma.HC5.log,2)` on the logarithmic concentrations +scale or `r round(MLE.gamma.HC5,3)` on the concentration scale. +The HC5 estimated after correcting for small sample bias is +`r round(REG.gamma.HC5.log,2)` on the logarithmic concentrations +scale or `r round(REG.gamma.HC5,3)` on the concentration scale. The ratio of these two HC5 values +is `r round(REG.gamma.HC5/MLE.gamma.HC5,3)`x on the concentration scale, +i.e. the HCx based on the MLE is `r round(MLE.gamma.HC5/REG.gamma.HC5,1)`x larger on the concentration scale. + +The differences between the HCx computed from the MLE and for +the bias corrected estimates will become more pronounced for small HCx values. For example, +the HC1 estimated from the MLE.gamma fit is `r round(MLE.gamma.HC1,3)` +and the HC1 estimated using the biased corrected estimates +is `r formatC(REG.gamma.HC1,digits=6, format="f")` on the concentration scale. The ratio of these two values +is now `r round(REG.gamma.HC1/MLE.gamma.HC1,3)`x, +i.e. the HCx based on the MLE is `r round(MLE.gamma.HC1/REG.gamma.HC1,1)`x larger on the concentration scale. + + +We repeated a similar simulation study with the gamma distribution. The shape and scale +parameters were chosen to match the mean and variance of the log-normal distribution used +in the previous simulation study. + +```{r echo=FALSE, message=FALSE, warning=FALSE, include=FALSE} +# Simulation study to estimate effect of small sample bias on estimates of HC5 and HC1 +# Use a gamma distribution with the same mean and sd as a log-normal (0,1) + +set.seed(23432) + + +# get the shape and scale parameter +mean.log <- 0 +sd.log <- 1 +mu <- exp(mean.log+.5*sd.log^2) +sd <- sqrt(exp(sd.log^2-1) * (exp(2*mean.log + sd.log^2))) +cat("Mean and variance of lognormal(0,1)", mu, sd, "\n") + +# solve for shape and scale +scale = sd^2/mu +shape = mu/scale +cat("Estimated shape and scale ", shape, scale, "\n") +scale*shape +sqrt(shape*scale^2) + +mean(rgamma(1000, shape=shape, scale=scale)) +sd (rgamma(1000, shape=shape, scale=scale)) + +sample.sizes <- c(6, 8, 10, 12, 15, 20, 25, 30, 50) + +res <- plyr::ldply(sample.sizes, function(n, shape, scale, nsim=1000){ + fits <- plyr::ldply(1:nsim, function(sim, n, shape, scale){ + # generate sample of size n from a normal distribution with specified mean and variance + #browser() + sim.error=FALSE + fit <- NULL + while(is.null(fit)) { + try({ + df <- data.frame(Conc= rgamma(n, shape=shape, scale=scale)) + + # find the mle using ssd tools + fit <- ssd_fit_dists(df, dist="gamma") + }, silent=TRUE) + } + + # find the bias corrected estimates + gamma.pdf <- quote(1 /(scale ^ shape * gamma(shape)) * x ^ (shape - 1) * exp(-x / scale)) + + # what is the log(density) functiong ingoring constants + log.gamma.pdf <- quote(-shape * log(scale) - lgamma(shape) + shape * log(x) - x / scale) + #browser() + bias.correct <- try(coxsnell.bc(density = gamma.pdf, + logdensity = log.gamma.pdf, + n = n, + parms = c("shape", "scale"), + mle = c(estimates(fit)$gamma.shape, + estimates(fit)$gamma.scale), + lower = 0, upper = 'Inf')) + if(class(bias.correct)=="try-error"){ + sim.error = TRUE + cat("Gamma bias correct sim error ", n, sim, "\n") + bias.correct <- NULL + bias.correct$mle.bc <- c(shape=shape, scale=scale) + } + + # find the hc5 and hc1 using the MLE and bias corrected values + # compute the HC5 from the two fit + actual.HC5.log <- log(qgamma(.05, shape=shape, scale=scale)) + actual.HC1.log <- log(qgamma(.01, shape=shape, scale=scale)) + actual.HC5 <- exp(actual.HC5.log) + actual.HC1 <- exp(actual.HC1.log) + MLE.HC5.log <- log(qgamma(.05,shape=estimates(fit)$gamma.shape, scale=estimates(fit)$gamma.scale)) + MLE.HC5 <- exp(MLE.HC5.log) + BC.HC5.log <- log(qgamma(.05,shape = bias.correct$mle.bc["shape"], + scale = bias.correct$mle.bc["scale"] )) + BC.HC5 <- exp(BC.HC5.log) + + MLE.HC1.log <- log(qgamma(.01, shape=estimates(fit)$gamma.shape, scale= estimates(fit)$gamma.scale)) + MLE.HC1 <- exp(MLE.HC1.log) + BC.HC1.log <- log(qgamma(.01,shape=bias.correct$mle.bc["shape"], + scale=bias.correct$mle.bc["scale"] )) + BC.HC1 <- exp(BC.HC1.log) + + data.frame(n=n, sim=sim, shape=shape, scale=scale, + mle.shape = estimates(fit)$gamma.shape, + mle.scale = estimates(fit)$gamma.scale, + bc.shape = bias.correct$mle.bc["shape"], + bc.scale = bias.correct$mle.bc["scale"], + actual.HC5.log, + actual.HC5, + actual.HC1.log, + actual.HC1, + MLE.HC5.log = MLE.HC5.log, + MLE.HC5, + BC.HC5.log, + BC.HC5, + MLE.HC1.log, + MLE.HC1, + BC.HC1.log, + BC.HC1, + sim.error=sim.error) + }, n=n, shape=shape, scale=scale) + fits +}, shape=shape, scale=scale, nsim=nsim) + +# remove simulation errors +sum(res$sim.error) +res <- res[ !res$sim.error, ] + +head(res) +# summarize the output from the sishapelation +res.summary <- plyr::ddply(res,"n", plyr::summarize, + n=mean(n), + nsims=max(sim), + gamma.shape=mean(shape), + gamma.scale=mean(scale), + mean.mle.shape = mean(mle.shape), + mean.mle.scale = mean(mle.scale), + mean.bc.shape = mean(bc.shape), + mean.bc.scale = mean(bc.scale), + actual.HC5.log = mean(actual.HC5.log), + actual.HC1.log = mean(actual.HC1.log), + mean.mle.HC5.log= mean(MLE.HC5.log), + mean.mle.HC1.log= mean(MLE.HC1.log), + mean.bc.HC5.log = mean(BC.HC5.log), + mean.bc.HC1.log = mean(BC.HC1.log), + mean.mle.HC5 = mean(MLE.HC5), + mean.mle.HC1 = mean(MLE.HC1), + mean.bc.HC5 = mean(BC.HC5), + mean.bc.HC1 = mean(BC.HC1) + ) +res.summary + + +plotdata <- reshape2::melt(res.summary, + id.vars="n", + value.name="value", + variable.name="Measure") +plotdata$Measure <- as.character(plotdata$Measure) +unique(plotdata$Measure) +str(plotdata) + +plotdata$parameter <- car::recode(plotdata$Measure, + " 'mean.mle.shape'= 'Shape'; + 'mean.bc.shape' = 'Shape'; + 'mean.mle.scale' ='Scale'; + 'mean.bc.scale' ='Scale'; + 'mean.mle.HC5.log'='log(HC)'; + 'mean.mle.HC1.log'='log(HC)'; + 'mean.bc.HC5.log' ='log(HC)'; + 'mean.bc.HC1.log' ='log(HC)'; + 'mean.mle.HC5' ='actual HC'; + 'mean.mle.HC1' ='actual HC'; + 'mean.bc.HC5' ='actual HC'; + 'mean.bc.HC1' ='actual HC'; + + ") + +plotdata$method <- car::recode(plotdata$Measure, + "'mean.mle.shape' ='MLE'; + 'mean.bc.shape' ='BC'; + 'mean.mle.scale' ='MLE'; + 'mean.bc.scale' ='BC'; + 'mean.mle.HC5.log'='MLE'; + 'mean.mle.HC1.log'='MLE'; + 'mean.bc.HC5.log' ='BC'; + 'mean.bc.HC1.log' ='BC'; + 'mean.mle.HC5' ='MLE'; + 'mean.mle.HC1' ='MLE'; + 'mean.bc.HC5' ='BC'; + 'mean.bc.HC1' ='BC'; + ") + +plotdata$HC <- car::recode(plotdata$Measure, + "'mean.mle.HC5.log'='HC5'; + 'mean.mle.HC1.log'='HC1'; + 'mean.bc.HC5.log' ='HC5'; + 'mean.bc.HC1.log' ='HC1'; + 'mean.mle.HC5' ='HC5'; + 'mean.mle.HC1' ='HC1'; + 'mean.bc.HC5' ='HC5'; + 'mean.bc.HC1' ='HC1'; + else='NA'; + ") + +head(plotdata) + +xtabs(~Measure+parameter, data=plotdata, exclude=NULL, na.action=na.pass) +xtabs(~Measure+method , data=plotdata, exclude=NULL, na.action=na.pass) +unique(plotdata$Measure) +select <- grepl("mle.shape$", plotdata$Measure) | + grepl("mle.scale$", plotdata$Measure) | + grepl("bc.shape$" , plotdata$Measure) | + grepl("bc.scale$" , plotdata$Measure) | + grepl("mle.HC5.log", plotdata$Measure) | + grepl("mle.HC1.log", plotdata$Measure) | + grepl("bc.HC5.log", plotdata$Measure) | + grepl("bc.HC1.log", plotdata$Measure) | + grepl("mle.HC5", plotdata$Measure) | + grepl("mle.HC1", plotdata$Measure) | + grepl("bc.HC5", plotdata$Measure) | + grepl("bc.HC1", plotdata$Measure) + +plotdata[select,] + +true.parms <- data.frame(parameter=c("Shape", + "Scale", + "log(HC)", + "log(HC)", + "actual HC", + 'actual HC'), + value=c(shape,scale, + log(qgamma(.05, shape=shape, scale=scale)), log(qgamma(.01, shape=shape, scale=scale)), + qgamma(.05, shape=shape, scale=scale), qgamma(.01, shape=shape, scale=scale)), + linetype=c("solid","solid","dashed","solid","dashed","solid"), stringsAsFactors=FALSE) +true.parms + +sim.plot <- ggplot(data=plotdata[select,], aes(x=n, y=value,color=method, linetype=HC))+ + ggtitle("Performance of mle and bias corrected estimators", + subtitle=paste("Gamma distribution with shape= ", round(shape,2), ' and scale =',round(scale,2),sep=""))+ + geom_point(position=position_jitter(w=0.4))+ + geom_line( position=position_jitter(w=0.4))+ + facet_wrap(~parameter, ncol=2,scales="free")+ + geom_hline(data=true.parms, aes(yintercept=value), linetype=true.parms$linetype)+ + xlab("Sample size")+ + scale_linetype_discrete(na.value="solid", breaks=c("HC1","HC5") ) + +``` +```{r echo=FALSE, warning=FALSE, message=FALSE} +sim.plot +``` + +The MLEs are biased in small-samples for both the shape and scale (bottom row of plots) but the +small-sample bias declines as sample size increases (as expected). The biases of the +two parameters are in opposite directions (i.e. one bias is positive and one bias is negative). +The bias corrected estimates +are unbiased (as expected). + +The estimated $\log{HC}$ (upper right plot) based on the MLE is slightly biased upwards (i.e. larger) than the true +values but the bias rapidly declines with sample size (as expected). Rather surprisingly, the +estimated HC5 and HC1 values using the bias-corrected estimates are biased downwards, likely an artefact +of the non-linear transformation from scale and shape to the HCx. + +Finally, the estimated $HC1$ and $HC5$ values are again biased upwards (upper left plot) based +on the MLEs, but the estimated $HCx$ values based on the bias-corrected estimates appear to exhibit +less bias despite the bias in the $\log(HCx)$ values. + +## Recommendations + +In cases with reasonably large sample sizes (around 15+), the small sample bias is +unlikely to be of concern given the uncertainty in the endpoints actually used +for the fit, and the uncertainty generated for the HCx from the model averaging process. + +The small sample bias in the estimates is expected to affect the smaller +HCx values (e.g. HC1) more than larger HCx values (e.g. HC5). +This is not unexpected because you are +trying to extrapolate out to the extreme tails of the distribution where there +is typically no data available and small changes to parameter values can have +large impacts on the extreme tails. + +For smaller sample sizes, a similar exercise as above can be used to +estimate the impact of the small sample bias. Howeverr, for small sample sizes, +this exercise may be akin to "fiddling while Rome burns", i.e, this does not change the basic +problems with small sample sizes including (a) most distributions will have adequate fits and it is unlikely be possible to discriminate between distributions; +and (b) extrapoloting even to a moderate tail fraction (e.g. HC5) is very, very +dependent on the chosen distribution; (c) there is no data available +to support even moderate extrapolation to tail proportions. Higher certainty in +the estimates can only be obtained by increasing sample sizes. + +----- + +Creative Commons Licence
ssdtools by the Province of British Columbia + is licensed under a +Creative Commons Attribution 4.0 International License.