From: Prof Brian Ripley <ripley_at_stats.ox.ac.uk>

Date: Thu 08 Dec 2005 - 00:55:28 EST

Date: Thu 08 Dec 2005 - 00:55:28 EST

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@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@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@Data)
**> ## make sure to detach it at the end
**> on.exit(detach(obj@Data))
**> ## get the variable names
**> variableNames <- names(obj@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@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@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 ______________________________________________ R-help@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.htmlReceived on Thu Dec 08 01:02:18 2005

*
This archive was generated by hypermail 2.1.8
: Fri 03 Mar 2006 - 03:41:30 EST
*