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([EMAIL PROTECTED])
## make sure to detach it at the end
on.exit(detach([EMAIL PROTECTED]))
## get the variable names
variableNames <- names([EMAIL PROTECTED])
## 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
