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

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

Author: weylandt
Date: 2012-07-02 17:27:18 +0200 (Mon, 02 Jul 2012)
New Revision: 656

Modified:
   pkg/xtsExtra/R/barplot.R
Log:
Added support for non-stacked barplots

Modified: pkg/xtsExtra/R/barplot.R
===================================================================
--- pkg/xtsExtra/R/barplot.R	2012-07-02 14:48:01 UTC (rev 655)
+++ pkg/xtsExtra/R/barplot.R	2012-07-02 15:27:18 UTC (rev 656)
@@ -27,8 +27,13 @@
   # xts format assures us of this
   # 
   # stacked = TRUE is default, scale = FALSE scales percentages
-  # Negatives are trickier to deal with reasonably
+  # Negatives are trickier to deal with reasonably so not yet supported
   
+  if(scale){
+    if(any(x < 0)) stop("Rescaling values for negative data not yet supported")
+    x <- x/rowSums(x) # Recycling makes this work I'm pretty sure
+  }
+  
   op <- par(no.readonly = TRUE)
   on.exit(par(op))
   
@@ -66,8 +71,11 @@
   
   # Vectorize this?
   posn = barplot(coredata(x), plot=FALSE, space=space)
+  if(!stacked) posn <- posn*nc
   for(i in 1:length(ep)) 
     ep1[i] = posn[ep[i]]
+  
+  
     
   if(is.null(colorset)) colorset <- seq_len(nc)
     
@@ -87,17 +95,27 @@
   positives = x * (x > 0)
   negatives = x * (x < 0)
   
-  # Set ylim to ends of stacked bars
+  # Set ylim to ends of stacked bars and to max/min if not stacked
   if(is.null(ylim)){
-    ymax=max(0,apply(positives,FUN=sum,MARGIN=1))
-    ymin=min(0,apply(negatives,FUN=sum,MARGIN=1))
-    ylim=c(ymin,ymax)
+    if(stacked){
+      ymax <- max(0, rowSums(positives)) # Faster than apply statement
+      ymin <- min(0, rowSums(negatives)) # Use rowSums to stack by dates
+      ylim <- c(ymin, ymax)
+    } else{
+      ymax <- max(0, positives)
+      ymin <- min(0, negatives)
+      ylim <- c(ymin, ymax)
+    }
   }
     
   # Use barplot.default to actually draw the bars
   # t() drops xts-ness and returns a named matrix so dispatches properly
-  barplot(t(positives), col=colorset, space=space, axisnames = FALSE, axes = FALSE, ylim=ylim, ...)
-  barplot(t(negatives), add=TRUE , col=colorset, space=space, las = las, xlab = xlab, cex.names = cex.lab, axes = FALSE, axisnames = FALSE, ylim=ylim, ...)
+  if(stacked){
+    barplot(t(positives), col=colorset, space=space, axisnames = FALSE, axes = FALSE, ylim=ylim, ...)
+    barplot(t(negatives), add=TRUE , col=colorset, space=space, las = las, xlab = xlab, cex.names = cex.lab, axes = FALSE, axisnames = FALSE, ylim=ylim, ...)
+  } else {
+    barplot(t(x), beside = TRUE, col = colorset, axes = FALSE, axisnames = FALSE, ylim = ylim, ...)
+  }
   
   axis(2, col = element.color, las = las, cex.axis = cex.axis)
   
@@ -132,6 +150,10 @@
   invisible(height)
 }
 
+do_unstacked.barplot <- function(){
+  
+}
+
 do_barplot.legend <- function (x, y = NULL, legend, fill = NULL, col = par("col"),
                                lty, lwd, pch, angle = 45, density = NULL, bty = "o", bg = par("bg"),
                                pt.bg = NA, cex = 1, pt.cex = cex, pt.lwd = lwd, xjust = 0,