R/means.R

In jmbarbone/qpm: Quantitative Psychological Methods

#' Geometric means
#'
#' Find the geometric mean of an object.
#'
#' @param x A numeric vector or data.frame
#' @param na.rm Logical.  If TRUE, NA values will be removed.
#'
#' @export

geometric_mean <- function(x, na.rm = FALSE) {
  UseMethod("geometric_mean")
}

#' @export
geometric_mean.default <- function(x, na.rm = FALSE) {
  invalid <- which(x <= 0)
  if(length(invalid) > 0) {
    message(sprintf("Invalid data found.  Removing values at these positions: %s",
                    paste(invalid, collapse = " ")))
    x <- x[-invalid]
  }
  exp(mean(log(x), na.rm = na.rm))
}

#' @export
geometric_mean.data.frame <- function(x, na.rm = FALSE) {
  sapply(x, geometric_mean.default, na.rm = na.rm)
}

#' Harmonic means
#'
#' Find the harmonic mean.
#'
#' @param x A numeric vector or data.frame
#' @param zero Logical.  If TRUE, 0 values are removed.
#' @param na.rm Logical.  If TRUE, NAs will be removed from the data.
#'   If zero is TRUE, na.rm will be overridden to TRUE.
#'
#' @export

harmonic_mean <- function(x, zero = FALSE, na.rm = FALSE) {
  UseMethod("harmonic_mean")
}

#' @export
harmonic_mean.default <- function(x, zero = FALSE, na.rm = FALSE) {
  if(!zero) {
    x[x == 0] <- NaN
    na.rm <- TRUE
  }

  1 / mean(1 / x, na.rm = na.rm)
}

#' @export
harmonic_mean.data.frame <- function(x, zero = FALSE, na.rm = FALSE) {
  sapply(x, harmonic_mean, na.rm = na.rm)
}