SCM

SCM Repository

[matrix] View of /pkg/R/AllGeneric.R
ViewVC logotype

View of /pkg/R/AllGeneric.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1175 - (download) (annotate)
Tue Jan 17 23:41:36 2006 UTC (13 years, 9 months ago) by bates
File size: 6314 byte(s)
Munging the data frame
#### Define those generics that we need, if they don't exist;
#### not all will be exported

if (!isGeneric("expand"))
    setGeneric("expand", function(x, ...) standardGeneric("expand"))

## if (!isGeneric("tcrossprod"))
##   setGeneric("tcrossprod", function(x, y = NULL) standardGeneric("tcrossprod"))
if (!exists("tcrossprod"))# R <= 2.2.x :
    tcrossprod <- function(x, y = NULL) x %*% t(if(is.null(y)) x else y)
## will become generic by setMethod(..)

if (!isGeneric("isDiagonal"))
    setGeneric("isDiagonal", function(object, ...)
               standardGeneric("isDiagonal"))

if (!isGeneric("isSymmetric"))
    ## no "..." here at the moment; must match isSymmetric()
    ## R 2.3.x base/R/eigen.R
    setGeneric("isSymmetric", function(object, ...)# no 'tol' in generic
	       standardGeneric("isSymmetric"))

if (!isGeneric("isTriangular"))
    setGeneric("isTriangular", function(object, ...)
               standardGeneric("isTriangular"))

if (!isGeneric("isNested"))
    setGeneric("isNested", function(object, ...) standardGeneric("isNested"))

if (!isGeneric("facmul"))
    setGeneric("facmul",
               function(x, factor, y, transpose, left, ...)
               standardGeneric("facmul"))

if (!isGeneric("lu"))
    setGeneric("lu", function(x, ...) standardGeneric("lu"))

if (!isGeneric("norm"))
    setGeneric("norm", function(x, type, ...) standardGeneric("norm"))

if (!isGeneric("rcond"))
    setGeneric("rcond", function(x, type, ...) standardGeneric("rcond"))

if (!isGeneric("Schur"))
    setGeneric("Schur", function(x, vectors, ...) standardGeneric("Schur"))

if (!isGeneric("unpack"))
    setGeneric("unpack", function(x, ...) standardGeneric("unpack"))

##- if (!isGeneric("%p%"))
##-     setGeneric("%p%", function(a, b) standardGeneric("%p%"))

if (!isGeneric("expm"))
    setGeneric("expm", function(x) standardGeneric("expm"))

if (!isGeneric("writeHB"))
    setGeneric("writeHB", function(obj, file, ...)
               standardGeneric("writeHB"))

if (!isGeneric("writeMM"))
    setGeneric("writeMM", function(obj, file, ...)
               standardGeneric("writeMM"))

## ----------------------- lmer-related Generics ---------------------------

## Hmm: If this does not match *exactly* the "formula" - method in ./lmer.R
## ---  the  match.call() in there may give a very different result
setGeneric("lmer",
           function(formula, data, family = gaussian,
                    method = c("REML", "ML", "PQL", "Laplace", "AGQ"),
                    control = list(), start, subset, weights, na.action,
                    offset, contrasts = NULL, model = TRUE,
                    x = TRUE, y = TRUE,
                    ...)
           standardGeneric("lmer"))


if (!isGeneric("LMEoptimize<-")) {
    setGeneric("LMEoptimize<-", function(x, ..., value)
               standardGeneric("LMEoptimize<-"))
}

if (!isGeneric("fixef")) {
    setGeneric("fixef", function(object, ...) standardGeneric("fixef"))
}

fixed.effects <- function(object, ...) {
    ## fixed.effects was an alternative name for fixef
    .Deprecated("fixef")
    mCall = match.call()
    mCall[[1]] = as.name("fixef")
    eval(mCall, parent.frame())
}

if (!isGeneric("ranef")) {
    setGeneric("ranef", function(object, ...)
               standardGeneric("ranef"))
}

random.effects <- function(object, ...) {
    ## random.effects was an alternative name for ranef
    .Deprecated("ranef")
    mCall = match.call()
    mCall[[1]] = as.name("ranef")
    eval(mCall, parent.frame())
}

if (!isGeneric("BIC")) {
    setGeneric("BIC", function(object, ...) standardGeneric("BIC"))
}

setMethod("BIC", "logLik",
          function(object, ...)
          -2 * (c(object) - attr(object, "df") * log(attr(object, "nobs"))/2)
          )

if (!isGeneric("VarCorr")) {
    setGeneric("VarCorr", function(x, ...) standardGeneric("VarCorr"))
}

if (!isGeneric("gradient")) {           # not exported
    setGeneric("gradient", function(x, ...) standardGeneric("gradient"))
}

if (!isGeneric("getFixDF")) {           # not exported
    setGeneric("getFixDF", function(object, ...) standardGeneric("getFixDF"))
}

if (!isGeneric("mcmcsamp")) {
    setGeneric("mcmcsamp", function(object, n = 1, verbose =
    FALSE, ...) standardGeneric("mcmcsamp"))
}

if (!exists("simulate", mode = "function")) {
    setGeneric("simulate", function(object, nsim = 1, seed = NULL, ...)
               standardGeneric("simulate"))
}

###---- Group Generics ----
## The following are **WORKAROUND** s currently needed for all non-Primitives:

##  "Math"
setGeneric("log", group="Math")
setGeneric("gamma", group="Math")
setGeneric("lgamma", group="Math")

## "Math2"
setGeneric("round",  group="Math2")
setGeneric("signif", group="Math2")

## "Summary" --- this needs some hoop jumping that may become unnecessary
##               in a future version of R (>= 2.3.x):

.max_def <- function(x, ..., na.rm = FALSE) base::max(x, ..., na.rm = na.rm)
.min_def <- function(x, ..., na.rm = FALSE) base::min(x, ..., na.rm = na.rm)
.range_def <- function(x, ..., na.rm = FALSE) base::range(x, ..., na.rm = na.rm)
.prod_def <- function(x, ..., na.rm = FALSE) base::prod(x, ..., na.rm = na.rm)
.sum_def <- function(x, ..., na.rm = FALSE) base::sum(x, ..., na.rm = na.rm)
.any_def <- function(x, ..., na.rm = FALSE) base::any(x, ..., na.rm = na.rm)
.all_def <- function(x, ..., na.rm = FALSE) base::all(x, ..., na.rm = na.rm)

setGeneric("max", function(x, ..., na.rm = FALSE) standardGeneric("max"),
           useAsDefault = .max_def, group = "Summary")
setGeneric("min", function(x, ..., na.rm = FALSE) standardGeneric("min"),
           useAsDefault = .min_def, group="Summary")
setGeneric("range", function(x, ..., na.rm = FALSE) standardGeneric("range"),
           useAsDefault = .range_def, group="Summary")
setGeneric("prod", function(x, ..., na.rm = FALSE) standardGeneric("prod"),
           useAsDefault = .prod_def, group="Summary")
setGeneric("sum", function(x, ..., na.rm = FALSE) standardGeneric("sum"),
           useAsDefault = .sum_def, group="Summary")
setGeneric("any", function(x, ..., na.rm = FALSE) standardGeneric("any"),
           useAsDefault = .any_def, group="Summary")
setGeneric("all", function(x, ..., na.rm = FALSE) standardGeneric("all"),
           useAsDefault = .all_def, group="Summary")

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge