# 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.