R/anova.ccabymargin.R

`anova.ccabymargin` <-
    function(object, step=100, scope, ...)
{
    if(inherits(object, "prc"))
        stop("anova(..., by = 'margin') cannot be used for 'prc' results")
    if (!missing(scope) && is.character(scope))
        trms <- scope
    else
        trms <- drop.scope(object, scope)
    alltrms <- labels(terms(object$terminfo))
    keep <- trms %in% alltrms
    trms <- trms[keep]
    ntrms <- length(trms)
    bigperm <- 0
    for (.ITRM in 1:ntrms) {
        fla <- formula(object)
        ## Put all trms except current into Condition() and update
        ## formula
        if (length(alltrms) > 1) {
            keeptrms <- alltrms[!(alltrms==trms[.ITRM])]
            updfla <- paste("Condition(",paste(keeptrms, collapse="+"), ")")
            fla <- update(fla, paste(". ~ . + ", updfla))
        }
        tmp <- update(object, fla)
        tmp <- anova(tmp, step=step, ...)
        ## Start every permutation from the same seed, but get the
        ## seed of the longest simulation and reset the RNG to that
        ## state when exiting the function
        if (tmp[1,"N.Perm"] > bigperm) {
            bigperm <- tmp[1, "N.Perm"]
            bigseed <- get(".Random.seed", envir = .GlobalEnv,
                           inherits = FALSE)
        }
        if (.ITRM == 1) {
            seed <- attr(tmp, "Random.seed")
            sol <- tmp
        }
        else {
            sol <- rbind(sol[1:(.ITRM-1),], as.matrix(tmp[1,]), sol[.ITRM,])
        }
        assign(".Random.seed", seed, envir = .GlobalEnv)
    }
    ## Put RNG at the end of the longest simulation
    if (bigperm > 0)
        assign(".Random.seed", bigseed, envir = .GlobalEnv)
    rownames(sol)[1:ntrms] <- trms
    head <- attr(sol, "heading")
    head[1] <- paste(head[1], "Marginal effects of terms\n", sep="")
    head[2] <- paste("Model:", c(object$call))
    attr(sol, "heading") <- head
    sol
}
pattakosn/Rworkshop documentation built on May 24, 2019, 8:22 p.m.