Yes, setting 'Summary' S4 group methods is a bit painful,
because the S3 generic starts with "...".
In the 'Matrix' CRAN package,
we do the following {thanks to hints by John Chambers IIRC}:
Our AllGeneric.R file
(https://svn.R-project.org/R-packages/trunk/Matrix/R/AllGeneric.R)
ends with
###---- 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")
##-------------------------
and then in dMatrix.R we have
## This needs extra work in ./AllGeneric.R :
setMethod("Summary", signature(x = "dMatrix", na.rm =
"ANY"),
function(x, ..., na.rm) callGeneric(x at x, ..., na.rm = na.rm))
I think you can safely follow this recipe;
Regards,
Martin Maechler, ETH Zurich
>>>>> "Parlamis" == Parlamis Franklin <fparlamis at
mac.com>
>>>>> on Wed, 28 Dec 2005 19:52:00 -1000 writes:
Parlamis> Hello. This question concerns the Methods
Parlamis> package. I have created a new class and am trying
Parlamis> to set a method for it for S4 group generic
Parlamis> "Summary". I have run into some signature
Parlamis> problems. An example:
>> setClass("track", representation(x="numeric",
>> y="character"))
Parlamis> [1] "track"
>> setGeneric("max", group="Summary")
Parlamis> [1] "max"
>> setMethod("Summary", signature(x="track"),
function(x,
>> ..., na.rm)
Parlamis> callGeneric(x at x, ..., na.rm)) [1] "Summary"
>> dd<-new("track", x=c(1,2), y="abc") max(dd)
Parlamis> [1] -Inf Warning message: no finite arguments to
Parlamis> max; returning -Inf
>> showMethods("max")
Parlamis> Function "max": na.rm = "ANY" na.rm =
"track"
Parlamis> na.rm = "missing" (inherited from na.rm =
"ANY")
Parlamis> As you can see from the above, the method I tried
Parlamis> to set for "max" (via "Summary") was
defined for
Parlamis> the formal argument "na.rm" not "x". This
makes
Parlamis> sense because the standardGeneric created for max
Parlamis> only allows methods to be defined for argument
Parlamis> "na.rm"
>> max
Parlamis> standardGeneric for "max" defined from package
Parlamis> "base" belonging to group(s): Summary
Parlamis> function (..., na.rm = FALSE)
Parlamis> standardGeneric("max") <environment:
0x19447a28>
Parlamis> Methods may be defined for arguments: na.rm
Parlamis> However, group "Summary" purports to allow you to
Parlamis> define methods for arguments "x" and
"na.rm".
>> Summary
Parlamis> groupGenericFunction for "Summary" defined from
Parlamis> package "base"
Parlamis> function (x, ..., na.rm = FALSE) stop("function
Parlamis> 'Summary' is a group generic; do not call it
Parlamis> directly", domain = NA) <environment: 0x16aef098>
Parlamis> Methods may be defined for arguments: x, na.rm
Parlamis> How does this work? Can someone point me to where
Parlamis> I am going wrong, and explain how to define S4
Parlamis> methods for group "Summary" for argument
"x"?
Parlamis> Perhaps I need to do more in my "setGeneric" call?
Parlamis> Thanks in advance.
Parlamis> ______________________________________________
Parlamis> R-help at stat.math.ethz.ch mailing list
Parlamis> https://stat.ethz.ch/mailman/listinfo/r-help
Parlamis> PLEASE do read the posting guide!
Parlamis> http://www.R-project.org/posting-guide.html