descStats.R

descStats <- function(x, na.rm = TRUE, trim = NULL, skew = FALSE, byrow = FALSE, digits = getOption("digits")) {
    fun <- function(x) {
        stopifnot(is.numeric(x))
        if (na.rm) x <- x[!is.na(x)]
        stats <- numeric(8)
        n <- length(x)
        mean <- sum(x) / n
        dev <- x - mean
        dev_s2 <- sum(dev^2L)
        sd <- sqrt(dev_s2 / (n - 1))
        se <- sqrt(sd / n)
        half <- (n + 1L) %/% 2L
        if (n %% 2L == 1L)
            median <- sort(x, partial = half)[half]
        else
            median <- sum(sort(x, partial = half + 0L:1L)[half + 0L:1L]) / 2L
        min <- min(x)
        max <- max(x)
        range <- max - min
        stats <- c(n, mean, se, sd, median, min, max, range)
        if (!is.null(trim)) {
            if (trim >= 0.5)
                trimmed <- median
            else {
                trimmed <- local({
                    lo <- floor(n * trim) + 1
                    hi <- n + 1 - lo
                    x <- sort(x, partial = unique(c(lo, hi)))[lo:hi]
                    return(sum(x) / n)
                })
            }
            stats <- append(stats, trimmed, 2)
        }
        if (skew) {
            skewness <- (sum(dev^3L) / n) / (dev_ss / n)^1.5
            kurtosis <- n * sum(dev^4L) / (dev_ss^2L)
            stats <- c(stats, skewness, kurtosis)
        }
        return(stats)
    }
    cn <- colnames(x)
    n.vars <- ncol(x)
    if (is.data.frame(x)) {
        for (i in seq_len(n.vars)) {
            if (!is.numeric(x[, i]) || is.factor(x[, i])) {
                x <- x[, -i]
                warning(paste("Variable \"", colnames(x)[i], "\"was droped from data.frame."))
            }
        }
    }
    if (!is.matrix(x))
        x <- as.matrix(x)
    if (byrow)
        x <- t.default(x)
    sn <- c("n", "mean", "se", "sd", "median", "min", "max", "range")
    if (skew)
        sn <- c(stat.nanmes, "skewness", "kurtosis")
    if (!is.null(trim))
        sn <- append(stat.nanmes, "trimmed", 2)
    result <- matrix(numeric(1), ncol = length(sn), nrow = n.vars,
                     dimnames = list(cn, sn), byrow = TRUE)
    for (i in seq_len(n.vars))
        result[i, ] <- fun(x[, i])
    return(signif(result, digits = digits))
}