[Rd] setReplaceMethod

[Robin Hankin]

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 at x)
   out[!from at positive] <- -out[!from at 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 at x[i], x at positive[i])
           } )

setReplaceMethod("[",signature(x="brob"),
                  function(x,i,j,value){
                    jj.x <- x at x
                    jj.pos <- x at positive
                    if(is.brob(value)){
                      jj.x[i] <- value at x
                      jj.pos[i] <- value at 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