R/xContrasts.R

In cwendorf/EASIalt: easiOrigin

# easiOrigin
## Mean Contrasts

### Confidence Intervals

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

.ciContrasts.default <- function(frame, contrasts = NULL, 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)
  vlevels <- nlevels(dataLong$Factor)
  if (!is.null(contrasts)) {
    contrasts(dataLong$Factor) <- contrasts
  }
  contrasts(dataLong$Subjects) <- contr.sum
  object <- lm(aov(Outcome ~ Factor + Error(Subjects), data = dataLong))
  .ciContrasts(object, conf.level = conf.level)
}

.ciContrasts.formula <- function(formula, contrasts = NULL, conf.level = .95, ...) {
  x <- eval(formula[[3]])
  y <- eval(formula[[2]])
  if (!is.null(contrasts)) {
    contrasts(x) <- contrasts
  }
  object <- lm(aov(y ~ x, ...))
  .ciContrasts(object, conf.level = conf.level)
}

.ciContrasts.lm <- function(object, conf.level = .95, ...) {
  nlevels <- length(object$xlevels[[1]])
  results <- cbind(summary(object)[[4]][, 1:2], object$df.residual, confint(object, level = conf.level))[1:nlevels, ]
  colnames(results) <- c("Est", "SE", "df", "LL", "UL")
  results
}

ciContrasts <- function(..., contrasts = NULL, conf.level = .95, main = NULL, digits = 3) {
  results <- .ciContrasts(..., contrasts = contrasts, conf.level = conf.level)
  if (is.null(main)) {
    main <- "Confidence Intervals for the Contrasts"
  }
  .formatList(list(results), main = main, digits = digits)
}

### Null Hypothesis Significance Tests

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

.nhstContrasts.default <- function(frame, contrasts = NULL, ...) {
  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)
  vlevels <- nlevels(dataLong$Factor)
  if (!is.null(contrasts)) {
    contrasts(dataLong$Factor) <- contrasts
  }
  contrasts(dataLong$Subjects) <- contr.sum
  object <- lm(aov(Outcome ~ Factor + Error(Subjects), data = dataLong))
  .nhstContrasts(object)
}

.nhstContrasts.formula <- function(formula, contrasts = NULL, ...) {
  x <- eval(formula[[3]])
  y <- eval(formula[[2]])
  if (!is.null(contrasts)) {
    contrasts(x) <- contrasts
  }
  object <- lm(aov(y ~ x, ...))
  .nhstContrasts(object)
}

.nhstContrasts.lm <- function(object, ...) {
  nlevels <- length(object$xlevels[[1]])
  results <- cbind(summary(object)[[4]][, 1:3], object$df.residual, summary(object)[[4]][, 4])[1:nlevels, ]
  colnames(results) <- c("Est", "SE", "t", "df", "p")
  results
}

nhstContrasts <- function(..., contrasts = NULL, main = NULL, digits = 3) {
  results <- .nhstContrasts(..., contrasts = contrasts)
  if (is.null(main)) {
    main <- "Hypothesis Tests for the Contrasts"
  }
  .formatList(list(results), main = main, digits = digits)
}

### Confidence Interval Plots

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

graphContrasts.default <- function(frame, contrasts = NULL, main = NULL, ylab = "Contrasts", xlab = "", mu = NULL, rope = NULL, conf.level = .95, values = TRUE, ylim = NULL, digits = 3, pch = 17, col = "black", ...) {
  results <- .ciContrasts(frame, contrasts = contrasts, conf.level = conf.level)[, c("Est", "LL", "UL")]
  if (is.null(main)) {
    main <- "Confidence Intervals for the Contrasts"
  }
  .cipMain(results, main = main, ylab = ylab, xlab = xlab, mu = mu, rope = rope, values = values, ylim = ylim, digits = digits, connect = FALSE, pch = pch, col = col)
}

graphContrasts.formula <- function(formula, contrasts = NULL, main = NULL, ylab = "Contrasts", xlab = "", mu = NULL, rope = NULL, conf.level = .95, values = TRUE, ylim = NULL, digits = 3, pch = 17, col = "black", ...) {
  results <- .ciContrasts(formula, contrasts = contrasts, conf.level = conf.level)[, c("Est", "LL", "UL")]
  if (is.null(main)) {
    main <- "Confidence Interval for the Contrasts"
  }
  .cipMain(results, main = main, ylab = ylab, xlab = xlab, mu = mu, rope = rope, values = values, ylim = ylim, digits = digits, connect = FALSE, pch = pch, col = col)
}