R/histbreaks.R

In exams.forge: Support for Compiling Examination Tasks using the 'exams' Package

#' @rdname histbreaks
#' @aliases rand_breaks
#' @aliases dhistbreaks
#' @title Histogram Breakpoints
#' @description
#' Randomly selects `size` breakpoints from `breaks`. If `outer` is `TRUE`, then 
#' the first and last element of `breaks` is always included into the returned break points.
#' If `size` is a vector, the number of breakpoints is first sampled from `size`.
#'
#' @param breaks numeric: a vector of possible break points
#' @param size integer: number of break points
#' @param outer logical: should be the first and last element of the included breaks (default: \code{TRUE}) 
#' @param ... further parameters given if sampling of `size` is necessary, see [base::sample]
#'
#' @return A vector of breakpoints.
#' @export
#'
#' @examples
#' # Always includes 100 and 200
#' histbreaks(seq(100, 200, by=10), 4)
#' # Always includes 100 and 200 and chooses randomly between 3 to 5 break points  
#' histbreaks(seq(100, 200, by=10), 3:5)           
#' # May not include 100 and 200
#' histbreaks(seq(100, 200, by=10), 4, outer=FALSE) 
histbreaks <- function(breaks, size, outer=TRUE, ...) {
  if (length(size)>1) {
    args      <- list(...)
    args$x    <- size
    args$size <- 1
    size      <- do.call(sample, args)
  }
  stopifnot(size>2)
  stopifnot(length(breaks)>=size)
  if (outer) b <- c(breaks[1], breaks[length(breaks)]) else b <-vector(mode(breaks), 0)
  bs   <- setdiff(breaks, b)
  size <- size-length(b)
  if (size==0) return(sort(bs))
  b <- c(b, if (length(bs)==1) bs else sample(bs, size))
  sort(b)  
}

#' @rdname histbreaks
#' @export 
# rand_breaks <- function(...){
#  histbreaks(...)}
rand_breaks <- histbreaks

#' @rdname histbreaks
#' @export 
# dhistbreaks <- function(...){
#  histbreaks(...)}
dhistbreaks <- histbreaks