R/xMeans.R

In cwendorf/EASIalt: easiOrigin

# easiOrigin
## Means

### Descriptives

.descMeans <- function(x, ...) {
  UseMethod(".descMeans")
}

.descMeans.default <- function(frame, ...) {
  data <- data.frame(frame)
  rn <- names(data)
  N <- sapply(data, length)
  M <- sapply(data, mean, na.rm = TRUE)
  SD <- sapply(data, sd, na.rm = TRUE)
  results <- cbind(N = N, M = M, SD = SD)
  rownames(results) <- rn
  results
}

.descMeans.formula <- function(formula, ...) {
  rn <- aggregate(formula, FUN = length)[[1]]
  N <- aggregate(formula, FUN = length)[[2]]
  M <- aggregate(formula, FUN = mean, na.rm = TRUE)[[2]]
  SD <- aggregate(formula, FUN = sd, na.rm = TRUE)[[2]]
  results <- cbind(N = N, M = M, SD = SD)
  rownames(results) <- rn
  results
}

.descMeans.lm <- function(object, ...) {
  formula <- object$terms
  .descMeans(formula, ...)
}

descMeans <- function(..., main = NULL, digits = 3) {
  results <- .descMeans(...)
  if (is.null(main)) {
    main <- "Descriptive Statistics for the Data"
  }
  .formatList(list(results), main = main, digits = digits)
}

### Confidence Intervals

.ciMeans <- function(x, ...) {
  UseMethod(".ciMeans")
}

.ciMeans.default <- function(frame, conf.level = .95, ...) {
  data <- data.frame(frame)
  columns <- dim(data)[2]
  dataLong <- reshape(data, varying = 1:columns, v.names = "Outcome", timevar = "Factor", idvar = "Subjects", direction = "long")
  dataLong$Subjects <- as.factor(dataLong$Subjects)
  dataLong$Factor <- as.factor(dataLong$Factor)
  object <- lm(Outcome ~ Factor - 1, data = dataLong)
  object$xlevels[[1]] <- names(data)
  .ciMeans(object, conf.level = conf.level)
}

.ciMeans.formula <- function(formula, conf.level = .95, ...) {
  formula <- update(formula, ~ . + -1)
  object <- lm(formula, ...)
  .ciMeans(object, conf.level = conf.level)
}

.ciMeans.lm <- function(object, conf.level = .95, ...) {
  results <- cbind(summary(object)$coeff[, 1:2], object$df.residual, confint(object, level = conf.level))
  colnames(results) <- c("M", "SE", "df", "LL", "UL")
  rownames(results) <- object$xlevels[[1]]
  results
}

ciMeans <- function(..., conf.level = .95, main = NULL, digits = 3) {
  results <- .ciMeans(..., conf.level = conf.level)
  if (is.null(main)) {
    if (nrow(results) > 1) {
      main <- "Confidence Intervals for the Means"
    } else {
      main <- "Confidence Interval for the Mean"
    }
  }
  .formatList(list(results), main = main, digits = digits)
}

### Null Hypothesis Significance Tests

.nhstMeans <- function(x, ...) {
  UseMethod(".nhstMeans")
}

.nhstMeans.default <- function(frame, mu = 0, ...) {
  data <- data.frame(frame)
  columns <- dim(data)[2]
  dataLong <- reshape(data, varying = 1:columns, v.names = "Outcome", timevar = "Factor", idvar = "Subjects", direction = "long")
  dataLong$Subjects <- as.factor(dataLong$Subjects)
  dataLong$Factor <- as.factor(dataLong$Factor)
  object <- lm(Outcome ~ Factor - 1, data = dataLong)
  object$xlevels[[1]] <- names(data)
  .nhstMeans(object, mu = mu)
}

.nhstMeans.formula <- function(formula, mu = 0, ...) {
  formula <- update(formula, ~ . + -1)
  object <- lm(formula, ...)
  .nhstMeans(object, mu = mu)
}

.nhstMeans.lm <- function(object, mu = 0, ...) {
  results <- cbind(summary(object)$coeff, 1)
  results[, 1] <- results[, 1] - mu
  results[, 3] <- results[, 1] / results[, 2]
  results[, 4] <- object$df.residual
  results[, 5] <- 2 * pt(-abs(results[, 3]), df = results[, 4])
  colnames(results) <- c("Diff", "SE", "t", "df", "p")
  rownames(results) <- object$xlevels[[1]]
  results
}

nhstMeans <- function(..., mu = 0, main = NULL, digits = 3) {
  results <- .nhstMeans(..., mu = mu)
  if (is.null(main)) {
    if (nrow(results) > 1) {
      main <- "Hypothesis Tests for the Means"
    } else {
      main <- "Hypothesis Test for the Mean"
    }
  }
  .formatList(list(results), main = main, digits = digits)
}

### Analyze Meta Function

.analyzeMeans <- function(..., conf.level = .95, mu = 0) {
  ci <- .ciMeans(..., conf.level = conf.level)
  nhst <- .nhstMeans(..., mu = mu)
  cbind(ci[, 1:2], ci[, 4:5], nhst[, 3:5])
}

analyzeMeans <- function(..., main = NULL, digits = 3) {
  results <- .analyzeMeans(...)
  if (is.null(main)) {
    main <- "Factor Means"
  }
  .formatList(list(results), main = main, digits = digits)
}

### Confidence Interval Plots

graphMeans <- function(x, ...) {
  UseMethod("graphMeans")
}

graphMeans.default <- function(frame, main = NULL, ylab = "Outcome", xlab = "", mu = NULL, rope = NULL, conf.level = .95, values = TRUE, ylim = NULL, add = FALSE, digits = 3, ...) {
  results <- .ciMeans(frame, conf.level = conf.level)[, c("M", "LL", "UL")]
  if (is.null(main)) {
    if (nrow(results) > 1) {
      main <- "Confidence Intervals for the Means"
    } else {
      main <- "Confidence Interval for the Mean"
    }
  }
  .cipMain(results, main = main, ylab = ylab, xlab = xlab, mu = mu, rope = rope, values = values, ylim = ylim, digits = digits, connect = TRUE, add = add, pch = 16)
}

graphMeans.formula <- function(formula, main = NULL, ylab = "Outcome", xlab = "", mu = NULL, rope = NULL, conf.level = .95, values = TRUE, ylim = NULL, add = FALSE, digits = 3, ...) {
  results <- .ciMeans(formula, conf.level = conf.level)[, c("M", "LL", "UL")]
  if (is.null(main)) {
    if (nrow(results) > 1) {
      main <- "Confidence Intervals for the Means"
    } else {
      main <- "Confidence Interval for the Mean"
    }
  }
  .cipMain(results, main = main, ylab = ylab, xlab = xlab, mu = mu, rope = rope, values = values, ylim = ylim, digits = digits, connect = FALSE, add = add, pch = 16)
}