[Xts-commits] r663 - in pkg/xtsExtra: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 3 03:05:13 CEST 2012
Author: weylandt
Date: 2012-07-03 03:05:12 +0200 (Tue, 03 Jul 2012)
New Revision: 663
Modified:
pkg/xtsExtra/R/plot.R
pkg/xtsExtra/man/plot.xts.Rd
Log:
Added events to plot.xts
Modified: pkg/xtsExtra/R/plot.R
===================================================================
--- pkg/xtsExtra/R/plot.R 2012-07-02 20:03:58 UTC (rev 662)
+++ pkg/xtsExtra/R/plot.R 2012-07-03 01:05:12 UTC (rev 663)
@@ -53,6 +53,7 @@
major.format=TRUE, bar.col.up = 'white',
bar.col.dn ='black', candle.col='black',
xy.labels = FALSE, xy.lines = NULL,
+ events,
...) {
# Restore old par() options from what I change in here
@@ -109,7 +110,8 @@
candle.col = candle.col, major.ticks = major.ticks,
minor.ticks = minor.ticks, auto.grid = auto.grid,
major.format = major.format, main = main,
- candles = (type == "candles"), ...)
+ candles = (type == "candles"), events = events, ...)
+
} else {
# Else need to do layout plots
screens <- do_layout(x, screens = screens, layout.screens = layout.screens,
@@ -140,11 +142,21 @@
}
# Note that do_add.grid also sets up axes and what not
- do_add.grid(x.plot, major.ticks, major.format, minor.ticks,
+ ylim <- do_add.grid(x.plot, major.ticks, major.format, minor.ticks,
auto.grid = auto.grid, ylab = ylab.panel, log = log.panel,
have_x_axis = have_x_axis[i], have_y_axis = have_y_axis[i],
ylab.axis = ylab.axis[i])
+ if(!missing(events)){
+ for(j in seq_along(events)){
+ do_add.event(time = do.call(paste0("as.",indexClass(x))[1], list(get.elm.recycle(events[["time"]], j))),
+ label = get.elm.recycle(events[["label"]], j),
+ col = if(!is.null(events[["col"]])) get.elm.recycle(events[["col"]],j) else "red",
+ lty = if(!is.null(events[["lty"]])) get.elm.recycle(events[["lty"]],j) else 2,
+ y = range(ylim)[2])
+ }
+ }
+
col.panel <- get.elm.from.dots("col", dots, screens, i)
pch.panel <- get.elm.from.dots("pch", dots, screens, i)
cex.panel <- get.elm.from.dots("cex", dots, screens, i)
@@ -303,6 +315,7 @@
}
box()
+ return(xy$y)
}
do_add.lines <- function(x, col, pch, cex, lwd, type, ...){
@@ -326,12 +339,16 @@
do_add.shading <- function(){}
-do_add.event <- function(){}
+do_add.event <- function(time, label, col = "red", lty = 2, y = ylim[2]){
+ abline(v = time, col = col, lty = lty)
+ text(x = time, y = y, label = label, offset = 0.2, pos = 2, srt = 90, col = col)
+}
do_add.legend <- function(){}
do_plot.ohlc <- function(x, bar.col.up, bar.col.dn, candle.col, major.ticks,
- minor.ticks, major.format, auto.grid, candles, ...){
+ minor.ticks, major.format, auto.grid,
+ candles, events, ...){
if(QUANTMOD_MESSAGE) {
message("Note that CRAN Package quantmod provides much better OHLC charting.\n",
@@ -344,10 +361,20 @@
# Extract OHLC Columns and order them
x <- x[,xts:::has.OHLC(x, TRUE)]
par(oma = c(1,4,4,3))
- do_add.grid(x, major.ticks = major.ticks, major.format = major.format,
+ ylim <- do_add.grid(x, major.ticks = major.ticks, major.format = major.format,
minor.ticks = minor.ticks, auto.grid = auto.grid,
have_x_axis = TRUE, have_y_axis = TRUE, ylab.axis = "none", ...)
+ if(!missing(events)){
+ for(j in seq_along(events)){
+ do_add.event(time = do.call(paste0("as.",indexClass(x))[1], list(get.elm.recycle(events[["time"]], j))),
+ label = get.elm.recycle(events[["label"]], j),
+ col = if(!is.null(events[["col"]])) get.elm.recycle(events[["col"]],j) else "red",
+ lty = if(!is.null(events[["lty"]])) get.elm.recycle(events[["lty"]],j) else 2,
+ y = range(ylim)[2])
+ }
+ }
+
width = .2*deltat(x)
# Better to do this with xts:::Op etc when moved to xts package
Modified: pkg/xtsExtra/man/plot.xts.Rd
===================================================================
--- pkg/xtsExtra/man/plot.xts.Rd 2012-07-02 20:03:58 UTC (rev 662)
+++ pkg/xtsExtra/man/plot.xts.Rd 2012-07-03 01:05:12 UTC (rev 663)
@@ -6,12 +6,13 @@
}
\usage{
\method{plot}{xts}(x, y = NULL,
- screens = 'auto', layout.screens = 'auto',
- ylab.loc = c("none","out","in","flip", "left", "right"),
- auto.grid=TRUE, major.ticks='auto', minor.ticks=TRUE,
- major.format=TRUE, bar.col.up = 'white',
- bar.col.dn ='black', candle.col='black',
- xy.labels = FALSE, xy.lines = NULL, ...)
+ screens = 'auto', layout.screens = 'auto',
+ ylab.loc = c("none","out","in","flip", "left", "right"),
+ auto.grid=TRUE, major.ticks='auto', minor.ticks=TRUE,
+ major.format=TRUE, bar.col.up = 'white',
+ bar.col.dn ='black', candle.col='black',
+ xy.labels = FALSE, xy.lines = NULL,
+ events, ...)
}
\arguments{
\item{x}{an \code{xts} object}
@@ -28,6 +29,8 @@
\item{candle.col}{the color of the candles when \code{type} is \sQuote{candles}. Also the outside of the bars.}
\item{xy.labels}{label points in scatterplot?}
\item{xy.lines}{connect points in scatterplot?}
+ \item{events}{A list with mandatory elements \code{time} and \code{label} and optional
+ elements \code{col} and \code{lty} giving the events to be highlighted. See examples.}
\item{\dots}{additional graphical arguments}
}
\details{
@@ -107,6 +110,9 @@
plot(merge(x,x), type = "p", col = 1:5, pch = 1:5, cex = 1:5)
plot(merge(x,x), type = "p", col = list(1:5, 1:3), pch = list(1:5, 1:3), cex = list(1:5, 1:3))
+# Using the events argument
+plot(x[,1], events = list(time = c("2007-03-15", "2007-05-01"), label = "bad day"))
+
# Makes a scatterplot if we pass two series
plot(sample_xts[,1],sample_xts[,2])
More information about the Xts-commits
mailing list