Skip to content

Modifying a built-in R function

6 messages · japal, Uwe Ligges, Brian Ripley +1 more

#
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.
#
japal wrote:
Can you send us your modified version and the way you called it (as the 
posting guide asks you to do)? Otherwise we cannot know.

Uwe Ligges
#
japal wrote:
Sorry, I did not show the code: (I have highlighted in bold the changes)

***********************************

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.
#
I am not sure what you intended by
That does nothing different from biplot().  You need to call your 
modified functions 'biplotes.default' and 'biplotes.princomp' and call 
those via
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:

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

  
    
#
Alternatively, gives a looked in the package bpca and biplotGUI, both
available on CRAN.

HTH,
JCFaria
japal wrote:

  
    
#
Ok, thank you for your guidelines. Additionally, I have had to put the
biplotes.princomp function in the first place of the script, just after
biplotes <- function(x, ...) UseMethod("biplotes"). By doing this it works,
althrough I don?t really know why. I hope to acquire higher skills in R
programming soon, there are still many things of R that I do not handle at
this time.

Thanks again.