AnovaM.aov {biology}R Documentation

~~function to do ... ~~

Description

~~ A concise (1-5 lines) description of what the function does. ~~

Usage

AnovaM.aov(object, type = III, error, intercept = FALSE, split = NULL, expand.split = TRUE, keep.zero.df = TRUE, denoms = "Resid", ...)

Arguments

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~~
... ~~Describe ... here~~

Details

~~ If necessary, more details than the description above ~~

Value

~Describe the value returned If it is a LIST, use

comp1 Description of 'comp1'
comp2 Description of 'comp2'

...

Warning

....

Note

~~further notes~~

~Make other sections like Warning with section{Warning }{....} ~

Author(s)

~~who you are~~

References

~put references to the literature/web site here ~

See Also

~~objects to See Also as help, ~~~

Examples

##---- 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 = III, error, intercept = FALSE, split = NULL, 
    expand.split = TRUE, keep.zero.df = TRUE, denoms = "Resid", 
    ...) 
{
    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 {
        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
    form <- deparse(form)
    form <- sub("Error\(([A-Za-z0-9_\.\(\)]*)\)", "\1", 
        form)
    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)
        }
        SS <- RSS - chisq
        if (length(s) > 1) {
            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)
                }
                else next
            }
        }
        else {
            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)
            }
        }
    }
    s <- Anovam(s, denoms = denoms)
    options(op)
    attr(s, "heading") <- c("Anova Table (Type III tests)\n", 
        paste("Response:", responseName(object)))
    s
  }

[Package biology version 1.0 Index]