R/sample_size.R

In radiant-rstats/radiant.design: Design Menu for Radiant: Business Analytics using R and Shiny

#' Sample size calculation
#'
#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size.html} for an example in Radiant
#'
#' @param type Choose "mean" or "proportion"
#' @param err_mean Acceptable Error for Mean
#' @param sd_mean Standard deviation for Mean
#' @param err_prop Acceptable Error for Proportion
#' @param p_prop Initial proportion estimate for Proportion
#' @param conf_lev Confidence level
#' @param incidence Incidence rate (i.e., fraction of valid respondents)
#' @param response Response rate
#' @param pop_correction Apply correction for population size ("yes","no")
#' @param pop_size Population size
#'
#' @return A list of variables defined in sample_size as an object of class sample_size
#'
#' @examples
#' sample_size(type = "mean", err_mean = 2, sd_mean = 10)
#'
#' @seealso \code{\link{summary.sample_size}} to summarize results
#' @export
sample_size <- function(type, err_mean = 2, sd_mean = 10, err_prop = .1,
                        p_prop = .5, conf_lev = 0.95, incidence = 1,
                        response = 1, pop_correction = "no", pop_size = 1000000) {
  if (pop_correction == "yes" && is_not(pop_size)) pop_size <- 1000000
  if (is_not(conf_lev) || conf_lev < 0 || conf_lev > 1) conf_lev <- 0.95
  zval <- -qnorm((1 - conf_lev) / 2)

  if (type == "mean") {
    if (is_not(err_mean)) {
      return("Please select an acceptable error greater than 0" %>%
        add_class("sample_size"))
    }
    n <- (zval^2 * sd_mean^2) / err_mean^2
    rm(err_prop, p_prop)
  } else {
    if (is_not(err_prop)) {
      return("Please select an acceptable error greater than 0" %>%
        add_class("sample_size"))
    }
    n <- (zval^2 * p_prop * (1 - p_prop)) / err_prop^2
    rm(err_mean, sd_mean)
  }

  if (pop_correction == "yes") {
    n <- n * pop_size / ((n - 1) + pop_size)
  } else {
    rm(pop_size)
  }

  n <- ceiling(n)

  as.list(environment()) %>% add_class("sample_size")
}

#' Summary method for the sample_size function
#'
#' @details See \url{https://radiant-rstats.github.io/docs/design/sample_size.html} for an example in Radiant
#'
#' @param object Return value from \code{\link{sample_size}}
#' @param ... further arguments passed to or from other methods
#'
#' @examples
#' sample_size(type = "mean", err_mean = 2, sd_mean = 10) %>%
#'   summary()
#'
#' @seealso \code{\link{sample_size}} to generate the results
#'
#' @export
summary.sample_size <- function(object, ...) {
  if (is.character(object)) {
    return(object)
  }

  cat("Sample size calculation\n")

  if (object$type == "mean") {
    cat("Calculation type     : Mean\n")
    cat("Acceptable Error     :", object$err_mean, "\n")
    cat("Standard deviation   :", object$sd_mean, "\n")
  } else {
    cat("Calculation type     : Proportion\n")
    cat("Acceptable Error     :", object$err_prop, "\n")
    cat("Proportion           :", object$p_prop, "\n")
  }

  cat("Confidence level     :", object$conf_lev, "\n")
  cat("Incidence rate       :", object$incidence, "\n")
  cat("Response rate        :", object$response, "\n")

  if (object$pop_correction == "no") {
    cat("Population correction: None\n")
  } else {
    cat("Population correction: Yes\n")
    cat("Population size      :", format_nr(object$pop_size, dec = 0), "\n")
  }

  cat("\nRequired sample size     :", format_nr(object$n, dec = 0))
  cat("\nRequired contact attempts:", format_nr(ceiling(object$n / object$incidence / object$response), dec = 0))

  rm(object)
}