atotal: Add all marginal sums to an array

In gmonette/spida15: Collection of miscellaneous functions for mixed models etc. prepared for SPIDA 2009+ (development version)

Usage

atotal(arr, FUN = sum, label = "Total", ...)

Arguments

arr
FUN
label
...

See Also

tab, acond

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 (arr, FUN = sum, label = "Total", ...) 
{
    help <- "\natotal                coursefun.R     for PSYC 6140/MATH 6630 05/06\n\nAdds border of sums to an array\n\nDescription:\n\n     'atotal' adds by default a border of sums to an array.\n     The function FUN may be used instead of 'sum'. Additional\n     arguments to FUN can also be given.\n\nUsage:\n\n     atotal( arr , FUN = sum, label = 'Total', ...)\n\nArguments:\n\n     arr: array, matrix or vector\n\n     FUN: function to be applied to cross sections of arr\n\n     ...: additional arguments to FUN\n\nDetails:\n\nValue:\n\n     An array with dimension dim(arr) + 1\n\nReferences:\n\nContributed by:  G. Monette  2005-10-10\n\nModifications:\n     2007-12-17: Fixed bug so dimnames is preserved for one-dimensional tables\n\n"
    d <- dim(arr)
    cls <- class(arr)
    dim1 <- FALSE
    if (length(d) == 1) {
        dim1 <- TRUE
        dn <- dimnames(arr)
        arr <- c(arr)
        d <- dim(arr)
    }
    if (is.character(FUN)) 
        FUN <- get(FUN, mode = "function")
    else if (mode(FUN) != "function") {
        farg <- substitute(FUN)
        if (mode(farg) == "name") 
            FUN <- get(farg, mode = "function")
        else stop(paste("\"", farg, "\" is not a function", sep = ""))
    }
    if (is.null(d)) {
        ret <- structure(c(arr, FUN(arr, ...)), names = c(names(arr), 
            label), class = cls)
        if (dim1) {
            dn[[1]] <- c(dn[[1]], label)
            ret <- structure(ret, dim = length(ret), dimnames = dn)
        }
        return(ret)
    }
    n <- length(d)
    ret <- arr
    ind <- 1:n
    for (i in n:1) {
        new <- apply(ret, ind[-i], FUN, ...)
        ret <- abind(ret, new, i, label)
    }
    class(ret) <- cls
    ret
  }

gmonette/spida15 documentation built on May 17, 2019, 7:26 a.m.