R/tools_cutoff_wrap.R

Defines functions cutoff_wrap

Documented in cutoff_wrap

#' Find a cut-off for estimates relying on contiguous counts
#' 
#' @param my_data Frequency count table
#' @param requested The user-requested cutoff
#' 
#' @return Cutoff value
cutoff_wrap <- function(my_data, requested = NA) {
  
  iss <- my_data$index
  fis <- my_data$frequency
  length_fis <- length(fis)
  
  breaks <- which(iss[-1] - iss[-length_fis] > 1)
  cutoff <- ifelse(is.na(breaks[1]), length_fis, breaks[1])
  
  if (!is.na(requested)) {
    # if the requested cutoff is lte cutoff, use cutoff, o/w, cutoff
    if (requested <= cutoff) {
      cutoff <- requested # ok
    } else {
      warning("ignoring requested cutoff; it's too low")
      cutoff <- cutoff
    }
  }
  
  return(cutoff)
}

Try the breakaway package in your browser

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

breakaway documentation built on Nov. 22, 2022, 5:08 p.m.