R/thresh_hardness_correction.R

In BWAM/stayCALM: Stay Calm when Applying a Consolidated Assessment Listing Methodology (CALM)

#' Establish the WQS threshold based on hardness (ppm)
#'
#' @param .param a character vector of parameter names.
#' @param .hardness a numeric vector of hardness values.
#' @param .type a character vector indicating if the sample should be
#' calculated with the aquatic (chronic) or aquatic (acute) criteria.
#' @return A vector of type double representing the threshold for the specified dissolved metal.
#' @examples
#' thresh_dissolved_metals(.param = "zinc",
#'   .hardness = 1,
#'    .type = "aquatic_chronic")
#' @export

thresh_hardness_correction <- function(.param, .hardness, .type) {

# return_early ------------------------------------------------------------
if (any(is.na(c(.param, .hardness, .type)))) return(NA_real_)

# stop_if -----------------------------------------------------------------

  if (!is.numeric(.hardness)) {
    stop(paste(".hardness must be numeric. You supplied:", class(.hardness)))
  }

  expected_type.vec <- c("aquatic_acute", "aquatic_chronic")
  if (!.type %in% expected_type.vec) {
    stop(paste(".type must be one of:",
               paste(expected_type.vec, collapse = ", "),
               ". You supplied:",
               .type))
  }

# calculate ---------------------------------------------------------------

  if (.type %in% "aquatic_acute") {
    final.vec <- acute_hardness_formula(.param = .param,
                                        .hardness = .hardness)
  } else if (.type %in% "aquatic_chronic") {
    final.vec <- chronic_hardness_formula(.param = .param,
                                          .hardness = .hardness)
  } else {
    stop(paste(".type must be 'aquatic_acute' or 'aquatic_chronic'.",
         "You supplied:", .type))
  }

  return(final.vec)
}


acute_hardness_formula <- Vectorize(
  vectorize.args = c(".param",".hardness"),
  FUN = function(.param, .hardness) {
    switch(.param,
           "cadmium" = 0.85 * exp(1.128 * log(.hardness) - 3.6867),
           "copper" = 0.96 * exp(0.9422 * log(.hardness) - 1.7),
           "fluoride" = 0.1 * exp(0.907 * log(.hardness) + 7.394),
           "lead" = (0.998) * (exp(0.846 * log(.hardness) + 2.255)),
           "nickel" = 0.998 * exp(0.846 * log(.hardness) + 2.255),
           "silver" = exp(1.72 * log(.hardness) - 6.52),
           "zinc" = 0.978 * exp(0.8473 * log(.hardness) + 0.884),
           stop(paste(".param must be one of the following:",
                      "'cadmium','copper', 'fluoride', 'lead',",
                      "'nickel', 'silver', or 'zinc'.",
                      "You supplied:", .param)))

  }
)


chronic_hardness_formula <- Vectorize(
  vectorize.args = c(".param", ".hardness"),
  FUN = function(.param, .hardness) {
    switch(.param,
           "cadmium" = 0.85 * exp(0.7852 * log(.hardness) - 2.715),
           "copper" = 0.96 * exp(0.8545 * log(.hardness) - 1.702),
           "fluoride" = 0.02 * exp(0.907 * log(.hardness) + 7.394),
           "lead" = 0.997 * (exp(0.846 * log(.hardness) + 0.0584)),
           "nickel" = 0.997 * exp(0.846 * log(.hardness) + 0.0584),
           "zinc" = exp(0.85 * log(.hardness) + 0.50),
           stop(paste(".param must be one of the following:",
                      "'cadmium','copper', 'fluoride',",
                      "'lead', 'nickel', or 'zinc'.",
                      "You supplied:", .param)))
  }
)