[Xts-commits] r666 - pkg/xtsExtra/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jul 3 04:51:04 CEST 2012


Author: weylandt
Date: 2012-07-03 04:51:04 +0200 (Tue, 03 Jul 2012)
New Revision: 666

Modified:
   pkg/xtsExtra/R/plot.R
Log:
Moved shading and event lines before grid so gridlines remain visible

Modified: pkg/xtsExtra/R/plot.R
===================================================================
--- pkg/xtsExtra/R/plot.R	2012-07-03 02:42:55 UTC (rev 665)
+++ pkg/xtsExtra/R/plot.R	2012-07-03 02:51:04 UTC (rev 666)
@@ -110,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"), events = events, ...)
+                 candles = (type == "candles"), events = events, 
+                 blocks = blocks, ...)
     
   } else {  
     # Else need to do layout plots
@@ -142,29 +143,12 @@
       }
 
       # Note that do_add.grid also sets up axes and what not
-      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])
+      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], events = events, blocks = blocks)
       
-      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])
-        }
-      }
       
-      if(!missing(blocks)){
-        for(j in seq_along(blocks)){
-          do_add.shading(start.time = do.call(paste0("as.",indexClass(x))[1], list(get.elm.recycle(blocks[["start.time"]], j))),
-                         end.time   = do.call(paste0("as.",indexClass(x))[1], list(get.elm.recycle(blocks[["end.time"]], j))),
-                         col = if(!is.null(blocks[["col"]])) get.elm.recycle(blocks[["col"]],j) else "lightblue1", 
-                         y = range(ylim))
-        }
-      }
       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)
@@ -287,7 +271,7 @@
 
 do_add.grid <- function(x, major.ticks, major.format, minor.ticks, axes, 
                         auto.grid, xlab, ylab, log, have_x_axis, have_y_axis, 
-                        ylab.axis, ...){
+                        ylab.axis, events, blocks, ...){
 
   # Set Margins for each panel here!
   par(mar = have_x_axis*c(3.4,0,0,0) + switch(ylab.axis,
@@ -306,6 +290,28 @@
   mtext(side = 2 + 2*(ylab.axis == "right"), text = if(ylab.axis == "none") "" else ylab, line = 3, cex = 0.8)
   ep <- axTicksByTime(x, major.ticks, format.labels = major.format)
   
+  ylim <- xy$y
+  
+  if(!missing(blocks)){
+    for(j in seq_along(blocks)){
+      do_add.shading(start.time = do.call(paste0("as.",indexClass(x))[1], list(get.elm.recycle(blocks[["start.time"]], j))),
+                     end.time   = do.call(paste0("as.",indexClass(x))[1], list(get.elm.recycle(blocks[["end.time"]], j))),
+                     col = if(!is.null(blocks[["col"]])) get.elm.recycle(blocks[["col"]],j) else "lightblue1", 
+                     y = range(ylim))
+    }
+  }
+  
+  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])
+    }
+  }
+  
+  
   if(auto.grid) {
     abline(v=xy$x[ep], col='grey', lty=4)
     grid(NA,NULL)
@@ -323,7 +329,6 @@
   }
   
   box()
-  return(xy$y)
 }
 
 do_add.lines <- function(x, col, pch, cex, lwd, type, ...){
@@ -358,7 +363,7 @@
 
 do_plot.ohlc <- function(x, bar.col.up, bar.col.dn, candle.col, major.ticks, 
                         minor.ticks, major.format, auto.grid, 
-                        candles, events, ...){
+                        candles, events, blocks, ...){
   
   if(QUANTMOD_MESSAGE) {
     message("Note that CRAN Package quantmod provides much better OHLC charting.\n",
@@ -373,7 +378,8 @@
   par(oma = c(1,4,4,3))
   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", ...)
+              have_x_axis = TRUE, have_y_axis = TRUE, ylab.axis = "none",
+              events = events, blocks = blocks, ...)
   
   if(!missing(events)){
     for(j in seq_along(events)){



More information about the Xts-commits mailing list