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

[noreply at r-forge.r-project.org]

Author: weylandt
Date: 2012-07-04 01:46:03 +0200 (Wed, 04 Jul 2012)
New Revision: 671

Modified:
   pkg/xtsExtra/R/plot.R
Log:
Moved repeated code into helper functions for ease of reuse

Modified: pkg/xtsExtra/R/plot.R
===================================================================
--- pkg/xtsExtra/R/plot.R	2012-07-03 20:30:14 UTC (rev 670)
+++ pkg/xtsExtra/R/plot.R	2012-07-03 23:46:03 UTC (rev 671)
@@ -293,22 +293,11 @@
   ylim <- xy$y
   
   if(!missing(blocks)){
-    for(j in seq_along(blocks[["time"]])){
-      do_add.shading(start.time = as.POSIXct(get.elm.recycle(blocks[["start.time"]], j)),
-                     end.time   = as.POSIXct(get.elm.recycle(blocks[["end.time"]], j)),
-                     col = if(!is.null(blocks[["col"]])) get.elm.recycle(blocks[["col"]],j) else "lightblue1", 
-                     y = range(ylim))
-    }
+    do_add.shading(blocks, ylim)
   }
   
   if(!missing(events)){
-    for(j in seq_along(events[["time"]])){
-      do_add.event(time = as.POSIXct(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])
-    }
+    do_add.event(events, ylim)
   }
   
   
@@ -350,13 +339,25 @@
   }
 }
 
-do_add.shading <- function(start.time, end.time, y, col = "lightblue1"){
-  rect(as.double(start.time), 0.5*y[1], as.double(end.time), 1.5*y[2], col = col, border = NA)
+do_add.shading <- function(blocks, y){
+  browser()
+  for(j in seq_along(blocks[["start.time"]])){
+    rect(as.POSIXct(get.elm.recycle(blocks[["start.time"]], j)), 0.5*min(y), 
+         as.POSIXct(get.elm.recycle(blocks[["end.time"]], j)), 1.5 * max(y),
+         col = if(!is.null(blocks[["col"]])) get.elm.recycle(blocks[["col"]],j) else "lightblue1",
+         border = NA)
+  }
 }
 
-do_add.event <- function(time, label, y, col = "red", lty = 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.event <- function(events, y){
+  for(j in seq_along(events[["time"]])){
+    time = as.POSIXct(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
+    text(x = time, y = max(y), label = label, offset = 0.2, pos = 2, srt = 90, col = col)
+    abline(v = time, col = col, lty = lty)
+  }
 }
 
 do_add.legend <- function(){}
@@ -381,16 +382,6 @@
               have_x_axis = TRUE, have_y_axis = TRUE, ylab.axis = "none",
               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])
-    }
-  }
-  
   width = .2*deltat(x)
   
   # Better to do this with xts:::Op etc when moved to xts package