[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