R help - Feb 2002 - problem plotting nls objects: couldn't find function "..."

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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._

On Tue, 12 Feb 2002, Cooke, Barry wrote:
> 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.
library(lattice)

(which is in that Windows distribution, but otherwise you would need to get
it from CRAN, plus grid).

Until recently this did not work in R, but at least your example now does.

xyplot is nothing like plot.xy.

[...]

-- 
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 272860 (secr)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._