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