R/mcval.R

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

#' @title Most Common Value
#' @rdname mcval
#' @aliases compute_modes
#' @aliases mcv
#' @description Computes all modes (most common value).
#'
#' @param x data object
#' @param exact logical: either compute the exact mode or use class mids (default: \code{FALSE})
#' @param ... further arguments
#'
#' @md
#' @return A vector of modes.
#' @export
#'
#' @examples
#' x <- sample(1:5, 15, replace=TRUE)
#' mcval(x)
mcval <- function(x, ...) {
  UseMethod("mcval")
}

#' @rdname mcval
#' @importFrom methods as
#' @export
mcval.default <- function(x, ...) {
  tab <- table(x)
  ret <- names(tab)[which(tab==max(tab))]
  as(ret, class(x))
}

#' @rdname mcval
#' @export
mcval.histogram <- function(x, exact=FALSE, ...) {
  modes <- which(x$density==max(x$density))
  ret   <- x$mids[modes]
  if (exact) {
    fl  <- ifelse(modes==1, 0, x$density[modes-1])
    fc  <- x$density[modes]
    fr  <- ifelse(modes==length(x$density), 0, x$density[modes+1])
    ret <- x$breaks[modes]+(fc-fl)/(2*fc-fr-fl)*(x$breaks[modes+1]-x$breaks[modes])
  } 
  attr(ret, "pos") <- modes
  ret
}

#' @rdname mcval
#' @export
# compute_modes <- function(...){
#  mcval(...)}
compute_modes <- mcval

#' @rdname mcval
#' @export
# mcv <- function(...){
#  mcval(...)}
mcv <- mcval