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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Aug 31 17:54:09 CEST 2014


Author: rossbennett34
Date: 2014-08-31 17:54:09 +0200 (Sun, 31 Aug 2014)
New Revision: 839

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
Adding support for stacked/unstacked bar chart. Parameters need some work to get the geometry correct. May need a separate function for barplots.

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-31 15:40:36 UTC (rev 838)
+++ pkg/xtsExtra/R/plot2.R	2014-08-31 15:54:09 UTC (rev 839)
@@ -18,18 +18,34 @@
                         lend=1,
                         colorset=1:10, 
                         up.col=NULL, 
-                        dn.col=NULL){
+                        dn.col=NULL,
+                        legend.loc=NULL){
   if(is.null(up.col)) up.col <- "green"
   if(is.null(dn.col)) dn.col <- "red"
   if(type == "h"){
     colors <- ifelse(x[,1] < 0, dn.col, up.col)
     lines(1:NROW(x),x[,1],lwd=2,col=colors,lend=lend,lty=1,type="h")
-  } else {
+  } else if(type == "l") {
     if(length(lty) == 1) lty <- rep(lty, NCOL(x))
     if(length(lwd) == 1) lwd <- rep(lwd, NCOL(x))
     for(i in NCOL(x):1){
       lines(1:NROW(x), x[,i], type="l", lend=lend, col=colorset[i], lty=lty[i], lwd=lwd[i])
     }
+  } else if(type == "bar"){
+    # This does not work correctly
+    # The geometry of the x-axis and y-axis is way off with stacked bar plot and
+    # the x-axis is off for unstacked bar plot
+    # We may need a separate function to do this correctly because of the
+    # different geometry/dimensions with stacked and unstacked barplots
+    positives = negatives = x
+    for(column in 1:NCOL(x)){
+      for(row in 1:NROW(x)){ 
+        positives[row,column] = max(0, x[row,column])
+        negatives[row,column] = min(0, x[row,column])
+      }
+    }
+    barplot.default(t(positives), add=TRUE, col=colorset, axisnames=FALSE, axes=FALSE)
+    barplot.default(t(negatives), add=TRUE, col=colorset, axisnames=FALSE, axes=FALSE)
   }
 }
 
@@ -203,9 +219,6 @@
                      shading=shading,
                      bg.col=bg.col,
                      grid2=grid2)
-      #p <- plot2_xts(x=x[,tmp], FUN=FUN, panels=panels, 
-      #               multi.panel=multi.panel, type=type, main=main, subset=subset, 
-      #               clev=clev, pars=pars, theme=theme, ylim=ylim, ...=...)
       if(i < length(chunks))
         print(p)
     }
@@ -289,6 +302,7 @@
   cs$Env$theme$srt <- srt
   cs$Env$theme$xaxis.las <- xaxis.las
   cs$Env$theme$cex.axis <- cex.axis
+  #cs$Env$theme$legend.loc <- legend.loc
   #cs$Env$theme$label.bg <- label.bg
   #cs$Env$theme$coarse.time <- coarse.time
   cs$Env$format.labels <- format.labels



More information about the Xts-commits mailing list