diff --git a/DESCRIPTION b/DESCRIPTION index 498805ab..d44df936 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,7 +10,7 @@ Depends: License: GPL-2 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Biarch: true Imports: formula.tools, @@ -21,6 +21,7 @@ Imports: tibble, tidyselect, evaluate, + modelbased, rlang, chk (>= 0.7.0) Suggests: diff --git a/NAMESPACE b/NAMESPACE index a39785b2..73397508 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -145,6 +145,7 @@ importFrom(graphics,mtext) importFrom(graphics,par) importFrom(graphics,plot) importFrom(loo,loo_model_weights) +importFrom(modelbased,zero_crossings) importFrom(purrr,map) importFrom(purrr,map_dfr) importFrom(rlang,.data) diff --git a/R/check_priors.R b/R/check_priors.R index 74251ffc..1429ca10 100644 --- a/R/check_priors.R +++ b/R/check_priors.R @@ -6,6 +6,8 @@ #' @param filename An optional \code{\link[base]{character}} vector to be used #' as a pdf filename in the case of a \code{\link{bayesmanecfit}}. Any non #' empty character string will indicate the user wants to save the plots. +#' @param ask Should the user be asked to hit enter for next page for a +#' \code{\link{bayesmanecfit}} object? #' #' @seealso \code{\link{bnec}} #' @@ -19,7 +21,7 @@ #' } #' #' @export -check_priors <- function(object, filename = NA) { +check_priors <- function(object, filename = NA, ask = ask) { UseMethod("check_priors") } @@ -41,7 +43,7 @@ check_priors <- function(object, filename = NA) { #' @noRd #' #' @export -check_priors.bayesnecfit <- function(object, filename = NA) { +check_priors.bayesnecfit <- function(object, filename = NA, ask = ask) { if (!is.na(filename)) { chk_character(filename) } @@ -80,7 +82,7 @@ check_priors.bayesnecfit <- function(object, filename = NA) { #' @noRd #' #' @export -check_priors.bayesmanecfit <- function(object, filename = NA) { +check_priors.bayesmanecfit <- function(object, filename = NA, ask = TRUE) { if (!is.na(filename)) { chk_character(filename) } @@ -88,7 +90,7 @@ check_priors.bayesmanecfit <- function(object, filename = NA) { pdf(file = paste(filename, ".pdf", sep = ""), onefile = TRUE, width = 12, height = 4) } else { - devAskNewPage(ask = TRUE) + devAskNewPage(ask = ask) } for (m in seq_len(length(object$mod_fits))) { out_plot <- check_priors(object = pull_out(object, model = names(object$mod_fits)[m])) + diff --git a/R/ecx.R b/R/ecx.R index 47bfa6fc..14d23d58 100644 --- a/R/ecx.R +++ b/R/ecx.R @@ -260,6 +260,8 @@ ecx.bayesmanecfit <- function(object, ecx_val = 10, resolution = 1000, } } +#' @importFrom modelbased zero_crossings +#' #' @noRd ecx_x_relative <- function(y, ecx_val, x_vec) { if (length(which(!is.na(y))) == 0) { @@ -267,11 +269,22 @@ ecx_x_relative <- function(y, ecx_val, x_vec) { } else { range_y <- range(y, na.rm = TRUE) ecx_y <- max(range_y) - diff(range_y) * (ecx_val / 100) - outval <- x_vec[min_abs(y - ecx_y)] + + val <- min(zero_crossings(y - ecx_y)) + if(is.na(val)) { + outval <- max(x_vec) + } else { + floor_x <- x_vec[floor(val)] + ceiling_x <- x_vec[ceiling(val)] + prop_x <- (val-floor(val))*(ceiling_x-floor_x) + outval <- floor_x + prop_x + } } outval } +#' @importFrom modelbased zero_crossings +#' #' @noRd ecx_x_absolute <- function(y, ecx_val, x_vec) { if (length(which(!is.na(y))) == 0) { @@ -279,18 +292,39 @@ ecx_x_absolute <- function(y, ecx_val, x_vec) { } else { range_y <- c(0, max(y, na.rm = TRUE)) ecx_y <- max(range_y) - diff(range_y) * (ecx_val / 100) - outval <- x_vec[min_abs(y - ecx_y)] + + val <- min(zero_crossings(y - ecx_y)) + if(is.na(val)) { + outval <- max(x_vec) + } else { + floor_x <- x_vec[floor(val)] + ceiling_x <- x_vec[ceiling(val)] + prop_x <- (val-floor(val))*(ceiling_x-floor_x) + outval <- floor_x + prop_x + } } outval } +#' @importFrom modelbased zero_crossings +#' #' @noRd ecx_x_direct <- function(y, ecx_val, x_vec) { if (length(which(!is.na(y))) == 0) { outval <- max(x_vec) } else { ecx_y <- ecx_val - outval <- x_vec[min_abs(y - ecx_y)] + + val <- min(zero_crossings(y - ecx_y)) + if(is.na(val)) { + outval <- max(x_vec) + } else { + floor_x <- x_vec[floor(val)] + ceiling_x <- x_vec[ceiling(val)] + prop_x <- (val-floor(val))*(ceiling_x-floor_x) + outval <- floor_x + prop_x + } } outval } + diff --git a/R/nsec.R b/R/nsec.R index cb9cbe98..3ad260c4 100644 --- a/R/nsec.R +++ b/R/nsec.R @@ -217,9 +217,18 @@ nsec.bayesmanecfit <- function(object, sig_val = 0.01, resolution = 1000, } } +#' @importFrom modelbased zero_crossings +#' #' @noRd nsec_fct <- function(y, reference, x_vec) { - x_vec[min_abs(y - reference)] + val <- min(zero_crossings(y - reference)) + if(is.na(val)) { + return(max(x_vec))} else { + floor_x <- x_vec[floor(val)] + ceiling_x <- x_vec[ceiling(val)] + prop_x <- (val-floor(val))*(ceiling_x-floor_x) + return(floor_x + prop_x) + } } #' @inheritParams nsec diff --git a/man/bayesnec-package.Rd b/man/bayesnec-package.Rd index 5e41f0f4..ed1bd20e 100644 --- a/man/bayesnec-package.Rd +++ b/man/bayesnec-package.Rd @@ -30,3 +30,22 @@ Fox DR (2010). A Bayesian Approach for Determining the No Effect Concentration and Hazardous Concentration in Ecotoxicology. Ecotoxicology and Environmental Safety, 73(2), 123–131. doi: 10.1016/j.ecoenv.2009.09.012. } +\seealso{ +Useful links: +\itemize{ + \item \url{https://open-aims.github.io/bayesnec/} + \item Report bugs at \url{https://github.com/open-aims/bayesnec/issues} +} + +} +\author{ +\strong{Maintainer}: Rebecca Fisher \email{r.fisher@aims.gov.au} + +Authors: +\itemize{ + \item Diego Barneche + \item Gerard Ricardo + \item David Fox +} + +} diff --git a/man/check_priors.Rd b/man/check_priors.Rd index 18e878f2..92c21ce8 100644 --- a/man/check_priors.Rd +++ b/man/check_priors.Rd @@ -5,7 +5,7 @@ \title{Plots the prior and posterior parameter probability densities from an object of class \code{\link{bayesnecfit}} or \code{\link{bayesmanecfit}}.} \usage{ -check_priors(object, filename = NA) +check_priors(object, filename = NA, ask = ask) } \arguments{ \item{object}{An object of class \code{\link{bayesnecfit}} or @@ -14,6 +14,9 @@ check_priors(object, filename = NA) \item{filename}{An optional \code{\link[base]{character}} vector to be used as a pdf filename in the case of a \code{\link{bayesmanecfit}}. Any non empty character string will indicate the user wants to save the plots.} + +\item{ask}{Should the user be asked to hit enter for next page for a +\code{\link{bayesmanecfit}} object?} } \value{ A plot of the prior and posterior parameter probability densities.