[Xts-commits] r865 - in pkg/xtsExtra: R man sandbox

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Dec 26 19:01:35 CET 2014


Author: rossbennett34
Date: 2014-12-26 19:01:34 +0100 (Fri, 26 Dec 2014)
New Revision: 865

Modified:
   pkg/xtsExtra/R/plot2.R
   pkg/xtsExtra/man/addLegend.Rd
   pkg/xtsExtra/man/plot.xts.Rd
   pkg/xtsExtra/sandbox/paFUN.R
   pkg/xtsExtra/sandbox/test_plot2.R
Log:
refactoring to replace the 'colorset' argument with 'col' for consistency with par

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-12-26 17:30:36 UTC (rev 864)
+++ pkg/xtsExtra/R/plot2.R	2014-12-26 18:01:34 UTC (rev 865)
@@ -69,7 +69,7 @@
                         lty=1,
                         lwd=2,
                         lend=1,
-                        colorset=1:10, 
+                        col=1:10, 
                         up.col=NULL, 
                         dn.col=NULL,
                         legend.loc=NULL,
@@ -86,9 +86,9 @@
     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=type, lend=lend, col=colorset[i], lty=lty[i], lwd=lwd[i], pch=pch)
+      # lines(1:NROW(x), x[,i], type=type, lend=lend, col=col[i], lty=lty[i], lwd=lwd[i], pch=pch)
       # non-equally spaced x-axis
-      lines(xx$Env$xycoords$x, x[,i], type=type, lend=lend, col=colorset[i], lty=lty[i], lwd=lwd[i], pch=pch)
+      lines(xx$Env$xycoords$x, x[,i], type=type, lend=lend, col=col[i], lty=lty[i], lwd=lwd[i], pch=pch)
     }
   } else if(type == "bar"){
     # This does not work correctly
@@ -103,8 +103,8 @@
         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)
+    barplot.default(t(positives), add=TRUE, col=col, axisnames=FALSE, axes=FALSE)
+    barplot.default(t(negatives), add=TRUE, col=col, axisnames=FALSE, axes=FALSE)
   }
   if(!is.null(legend.loc)){
     yrange <- range(x, na.rm=TRUE)
@@ -167,7 +167,7 @@
            }
     )
     legend(x=lx, y=ly, legend=colnames(x), xjust=xjust, yjust=yjust, 
-           fill=colorset[1:NCOL(x)], bty="n")
+           fill=col[1:NCOL(x)], bty="n")
   }
 }
 
@@ -212,7 +212,7 @@
 #' separate panel. For example, if \code{multi.panel = 2}, then the data
 #' will be plotted in groups of 2 columns and each group is plotted in a 
 #' separate panel. 
-#' @param colorset color palette to use, set by default to rational choices
+#' @param col color palette to use, set by default to rational choices
 #' @param up.col color for positive bars if \code{type="h"}
 #' @param dn.col color for positive bars if \code{type="h"}
 #' @param type the type of plot to be drawn, same as in \code{\link{plot}}
@@ -250,7 +250,7 @@
                      FUN=NULL,
                      panels=NULL,
                      multi.panel=FALSE,
-                     colorset=1:12,
+                     col=1:12,
                      up.col="green",
                      dn.col="red",
                      type="l",
@@ -328,7 +328,7 @@
                     FUN=FUN,
                     panels=panels,
                     multi.panel=multi.panel,
-                    colorset=colorset,
+                    col=col,
                     up.col=up.col,
                     dn.col=dn.col,
                     type=type,
@@ -419,7 +419,11 @@
   cs$Env$theme$shading <- shading
   cs$Env$theme$up.col <- up.col
   cs$Env$theme$dn.col <- dn.col
-  cs$Env$theme$colorset <- colorset
+  if (hasArg(colorset)){
+    cs$Env$theme$col <- match.call(expand.dots=TRUE)$colorset
+  } else {
+    cs$Env$theme$col <- col
+  }
   cs$Env$theme$rylab <- yaxis.right
   cs$Env$theme$lylab <- yaxis.left
   cs$Env$theme$bg <- bg.col
@@ -616,7 +620,7 @@
                                   lty=lty,
                                   lwd=lwd,
                                   lend=lend,
-                                  colorset=theme$colorset, 
+                                  col=theme$col, 
                                   up.col=theme$up.col, 
                                   dn.col=theme$dn.col,
                                   legend.loc=legend.loc))
@@ -660,7 +664,7 @@
                                       lty=lty,
                                       lwd=lwd,
                                       lend=lend,
-                                      colorset=theme$colorset, 
+                                      col=theme$col, 
                                       up.col=theme$up.col, 
                                       dn.col=theme$dn.col,
                                       legend.loc=legend.loc))
@@ -719,7 +723,7 @@
                                   lty=lty,
                                   lwd=lwd,
                                   lend=lend,
-                                  colorset=theme$colorset,
+                                  col=theme$col,
                                   up.col=theme$up.col, 
                                   dn.col=theme$dn.col,
                                   legend.loc=legend.loc)),expr=TRUE)
@@ -759,11 +763,7 @@
   lenv$plot_lines <- function(x, ta, on, type, col, lty, lwd, pch, ...){
     xdata <- x$Env$xdata
     xsubset <- x$Env$xsubset
-    if(is.null(col)){
-      colorset <- x$Env$theme$colorset
-    } else {
-      colorset <- col
-    }
+    if(is.null(col)) col <- x$Env$theme$col
     if(all(is.na(on))){
       # Add x-axis grid lines
       atbt <- axTicksByTime2(xdata[xsubset])
@@ -782,7 +782,7 @@
                            tzone=indexTZ(xdata)),ta)[subset.range]
     ta.x <- as.numeric(na.approx(ta.adj[,1], rule=2) )
     ta.y <- ta.adj[,-1]
-    chart.lines(ta.y, type=type, colorset=colorset, lty=lty, lwd=lwd, pch=pch)
+    chart.lines(ta.y, type=type, col=col, lty=lty, lwd=lwd, pch=pch)
   }
   # map all passed args (if any) to 'lenv' environment
   mapply(function(name,value) { assign(name,value,envir=lenv) }, 
@@ -906,7 +906,7 @@
   lenv$plot_event_lines <- function(x, event.dates, event.labels, date.format, on, lty, lwd, col, ...){
     xdata <- x$Env$xdata
     xsubset <- x$Env$xsubset
-    colorset <- x$Env$theme$colorset
+    col <- x$Env$theme$col
     if(all(is.na(on))){
       # Add x-axis grid lines
       atbt <- axTicksByTime2(xdata[xsubset])
@@ -1039,12 +1039,12 @@
 #' right, or center.
 #' @param legend.names character vector of names for the legend. If \code{NULL},
 #' the column names of the current plot object are used.
-#' @param colorset fill colorset for the legend. If \code{NULL},
+#' @param col fill colors for the legend. If \code{NULL},
 #' the colorset of the current plot object data is used.
 #' @param ncol number of columns for the legend
 #' @param \dots any other passthrough parameters. Not currently used.
 #' @author Ross Bennett
-addLegend <- function(legend.loc="center", legend.names=NULL, colorset=NULL, ncol=1, ...){
+addLegend <- function(legend.loc="center", legend.names=NULL, col=NULL, ncol=1, ...){
   lenv <- new.env()
   lenv$main <- ""
   
@@ -1129,10 +1129,10 @@
   lenv$ly <- ly
   lenv$xjust <- xjust
   lenv$yjust <- yjust
-  if(!is.null(colorset)){
-    lenv$colorset <- colorset[1:nc]
+  if(!is.null(col)){
+    lenv$col <- col[1:nc]
   } else {
-    lenv$colorset <- plot_object$Env$theme$colorset[1:nc]
+    lenv$col <- plot_object$Env$theme$col[1:nc]
   }
   if(!is.null(legend.names)){
     lenv$names <- legend.names
@@ -1142,7 +1142,7 @@
   lenv$nc <- ncol
   # add expression for legend
   exp <- expression(legend(x=lx, y=ly, legend=names, xjust=xjust, yjust=yjust, 
-                           fill=colorset, ncol=nc, bty="n"))
+                           fill=col, ncol=nc, bty="n"))
   
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE,no.update=TRUE)
   plot_object

Modified: pkg/xtsExtra/man/addLegend.Rd
===================================================================
--- pkg/xtsExtra/man/addLegend.Rd	2014-12-26 17:30:36 UTC (rev 864)
+++ pkg/xtsExtra/man/addLegend.Rd	2014-12-26 18:01:34 UTC (rev 865)
@@ -3,13 +3,20 @@
 \alias{addLegend}
 \title{Add Legend}
 \usage{
-addLegend(legend.loc = "center", ncol = 1, ...)
+addLegend(legend.loc = "center", legend.names = NULL, col = NULL,
+  ncol = 1, ...)
 }
 \arguments{
 \item{legend.loc}{legend.loc places a legend into one of nine locations on
 the chart: bottomright, bottom, bottomleft, left, topleft, top, topright,
 right, or center.}
 
+\item{legend.names}{character vector of names for the legend. If \code{NULL},
+the column names of the current plot object are used.}
+
+\item{col}{fill colors for the legend. If \code{NULL},
+the colorset of the current plot object data is used.}
+
 \item{ncol}{number of columns for the legend}
 
 \item{\dots}{any other passthrough parameters. Not currently used.}

Modified: pkg/xtsExtra/man/plot.xts.Rd
===================================================================
--- pkg/xtsExtra/man/plot.xts.Rd	2014-12-26 17:30:36 UTC (rev 864)
+++ pkg/xtsExtra/man/plot.xts.Rd	2014-12-26 18:01:34 UTC (rev 865)
@@ -4,7 +4,7 @@
 \title{Time series Plotting}
 \usage{
 \method{plot}{xts}(x, y = NULL, ..., subset = "", FUN = NULL,
-  panels = NULL, multi.panel = FALSE, colorset = 1:12, up.col = "green",
+  panels = NULL, multi.panel = FALSE, col = 1:12, up.col = "green",
   dn.col = "red", type = "l", lty = 1, lwd = 2, lend = 1,
   main = deparse(substitute(x)), clev = 0, cex = 0.6, cex.axis = 0.9,
   mar = c(3, 2, 0, 2), srt = 0, xaxis.las = 0, ylim = NULL,
@@ -32,7 +32,7 @@
 will be plotted in groups of 2 columns and each group is plotted in a
 separate panel.}
 
-\item{colorset}{color palette to use, set by default to rational choices}
+\item{col}{color palette to use, set by default to rational choices}
 
 \item{up.col}{color for positive bars if \code{type="h"}}
 

Modified: pkg/xtsExtra/sandbox/paFUN.R
===================================================================
--- pkg/xtsExtra/sandbox/paFUN.R	2014-12-26 17:30:36 UTC (rev 864)
+++ pkg/xtsExtra/sandbox/paFUN.R	2014-12-26 18:01:34 UTC (rev 865)
@@ -5,7 +5,7 @@
   lenv$plot_drawdowns <- function(x, geometric, ...) {
     xdata <- x$Env$xdata
     xsubset <- x$Env$xsubset
-    colorset <- x$Env$theme$colorset
+    col <- x$Env$theme$col
     # Add x-axis grid lines
     atbt <- xtsExtra:::axTicksByTime2(xdata[xsubset])
     segments(x$Env$xycoords$x[atbt],
@@ -14,7 +14,7 @@
              par("usr")[4],
              col=x$Env$theme$grid)
     drawdowns <- PerformanceAnalytics:::Drawdowns(xdata, geometric)[xsubset]
-    xtsExtra:::chart.lines(drawdowns, type="l", colorset=colorset) 
+    xtsExtra:::chart.lines(drawdowns, type="l", col=col) 
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, 
          names(list(geometric=geometric,...)),
@@ -81,7 +81,7 @@
   lenv$plot_returns <- function(x, type) {
     xdata <- x$Env$xdata
     xsubset <- x$Env$xsubset
-    colorset <- x$Env$theme$colorset
+    col <- x$Env$theme$col
     up.col <- x$Env$theme$up.col
     dn.col <- x$Env$theme$dn.col
     # Add x-axis grid lines
@@ -91,7 +91,7 @@
              x$Env$xycoords$x[atbt],
              par("usr")[4],
              col=x$Env$theme$grid)
-    xtsExtra:::chart.lines(xdata[xsubset], type=type, colorset=colorset, up.col=up.col, dn.col=dn.col)
+    xtsExtra:::chart.lines(xdata[xsubset], type=type, col=col, up.col=up.col, dn.col=dn.col)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, 
          names(list(type=type)),
@@ -163,7 +163,7 @@
   lenv$plot_performance <- function(x, width, FUN, fill, ...) {
     xdata <- x$Env$xdata
     xsubset <- x$Env$xsubset
-    colorset <- x$Env$theme$colorset
+    col <- x$Env$theme$col
     up.col <- x$Env$theme$up.col
     dn.col <- x$Env$theme$dn.col
     # Add x-axis grid lines
@@ -173,7 +173,7 @@
              par("usr")[4],
              col=x$Env$theme$grid)
     rolling_performance <- RollingPerformance(R=xdata, width=width, FUN=FUN, fill=fill, ...=...)
-    xtsExtra:::chart.lines(rolling_performance, type="l", colorset=colorset, up.col=up.col, dn.col=dn.col) 
+    xtsExtra:::chart.lines(rolling_performance, type="l", col=col, up.col=up.col, dn.col=dn.col) 
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, 
          names(list(width=width, FUN=FUN, fill=fill, ...)),

Modified: pkg/xtsExtra/sandbox/test_plot2.R
===================================================================
--- pkg/xtsExtra/sandbox/test_plot2.R	2014-12-26 17:30:36 UTC (rev 864)
+++ pkg/xtsExtra/sandbox/test_plot2.R	2014-12-26 18:01:34 UTC (rev 865)
@@ -90,7 +90,7 @@
 plot(R, FUN="CumReturns")
 plot(R, FUN="CumReturns", lty=1:4)
 plot(R, FUN="CumReturns", lty=1:4, lwd=c(3, 1, 1, 1))
-plot(R, FUN="CumReturns", lwd=c(3, 2, 2, 2), colorset=c(1, rep("gray", 3)))
+plot(R, FUN="CumReturns", lwd=c(3, 2, 2, 2), col=c(1, rep("gray", 3)))
 
 plot(R, yaxis.left=TRUE, yaxis.right=FALSE)
 plot(R, grid.ticks.lwd=1, grid.ticks.lty="solid", grid.col="black")
@@ -102,7 +102,7 @@
 }
 plot(R, FUN=foo)
 addLegend(ncol = 4)
-addLegend(legend.names = c("foo", "bar"), colorset = c(1,2), ncol=2)
+addLegend(legend.names = c("foo", "bar"), col = c(1,2), ncol=2)
 
 plot(R, FUN=foo, legend.loc="topleft")
 plot(R, FUN=foo, legend.loc="left")



More information about the Xts-commits mailing list