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 = "I", error, intercept = FALSE, split = NULL, expand.split = TRUE, keep.zero.df = TRUE, denoms = "Resid", RM = F, ...)

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~~
RM ~~Describe RM 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 = "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
  }

[Package biology version 1.0 Index]