R/xMultifactor.R

In cwendorf/easiOrigin: easiOrigin

# easiOrigin
## Multifactor Designs

### Descriptives

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

.descMultifactor.default <- function(frame, by, ...) {
  data <- data.frame(frame)
  columns <- dim(data)[2]
  data <- data.frame(frame, by)
  byname <- deparse(substitute(by))
  intxname <- paste("Measures", byname, sep = ":")
  dataLong <- reshape(data, varying = 1:columns, v.names = "Outcome", timevar = "Measures", idvar = "Subjects", direction = "long")
  dataLong$Subjects <- as.factor(dataLong$Subjects)
  dataLong$Measures <- as.factor(dataLong$Measures)
  dataLong$by <- as.factor(dataLong$by)
  object <- aov(Outcome ~ by + (Measures * by) + Error(Subjects / Measures), data = dataLong)
  w <- summary(object)
  x <- w[[1]][[1]]
  results1 <- cbind(x[2], x[1], x[3])
  colnames(results1) <- c("SS", "df", "MS")
  rownames(results1) <- c(byname, "Residuals")
  y <- w[[2]][[1]]
  results2 <- cbind(y[2], y[1], y[3])
  colnames(results2) <- c("SS", "df", "MS")
  rownames(results2) <- c("Measures", intxname, "Residuals")
  results <- list(results1, results2)
  names(results) <- c("Between Subjects", "Within Subjects")
  return(results)
}

.descMultifactor.formula <- function(formula, by, ...) {
  Group <- eval(formula[[3]])
  groupname <- deparse(formula[[3]])
  Outcome <- eval(formula[[2]])
  byname <- deparse(substitute(by))
  intxname <- paste(groupname, byname, sep = ":")
  object <- aov(Outcome ~ by + Group + (by * Group))
  x <- summary(object)[[1]]
  results <- cbind(x[2], x[1], x[3])
  colnames(results) <- c("SS", "df", "MS")
  rownames(results) <- c(groupname, byname, intxname, "Residuals")
  results <- list(results)
  names(results) <- "Between Subjects"
  return(results)
}

descMultifactor <- function(..., main = NULL, digits = 3) {
  results <- .descMultifactor(...)
  if (is.null(main)) {
    main <- "Source Table for the Effects"
  }
  main <- paste(main, names(results), sep = ": ")
  .formatList(results, main = main, digits = digits)
}

### Null Hypothesis Significance Tests

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

.nhstMultifactor.default <- function(frame, by, ...) {
  data <- data.frame(frame)
  columns <- dim(data)[2]
  data <- data.frame(frame, by)
  byname <- deparse(substitute(by))
  intxname <- paste("Measures", byname, sep = ":")
  dataLong <- reshape(data, varying = 1:columns, v.names = "Outcome", timevar = "Measures", idvar = "Subjects", direction = "long")
  dataLong$Subjects <- as.factor(dataLong$Subjects)
  dataLong$Measures <- as.factor(dataLong$Measures)
  dataLong$by <- as.factor(dataLong$by)
  object <- aov(Outcome ~ by + (Measures * by) + Error(Subjects / Measures), data = dataLong)
  w <- summary(object)
  x <- w[[1]][[1]]
  results1 <- cbind(x[4], x[1], x[5])
  colnames(results1) <- c("F", "df", "p")
  rownames(results1) <- c(byname, "Residuals")
  y <- w[[2]][[1]]
  results2 <- cbind(y[4], y[1], y[5])
  colnames(results2) <- c("F", "df", "p")
  rownames(results2) <- c("Measures", intxname, "Residuals")
  results <- list(results1, results2)
  names(results) <- c("Between Subjects", "Within Subjects")
  return(results)
}

.nhstMultifactor.formula <- function(formula, by, ...) {
  Group <- eval(formula[[3]])
  groupname <- deparse(formula[[3]])
  Outcome <- eval(formula[[2]])
  byname <- deparse(substitute(by))
  intxname <- paste(groupname, byname, sep = ":")
  object <- aov(Outcome ~ by + Group + (by * Group))
  x <- summary(object)[[1]]
  results <- cbind(x[4], x[1], x[5])
  colnames(results) <- c("F", "df", "p")
  rownames(results) <- c(groupname, byname, intxname, "Residuals")
  results <- list(results)
  names(results) <- "Between Subjects"
  return(results)
}

nhstMultifactor <- function(..., main = NULL, digits = 3) {
  results <- .nhstMultifactor(...)
  if (is.null(main)) {
    main <- "Hypothesis Tests for the Effects"
  }
  main <- paste(main, names(results), sep = ": ")
  .formatList(results, main = main, digits = digits)
}

### Proportion of Variance Accounted For

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

.pvaMultifactor.default <- function(frame, by, ...) {
  x <- .descMultifactor(frame, by = by)
  byname <- deparse(substitute(by))
  intxname <- paste("Measures", byname, sep = ":")
  results <- x[[1]]
  results[, 2] <- results[, 1] / sum(results[, 1])
  results[, 3] <- results[, 1] / (results[, 1] + tail(results[, 1], 1))
  results[length(results[, 2]), 3] <- NA
  results1 <- results[, 2:3]
  colnames(results1) <- c("EtaSq", "ParEtaSq")
  rownames(results1) <- c(byname, "Residuals")
  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
  results2 <- results[, 2:3]
  colnames(results2) <- c("EtaSq", "ParEtaSq")
  rownames(results2) <- c("Measures", intxname, "Residuals")
  results <- list(results1, results2)
  names(results) <- c("Between Subjects", "Within Subjects")
  return(results)
}

.pvaMultifactor.formula <- function(formula, by, ...) {
  x <- .descMultifactor(formula = formula, by = by)
  byname <- deparse(substitute(by))
  groupname <- deparse(formula[[3]])
  intxname <- paste(groupname, byname, sep = ":")
  results <- x[[1]]
  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")
  rownames(results) <- c(groupname, byname, intxname, "Residuals")
  results <- list(results)
  names(results) <- "Between Subjects"
  return(results)
}

pvaMultifactor <- function(..., main = NULL, digits = 3) {
  results <- .pvaMultifactor(...)
  if (is.null(main)) {
    main <- "Proportion of Variance Accounted for by the Effects"
  }
  main <- paste(main, names(results), sep = ": ")
  .formatList(results, main = main, digits = digits)
}