[R] Modifying a built-in R function

[Prof Brian Ripley]

I am not sure what you intended by

> biplotes <- function(x, ...) UseMethod("biplot")

That does nothing different from biplot().  You need to call your 
modified functions 'biplotes.default' and 'biplotes.princomp' and call 
those via

> biplotes <- function(x, ...) UseMethod("biplotes")

Anything else depends on the scoping rules for S3 methods, and those 
are too complex to rely on with multiple objects of the same name -- 
but if your biplot.default is visible from where biplotes is called, I 
would expect it to be used.

There are good reasons why the posting guide and message footers asks 
for reproducible examples -- otherwise, as here, we are left to guess.

On Mon, 2 Mar 2009, japal wrote:

>
>
>
> japal wrote:
>>
>> Hello,
>>
>> Something incredible (at least for me) has happen. Yesterday night I
>> downloaded biplot.R to edit this function and add new features I wished.
>> Namely I wanted to plot points belonging to different groups using
>> different colors and symbols. I identified which part of the original code
>> I had to modify. Then, I rename biplot by biplotes and executing
>> biplotes(x), being x a princomp class object, the function did what I
>> wanted.
>>
>> The problem is that today I type exactly the same (after sourcing my
>> script file incluiding biplotes) but  biplotes(x) execute the original
>> biplot function. Also, if I invoke any of the new arguments I wrote in the
>> code then multiple warnings messages are displayed. I don't understand
>> what is the problem. Yesterday it works perfectly. Why R does not execute
>> my code and call the original biplot function?
>>
>> Thanks in advance,
>> Javier.
>>
>
>
> Sorry, I did not show the code: (I have highlighted in bold the changes)

Highlighting does not work in plain text, all you were asked to send.

> ***********************************
>
> biplotes <- function(x, ...) UseMethod("biplot")
>
> biplot.default <-
>    function(x, y, color="blue", char=1, var.axes = TRUE, col, cex =
> rep(par("cex"), 2),
>         xlabs = NULL, ylabs = NULL, expand=1, xlim = NULL, ylim = NULL,
>         arrow.len = 0.1,
>             main = NULL, sub = NULL, xlab = NULL, ylab = NULL, ...)
> {
>    n <- nrow(x)
>    p <- nrow(y)
>    if(missing(xlabs)) {
>    xlabs <- dimnames(x)[[1L]]
>    if(is.null(xlabs)) xlabs <- 1L:n
>    }
>    xlabs <- as.character(xlabs)
>    dimnames(x) <- list(xlabs, dimnames(x)[[2L]])
>    if(missing(ylabs)) {
>    ylabs <- dimnames(y)[[1L]]
>    if(is.null(ylabs)) ylabs <- paste("Var", 1L:p)
>    }
>    ylabs <- as.character(ylabs)
>    dimnames(y) <- list(ylabs, dimnames(y)[[2L]])
>
>    if(length(cex) == 1L) cex <- c(cex, cex)
>    if(missing(col)) {
>    col <- par("col")
>    if (!is.numeric(col)) col <- match(col, palette(), nomatch=1L)
>    col <- c(col, col + 1L)
>    }
>    else if(length(col) == 1L) col <- c(col, col)
>
>
> biplot.princomp <- function(x, choices = 1L:2, scale = 1, pc.biplot=FALSE,
> ...)
> {
>    if(length(choices) != 2) stop("length of choices must be 2")
>    if(!length(scores <- x$scores))
>    stop(gettextf("object '%s' has no scores", deparse(substitute(x))),
>             domain = NA)
>    lam <- x$sdev[choices]
>    if(is.null(n <- x$n.obs)) n <- 1
>    lam <- lam * sqrt(n)
>    if(scale < 0 || scale > 1) warning("'scale' is outside [0, 1]")
>    if(scale != 0) lam <- lam^scale else lam <- 1
>    if(pc.biplot) lam <- lam / sqrt(n)
>    biplot.default(t(t(scores[, choices]) / lam),
>           t(t(x$loadings[, choices]) * lam), ...)
>    invisible()
> }
>
>    unsigned.range <- function(x)
>        c(-abs(min(x, na.rm=TRUE)), abs(max(x, na.rm=TRUE)))
>    rangx1 <- unsigned.range(x[, 1L])
>    rangx2 <- unsigned.range(x[, 2L])
>    rangy1 <- unsigned.range(y[, 1L])
>    rangy2 <- unsigned.range(y[, 2L])
>
>    if(missing(xlim) && missing(ylim))
>    xlim <- ylim <- rangx1 <- rangx2 <- range(rangx1, rangx2)
>    else if(missing(xlim)) xlim <- rangx1
>    else if(missing(ylim)) ylim <- rangx2
>    ratio <- max(rangy1/rangx1, rangy2/rangx2)/expand
>    on.exit(par(op))
>    op <- par(pty = "s")
>    if(!is.null(main))
>        op <- c(op, par(mar = par("mar")+c(0,0,1,0)))
>    plot(x, type = "p", xlim = xlim, ylim = ylim,
>    col = color,pch=char,cex=0.75, #color, símbolo y tamaños de los puntos
>    xlab = xlab, ylab = ylab, sub = sub, main = main, ...)
>
>    par(new = TRUE)
>    plot(y, axes = FALSE, type = "n", xlim = xlim*ratio, ylim = ylim*ratio,
>     xlab = "", ylab = "", col = col[1L], ...)
> #    axis(3, col = col[2L], ...)
> #    axis(4, col = col[2L], ...)
> #    box(col = col[1L])
>    text(y, labels=ylabs, cex = 0.9, col = "grey32", ...)
>    if(var.axes)
>    arrows(0, 0, y[,1L] * 0.8, y[,2L] * 0.8,
>    col = "grey32", #Arrow color
>    length=0.07)
>    invisible()
> }
>
> *********************************
>
> Note that the problem is solved if (after sourcing the R script incluiding
> biplotes function to the current R session) I only copy-paste the
> biplot.princomp function into the R console. After this, biplotes apply my
> changes correctly, without invoke the original biplot function. But I think
> this is only a trick and not the suitable way.
>
> Thanks again.
>
> -- 
> View this message in context: http://www.nabble.com/Modifying-a-built-in-R-function-tp22278950p22284264.html
> Sent from the R help mailing list archive at Nabble.com.
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>

-- 
Brian D. Ripley,                  ripley at stats.ox.ac.uk
Professor of Applied Statistics,  http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595