[Rd] setReplaceMethod

From: Robin Hankin <r.hankin_at_noc.soton.ac.uk>
Date: Tue 31 Oct 2006 - 15:24:38 GMT


Hi

If x <- 1:10 then x[5] <- 1i will promote x to be a complex vector.

Suppose I have an S4 class "brob", and have functions is.brob(), as.brob(), as.numeric() and so forth (minimal self-contained code below).

If x is numeric (1:10, say) and y is a brob, what is the best way to make

x[5] <- y

promote x to a brob in the same way as the complex example?

Or is this not desirable for some reason?

My first idea was to use

setReplaceMethod("[",signature("ANY","brob"), ...)

but this gives a seal error:

Error in setMethod(paste(f, "<-", sep = ""), ..., where = where) :

        the method for function "[<-" and signature x="ANY", i="brob" is sealed and cannot be re-defined

so this can't be right.

setClass("swift",

          representation = "VIRTUAL"
          )

setClass("brob",
          representation = representation 
(x="numeric",positive="logical"),
          prototype      = list(x=numeric(),positive=logical()),
          contains       = "swift"
          )

setAs("brob", "numeric", function(from){

   out <- exp(from@x)
   out[!from@positive] <- -out[!from@positive]    return(out)
} )

setMethod("as.numeric",signature(x="brob"),function(x){as(x,"numeric")}) is.brob <- function(x){is(x,"brob")}

"brob" <- function(x=double(),positive){

   if(missing(positive)){
     positive <- rep(TRUE,length(x))
}

   if(length(positive)==1){
     positive <- rep(positive,length(x))
}

   new("brob",x=as.numeric(x),positive=positive) }

"as.brob" <- function(x){

   if(is.brob(x)){
     return(x)
} else if(is.complex(x)) {

     warning("imaginary parts discarded")
     return(Recall(Re(x)))

} else if(is.glub(x)){
warning("imaginary parts discarded") return(Re(x))
} else {
return(brob(log(abs(x)), x>=0))

}

}

setMethod("[", "brob",

           function(x, i, j, drop){
             brob(x@x[i], x@positive[i])
           } )

setReplaceMethod("[",signature(x="brob"),
                  function(x,i,j,value){
                    jj.x <- x@x
                    jj.pos <- x@positive
                    if(is.brob(value)){
                      jj.x[i] <- value@x
                      jj.pos[i] <- value@positive
                      return(brob(x=jj.x,positive=jj.pos))
                    } else {
                      x[i] <- as.brob(value)
                      return(x)
                    }
                  } )


setReplaceMethod("[",signature("ANY","brob"),

                  function(x,i,j,value){
                    x <- as.brob(x)
                    x[i] <- as.brob(value)
                    return(x)
                  }
                  )




--
Robin Hankin
Uncertainty Analyst
National Oceanography Centre, Southampton
European Way, Southampton SO14 3ZH, UK
  tel  023-8059-7743

______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Received on Wed Nov 01 02:42:49 2006

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.1.8, at Wed 01 Nov 2006 - 05:30:36 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.