AnovaM.aov {biology} | R Documentation |
~~ A concise (1-5 lines) description of what the function does. ~~
AnovaM.aov(object, type = "I", error, intercept = FALSE, split = NULL, expand.split = TRUE, keep.zero.df = TRUE, denoms = "Resid", RM = F, ...)
object |
~~Describe object here~~ |
type |
~~Describe type here~~ |
error |
~~Describe error here~~ |
intercept |
~~Describe intercept here~~ |
split |
~~Describe split here~~ |
expand.split |
~~Describe expand.split here~~ |
keep.zero.df |
~~Describe keep.zero.df here~~ |
denoms |
~~Describe denoms here~~ |
RM |
~~Describe RM here~~ |
... |
~~Describe ... here~~ |
~~ If necessary, more details than the description above ~~
~Describe the value returned If it is a LIST, use
comp1 |
Description of 'comp1' |
comp2 |
Description of 'comp2' |
~~further notes~~
~Make other sections like Warning with Warning .... ~
~~who you are~~
~put references to the literature/web site here ~
~~objects to See Also as help
, ~~~
##---- Should be DIRECTLY executable !! ---- ##-- ==> Define data, use random, ##-- or do help(data=index) for the standard data sets. ## The function is currently defined as function (object, type = "I", error, intercept = FALSE, split = NULL, expand.split = TRUE, keep.zero.df = TRUE, denoms = "Resid", RM = F, ...) { require(car) dots <- list(...) op <- options() options(warn = -1) if (!is.null(split)) { s <- do.call("summary", c(list(object, intercept = intercept, split = split, expand.split = expand.split, keep.zero.df = keep.zero.df, dots))) } else { s <- do.call("summary", c(list(object, intercept = intercept, expand.split = expand.split, keep.zero.df = keep.zero.df))) } names <- character(0) if (length(s) > 1) { for (i in 1:length(s)) { nms <- attr(s[[i]][[1]], "row.names") nms <- sub("^ +", "", nms) nms <- sub(" +$", "", nms) nms <- nms[-length(nms)] names <- c(names, nms) } } else { if (length(s[[1]]) == 1) nms <- attr(s[[1]][[1]], "row.names") else nms <- attr(s[[1]], "row.names") nms <- sub("^ +", "", nms) nms <- sub(" +$", "", nms) nms <- nms[-length(nms)] names <- c(names, nms) if (!missing(error)) { sumry <- summary(error, corr = FALSE) s2 <- sumry$sigma^2 error.df <- error$df.residual nms <- row.names(s[[1]]) nms <- sub("^ +", "", nms) nms <- sub(" +$", "", nms) ind <- match("Residuals", nms, nomatch = 0) s[[1]][ind, "Df"] <- error.df s[[1]][ind, "Sum Sq"] <- s2 * error.df s[[1]][ind, "Mean Sq"] <- s2 } } if (length(s) > 1) form <- attr(object, "call") else { form <- object$call if (is.null(form)) form <- attr(object, "call") } original_form <- form form <- deparse(form) form <- sub("Error\(([A-Za-z0-9_\.\/\,\ \(\)]*)\)", "\1", form) if (RM == T) { gg.hf <- epsi.GG.HF(object) print(gg.hf) } form <- eval(parse(text = form)) x <- model.matrix(form) offset <- model.offset(model.frame(form)) asgn <- attr(x, "assign") tl <- attr(form$terms, "term.labels") fac <- attr(form$terms, "factors") split.fact <- vector("list", length(tl)) names(split.fact) <- tl for (k in 1:length(tl)) { scope <- attr(terms(update.formula(form, paste("~", tl[k], sep = ""))), "term.labels") ndrop <- match(scope, tl) ii <- seq(along = asgn)[asgn == ndrop] split.fact[k] <- vector("list", length(ii)) split.fact[k] <- list(ii) } names.scope <- vector("list", length(names)) names(names.scope) <- names main.scope <- names.scope for (ll in 1:length(names)) { for (mm in 1:length(split.fact)) { if (names(names.scope[ll]) == names(split.fact[mm])) { names.scope[[ll]] <- split.fact[[mm]] main.scope[[ll]] <- names(split.fact[mm]) } } } if (!is.null(split)) { split.cont <- split split.cont <- splitInteractions(split.cont, factors = attr(form$terms, "factors"), c("(Intercept)", tl), asgn, names(form$coef)) for (ll in 1:length(names)) { for (mm in 1:length(split.cont)) { for (nn in 1:length(split.cont[[mm]])) { if (names(names.scope[ll]) == paste(names(split.cont[mm]), ": ", names(split.cont[[mm]][nn]), sep = "")) { names.scope[[ll]] <- split.fact[[names(split.cont[mm])]][split.cont[[mm]][[nn]]] main.scope[[ll]] <- names(split.cont[mm]) } } } } } chisq <- deviance(form) y <- form$residuals + predict(form) tol <- .Machine$double.eps^0.5 for (ll in 1:length(names.scope)) { if (type == "II") { if (ncol(fac) > 1) { ndrop <- relatives(main.scope[[ll]], main.scope, fac) ii <- seq(along = asgn)[asgn == ndrop] jj <- setdiff(seq(ncol(x)), ii) } else jj <- seq(ncol(x)) z <- lm.fit(x[, jj, drop = FALSE], y, offset = offset) oldClass(z) <- "lm" chisq <- deviance(z) jj <- setdiff(jj, names.scope[[ll]]) z <- lm.fit(x[, jj, drop = FALSE], y, offset = offset) oldClass(z) <- "lm" RSS <- deviance(z) } if (type == "III") { jj <- setdiff(seq(ncol(x)), names.scope[[ll]]) z <- lm.fit(x[, jj, drop = FALSE], y, offset = offset) oldClass(z) <- "lm" RSS <- deviance(z) } if (type != "I") SS <- RSS - chisq if (length(s) > 1 & type != "I") { for (mm in 1:length(s)) { nms <- row.names(s[[mm]][[1]]) nms <- sub("^ +", "", nms) nms <- sub(" +$", "", nms) ind <- match(names(names.scope[ll]), nms, nomatch = 0) if (ind && SS > tol) { s[[mm]][[1]][ind, "Sum Sq"] <- SS s[[mm]][[1]][ind, "Mean Sq"] <- SS/s[[mm]][[1]][ind, "Df"] s[[mm]][[1]][ind, "F value"] <- s[[mm]][[1]][ind, "Mean Sq"]/s[[mm]][[1]]["Residuals", "Mean Sq"] s[[mm]][[1]][ind, "Pr(>F)"] <- pf(s[[mm]][[1]][ind, "F value"], s[[mm]][[1]][ind, "Df"], s[[mm]][[1]]["Residuals", "Df"], lower.tail = FALSE) if (RM == T && 1 == 2) { if (!is.na(match(trim.blanks(rownames(s[[mm]][[1]][ind, ])), rownames(gg.hf)))) mtch <- match(trim.blanks(rownames(s[[mm]][[1]][ind, ])), rownames(gg.hf)) if (is.na(mtch)) mtch <- 1 if (RM == T && gg.hf[mm][1] != "NA") { eps.GG <- gg.hf[mtch][1] dfsGR_df <- s[[mm]][[1]]["Residuals", "Df"] dfsG <- s[[mm]][[1]][ind, "Df"] * eps.GG dfsH <- s[[mm]][[1]][ind, "Df"] * gg.hf[mtch, 2] s[[mm]][[1]][ind, "GG.P"] <- 1 - pf(s[[mm]][[1]][ind, "F value"], dfsG, dfsGR_df) s[[mm]][[1]][ind, "HF.P"] <- 1 - pf(s[[mm]][[1]][ind, "F value"], dfsH, dfsGR_df) } } } else next } } else { if (type != "I") { nms <- row.names(s[[1]]) nms <- sub("^ +", "", nms) nms <- sub(" +$", "", nms) ind <- match(names(names.scope[ll]), nms, nomatch = 0) if (ind && SS > tol) { s[[1]][ind, "Sum Sq"] <- SS s[[1]][ind, "Mean Sq"] <- SS/s[[1]][ind, "Df"] s[[1]][ind, "F value"] <- s[[1]][ind, "Mean Sq"]/s[[1]]["Residuals", "Mean Sq"] s[[1]][ind, "Pr(>F)"] <- pf(s[[1]][ind, "F value"], s[[1]][ind, "Df"], s[[1]]["Residuals", "Df"], lower.tail = FALSE) } } } } if (length(s) > 1) { ss <- NULL for (i in 1:length(s)) { if (denoms != "Resid") s[[i]] <- Anovam(s[[i]], denoms = denoms[[i]]) } } else if (denoms != "Resid") s <- Anovam(s, denoms = denoms) if (RM == T) { if (length(s) > 1) { for (ll in 1:length(names.scope)) { for (mm in 1:length(s)) { nms <- row.names(s[[mm]][[1]]) nms <- sub("^ +", "", nms) nms <- sub(" +$", "", nms) ind <- match(names(names.scope[ll]), nms, nomatch = 0) if (!ind) next if (!is.na(match(trim.blanks(rownames(s[[mm]][[1]][ind, ])), rownames(gg.hf)))) mtch <- match(trim.blanks(rownames(s[[mm]][[1]][ind, ])), rownames(gg.hf)) if (is.na(mtch)) mtch <- 1 if (RM == T && !is.na(gg.hf[mm][1])) { eps.GG <- gg.hf[mtch][1] dfsGR_df <- s[[mm]][[1]]["Residuals", "Df"] dfsG <- s[[mm]][[1]][ind, "Df"] * eps.GG dfsH <- s[[mm]][[1]][ind, "Df"] * gg.hf[mtch, 2] s[[mm]][[1]][ind, "GG.P"] <- 1 - pf(s[[mm]][[1]][ind, "F value"], dfsG, dfsGR_df) s[[mm]][[1]][ind, "HF.P"] <- 1 - pf(s[[mm]][[1]][ind, "F value"], dfsH, dfsGR_df) } } } } } options(op) attr(s, "heading") <- c("Anova Table (Type III tests)\n", paste("Response:", responseName(object))) attr(s, "call") <- original_form s s }