R/xEffect.R

Defines functions pvaEffect .pvaEffect.lm .pvaEffect.formula .pvaEffect.default .pvaEffect nhstEffect .nhstEffect.lm .nhstEffect.formula .nhstEffect.default .nhstEffect descEffect .descEffect.lm .descEffect.formula .descEffect.default .descEffect

# easiOrigin
## ANOVA Effects

### Descriptives

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

.descEffect.default <- function(...) {
  data <- data.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 + Subjects, data = dataLong)
  .descEffect(object)
}

.descEffect.formula <- function(formula, ...) {
  object <- lm(formula, ...)
  .descEffect(object)
}

.descEffect.lm <- function(object, ...) {
  x <- anova(object)
  results <- cbind(x[2], x[1], x[3])
  colnames(results) <- c("SS", "df", "MS")
  results
}

descEffect <- function(..., main = NULL, digits = 3) {
  results <- .descEffect(...)
  if (is.null(main)) {
    main <- "Source Table for the Effect"
  }
  .formatList(list(results), main = main, digits = digits)
}

### Null Hypothesis Significance Tests

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

.nhstEffect.default <- function(...) {
  data <- data.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 + Subjects, data = dataLong)
  .nhstEffect(object)
}

.nhstEffect.formula <- function(formula, ...) {
  object <- lm(formula, ...)
  .nhstEffect(object)
}

.nhstEffect.lm <- function(object, ...) {
  x <- anova(object)
  results <- cbind(x[4], x[1], x[5])
  colnames(results) <- c("F", "df", "p")
  results
}

nhstEffect <- function(..., main = NULL, digits = 3) {
  results <- .nhstEffect(...)
  if (is.null(main)) {
    main <- "Hypothesis Test for the Effect"
  }
  .formatList(list(results), main = main, digits = digits)
}

### Proportion of Variance Accounted For

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

.pvaEffect.default <- function(...) {
  data <- data.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 + Subjects, data = dataLong)
  .pvaEffect(object)
}

.pvaEffect.formula <- function(formula, ...) {
  object <- lm(formula, ...)
  .pvaEffect(object)
}

.pvaEffect.lm <- function(object, ...) {
  x <- anova(object)
  results <- x[2]
  results[, 2] <- results[, 1] / sum(results[, 1])
  results[, 3] <- results[, 1] / (results[, 1] + tail(results[, 1], 1))
  results[length(results[, 2]), 3] <- NA
  results <- results[, 2:3]
  colnames(results) <- c("EtaSq", "ParEtaSq")
  results
}

pvaEffect <- function(..., main = NULL, digits = 3) {
  results <- .pvaEffect(...)
  if (is.null(main)) {
    main <- "Proportion of Variance Accounted for by the Effect"
  }
  .formatList(list(results), main = main, digits = digits)
}
cwendorf/EASIalt documentation built on Oct. 31, 2023, 1:20 a.m.