R/adjust_equivocal_zone.R

Defines functions estimate_adj_chars.equivocal_zone orbital.equivocal_zone

#' @export
orbital.equivocal_zone <- function(x, tailor, type, prefix, ...) {
  if (!rlang::is_missing(type) && !(all(c("prob", "class") %in% type))) {
    cli::cli_abort(c(
      x = "{.arg type} must contain {.val prob} and {.val class} to work with
      {.fn adjust_equivocal_zone}."
    ))
  }

  input <- x$arguments

  out_name <- tailor$columns$estimate
  prob_name <- tailor$columns$probabilities[[1]]

  levels <- gsub("^\\.pred_", "", tailor$columns$probabilities)

  if (prefix != "prefix") {
    out_name <- gsub("^\\.pred", prefix, out_name)
    prob_name <- gsub("^\\.pred", prefix, prob_name)
  }

  threshold_fmt <- format_numeric(input$threshold)
  value_fmt <- format_numeric(input$value)
  out <- glue::glue(
    "dplyr::case_when(
    {prob_name} > {threshold_fmt} + {value_fmt} ~ '{levels[1]}',
    {prob_name} < {threshold_fmt} - {value_fmt} ~ '{levels[2]}',
    .default = '[EQ]'
    )"
  )
  names(out) <- out_name
  out
}

# dplyr::case_when with 3 branches and arithmetic ~= 120 chars
#' @exportS3Method
estimate_adj_chars.equivocal_zone <- function(x, ...) {
  120L
}

Try the orbital package in your browser

Any scripts or data that you put into this service are public.

orbital documentation built on Sept. 5, 2026, 1:07 a.m.