[R] Dots argument in apply method
Prof Brian Ripley
ripley at stats.ox.ac.uk
Wed Dec 7 14:55:28 CET 2005
Why does simply
setMethod("apply",
signature(X = "myClass",
MARGIN = "numeric",
FUN = "function"),
function(X, MARGIN, FUN, ...) .apply.myClass(X, MARGIN, FUN, ...))
not do what you want? It works for me in your example, e.g.
> apply(myObj, 2, sum, groups=myObj at Data$label)
gives exactly the same answer as your complicated solution.
I do wonder if you have misunderstood what '...' does.
I also wonder why you chose to overload a basic R function as an S4
generic like this. If you think that thereby existing calls to apply()
will go via your S4 methods then I fear you have overlooked the effects of
namespaces.
A simpler example
setClass("myClass", representation(tt="numeric"))
setMethod("lapply", signature(X="myClass"), function(X, FUN, ...) FUN(X at tt))
myObj <- new("myClass", tt=1:10)
> lapply(myObj, sum)
[1] 55
> sapply(myObj, sum)
list()
since sapply is calling base::lapply, not the lapply S4 generic.
On Wed, 7 Dec 2005, Christophe Pouzat wrote:
> Hello everyone,
>
> I'm working on a package using S4 classes and methods and I ran into the
> following "problem" when I tried to create an "apply" method for objects
> of one of my new classes. I've found a way around the problem but I
> wonder if I did not paint myself into the corner. I'd like your opinion
> about that.
>
> So I have an object "myObj" of class "myClass". I define a new function
> ".apply.myClass" which is a "myClass" specific version of "apply". The
> trick is that I would like to have an additional formal argument in
> .apply.myClass compared to apply. More precisely we have:
>
> apply(X, MARGIN, FUN, ...)
>
> and I want:
>
> .apply.myClass(x, margin, fun, groups = NULL, ...)
>
> As long as I stay at the function level there is no problem. Life
> becomes harder when I want to define an "apply" method for myClass
> objects, method which should call .apply.myClass.
> The formal argument "groups" in the myClass specific apply method will
> have to be passed in the dots argument, together with the "FUN" specific
> arguments. Then if the "groups" argument is provided it will have to be
> extracted and the remaining dots argument(s), if any, will have to be
> passed as such to .apply.myClass. Here is the way I did it:
>
> ## Start by setting a generic apply method
> if (!isGeneric("apply"))
> setGeneric("apply", function(X, MARGIN, FUN, ...)
> standardGeneric("apply"))
>
> ## set apply method for myClass objects
> setMethod("apply",
> signature(X = "myClass",
> MARGIN = "numeric",
> FUN = "function"),
> function(X, MARGIN, FUN, ...) {
> .call <- match.call(.apply.myClass)
>
> if (is.null(.call$groups)) myGroups <- NULL
> else myGroups <- .call$groups
>
> argList <- list(obj = .call$obj,
> margin = .call$margin,
> fun = .call$fun,
> groups = myGroups
> )
> if(!all(names(.call)[-1] %in% names(formals(.apply.myClass)))) {
> ## Some dots arguments have been provided
> otherNames <- (names(.call)[-1])[!(names(.call)[-1] %in%
> names(formals(.apply.myClass)))]
> remainingDots <- lapply(otherNames, function(i) .call[[i]])
> names(remainingDots) <- otherNames
> argList <- c(argList,remainingDots)
> }
> do.call(.apply.myClass, args = argList)
> }
> )
>
> Does anyone have a quicker solution?
>
> Thanks in advance,
>
> Christophe.
>
>
> PS: If you want a full example with actual class and .apply.myClass
> definitions, here is one:
>
> ## define class myClass
> setClass("myClass", representation(Data = "data.frame", timeRange =
> "numeric"))
>
> ## create myObj an instantiation of myClass
> myObj <- new("myClass",
> Data = data.frame(Time = sort(runif(10)),
> observation = I(matrix(rnorm(20),nrow=10,ncol=2)),
> label = factor(rep(1:2,5),levels = 1:2, labels = c("cat.
> 1", "cat. 2"))
> ),
> timeRange = c(0,1)
> )
>
> ## create function .apply.myClass for myClass objects
> .apply.myClass <- function(obj, ## object of class myClass
> margin, ## a numeric which should be 1 or 2
> fun, ## a function
> groups = NULL, ## should fun be applied in a
> group
> ## specific manner?
> ... ## additional arguments passed to fun
> ) {
>
> ## attach the data frame contained in obj
> attach(obj at Data)
> ## make sure to detach it at the end
> on.exit(detach(obj at Data))
> ## get the variable names
> variableNames <- names(obj at Data)
> ## check that one variable is named "observation"
> if (!("observation" %in% variableNames))
> stop(paste("The slot Data of",
> deparse(substitute(obj)),
> "does not contain an observation variable as it should."
> )
> )
>
> if (margin == 1) {
> ## in that case we don't care of the group
> myResult <- apply(observation, 1, fun, ...)
> return(myResult)
> } else if (margin == 2) {
> if (is.null(groups)) {
> ## no groups defined
> myResult <- apply(observation, 2, fun, ...)
> return(myResult)
> } else {
> ## groups defined
> groups <- eval(groups)
> X <- levels(groups)
> dim(X) <- c(1,length(X))
> myResult <- apply(X,
> 2,
> function(i) apply(observation[groups == i,],
> 2,
> fun, ...)
> )
> return(myResult)
> }
> } else {
> stop("margin should be set to 1 or 2.")
> }
>
> }
>
> --
> A Master Carpenter has many tools and is expert with most of them.If you
> only know how to use a hammer, every problem starts to look like a nail.
> Stay away from that trap.
> Richard B Johnson.
> --
>
> Christophe Pouzat
> Laboratoire de Physiologie Cerebrale
> CNRS UMR 8118
> UFR biomedicale de l'Universite Paris V
> 45, rue des Saints Peres
> 75006 PARIS
> France
>
> tel: +33 (0)1 42 86 38 28
> fax: +33 (0)1 42 86 38 30
> web: www.biomedicale.univ-paris5.fr/physcerv/C_Pouzat.html
>
> ______________________________________________
> R-help at stat.math.ethz.ch mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
>
--
Brian D. Ripley, ripley at stats.ox.ac.uk
Professor of Applied Statistics, http://www.stats.ox.ac.uk/~ripley/
University of Oxford, Tel: +44 1865 272861 (self)
1 South Parks Road, +44 1865 272866 (PA)
Oxford OX1 3TG, UK Fax: +44 1865 272595
More information about the R-help
mailing list