#' Add a plot to a graph
#'
#' Adds points or lines to the current graph.
#'
#' @name addXY
#' @rdname addXY
#' @aliases addXY addXY,ANY,numeric-method
#' addXY,numeric,character-method
#' @param x the x-axis data. Missing values are permitted, but result in breaks
#' in the plotted data.
#' @param y the y-axis data. Missing values are permitted, but result in breaks
#' in the plotted data.
#' @param Plot parameters defining the characteristics of the plot. See
#' \code{\link{setPlot}} for a description of the parameters.
#' @param current the current plot information. Typically, this would be the
#' output from one of the graph creation functions like \code{xyPlot}.
#' @param new.axis character: indicating which new axis to set up. Must be either "right," "top,"
#' or "none," which indicates that the existing axes be used (default).
#' @param new.log logical, if \code{TRUE}, then log transform new axis.
#' @param new.rev logical, if \code{TRUE}, then reverse new axis.
#' @param new.range set new-axis range.
#' @param new.labels set up new-axis labels.
#' @param new.title the new-axis title.
#' @param jitter.y adjust \code{y} values to reduce overlap for each group?
#' @param ... arguments for specific methods.
#' @return Information about the graph.
#' @docType methods
#' @section Methods: \describe{
#'
#'\item{signature(x ="ANY", y = "numeric"}{Any valid x-axis data and numeric y.}
#'\item{signature(x ="numeric", y = "character"}{Method to add to a dot plot;
#'the right-axis arguments are not valid.}
#'}
#' @keywords methods aplot
#' @examples
#' \dontrun{
#' set.seed(1)
#' X <- rnorm(32)
#' Y <- X + rnorm(32)
#' Y2 <- X + rnorm(32, sd=0.5)
#' setGD()
#' AA.pl <- xyPlot(X, Y)
#' addXY(X, Y2, Plot=list(what="points", color="brown"))
#' # See for examples of addXY:
#' vignette(topic="GraphAdditions", package="smwrGraphs")
#' vignette(topic="GraphSetup", package="smwrGraphs")
#' vignette(topic="ProbabilityPlots", package="smwrGraphs")
#' demo(topic="DurationHydrograph", package="smwrGraphs")
#' demo(topic="FlowDur-Measurements", package="smwrGraphs")
#' demo(topic="MeasurementRating", package="smwrGraphs")
#' demo(topic="RightAxisExample", package="smwrGraphs")
#' demo(topic="TopAxisExample", package="smwrGraphs")
#' }
#' @exportMethod addXY
setGeneric("addXY", function(x, y, ...) standardGeneric("addXY")
# 2008Jun27 DLLorenz Original coding.
# 2010Nov20 DLLorenz Begin modifications for R
# 2011Apr16 DLLorenz Added complete complement of args to setPlot
# 2011Jun17 DLLorenz fixed date conversion
# 2011Oct24 DLLorenz fixed call to renderY and tweak for package
# 2012Aug28 DLLorenz dots for future methods
# 2012Sep27 DLLorenz Made generic
# 2014Jun25 DLLorenz Converted to roxygen
)
#' @rdname addXY
setMethod("addXY", signature("ANY", "numeric"),
function(x, y, # data
Plot=list(name="", what='lines', type='solid',
width='standard', symbol='circle', filled=TRUE,
size=0.09, color='black'), # plot controls
current=list(yaxis.log=FALSE, yaxis.rev=FALSE,
xaxis.log=FALSE), # current plot parameters
new.axis="none", new.log=FALSE, new.rev=FALSE,
new.range=c(NA,NA), ## right/top-axis controls
new.labels=7, new.title='') { # right/top-axis labels and titles
##
new.axis <- match.arg(new.axis, c("none","right","top"))
if(new.axis == "right") { # set up right axis
rax <- setAxis(y, new.range, new.log, new.rev, new.labels)
y <- rax$data
rax <- rax$dax
## reset y-axis limits
usr <- par('usr')
usr[3:4] <- rax$range
par(usr=usr)
## label right axis
renderY(rax, left=list(ticks=FALSE, labels=FALSE), right=list(ticks=TRUE,
labels=TRUE),
lefttitle='', righttitle=new.title)
## update current
current$yaxis.log <- new.log
current$yaxis.rev <- new.rev
## convert x
x <- numericData(x, lev=current$xaxis.lev) # Convert dates to consistent numeric
x <- transData(x, current$xaxis.log, FALSE,
current$xtrans, current$xtarg)
} else if (new.axis == "top"){
rax <- setAxis(x, new.range, new.log, new.rev, new.labels)
x <- rax$data
rax <- rax$dax
## reset x-axis limits
usr <- par('usr')
usr[1:2] <- rax$range
par(usr=usr)
renderX(rax, bottom=list(ticks=FALSE, labels=FALSE), top=list(ticks=TRUE,
labels=TRUE),
bottitle='', toptitle=new.title)
## update current, no reverse x-axis
current$xaxis.log <- new.log
if(new.rev)
warning("x-axis cannot be reversed")
# Convert y
y <- numericData(y, lev=current$yaxis.lev)
y <- transData(y, current$yaxis.log, current$yaxis.rev,
current$ytrans, current$ytarg)
} else { # convert the data according to the existing
x <- numericData(x, lev=current$xaxis.lev) # Convert dates to consistent numeric
x <- transData(x, current$xaxis.log, FALSE,
current$xtrans, current$xtarg)
y <- numericData(y, lev=current$yaxis.lev)
y <- transData(y, current$yaxis.log, current$yaxis.rev,
current$ytrans, current$ytarg)
}
Plot <- setPlot(Plot, name="", what='lines', type='solid',
width='standard', symbol='circle', filled=TRUE,
size=0.09, color='black') # force defaults if not set
explan <- setExplan(Plot, old=current$explanation) # add info to set up explanation
plotPars <- explan$current
lines(x, y, type=plotPars$type, lwd=plotPars$lwd, lty=plotPars$lty,
pch=plotPars$pch, cex=plotPars$cex, col=plotPars$col, bg=plotPars$col)
current$x <- x
current$y <- y
current$explanation <- explan
invisible(current)
}
)
#' @rdname addXY
setMethod("addXY", signature("numeric", "character"),
function(x, y, # data
Plot=list(name="", what='points', type='solid',
width='standard', symbol='circle', filled=TRUE,
size=0.09, color='black'), # plot controls
current=list(yaxis.log=FALSE, yaxis.rev=FALSE,
xaxis.log=FALSE), # current plot parameters
jitter.y=FALSE) { # jitter y-values a bit
##
y <- numericData(y, lev=current$yaxis.lev)
y <- transData(y, current$yaxis.log, current$yaxis.rev,
current$ytrans, current$ytarg)
x <- numericData(x, lev=current$xaxis.lev) # Convert dates to consistent numeric
x <- transData(x, current$xaxis.log, FALSE,
current$xtrans, current$xtarg)
if(jitter.y) {
jitter.y <- runif(length(y), -.1, .1)
} else
jitter.y <- 0
Plot <- setPlot(Plot, name="", what='points', type='solid',
width='standard', symbol='circle', filled=TRUE,
size=0.09, color='black') # force defaults if not set
explan <- setExplan(Plot, old=current$explanation) # add info to set up explanation
plotPars <- explan$current
points(x, y + jitter.y, type=plotPars$type, lwd=plotPars$lwd, lty=plotPars$lty,
pch=plotPars$pch, cex=plotPars$cex, col=plotPars$col, bg=plotPars$col)
current$x <- x
current$y <- y
current$explanation <- explan
invisible(current)
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.