[Rd] setMethod("c") [was: setMethod("Summary")]
Robin Hankin
r.hankin at noc.soton.ac.uk
Thu Sep 7 13:18:51 CEST 2006
Thank you for this. Minimal self-contained code included below.
It is slightly modified from the original because brob objects have two
slots, both of which are needed by c().
[
A "brob" obect is represents a real number with two slots: "x" holds
its natural
logarithm; slot "positive" is Boolean, indicating whether the number
is positive.
I want this because I need to manipulate numbers up to ~1e20000.
The hard bit is addition: log(exp(x) + exp(y)) == x + log1p(exp(y-x))
]
It seemed to make sense to coerce non-brob arguments to brobs,
then make cPair() use cPairOfBrobs() [with coerced arguments] in
three of the cases, and c() for the fourth with signature c("ANY",
"ANY").
Now below, JC states that "cWithMethods() _replaces_ the ordinary c
(), it's not
just a method for it". Does this imply that one cannot set up an R
package
so that the following code:
x <- as.brob(1:10)
x1 <- c(1,x)
x2 <- c(x,1)
works as expected? Or is there some workaround that would enable
me to do this?
best wishes
Robin
setClass("brob",
representation = representation
(x="numeric",positive="logical"),
prototype = list(x=numeric(),positive=logical())
)
"brob" <- function(x,positive){
if(missing(positive)){
positive <- rep(TRUE,length(x))
}
if(length(positive)==1){
positive <- rep(positive,length(x))
}
new("brob",x=x,positive=positive)
}
is.brob <- function(x){is(x,"brob")}
as.brob <- function(x){
if(is.brob(x)){
return(x)
} else {
return(brob(log(abs(x)),x>0))
}
}
cWithMethods <- function(x, ...) {
if(nargs()<3)
cPair(x,...)
else
cPair(x, cWithMethods(...))
}
cPairOfBrobs <- function(x,y){
x <- as.brob(x)
y <- as.brob(y)
brob(c(x at x,y at x),c(x at positive,y at positive))
}
setGeneric("cPair", function(x,y)standardGeneric("cPair"))
setMethod("cPair", c("brob", "brob"), function(x,y)cPairOfBrobs(x,y))
setMethod("cPair", c("brob", "ANY"), function(x,y)cPairOfBrobs
(x,as.brob(y)))
setMethod("cPair", c("ANY", "brob"), function(x,y)cPairOfBrobs
(as.brob(x),y))
setMethod("cPair", c("ANY", "ANY"), function(x,y)c(x,y))
On 6 Sep 2006, at 18:32, John Chambers wrote:
> You missed the point of the example, which is why your own
> implementation didn't work.
>
> It's not the tail recursion that is important, but the recasting of
> max() (or of c()) to not just a standard generic, but to a recursive
> computation, so that methods need only be defined for a finite number
> of arguments.
>
> Because the recursion in c() requires two arguments, not one as with
> max(), the methods are more naturally transferred to an auxiliary
> function, cPair in my sketch. Then cWithMethods _replaces_ the
> ordinary
> c(), it's not just a method for it.
>
> Also required are a set of methods that corresponds to what you
> want to
> do. The methods apply, as I said before, to cPair(), which is a
> generic
> with two arguments.
>
> If your picture is that you can bind your class to anything, in either
> order, then you need methods for ("ANY", "brob") and ("brob",
> "ANY"), as
> well as the method ("brob", "brob"), equivalent to the function
> cPairOfBrobs(), and a default method that just uses c().
>
> Something like:
> ---------------------
> cWithMethods <- function(x, ...) {
> if(nargs()<3)
> cPair(x,...)
> else
> cPair(x, cWithMethods(...))
> }
>
> setGeneric("cPair", function(x,y)standardGeneric("cPair"))
>
> setMethod("cPair", c("brob", "brob"), function(x,y)cPairOfBrobs(x,y))
>
> setMethod("cPair", c("brob", "ANY"), function(x,y)c(x at x, y))
>
> setMethod("cPair", c("ANY", "brob"), function(x,y)c(x, y at x))
>
> setMethod("cPair", c("ANY", "ANY"), function(x,y)c(x,y))
>
>
> Robin Hankin wrote:
>>
[snip]
--
Robin Hankin
Uncertainty Analyst
National Oceanography Centre, Southampton
European Way, Southampton SO14 3ZH, UK
tel 023-8059-7743
More information about the R-devel
mailing list