[Xts-commits] r618 - in pkg/xtsExtra: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 22 22:14:25 CEST 2012
Author: weylandt
Date: 2012-05-22 22:14:25 +0200 (Tue, 22 May 2012)
New Revision: 618
Modified:
pkg/xtsExtra/R/plot.R
pkg/xtsExtra/man/plot.xts.Rd
Log:
More work on plot.xts -- preliminary support for multi-variate columns; scatterplots seem good for now.
Modified: pkg/xtsExtra/R/plot.R
===================================================================
--- pkg/xtsExtra/R/plot.R 2012-05-22 04:13:22 UTC (rev 617)
+++ pkg/xtsExtra/R/plot.R 2012-05-22 20:14:25 UTC (rev 618)
@@ -19,24 +19,56 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
-# SHOULD REMOVE par() ARGS FROM FORMALS AND INSTEAD TREAT ... BETTER
+# To do:
+# REMOVE par() ARGS FROM FORMALS AND INSTEAD TREAT ... BETTER
+# DO LAYOUT WITHOUT USING LAYOUT -- NEED TO BE ABLE TO MOVE BETWEEN PLOTS WHEN ADDING LINES?
+# GET LAYOUT TO SUPPORT ADJACENT COLUMNS
+# HANDLE xlim AS ISO8601 AS WELL
+# legend.loc
+# COLOR GRADIENT FOR SCATTERPLOT CASE
+# Combine OHLC and multi-panel (i.e., if passed cbind(SPY, AGG))
+# Get OHLC to support log =
+# candle.col is not supported?
+
`plot.xts` <- function(x, y = NULL,
screens, screens.layout,
type, auto.grid=TRUE,
major.ticks='auto', minor.ticks=TRUE,
major.format=TRUE,
bar.col='grey', candle.col='white',
- ann, axes, xlab, ylab, main, xlim, ylim,
xy.labels = FALSE, xy.lines = NULL,
...) {
+ dots <- list(...)
+
+ setPar <- function(x, default){
+ # See if par was passed through ...
+ # if so, use it, else use default
+ # Also strip from dots once it's been handled directly
+
+ # Other model would be to modify it in dots and pass that way
+
+ x <- deparse(substitute(x))
+
+ r <- if(x %in% names(dots)){
+ dots[[x]]
+ } else {
+ default
+ }
+ dots[[x]] <- NULL
+ assign("dots", dots, parent.frame())
+
+ r
+ }
+
## if y supplied: scatter plot y ~ x
if(!is.null(y)) {
if(NCOL(x) > 1 || NCOL(y) > 1) stop("Scatter plots only for univariate series")
- # Catch these early enough?
- xlab <- if(missing(xlab)) deparse(substitute(x)) else xlab
- ylab <- if(missing(ylab)) deparse(substitute(y)) else ylab
+ # Am I catching these early enough
+ xlab <- setPar(xlab, deparse(substitute(x)))
+ ylab <- setPar(ylab, deparse(substitute(y)))
+ main <- setPar(main, paste(xlab, "vs.", ylab))
x <- try.xts(x); y <- try.xts(y)
@@ -46,33 +78,77 @@
xy <- xy.coords(xy[,1], xy[,2])
- xlim <- if(missing(xlim)) range(xy$x[is.finite(xy$x)]) else xlim
- ylim <- if(missing(ylim)) range(xy$y[is.finite(xy$y)]) else ylim
+ xlim <- setPar(xlim, range(xy$x[is.finite(xy$x)]))
+ ylim <- setPar(xlim, range(xy$y[is.finite(xy$y)]))
- if(missing(main)) main <- paste(xlab, "vs.", ylab)
-
do.lab <- if(is.logical(xy.labels)) xy.labels else TRUE
if(is.null(xy.lines)) xy.lines <- do.lab
- ptype <- if(do.lab) "n" else if(missing(type)) "p" else type
+ ptype <- setPar(type, if(do.lab) "n" else "p")
- plot.default(xy, type = ptype, main = main, xlab = xlab,
- ylab = ylab, xlim = xlim, ylim = ylim, ...)
+ do.call("plot.default", c(xy[1:2], list(type = ptype, main = main, xlab = xlab,
+ ylab = ylab, xlim = xlim, ylim = ylim), dots))
- if(do.lab) text(xy,
- labels = if(!is.logical(xy.labels)) xy.labels else index2char(index(xy.xts)), ...)
- if(xy.lines) lines(xy, type = if(do.lab) "c" else "l", ...)
+ if(do.lab) do.call("text",
+ c(xy[1:2], list(labels = if(!is.logical(xy.labels)) xy.labels else index2char(index(xy.xts))), dots))
+ if(xy.lines) do.call("lines", c(xy[1:2], list( type = if(do.lab) "c" else "l"), dots))
+ assign(".plot.xts", recordPlot(), .GlobalEnv)
return(invisible(xy.xts))
}
## Else : no y, only x
+ main <- setPar(main, deparse(substitute(x)))
+ xlab <- setPar(xlab, '')
+ log <- setPar(log, '')
+ axes <- setPar(axes, TRUE)
+
x <- try.xts(x)
+ # Catch OHLC case independently -- will violate DRY but that's ok for now
+ if(!missing(type) && type %in% c('candles','bars') && xts:::is.OHLC(x)){
+
+ if(type == 'bars') stop('OHLC bars not yet supported.')
+
+ # Handle OHLC candles
+ x <- x[,xts:::has.OHLC(x, TRUE)]
+ ylab <- setPar(ylab, '')
+
+ ep <- axTicksByTime(x, major.ticks, format.labels = major.format)
+
+ xy <- list(x = .index(x), y = seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = NROW(x)))
+ do.call("plot", c(list(x = xy$x, y = xy$y, type = "n", axes=FALSE, xlab = xlab, ylab = ylab, main = main), dots))
+
+ if(auto.grid) {
+ abline(v=xy$x[ep], col='grey', lty=4)
+ grid(NA,NULL)
+ }
+
+ if(axes) {
+ if(minor.ticks)
+ axis(1, at=xy$x, labels=FALSE, col='#BBBBBB')
+ axis(1, at=xy$x[ep], labels=names(ep), las=1, lwd=1, mgp=c(3,2,0))
+ axis(2)
+ }
+
+ print(candle.col)
+
+ xts:::plot.ohlc.candles(x, bar.col = bar.col, candle.col = candle.col)
+ box()
+ assign(".plot.xts",recordPlot(),.GlobalEnv)
+ return(invisible(reclass(x)))
+ }
+
+ # Else need to do layout plots
+ ylab <- setPar(ylab, if(NCOL(x) == 1) "" else
+ if(!is.null(colnames(x))) colnames(x) else paste("Column", seq_len(NCOL(x))))
+
# By default one screen per panel
if(missing(screens)){
screens <- 1:NCOL(x)
+ } else {
+ screens <- factor(screens)
}
if(missing(screens.layout)){
@@ -85,50 +161,39 @@
#
#####
-
- #time.scale <- periodicity(x)$scale
ep <- axTicksByTime(x,major.ticks, format.labels=major.format)
+ type <- if(missing(type)) rep('l', NCOL(x)) else rep(type, length.out = NCOL(x))
- otype <- type
-
- if(xts:::is.OHLC(x) && type %in% c('candles','bars')) {
- x <- x[,xts:::has.OHLC(x, TRUE)]
- xycoords <- list(x=.index(x), y=seq(min(x),max(x),length.out=NROW(x)))
- type <- "n"
- } else {
- if(NCOL(x) > 1) warning('only the univariate series will be plotted')
- if(is.null(y))
- xycoords <- xy.coords(.index(x), x[,1])
+ layout(screens.layout)
+
+ # For now, loop over screens and do plots automatically
+ for(scrn in unique(screens)){
+ x.temp <- x[, which(screens == scrn)]
+
+ xy <- list(x = .index(x.temp), y = seq(min(x.temp, na.rm = TRUE), max(x.temp, na.rm = TRUE), length.out = NROW(x)))
+ do.call("plot", c(xy[1:2], list(type = "n", axes=FALSE, xlab = "", ylab = ""), dots))
+
+ if(auto.grid) {
+ abline(v=xy$x[ep], col='grey', lty=4)
+ grid(NA,NULL)
+ }
+
+ if(axes) {
+ if(minor.ticks)
+ axis(1, at=xy$x, labels=FALSE, col='#BBBBBB')
+ axis(1, at=xy$x[ep], labels=names(ep), las=1, lwd=1, mgp=c(3,2,0))
+ axis(2)
+ }
+
+ for(col in seq_len(NCOL(x.temp))){
+ lines(x.temp[, col], type = "l")
+ }
+
+ box()
}
-
- plot(xycoords$x, xycoords$y, type=type, axes=FALSE, ann=FALSE, ...)
-
- if(auto.grid) {
- abline(v=xycoords$x[ep], col='grey', lty=4)
- grid(NA,NULL)
- }
-
- if(xts:::is.OHLC(x) && otype == 'candles')
- xts:::plot.ohlc.candles(x, bar.col=bar.col, candle.col=candle.col, ...)
-
- dots <- list(...)
-
-# if('axes' %in% names(dots)) {
-# if(!dots$axes) axes <- FALSE
-# } else axes <- TRUE
-
- if(axes) {
- if(minor.ticks)
- axis(1, at=xycoords$x, labels=FALSE, col='#BBBBBB', ...)
- axis(1, at=xycoords$x[ep], labels=names(ep), las=1, lwd=1, mgp=c(3,2,0),...)
- axis(2, ...)
- }
- box()
-
- if(!'main' %in% names(dots)) title(main)
- do.call('title',list(...))
assign(".plot.xts",recordPlot(),.GlobalEnv)
return(invisible(reclass(x)))
}
+
Modified: pkg/xtsExtra/man/plot.xts.Rd
===================================================================
--- pkg/xtsExtra/man/plot.xts.Rd 2012-05-22 04:13:22 UTC (rev 617)
+++ pkg/xtsExtra/man/plot.xts.Rd 2012-05-22 20:14:25 UTC (rev 618)
@@ -11,9 +11,6 @@
major.ticks='auto', minor.ticks=TRUE,
major.format=TRUE,
bar.col='grey', candle.col='white',
- ann, axes,
- xlab, ylab, main,
- xlim, ylim,
xy.labels = FALSE, xy.lines = NULL,
...)
}
@@ -22,16 +19,15 @@
\item{y}{ an \code{xts} object or NULL }
\item{screens}{ factor (or coerced to factor) whose levels specify which graph each series is to
be plotted in. If not specified, then defaults to a single series per screen for
- \code{plot.type} not \code{OHLC}. See examples.}
+ \code{type} not \code{"candles"} or \code{"bars"} See examples.}
\item{screens.layout}{ Matrix (in a form that could be passed to layout) which arranges screens.}
- \item{type}{ type of plot to produce }
+ \item{type}{ type of plot to produce; can be \code{"candles"} or \code{"bars"} in addition to the regular options. }
\item{auto.grid}{ should grid lines be drawn }
\item{major.ticks}{ should major tickmarks be drawn and labeled }
\item{minor.ticks}{ should minor tickmarks be drawn }
\item{major.format}{ passed along to axTicksByTime. See also }
\item{bar.col}{ the color of the bars when type is \sQuote{bars} or \sQuote{candles} }
\item{candle.col}{ the color of the candles when type is \sQuote{candles} }
- \item{ann, axes, xlab, ylab, main, xlim, ylim}{ passed \sQuote{par} graphical parameters }
\item{xy.labels}{ label points in scatterplot?}
\item{xy.lines}{ connect points in scatterplot?}
\item{\dots}{ additional graphical arguments }
@@ -48,10 +44,10 @@
}
\author{ Jeffrey A. Ryan }
\examples{
-#data(sample_matrix)
-#plot(sample_matrix)
-#plot(as.xts(sample_matrix))
-#plot(as.xts(sample_matrix), type='candles')
+data(sample_matrix)
+plot(sample_matrix)
+plot(as.xts(sample_matrix))
+plot(as.xts(sample_matrix), type='candles')
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
More information about the Xts-commits
mailing list