#
# plot.fv.R (was: conspire.S)
#
# $Revision: 1.8 $ $Date: 2005/02/08 01:52:32 $
#
#
conspire <- function(...) {
.Deprecated("plot.fv")
plot.fv(...)
}
plot.fv <- function(x, fmla, subset=NULL, lty=NULL, col=NULL,
xlim, ylim, xlab, ylab, ...) {
verifyclass(x, "fv")
indata <- as.data.frame(x)
defaultplot <- missing(fmla)
if(defaultplot)
fmla <- attr(x, "fmla")
# This *is* the last possible moment, so...
fmla <- as.formula(fmla)
lhs <- fmla[[2]]
rhs <- fmla[[3]]
# evaluate expression a in data frame b
evaluate <- function(a,b) {
if(exists("is.R") && is.R())
eval(a, envir=b)
else
eval(a, local=b)
}
lhsdata <- evaluate(lhs, indata)
rhsdata <- evaluate(rhs, indata)
if(is.vector(lhsdata))
lhsdata <- matrix(lhsdata, ncol=1)
if(!is.vector(rhsdata))
stop("rhs of formula seems not to be a vector")
# restrict data to subset if desired
if(!is.null(subset)) {
keep <- if(is.character(subset))
evaluate(parse(text=subset), indata)
else
evaluate(subset, indata)
lhsdata <- lhsdata[keep, , drop=FALSE]
rhsdata <- rhsdata[keep]
}
# determine x and y limits and clip data to these limits
if(!missing(xlim)) {
ok <- (xlim[1] <= rhsdata & rhsdata <= xlim[2])
rhsdata <- rhsdata[ok]
lhsdata <- lhsdata[ok, , drop=FALSE]
} else {
# if we're using the default argument, use its recommended range
if(rhs == attr(x, "argu")) {
xlim <- attr(x,"alim")
ok <- is.finite(rhsdata) & rhsdata >= xlim[1] & rhsdata <= xlim[2]
rhsdata <- rhsdata[ok]
lhsdata <- lhsdata[ok, , drop=FALSE]
} else { # actual range of values to be plotted
xlim <- range(rhsdata[is.finite(rhsdata)],na.rm=TRUE)
rok <- is.finite(rhsdata) & rhsdata >= xlim[1] & rhsdata <= xlim[2]
lok <- apply(is.finite(lhsdata), 1, any)
ok <- lok & rok
rhsdata <- rhsdata[ok]
lhsdata <- lhsdata[ok, , drop=FALSE]
xlim <- range(rhsdata)
}
}
if(missing(ylim))
ylim <- range(lhsdata,na.rm=TRUE)
# work out how to label the plot
if(missing(xlab))
xlab <- as.character(fmla)[3]
if(missing(ylab)) {
yl <- attr(x, "ylab")
if(!is.null(yl) && defaultplot)
ylab <- yl
else {
yname <- paste(lhs)
if(length(yname) > 1 && yname[[1]] == "cbind")
ylab <- paste(yname[-1], collapse=" , ")
else
ylab <- as.character(fmla)[2]
}
}
# check for argument "add"=TRUE
dotargs <- list(...)
v <- match("add", names(dotargs))
if(is.na(v) || !(addit <- as.logical(dotargs[[v]])))
plot(xlim, ylim, type="n", xlab=xlab, ylab=ylab, ...)
nplots <- ncol(lhsdata)
if(is.null(lty))
lty <- 1:nplots
else if(length(lty) == 1)
lty <- rep(lty, nplots)
else if(length(lty) != nplots)
stop("Length of \`lty\' does not match number of curves to be plotted")
if(is.null(col))
col <- 1:nplots
else if(length(col) == 1)
col <- rep(col, nplots)
else if(length(col) != nplots)
stop("Length of \`col\' does not match number of curves to be plotted")
for(i in 1:nplots)
lines(rhsdata, lhsdata[,i], lty=lty[i], col=col[i])
if(nplots == 1)
return(invisible(NULL))
else
return(data.frame(lty=lty, col=col, row.names=colnames(lhsdata)))
}