R/isum.R

In myominnoo/stats2: Tools of statistical analysis and data management

#' @title Number summary statistics
#' @description
#' \code{isum} generates seven number summary statistics and tests normality on the fly.
#' @param x a numeric object
#' @param data a data frame object (Optional)
#' @param rnd specify rounding of numbers. See \code{\link{round}}.
#' @param na.rm A logical value to specify missing values, <NA> in the table
#' @details
#' Normality test is perfomed by Shapiro-Wilk Normality Test. See more at
#' \code{\link{shapiro.test}}.
#' @seealso \code{\link{isum.by}}, \code{\link{tab}}, \code{\link{xtab}}
#' @keywords number summary
#' @author Myo Minn Oo (Email: \email{dr.myominnoo@@gmail.com} |
#' Website: \url{https://myominnoo.github.io/})
#' @examples
#' str(infert)
#' isum(infert$age)
#' isum(age, data = infert)
#' isum(age, infert)
#' isum(pooled.stratum, data = infert)

#' @export
isum <- function(x, data = NULL, rnd = 1, na.rm = FALSE)
{
  if (!is.null(data)) {
    arguments <- as.list(match.call())
    x <- eval(substitute(x), data)
    x.name <- arguments$x
  } else {
    x.name <- deparse(substitute(x))
  }
  len <- ifelse(na.rm, length(x[!is.na(x)]), length(x))
  na <- length(x[is.na(x)])
  na.rm <- TRUE
  mu <- mean(x, na.rm = na.rm)
  std <- sd(x, na.rm = na.rm)
  q <- round(quantile(x, probs = c(0, .25, .5, .75, 1), na.rm = na.rm), rnd)
  v <- round(c(mu, std, q), rnd)
  pvalue <- tryCatch({
    suppressWarnings(shapiro.test(x)$p.value)
  }, error = function(err) {
    return(NA)
  })
  pvalue <- ifelse(pvalue < 0.00001, "< 0.00001", round(pvalue, 5))
  f <- data.frame(Obs. = len, NA. = na, Mean = v[1], Std.Dev = v[2],
                  Median = v[5], Q1 = v[4], Q3 = v[6],
                  Min = v[3], Max = v[7], Normal.test = pvalue,
                  stringsAsFactors = FALSE)
  row.names(f) <- x.name
  cat("\nNumber summary: ", x.name, "\n\n")
  return(f)
}