[R] problem plotting nls objects: couldn't find function "..."

Cooke, Barry BCooke at exchange.cfl.forestry.ca
Tue Feb 12 18:22:09 CET 2002


Dear R-help,

I can't plot nls objects for some reason.  The following example, taken from
help(plot.nls) illustrates the problem:

> data(Orthodont)
> fm1 <- lme(distance ~ age, Orthodont, random = ~ age | Subject)
> plot(fm1, resid(., type = "p") ~ fitted(.) | Sex, abline = 0) 
Error in do.call(plotFun, as.list(args)) : 
        couldn't find function "xyplot"

I checked the 2002 archives to see if this is a common problem resulting
from a recent break, but found no hints of that.  I am guessing that plot()
is correctly calling on plot.nls() which is calling the S function xyplot()
instead of the  R function plot.xy(), but I am not sure if this is so.  The
code for plot.nls(), appended below, suggests this is the intended
behaviour.  I noticed here that plot.nls() also relies on bwplot(), which I
(and my system) can't find either.  Why would this be happening and what
should I change?  I should mention: packages nls and nlme were loaded at
startup using the library() command.  Sorry if I am missing something
obvious.

My system is as follows:

> R.version
         _              
platform i386-pc-mingw32
arch     x86            
os       Win32          
system   x86, Win32     
status                  
major    1              
minor    4.1            
year     2002           
month    01             
day      30             
language R              

Barry J. Cooke

> plot.nls
function (x, form = resid(., type = "pearson") ~ fitted(.), abline, 
    id = NULL, idLabels = NULL, idResType = c("pearson", "normalized"), 
    grid, ...) 
{
    object <- x
    if (!inherits(form, "formula")) {
        stop("\"Form\" must be a formula")
    }
    allV <- all.vars(asOneFormula(form, id, idLabels))
    allV <- allV[is.na(match(allV, c("T", "F", "TRUE", "FALSE")))]
    if (length(allV) > 0) {
        data <- getData(object)
        if (is.null(data)) {
            alist <- lapply(as.list(allV), as.name)
            names(alist) <- allV
            alist <- c(as.list(as.name("data.frame")), alist)
            mode(alist) <- "call"
            data <- eval(alist, sys.parent(1))
        }
        else {
            if (any(naV <- is.na(match(allV, names(data))))) {
                stop(paste(allV[naV], "not found in data"))
            }
        }
    }
    else data <- NULL
    if (inherits(data, "groupedData")) {
        ff <- formula(data)
        rF <- deparse(getResponseFormula(ff)[[2]])
        cF <- deparse(getCovariateFormula(ff)[[2]])
        lbs <- attr(data, "labels")
        unts <- attr(data, "units")
        if (!is.null(lbs$x)) 
            cL <- paste(lbs$x, unts$x)
        else cF <- NULL
        if (!is.null(lbs$y)) 
            rL <- paste(lbs$y, unts$y)
        else rF <- NULL
    }
    else {
        rF <- cF <- NULL
    }
    dots <- list(...)
    if (length(dots) > 0) 
        args <- dots
    else args <- list()
    data <- as.list(c(as.list(data), . = list(object)))
    covF <- getCovariateFormula(form)
    .x <- eval(covF[[2]], data)
    if (!is.numeric(.x)) {
        stop("Covariate must be numeric")
    }
    argForm <- ~.x
    argData <- data.frame(.x = .x, check.names = FALSE)
    if (is.null(xlab <- attr(.x, "label"))) {
        xlab <- deparse(covF[[2]])
        if (!is.null(cF) && (xlab == cF)) 
            xlab <- cL
        else if (!is.null(rF) && (xlab == rF)) 
            xlab <- rL
    }
    if (is.null(args$xlab)) 
        args$xlab <- xlab
    respF <- getResponseFormula(form)
    if (!is.null(respF)) {
        .y <- eval(respF[[2]], data)
        if (is.null(ylab <- attr(.y, "label"))) {
            ylab <- deparse(respF[[2]])
            if (!is.null(cF) && (ylab == cF)) 
                ylab <- cL
            else if (!is.null(rF) && (ylab == rF)) 
                ylab <- rL
        }
        argForm <- .y ~ .x
        argData[, ".y"] <- .y
        if (is.null(args$ylab)) 
            args$ylab <- ylab
    }
    grpsF <- getGroupsFormula(form)
    if (!is.null(grpsF)) {
        gr <- splitFormula(grpsF, sep = "*")
        for (i in 1:length(gr)) {
            auxGr <- all.vars(gr[[i]])
            for (j in auxGr) {
                argData[[j]] <- eval(as.name(j), data)
            }
        }
        if (length(argForm) == 2) 
            argForm <- eval(parse(text = paste("~ .x |",
deparse(grpsF[[2]]))))
        else argForm <- eval(parse(text = paste(".y ~ .x |", 
            deparse(grpsF[[2]]))))
    }
    args <- c(args, formula = list(argForm), data = list(argData))
    if (is.null(args$strip)) {
        args$strip <- function(...) strip.default(..., style = 1)
    }
    if (is.null(args$cex)) 
        args$cex <- par("cex")
    if (is.null(args$adj)) 
        args$adj <- par("adj")
    if (!is.null(id)) {
        idResType <- match.arg(idResType)
        id <- switch(mode(id), numeric = {
            if ((id <= 0) || (id >= 1)) {
                stop("Id must be between 0 and 1")
            }
            as.logical(abs(resid(object, type = idResType)) > 
                -qnorm(id/2))
        }, call = eval(asOneSidedFormula(id)[[2]], data), stop("\"Id\" can
only be a formula or numeric."))
        if (is.null(idLabels)) {
            idLabels <- getGroups(object)
            if (length(idLabels) == 0) 
                idLabels <- 1:object$dims$N
            idLabels <- as.character(idLabels)
        }
        else {
            if (mode(idLabels) == "call") {
                idLabels <-
as.character(eval(asOneSidedFormula(idLabels)[[2]], 
                  data))
            }
            else if (is.vector(idLabels)) {
                if (length(idLabels <- unlist(idLabels)) != length(id)) {
                  stop("\"IdLabels\" of incorrect length")
                }
                idLabels <- as.character(idLabels)
            }
            else {
                stop("\"IdLabels\" can only be a formula or a vector")
            }
        }
    }
    if (missing(abline)) {
        if (missing(form)) {
            abline <- c(0, 0)
        }
        else {
            abline <- NULL
        }
    }
    assign("abl", abline)
    if (length(argForm) == 3) {
        if (is.numeric(.y)) {
            plotFun <- "xyplot"
            if (is.null(args$panel)) {
                args <- c(args, panel = list(function(x, y, subscripts, 
                  ...) {
                  dots <- list(...)
                  if (grid) panel.grid()
                  panel.xyplot(x, y, ...)
                  if (any(ids <- id[subscripts])) {
                    text(x[ids], y[ids], idLabels[subscripts][ids], 
                      cex = dots$cex, adj = dots$adj)
                  }
                  if (!is.null(abl)) {
                    panel.abline(abl, ...)
                  }
                }))
            }
        }
        else {
            plotFun <- "bwplot"
            if (is.null(args$panel)) {
                args <- c(args, panel = list(function(x, y, ...) {
                  if (grid) panel.grid()
                  panel.bwplot(x, y, ...)
                  if (!is.null(abl)) {
                    panel.abline(v = abl[1], ...)
                  }
                }))
            }
        }
    }
    else {
        plotFun <- "histogram"
        if (is.null(args$panel)) {
            args <- c(args, panel = list(function(x, ...) {
                if (grid) panel.grid()
                panel.histogram(x, ...)
                if (!is.null(abl)) {
                  panel.abline(v = abl[1], ...)
                }
            }))
        }
    }
    if (missing(grid)) {
        if (plotFun == "xyplot") 
            grid <- TRUE
        else grid <- FALSE
    }
    do.call(plotFun, as.list(args))
}

Dr. Barry J. Cooke
Natural Resources Canada
Canadian Forestry Service
Laurentian Forestry Centre
P.O. Box 3800
Ste-Foy, QC
G1V 4C7

Tel: (418) 648-7532
Fax: (418) 648-5849

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._



More information about the R-help mailing list