From noreply at r-forge.r-project.org  Sun Aug  3 07:45:10 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun,  3 Aug 2014 07:45:10 +0200 (CEST)
Subject: [Xts-commits] r826 - pkg/xtsExtra/sandbox
Message-ID: <20140803054510.C22FE1849B7@r-forge.r-project.org>

Author: durrettw
Date: 2014-08-03 07:45:09 +0200 (Sun, 03 Aug 2014)
New Revision: 826

Modified:
   pkg/xtsExtra/sandbox/paFUN.R
Log:
adding other pieces of performanalytics to PAfun

Modified: pkg/xtsExtra/sandbox/paFUN.R
===================================================================
--- pkg/xtsExtra/sandbox/paFUN.R	2014-07-31 21:43:04 UTC (rev 825)
+++ pkg/xtsExtra/sandbox/paFUN.R	2014-08-03 05:45:09 UTC (rev 826)
@@ -81,7 +81,7 @@
     
     return(Return.cumulative)
   }
-
+#addingtest command from performance 
 RollingPerformance <- function (R, width = 12, FUN = "Return.annualized", ..., fill = NA)
 { # @author Peter Carl
   
@@ -130,3 +130,120 @@
   colnames(Return.calc) = columnnames
   Return.calc
 }
+##adding another test
+ACFwoo <- function(R, maxlag = NULL, elementcolor = "gray", main = NULL, ...)
+{ # @author David Stoffer and Robert Shumway
+  # @modifiedby Peter Carl
+  
+  # DESCRIPTION:
+  
+  # Inspired by the same charts as chart.ACFplus.R
+  
+  # From the website: http://www.stat.pitt.edu/stoffer/tsa2/Rcode/acf2.R
+  # "...here's an R function that will plot the ACF and PACF of a time series 
+  # at the same time on the SAME SCALE, and it leaves out the zero lag in the 
+  # ACF: acf2.R. If your time series is in x and you want the ACF and PACF of 
+  # x to lag 50, the call to the function is acf2(x,50). The number of lags 
+  # is optional, so acf2(x) will use a default number of lags [?n + 10, where 
+  # n is the number of observations]."
+  
+  # This function uses those same defaults to print just the ACF chart.
+  
+  R = checkData(R)
+  data = checkData(R[,1], method="vector", na.rm = TRUE)
+  
+  columns = ncol(R)
+  rows = nrow(R)
+  columnnames = colnames(R)
+  
+  if(is.null(main))
+    main = columnnames[1]
+  
+  num = length(data)
+  if (is.null(maxlag)) 
+    maxlag = ceiling(10 + sqrt(num))
+  ACF = acf(data, maxlag, plot = FALSE)$acf[-1]
+  Lag = 1:length(ACF)/frequency(data)
+  minA = min(ACF)
+  U = 2/sqrt(num)
+  L = -U
+  minu = min(minA, L) - .01
+  
+  plot(Lag, ACF, type = "h", ylim = c(minu,1), main = main, axes = FALSE, ...)
+  box(col=elementcolor)
+  axis(2, col = elementcolor, cex.axis = 0.8)
+  axis(1, col = elementcolor, cex.axis = 0.8)
+  abline(h=c(0,L,U), lty=c(1,2,2), col=c(1,4,4))
+  
+}
+
+rollingreg= function (Ra, Rb, width = 12, Rf = 0, main = NULL, legend.loc = NULL, event.labels=NULL, ...)
+{ # @author Peter Carl
+  
+  # DESCRIPTION:
+  # A wrapper to create a panel of RollingRegression charts that demonstrates
+  # how the attributes change through time.
+  
+  # Inputs:
+  # Ra: a matrix, data frame, or timeSeries, usually a set of monthly returns.
+  #   The first column is assumed to be the returns of interest, the next
+  #   columns are assumed to be relevant benchmarks for comparison.
+  # Rb: a matrix, data frame, or timeSeries that is a set of returns of the
+  #   same scale and periodicity as R.
+  # Rf: the risk free rate.  Remember to set this to the same periodicity
+  #   as the data being passed in.
+  # attribute: Used to select the regression parameter to use in the chart  May
+  #   be any of:
+  #     Alpha - shows the y-intercept
+  #     Beta - shows the slope of the regression line
+  #     R-Squared - shows the fit of the regression to the data
+  #
+  
+  # Outputs:
+  # A stack of three related timeseries line charts
+  
+  # FUNCTION:
+  
+  columns.a = ncol(Ra)
+  columns.b = ncol(Rb)
+  
+  #     if(columns.a > 1 | columns.b > 1)
+  #         legend.loc = "topleft"
+  #     else
+  #         legend.loc = NULL
+  
+  #    plot.new()
+  
+  op <- par(no.readonly=TRUE)
+  
+  layout(matrix(c(1,2,3)),heights=c(1.3,1,1.3),widths=1)
+  
+  par(mar=c(1,4,4,2))
+  if(is.null(main)){
+    freq = periodicity(Ra)
+    
+    switch(freq$scale,
+           minute = {freq.lab = "minute"},
+           hourly = {freq.lab = "hour"},
+           daily = {freq.lab = "day"},
+           weekly = {freq.lab = "week"},
+           monthly = {freq.lab = "month"},
+           quarterly = {freq.lab = "quarter"},
+           yearly = {freq.lab = "year"}
+    )
+    
+    main = paste("Rolling ",width,"-",freq.lab," Regressions", sep="")
+  }
+  
+  rollingreg(Ra, Rb, width = width, Rf = Rf, attribute = "Alpha", xaxis = FALSE, main = main, ylab = "Alpha", legend.loc=legend.loc, event.labels = event.labels, ...)
+  
+  par(mar=c(1,4,0,2))
+  
+  rollingreg(Ra, Rb, width = width, Rf = Rf, attribute = "Beta", main = "", ylab = "Beta", xaxis = FALSE, event.labels = NULL, ...)
+  
+  par(mar=c(5,4,0,2))
+  
+  rollingreg(Ra, Rb, width = width, Rf = Rf, attribute = "R-Squared", main = "", ylab = "R-Squared", event.labels = NULL, ...)
+  
+  par(op)
+}


From noreply at r-forge.r-project.org  Wed Aug  6 12:52:08 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  6 Aug 2014 12:52:08 +0200 (CEST)
Subject: [Xts-commits] r827 - in pkg/xtsExtra: R sandbox
Message-ID: <20140806105208.E36F81872CA@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-06 12:52:08 +0200 (Wed, 06 Aug 2014)
New Revision: 827

Modified:
   pkg/xtsExtra/R/plot2.R
   pkg/xtsExtra/sandbox/test_plot2.R
Log:
adding call_list slot to xts_chob environment

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-03 05:45:09 UTC (rev 826)
+++ pkg/xtsExtra/R/plot2.R	2014-08-06 10:52:08 UTC (rev 827)
@@ -198,6 +198,8 @@
   cs$Env$ticks.on <- grid.ticks.on
   cs$Env$grid.ticks.lwd <- theme$grid.ticks.lwd
   cs$Env$type <- type
+  cs$Env$call_list <- list()
+  cs$Env$call_list[[1]] <- match.call()
   
   # Do some checks on x
   if(is.character(x))
@@ -477,6 +479,9 @@
                srcfile=NULL)
   
   plot_object <- current.xts_chob()
+  ncalls <- length(plot_object$Env$call_list)
+  plot_object$Env$call_list[[ncalls+1]] <- match.call()
+  
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
   
@@ -565,6 +570,8 @@
                                                        type=type,col=col,...)))),
                srcfile=NULL)
   plot_object <- current.xts_chob()
+  ncalls <- length(plot_object$Env$call_list)
+  plot_object$Env$call_list[[ncalls+1]] <- match.call()
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
   if(is.logical(x)) no.update <- TRUE else no.update <- FALSE
@@ -653,6 +660,8 @@
                srcfile=NULL)
   
   plot_object <- current.xts_chob()
+  ncalls <- length(plot_object$Env$call_list)
+  plot_object$Env$call_list[[ncalls+1]] <- match.call()
   
   # get the raw returns data
   xdata <- plot_object$Env$xdata
@@ -726,6 +735,9 @@
                srcfile=NULL)
   
   plot_object <- current.xts_chob()
+  ncalls <- length(plot_object$Env$call_list)
+  plot_object$Env$call_list[[ncalls+1]] <- match.call()
+  
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
   

Modified: pkg/xtsExtra/sandbox/test_plot2.R
===================================================================
--- pkg/xtsExtra/sandbox/test_plot2.R	2014-08-03 05:45:09 UTC (rev 826)
+++ pkg/xtsExtra/sandbox/test_plot2.R	2014-08-06 10:52:08 UTC (rev 827)
@@ -77,6 +77,9 @@
 addRollingPerformance(FUN="StdDev.annualized")
 addRollingPerformance(FUN="SharpeRatio.annualized")
 
+x <- xtsExtra:::current.xts_chob()
+x$Env$call_list
+x$Env$call_list[[1]]
 
 ##### scratch area #####
 # Should we have a theme object, as in quantmod, that sets all of the basic 


From noreply at r-forge.r-project.org  Sun Aug 17 17:03:29 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 17 Aug 2014 17:03:29 +0200 (CEST)
Subject: [Xts-commits] r828 - pkg/xtsExtra/R
Message-ID: <20140817150329.6B44718749C@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-17 17:03:29 +0200 (Sun, 17 Aug 2014)
New Revision: 828

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
initial pass at modifying function args to better match base plot and plot.zoo

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-06 10:52:08 UTC (rev 827)
+++ pkg/xtsExtra/R/plot2.R	2014-08-17 15:03:29 UTC (rev 828)
@@ -72,17 +72,34 @@
 }
 
 plot2_xts <- function(x, 
+                      y=NULL,
+                      ...,
+                      subset="",
                       FUN=NULL,
                       panels=NULL,
                       multi.panel=FALSE,
+                      colorset=1:12,
+                      up.col="green",
+                      dn.col="red",
                       type="l",
-                      main=deparse(substitute(x)), 
-                      subset="", 
+                      lty=1,
+                      lwd=2,
+                      main=deparse(substitute(x)),  
                       clev=0,
-                      pars=chart_pars(), theme=xtsExtraTheme(),
+                      pars=chart_pars(), 
                       ylim=NULL,
-                      y.axis.same=TRUE,
-                      ...){
+                      yaxis.same=TRUE,
+                      yaxis.left=TRUE,
+                      yaxis.right=TRUE,
+                      grid.ticks.on="months",
+                      grid.ticks.lwd=1,
+                      grid.col="darkgray",
+                      labels.col="#333333",
+                      format.labels=TRUE,
+                      coarse.time=TRUE,
+                      shading=1,
+                      bg.col="#FFFFFF",
+                      grid2="#F5F5F5"){
   
   # Small multiples with multiple pages behavior occurs when multi.panel is
   # an integer. (i.e. multi.panel=2 means to iterate over the data in a step
@@ -101,7 +118,7 @@
       multi.panel <- TRUE
       panels <- NULL
       FUN <- NULL
-      if(y.axis.same){
+      if(yaxis.same){
         ylim <- range(na.omit(x[subset]))
       } else {
         ylim <- NULL
@@ -110,9 +127,36 @@
     
     for(i in 1:length(chunks)){
       tmp <- chunks[[i]]
-      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, ...=...)
+      p <- plot2_xts(x=x[,tmp], 
+                     y=NULL,
+                     ...=...,
+                     subset=subset,
+                     FUN=FUN,
+                     panels=panels,
+                     multi.panel=multi.panel,
+                     colorset=colorset,
+                     up.col=up.col,
+                     dn.col=dn.col,
+                     type=type,
+                     lty=lty,
+                     lwd=lwd,
+                     main=main,  
+                     clev=clev,
+                     pars=pars, 
+                     ylim=ylim,
+                     yaxis.same=yaxis.same,
+                     yaxis.left=yaxis.left,
+                     yaxis.right=yaxis.right,
+                     grid.ticks.on=grid.ticks.on,
+                     grid.ticks.lwd=grid.ticks.lwd,
+                     grid.col=grid.col,
+                     labels.col=labels.col,
+                     format.labels=format.labels,
+                     coarse.time=coarse.time,
+                     shading=shading)
+      #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)
     }
@@ -123,20 +167,20 @@
   cs <- new.replot_xts()
   #cex <- pars$cex
   #mar <- pars$mar
-  line.col <- theme$col$line.col
-  up.col <- theme$col$up.col
-  dn.col <- theme$col$dn.col
-  up.border <- theme$col$up.border
-  dn.border <- theme$col$dn.border
-  format.labels <- theme$format.labels
-  if(is.null(theme$grid.ticks.on)) {
+  #line.col <- theme$col$line.col
+  #up.col <- theme$col$up.col
+  #dn.col <- theme$col$dn.col
+  #up.border <- theme$col$up.border
+  #dn.border <- theme$col$dn.border
+  #format.labels <- theme$format.labels
+  if(is.null(grid.ticks.on)) {
     xs <- x[subset]
     major.grid <- c(years=nyears(xs),
                     months=nmonths(xs),
                     days=ndays(xs))
     grid.ticks.on <- names(major.grid)[rev(which(major.grid < 30))[1]]
-  } else grid.ticks.on <- theme$grid.ticks.on
-  label.bg <- theme$col$label.bg
+  } #else grid.ticks.on <- theme$grid.ticks.on
+  #label.bg <- theme$col$label.bg
   
   # define a subset function
   cs$subset <- function(x) {
@@ -179,24 +223,25 @@
   cs$Env$cex <- pars$cex
   cs$Env$mar <- pars$mar
   cs$Env$clev = min(clev+0.01,1) # (0,1]
-  cs$Env$theme$bbands <- theme$bbands
-  cs$Env$theme$shading <- theme$shading
-  cs$Env$theme$line.col <- theme$col$line.col
+  #cs$Env$theme$bbands <- theme$bbands
+  cs$Env$theme$shading <- shading
+  #cs$Env$theme$line.col <- theme$col$line.col
   cs$Env$theme$up.col <- up.col
   cs$Env$theme$dn.col <- dn.col
-  cs$Env$theme$up.border <- up.border
-  cs$Env$theme$dn.border <- dn.border
-  cs$Env$theme$colorset <- theme$col$colorset
-  cs$Env$theme$rylab <- theme$rylab
-  cs$Env$theme$lylab <- theme$lylab
-  cs$Env$theme$bg <- theme$col$bg
-  cs$Env$theme$grid <- theme$col$grid
-  cs$Env$theme$grid2 <- theme$col$grid2
-  cs$Env$theme$labels <- "#333333"
-  cs$Env$theme$label.bg <- label.bg
+  #cs$Env$theme$up.border <- up.border
+  #cs$Env$theme$dn.border <- dn.border
+  cs$Env$theme$colorset <- colorset
+  cs$Env$theme$rylab <- yaxis.right
+  cs$Env$theme$lylab <- yaxis.left
+  cs$Env$theme$bg <- bg.col
+  cs$Env$theme$grid <- grid.col
+  cs$Env$theme$grid2 <- grid2
+  cs$Env$theme$labels <- labels.col
+  #cs$Env$theme$label.bg <- label.bg
+  cs$Env$theme$coarse.time <- coarse.time
   cs$Env$format.labels <- format.labels
   cs$Env$ticks.on <- grid.ticks.on
-  cs$Env$grid.ticks.lwd <- theme$grid.ticks.lwd
+  cs$Env$grid.ticks.lwd <- grid.ticks.lwd
   cs$Env$type <- type
   cs$Env$call_list <- list()
   cs$Env$call_list[[1]] <- match.call()
@@ -245,7 +290,7 @@
   # which is best.
   if(is.null(ylim)){
     if(isTRUE(multi.panel)){
-      if(y.axis.same){
+      if(yaxis.same){
         # set the ylim for the first panel based on all the data
         cs$set_ylim(list(structure(range(na.omit(cs$Env$R[subset])),fixed=TRUE)))
       } else {
@@ -268,7 +313,7 @@
   cs$Env$axis_ticks <- function(xdata,xsubset) {
     ticks <- diff(axTicksByTime2(xdata[xsubset],labels=FALSE))/2 + 
       last(axTicksByTime2(xdata[xsubset],labels=TRUE),-1)
-    if(!theme$coarse.time || length(ticks) == 1)
+    if(!coarse.time || length(ticks) == 1)
       return(unname(ticks))
     if(min(diff(ticks)) < max(strwidth(names(ticks)))) {
       ticks <- unname(ticks)
@@ -331,7 +376,7 @@
   # add y-axis grid lines and labels
   exp <- expression(segments(1, y_grid_lines(constant_ylim), NROW(xdata[xsubset]), 
                              y_grid_lines(constant_ylim), col=theme$grid))
-  if(theme$lylab){
+  if(yaxis.left){
     exp <- c(exp, 
              # left y-axis labels
              expression(text(1-1/3-max(strwidth(y_grid_lines(constant_ylim))), 
@@ -339,7 +384,7 @@
                              noquote(format(y_grid_lines(constant_ylim), justify="right")),
                              col=theme$labels, offset=0, pos=4, cex=0.9, xpd=TRUE)))
   }
-  if(theme$rylab){
+  if(yaxis.right){
     exp <- c(exp, 
              # right y-axis labels
              expression(text(NROW(R[xsubset])+1/3, y_grid_lines(constant_ylim),
@@ -370,7 +415,7 @@
         lenv <- new.env()
         lenv$xdata <- cs$Env$R[,i][subset]
         lenv$main <- cs$Env$column_names[i]
-        if(y.axis.same){
+        if(yaxis.same){
           lenv$ylim <- cs$Env$constant_ylim
         } else {
           lenv$ylim <- range(na.omit(cs$Env$R[,i][subset]))
@@ -414,14 +459,14 @@
                                      ylim[1],
                                      atbt, #axTicksByTime2(xdata[xsubset]),
                                      ylim[2], col=theme$grid)))
-        if(theme$lylab){
+        if(yaxis.left){
           exp <- c(exp, 
                    # y-axis labels/boxes
                    expression(text(1-1/3-max(strwidth(y_grid_lines(ylim))), y_grid_lines(ylim),
                                    noquote(format(y_grid_lines(ylim),justify="right")),
                                    col=theme$labels,offset=0,pos=4,cex=0.9, xpd=TRUE)))
         }
-        if(theme$rylab){
+        if(yaxis.right){
           exp <- c(exp, 
                    expression(text(NROW(xdata[xsubset])+1/3, y_grid_lines(ylim),
                                    noquote(format(y_grid_lines(ylim),justify="right")),


From noreply at r-forge.r-project.org  Mon Aug 18 00:43:10 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon, 18 Aug 2014 00:43:10 +0200 (CEST)
Subject: [Xts-commits] r829 - in pkg/xtsExtra: R sandbox
Message-ID: <20140817224310.CA80C185C20@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-18 00:43:09 +0200 (Mon, 18 Aug 2014)
New Revision: 829

Modified:
   pkg/xtsExtra/R/plot2.R
   pkg/xtsExtra/sandbox/test_plot2.R
Log:
modifying arguments to allow plot attributes to be passed into chart.lines.

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-17 15:03:29 UTC (rev 828)
+++ pkg/xtsExtra/R/plot2.R	2014-08-17 22:43:09 UTC (rev 829)
@@ -11,15 +11,24 @@
   list(cex=0.6, mar=c(3,2,0,2))
 } # }}}
 
-chart.lines <- function(x, type="l", colorset=1:10, up.col=NULL, dn.col=NULL){
+chart.lines <- function(x, 
+                        type="l", 
+                        lty=1,
+                        lwd=2,
+                        lend=1,
+                        colorset=1:10, 
+                        up.col=NULL, 
+                        dn.col=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=1,lty=1,type="h")
+    lines(1:NROW(x),x[,1],lwd=2,col=colors,lend=lend,lty=1,type="h")
   } else {
+    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],lwd=2,col=colorset[i],lend=1,lty=1,type="l")
+      lines(1:NROW(x), x[,i], type="l", lend=lend, col=colorset[i], lty=lty[i], lwd=lwd[i])
     }
   }
 }
@@ -84,15 +93,18 @@
                       type="l",
                       lty=1,
                       lwd=2,
+                      lend=1,
                       main=deparse(substitute(x)),  
                       clev=0,
-                      pars=chart_pars(), 
+                      cex=0.6, 
+                      mar=c(3,2,0,2), 
                       ylim=NULL,
                       yaxis.same=TRUE,
                       yaxis.left=TRUE,
                       yaxis.right=TRUE,
                       grid.ticks.on="months",
                       grid.ticks.lwd=1,
+                      grid.ticks.lty=1,
                       grid.col="darkgray",
                       labels.col="#333333",
                       format.labels=TRUE,
@@ -140,6 +152,7 @@
                      type=type,
                      lty=lty,
                      lwd=lwd,
+                     lend=lend,
                      main=main,  
                      clev=clev,
                      pars=pars, 
@@ -149,6 +162,7 @@
                      yaxis.right=yaxis.right,
                      grid.ticks.on=grid.ticks.on,
                      grid.ticks.lwd=grid.ticks.lwd,
+                     grid.ticks.lty=grid.ticks.lty,
                      grid.col=grid.col,
                      labels.col=labels.col,
                      format.labels=format.labels,
@@ -220,8 +234,8 @@
   } else {
     cs$set_asp(3)
   }
-  cs$Env$cex <- pars$cex
-  cs$Env$mar <- pars$mar
+  cs$Env$cex <- cex
+  cs$Env$mar <- mar
   cs$Env$clev = min(clev+0.01,1) # (0,1]
   #cs$Env$theme$bbands <- theme$bbands
   cs$Env$theme$shading <- shading
@@ -240,9 +254,13 @@
   #cs$Env$theme$label.bg <- label.bg
   cs$Env$theme$coarse.time <- coarse.time
   cs$Env$format.labels <- format.labels
-  cs$Env$ticks.on <- grid.ticks.on
+  cs$Env$grid.ticks.on <- grid.ticks.on
   cs$Env$grid.ticks.lwd <- grid.ticks.lwd
+  cs$Env$grid.ticks.lty <- grid.ticks.lty
   cs$Env$type <- type
+  cs$Env$lty <- lty
+  cs$Env$lwd <- lwd
+  cs$Env$lend <- lend
   cs$Env$call_list <- list()
   cs$Env$call_list[[1]] <- match.call()
   
@@ -327,7 +345,8 @@
                     segments(atbt, #axTicksByTime2(xdata[xsubset]),
                              get_ylim()[[2]][1],
                              atbt, #axTicksByTime2(xdata[xsubset]),
-                             get_ylim()[[2]][2], col=theme$grid, lwd=grid.ticks.lwd),
+                             get_ylim()[[2]][2], 
+                             col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty),
                     axt <- axis_ticks(xdata,xsubset),
                     text(as.numeric(axt),
                          par('usr')[3]-0.2*min(strheight(axt)),
@@ -374,8 +393,9 @@
   }
   
   # add y-axis grid lines and labels
-  exp <- expression(segments(1, y_grid_lines(constant_ylim), NROW(xdata[xsubset]), 
-                             y_grid_lines(constant_ylim), col=theme$grid))
+  exp <- expression(segments(1, y_grid_lines(constant_ylim), 
+                             NROW(xdata[xsubset]), y_grid_lines(constant_ylim), 
+                             col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty))
   if(yaxis.left){
     exp <- c(exp, 
              # left y-axis labels
@@ -403,8 +423,14 @@
     lenv$main <- cs$Env$colum_names[1]
     #lenv$ymax <- range(cs$Env$R[subset])[2]
     lenv$type <- cs$Env$type
-    exp <- expression(chart.lines(xdata, type=type, colorset=theme$colorset, 
-                                  up.col=theme$up.col, dn.col=theme$dn.col))
+    exp <- expression(chart.lines(xdata, 
+                                  type=type, 
+                                  lty=lty,
+                                  lwd=lwd,
+                                  lend=lend,
+                                  colorset=theme$colorset, 
+                                  up.col=theme$up.col, 
+                                  dn.col=theme$dn.col))
     #exp <- c(exp, expression(text(1, ymax, adj=c(0,0), pos=4, cex=0.9, offset=0, labels=main)))
     # Add expression for the main plot
     cs$add(exp, env=c(lenv,cs$Env), expr=TRUE)
@@ -436,7 +462,11 @@
         cs$add_frame(ylim=lenv$ylim, asp=NCOL(cs$Env$xdata), fixed=TRUE)
         cs$next_frame()
         
-        exp <- expression(chart.lines(xdata[xsubset], type=type, 
+        exp <- expression(chart.lines(xdata[xsubset], 
+                                      type=type, 
+                                      lty=lty,
+                                      lwd=lwd,
+                                      lend=lend,
                                       colorset=theme$colorset, 
                                       up.col=theme$up.col, 
                                       dn.col=theme$dn.col))
@@ -451,14 +481,16 @@
         # NOTE 'exp' was defined earlier as chart.lines
         exp <- c(exp, 
                  # y-axis grid lines
-                 expression(segments(1,y_grid_lines(ylim),NROW(xdata[xsubset]), 
-                                     y_grid_lines(ylim), col=theme$grid)),
+                 expression(segments(1,y_grid_lines(ylim),
+                                     NROW(xdata[xsubset]), y_grid_lines(ylim), 
+                                     col=theme$grid, lwd=gird.ticks.lwd, lty=grid.ticks.lty)),
                  # x-axis grid lines
                  expression(atbt <- axTicksByTime2(xdata[xsubset]),
                             segments(atbt, #axTicksByTime2(xdata[xsubset]),
                                      ylim[1],
                                      atbt, #axTicksByTime2(xdata[xsubset]),
-                                     ylim[2], col=theme$grid)))
+                                     ylim[2], 
+                                     col=theme$grid, lwd=gird.ticks.lwd, lty=grid.ticks.lty)))
         if(yaxis.left){
           exp <- c(exp, 
                    # y-axis labels/boxes
@@ -476,7 +508,11 @@
       }
   }
   } else {
-    cs$add(expression(chart.lines(R[xsubset], type=type, 
+    cs$add(expression(chart.lines(R[xsubset], 
+                                  type=type, 
+                                  lty=lty,
+                                  lwd=lwd,
+                                  lend=lend,
                                   colorset=theme$colorset,
                                   up.col=theme$up.col, 
                                   dn.col=theme$dn.col)),expr=TRUE)

Modified: pkg/xtsExtra/sandbox/test_plot2.R
===================================================================
--- pkg/xtsExtra/sandbox/test_plot2.R	2014-08-17 15:03:29 UTC (rev 828)
+++ pkg/xtsExtra/sandbox/test_plot2.R	2014-08-17 22:43:09 UTC (rev 829)
@@ -81,6 +81,14 @@
 x$Env$call_list
 x$Env$call_list[[1]]
 
+plot2_xts(R, FUN="CumReturns")
+plot2_xts(R, FUN="CumReturns", lty=1:4)
+plot2_xts(R, FUN="CumReturns", lty=1:4, lwd=c(3, 1, 1, 1))
+plot2_xts(R, FUN="CumReturns", lwd=c(3, 2, 2, 2), colorset=c(1, rep("gray", 3)))
+
+plot2_xts(R, yaxis.left=TRUE, yaxis.right=FALSE)
+plot2_xts(R, grid.ticks.lwd=1, grid.ticks.lty="solid", grid.col="black")
+
 ##### scratch area #####
 # Should we have a theme object, as in quantmod, that sets all of the basic 
 # parameters such as lty, lwd, las, cex, colorset, element.color, etc?


From noreply at r-forge.r-project.org  Thu Aug 21 21:51:21 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 21 Aug 2014 21:51:21 +0200 (CEST)
Subject: [Xts-commits] r830 - pkg/xtsExtra/R
Message-ID: <20140821195121.35E461875B4@r-forge.r-project.org>

Author: bodanker
Date: 2014-08-21 21:51:20 +0200 (Thu, 21 Aug 2014)
New Revision: 830

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
- s/gird/grid (thanks to Samo Pahor and Kyle Balkissoon)


Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-17 22:43:09 UTC (rev 829)
+++ pkg/xtsExtra/R/plot2.R	2014-08-21 19:51:20 UTC (rev 830)
@@ -483,14 +483,14 @@
                  # y-axis grid lines
                  expression(segments(1,y_grid_lines(ylim),
                                      NROW(xdata[xsubset]), y_grid_lines(ylim), 
-                                     col=theme$grid, lwd=gird.ticks.lwd, lty=grid.ticks.lty)),
+                                     col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty)),
                  # x-axis grid lines
                  expression(atbt <- axTicksByTime2(xdata[xsubset]),
                             segments(atbt, #axTicksByTime2(xdata[xsubset]),
                                      ylim[1],
                                      atbt, #axTicksByTime2(xdata[xsubset]),
                                      ylim[2], 
-                                     col=theme$grid, lwd=gird.ticks.lwd, lty=grid.ticks.lty)))
+                                     col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty)))
         if(yaxis.left){
           exp <- c(exp, 
                    # y-axis labels/boxes


From noreply at r-forge.r-project.org  Fri Aug 22 15:25:19 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 22 Aug 2014 15:25:19 +0200 (CEST)
Subject: [Xts-commits] r831 - pkg/xts/R
Message-ID: <20140822132519.43D1D187565@r-forge.r-project.org>

Author: bodanker
Date: 2014-08-22 15:25:18 +0200 (Fri, 22 Aug 2014)
New Revision: 831

Modified:
   pkg/xts/R/xts.methods.R
Log:
- Fix bug #5885


Modified: pkg/xts/R/xts.methods.R
===================================================================
--- pkg/xts/R/xts.methods.R	2014-08-21 19:51:20 UTC (rev 830)
+++ pkg/xts/R/xts.methods.R	2014-08-22 13:25:18 UTC (rev 831)
@@ -128,8 +128,8 @@
         i <- seq_len(nr)
 
       if(length(x)==0) {
-        x.tmp <- .xts(rep(NA,length(i)), .index(x)[i])
-        return((colnames(x.tmp) <- colnames(x)))
+        x.tmp <- .xts(rep(NA,length(i)), .index(x)[i], dimnames=list(NULL, colnames(x)))
+        return(x.tmp)
       } else {
         if(USE_EXTRACT) {
           return(.Call('extract_col', 


From noreply at r-forge.r-project.org  Sat Aug 23 17:41:33 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 23 Aug 2014 17:41:33 +0200 (CEST)
Subject: [Xts-commits] r832 - pkg/xtsExtra/R
Message-ID: <20140823154133.C5B4F186D4E@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-23 17:41:33 +0200 (Sat, 23 Aug 2014)
New Revision: 832

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
fixes bug report #5876

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-22 13:25:18 UTC (rev 831)
+++ pkg/xtsExtra/R/plot2.R	2014-08-23 15:41:33 UTC (rev 832)
@@ -129,18 +129,34 @@
       # we will plot the returns by column, but not the panels
       multi.panel <- TRUE
       panels <- NULL
-      FUN <- NULL
+      
       if(yaxis.same){
-        ylim <- range(na.omit(x[subset]))
-      } else {
-        ylim <- NULL
+        # If we want the same y-axis and a FUN is specified, we need to
+        # apply the transformation first to compute the range for the y-axis
+        if(!is.null(FUN) && nchar(FUN) > 0){
+          fun <- match.fun(FUN)
+          .formals <- formals(fun)
+          .formals <- modify.args(formals=.formals, arglist=list(...), dots=TRUE)
+          if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=x, dots=TRUE)
+          .formals$... <- NULL
+          R <- try(do.call(fun, .formals), silent=TRUE)
+          if(inherits(R, "try-error")) { 
+            message(paste("FUN function failed with message", R))
+            ylim <- range(na.omit(x[subset]))
+          } else {
+            ylim <- range(na.omit(R[subset]))
+          }
+        } else {
+           # set the ylim based on the data passed into the x argument
+          ylim <- range(na.omit(x[subset]))
+        }
       }
     }
     
     for(i in 1:length(chunks)){
       tmp <- chunks[[i]]
       p <- plot2_xts(x=x[,tmp], 
-                     y=NULL,
+                     y=y,
                      ...=...,
                      subset=subset,
                      FUN=FUN,
@@ -155,7 +171,8 @@
                      lend=lend,
                      main=main,  
                      clev=clev,
-                     pars=pars, 
+                     cex=cex, 
+                     mar=mar, 
                      ylim=ylim,
                      yaxis.same=yaxis.same,
                      yaxis.left=yaxis.left,
@@ -167,7 +184,9 @@
                      labels.col=labels.col,
                      format.labels=format.labels,
                      coarse.time=coarse.time,
-                     shading=shading)
+                     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, ...=...)


From noreply at r-forge.r-project.org  Sat Aug 23 18:19:50 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 23 Aug 2014 18:19:50 +0200 (CEST)
Subject: [Xts-commits] r833 - pkg/xtsExtra/R
Message-ID: <20140823161950.124B71875A1@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-23 18:19:49 +0200 (Sat, 23 Aug 2014)
New Revision: 833

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
fixes bug #5874

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-23 15:41:33 UTC (rev 832)
+++ pkg/xtsExtra/R/plot2.R	2014-08-23 16:19:49 UTC (rev 833)
@@ -307,6 +307,7 @@
     .formals <- formals(fun)
     .formals <- modify.args(formals=.formals, arglist=list(...), dots=TRUE)
     if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=x, dots=TRUE)
+    if("x" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, x=x, dots=TRUE)
     .formals$... <- NULL
     R <- try(do.call(fun, .formals), silent=TRUE)
     if(inherits(R, "try-error")) { 


From noreply at r-forge.r-project.org  Sun Aug 24 14:53:45 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 24 Aug 2014 14:53:45 +0200 (CEST)
Subject: [Xts-commits] r834 - pkg/xtsExtra/R
Message-ID: <20140824125345.DC285186FB1@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-24 14:53:45 +0200 (Sun, 24 Aug 2014)
New Revision: 834

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
adding arguments to allow rotating x and y axis labels

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-23 16:19:49 UTC (rev 833)
+++ pkg/xtsExtra/R/plot2.R	2014-08-24 12:53:45 UTC (rev 834)
@@ -97,7 +97,10 @@
                       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,
                       yaxis.same=TRUE,
                       yaxis.left=TRUE,
@@ -172,7 +175,10 @@
                      main=main,  
                      clev=clev,
                      cex=cex, 
+                     cex.axis=cex.axis,
                      mar=mar, 
+                     srt=srt,
+                     xaxis.las=xaxis.las,
                      ylim=ylim,
                      yaxis.same=yaxis.same,
                      yaxis.left=yaxis.left,
@@ -270,6 +276,9 @@
   cs$Env$theme$grid <- grid.col
   cs$Env$theme$grid2 <- grid2
   cs$Env$theme$labels <- labels.col
+  cs$Env$theme$srt <- srt
+  cs$Env$theme$xaxis.las <- xaxis.las
+  cs$Env$theme$cex.axis <- cex.axis
   #cs$Env$theme$label.bg <- label.bg
   cs$Env$theme$coarse.time <- coarse.time
   cs$Env$format.labels <- format.labels
@@ -370,7 +379,7 @@
                     axt <- axis_ticks(xdata,xsubset),
                     text(as.numeric(axt),
                          par('usr')[3]-0.2*min(strheight(axt)),
-                         names(axt),xpd=TRUE,cex=0.9,pos=3)),
+                         names(axt),xpd=TRUE,cex=theme$cex.axis,pos=3)),
          clip=FALSE,expr=TRUE)
   
   # Add frame for the chart "header" to display the name and start/end dates
@@ -385,7 +394,8 @@
   cs$add(expression(axt <- axTicksByTime(xdata[xsubset],format.labels=format.labels),
                     axis(1,at=axt, #axTicksByTime(xdata[xsubset]),
                          labels=names(axt), #axTicksByTime(xdata[xsubset],format.labels=format.labels)),
-                         las=1,lwd.ticks=1,mgp=c(3,1.5,0),tcl=-0.4,cex.axis=.9)),
+                         las=theme$xaxis.las, lwd.ticks=1, mgp=c(3,1.5,0), 
+                         tcl=-0.4, cex.axis=theme$cex.axis)),
          expr=TRUE)
   
   # add main and start/end dates
@@ -422,14 +432,16 @@
              expression(text(1-1/3-max(strwidth(y_grid_lines(constant_ylim))), 
                              y_grid_lines(constant_ylim),
                              noquote(format(y_grid_lines(constant_ylim), justify="right")),
-                             col=theme$labels, offset=0, pos=4, cex=0.9, xpd=TRUE)))
+                             col=theme$labels, srt=theme$srt, offset=0, pos=4, 
+                             cex=theme$cex.axis, xpd=TRUE)))
   }
   if(yaxis.right){
     exp <- c(exp, 
              # right y-axis labels
              expression(text(NROW(R[xsubset])+1/3, y_grid_lines(constant_ylim),
                              noquote(format(y_grid_lines(constant_ylim), justify="right")),
-                             col=theme$labels, offset=0, pos=4, cex=0.9, xpd=TRUE)))
+                             col=theme$labels, srt=theme$srt, offset=0, pos=4, 
+                             cex=theme$cex.axis, xpd=TRUE)))
   }
   cs$add(exp, env=cs$Env, expr=TRUE)
   
@@ -516,13 +528,15 @@
                    # y-axis labels/boxes
                    expression(text(1-1/3-max(strwidth(y_grid_lines(ylim))), y_grid_lines(ylim),
                                    noquote(format(y_grid_lines(ylim),justify="right")),
-                                   col=theme$labels,offset=0,pos=4,cex=0.9, xpd=TRUE)))
+                                   col=theme$labels, srt=theme$srt, offset=0, 
+                                   pos=4, cex=theme$cex.axis, xpd=TRUE)))
         }
         if(yaxis.right){
           exp <- c(exp, 
                    expression(text(NROW(xdata[xsubset])+1/3, y_grid_lines(ylim),
                                    noquote(format(y_grid_lines(ylim),justify="right")),
-                                   col=theme$labels,offset=0,pos=4,cex=0.9, xpd=TRUE)))
+                                   col=theme$labels, srt=theme$srt, offset=0,
+                                   pos=4, cex=theme$cex.axis, xpd=TRUE)))
         }
         cs$add(exp,env=c(lenv, cs$Env),expr=TRUE,no.update=TRUE)
       }


From noreply at r-forge.r-project.org  Wed Aug 27 17:28:29 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 27 Aug 2014 17:28:29 +0200 (CEST)
Subject: [Xts-commits] r835 - pkg/xts/vignettes
Message-ID: <20140827152829.B36E5187542@r-forge.r-project.org>

Author: bodanker
Date: 2014-08-27 17:28:29 +0200 (Wed, 27 Aug 2014)
New Revision: 835

Modified:
   pkg/xts/vignettes/xts-faq.Rnw
Log:
- major updates to xts FAQ vignette to prepare for adding it to CRAN xts


Modified: pkg/xts/vignettes/xts-faq.Rnw
===================================================================
--- pkg/xts/vignettes/xts-faq.Rnw	2014-08-24 12:53:45 UTC (rev 834)
+++ pkg/xts/vignettes/xts-faq.Rnw	2014-08-27 15:28:29 UTC (rev 835)
@@ -10,29 +10,29 @@
 
 %% -*- encoding: utf-8 -*-
 %\VignetteIndexEntry{xts FAQ}
+%\VignetteDepends{zoo}
 \documentclass{article}
 %
 \usepackage{Rd}
 \usepackage{Sweave}
+\usepackage{hyperref}
+\hypersetup{colorlinks,%
+            citecolor=black,%
+            linkcolor=blue,%
+            urlcolor=blue,%
+            }
 %%\encoding{UTF-8}
 %%\usepackage[UTF-8]{inputenc}
 %
 \newcommand{\q}[1]{\section*{#1}\addcontentsline{toc}{subsection}{#1}}
 
-\author{\pkg{xts} Development Team}
-%\Plainauthor{xts Development Team}
-%-%-%-%-% Need to add footnote thanking Alberto Giannetti for his
-%-%-%-%-% contribution of many useful questions.
+\author{xts Deveopment Team%
+ \footnote{Contact author: Joshua M. Ulrich \email{josh.m.ulrich at gmail.com}}
+ \footnote{Thanks to Alberto Giannetti and Michael R. Weylandt for their many contributions.}
+}
 
-%\Address{
-%  \pkg{xts} Development Team\\
-%  \proglang{R}-Forge: \url{http://r-forge.r-project.org/projects/xts/}\\
-%  Comprehensive \proglang{R} Archive Network: \url{http://cran.r-project.org/package=xts}
-%}
+\title{\bf xts FAQ}
 
-\title{\pkg{xts} FAQ}
-%\Plaintitle{xts FAQ}
-
 %\Keywords{irregular time series, time index, daily data, weekly data, returns}
 
 %\Abstract{
@@ -48,7 +48,7 @@
 
 <<preliminaries, echo=FALSE, results=hide>>=
 library("xts")
-Sys.setenv(TZ = "GMT")
+Sys.setenv(TZ="GMT")
 @
 
 \makeatletter
@@ -69,150 +69,160 @@
 %
 The main benefit of \pkg{xts} is its seamless compatibility with other packages
 using different time-series classes (\pkg{timeSeries}, \pkg{zoo}, ...). In
-addition \pkg{xts} allows the user to add custom attributes to any object. For
-more information check the \pkg{xts} Vignette Introduction.
+addition, \pkg{xts} allows the user to add custom attributes to any object. See
+the main \pkg{xts} vignette for more information.
 
 \q{How do I install \pkg{xts}?}
 %
-\pkg{xts} depends on \pkg{zoo} and some other packages. You should be able to
-install \pkg{xts} and all the other required components by simply calling
-\code{install.packages('pkg')} from your \pkg{R} prompt.
+\pkg{xts} depends on \pkg{zoo} and suggests some other packages. You should be
+able to install \pkg{xts} and all the other required components by simply
+calling \code{install.packages('pkg')} from the \pkg{R} prompt.
 
 \q{I have multiple .csv time-series files that I need to load in a single
-\pkg{xts} matrix. What is the most efficient way to import the files?}
+\pkg{xts} object. What is the most efficient way to import the files?}
 %
-If the files series have the same format, load them with \code{read.csv()} and
-then call \code{rbind()} to join the series together:
+If the files have the same format, load them with \code{read.zoo} and
+then call \code{rbind} to join the series together; finally, call \code{as.xts}
+on the result. Using a combination of \code{lapply} and \code{do.call} can
+accomplish this with very little code:
 <<eval=FALSE>>=
 filenames <- c("a.csv", "b.csv", "c.csv")
-l <- lapply(filenames, read.csv)
-do.call("rbind", l)
+sample.xts <- as.xts(do.call("rbind", lapply(filenames, read.zoo)))
 @
 
 \q{Why is \pkg{xts} implemented as a matrix rather than a data frame?}
 %
 \pkg{xts} uses a matrix rather than data.frame because:
 \begin{enumerate}
-  \item It is a subclass of \pkg{zoo}, and that's how \pkg{zoo} objects are
-    structured; and
+  \item \pkg{xts} is a subclass of \pkg{zoo}, and that's how \pkg{zoo} objects
+    are structured; and
   \item matrix objects have much better performance than data.frames.
 \end{enumerate}
 
-\q{How can I simplify the syntax of my \pkg{xts} matrix column names?}
+\q{How can I simplify the syntax when referring to \pkg{xts} object column names?}
 %
-\code{with()} allows to enter the matrix name avoiding the full square brackets
-syntax. For example:
+\code{with} allows you to use the colmn names while avoiding the full square
+brackets syntax. For example:
 <<eval=FALSE>>=
-lm(myxts[, "Res"] ~ myxts[, "ThisVar"] + myxts[, "ThatVar"])
+lm(sample.xts[, "Res"] ~ sample.xts[, "ThisVar"] + sample.xts[, "ThatVar"])
 @
 can be converted to
 <<eval=FALSE>>=
-with(myxts, lm(Res ~ ThisVar + ThatVar))
+with(sample.xts, lm(Res ~ ThisVar + ThatVar))
 @
 
-\q{How can I replace the 0s in an \pkg{xts} object with the last non-zero value
+\q{How can I replace the zeros in an \pkg{xts} object with the last non-zero value
 in the series?}
 %
-Use \code{na.locf}:
+Convert the zeros to \code{NA} and then use \code{na.locf}:
 <<>>=
-x <- .xts(c(1, 2, 3, 0, 0, 0), 1:6)
-x[x==0] <- NA
-na.locf(x)
-x
+sample.xts <- xts(c(1:3, 0, 0, 0), as.POSIXct("1970-01-01")+0:5)
+sample.xts[sample.xts==0] <- NA
+cbind(orig=sample.xts, locf=na.locf(sample.xts))
 @
 
 \q{How do I create an \pkg{xts} index with millisecond precision?}
 %
-Milliseconds in \pkg{xts} are stored as decimal values. This example builds a
-series spaced by 100 milliseconds, starting at the current system time:
+Milliseconds in \pkg{xts} indexes are stored as decimal values. This example
+builds an index spaced by 100 milliseconds, starting at the current system time:
 <<>>=
 data(sample_matrix)
-sample.xts = xts(sample_matrix, Sys.time() + seq(0, by = 0.1, length = 180))
+sample.xts <- xts(1:10, seq(as.POSIXct("1970-01-01"), by=0.1, length=10))
 @
 
-\q{OK, so now I have my millisecond series but I still can't see the
-milliseconds displayed. What went wrong?}
+\q{I have a millisecond-resolution index, but the milliseconds aren't
+displayed. What went wrong?}
 %
 Set the \code{digits.secs} option to some sub-second precision. Continuing from
 the previous example, if you are interested in milliseconds:
 <<>>=
-options(digits.secs = 3)
+options(digits.secs=3)
 head(sample.xts)
 @
 
-\q{I set \code{digits.sec = 3}, but \pkg{R} doesn't show the values correctly.}
+\q{I set \code{digits.sec=3}, but \pkg{R} doesn't show the values correctly.}
 %
-Sub-second values are stored in floating point format with microseconds
-precision. Setting the precision to only 3 decimal hides the full index value
-in microseconds and might be tricky to interpret depending how the machine
-rounds the millisecond (3rd) digit. Set the digits.secs options to a value
-higher than 3 or use the \code{as.numeric()} 'digits' parameter to display the
-full value. For example:
+Sub-second values are stored with approximately microsecond precision. Setting
+the precision to only 3 decimal hides the full index value in microseconds and
+might be tricky to interpret depending how the machine rounds the millisecond
+(3rd) digit. Set the \code{digits.secs} option to a value higher than 3 or
+convert the date-time to numeric and use \code{print}'s \code{digits} argument,
+or \code{sprintf} to display the full value. For example:
 <<>>=
-print(as.numeric(as.POSIXlt("2012-03-20 09:02:50.001")), digits = 20)
+dt <- as.POSIXct("2012-03-20 09:02:50.001")
+print(as.numeric(dt), digits=20)
+sprintf("%20.10f", dt)
 @
 
-\q{I am using \code{apply()} to run a custom function on my \pkg{xts} series.
+\q{I am using \code{apply} to run a custom function on my \pkg{xts} object.
 Why the returned matrix has different dimensions than the original one?}
 %
-When working on rows, \code{apply()} returns a transposed version of the
-original matrix. Simply call \code{t()} on the returned matrix to restore the
+When working on rows, \code{apply} returns a transposed version of the
+original matrix. Simply call \code{t} on the returned matrix to restore the
 original dimensions:
 <<eval=FALSE>>=
-myxts.2 <- xts(t(apply(myxts, 1 , myfun)), index(myxts))
+sample.xts.2 <- xts(t(apply(sample.xts, 1, myfun)), index(sample.xts))
 @
 
-\q{I have an \pkg{xts} matrix with multiple days of data at various
-frequencies. For example, day 1 might contain 10 different rows of 1 minute
-observations, while day 2 contains 20 observations. How can I process all
-observations for each day and return the summary daily statistics in a new
-matrix?}
+\q{I have an \pkg{xts} object with varying numbers of observations per day (e.g.,
+one day might contain 10 observations, while another day contains 20 observations).
+How can I apply a function to all observations for each day?}
 %
-First split the source matrix in day subsets, then call \code{rbind()} to join
-the processed day statistics together:
-<<eval=FALSE>>=
-do.call(rbind, lapply(split(myxts,"days"), myfun))
+You can use \code{apply.daily}, or \code{period.apply} more generally:
+<<>>=
+sample.xts <- xts(1:50, seq(as.POSIXct("1970-01-01"),
+  as.POSIXct("1970-01-03")-1, length=50))
+apply.daily(sample.xts, mean)
+period.apply(sample.xts, endpoints(sample.xts, "days"), mean)
+period.apply(sample.xts, endpoints(sample.xts, "hours", 6), mean)
 @
 
 \q{How can I process daily data for a specific time subset?}
 %
-First extract the time range you want to work on, then apply the daily function:
+First use time-of-day subsetting to extract the time range you want to work on (note
+the leading \code{"T"} and leading zeros are required for each time in the range:
+\code{"T06:00"}), then use \code{apply.daily} to apply your function to the subset:
 <<eval=FALSE>>=
-rt <- r['T16:00/T17:00','Value']
-rd <- apply.daily(rt, function(x) xts(t(quantile(x,0.9)), end(x)))
+apply.daily(sample.xts['T06:00/T17:00',], mean)
 @
 
-\q{How can I process my data in 3-hour blocks, regardless of the begin/end time?
- I also want to add observations at the beginning and end of each discrete
- period if missing from the original time-series object.}
+\q{How can I analyze my irregular data in regular blocks, adding observations
+for each regular block if one doesn't exist in the origianl time-series object?}
 %
-Use \code{align.time()} to set indexes in the periods you are interested in,
-then call \code{period.apply} to run your processing function:
-<<eval=FALSE>>=
-# align index into 3-hour blocks
-a <- align.time(s, n=60*60*3)
-# find the number of obs in each block
-count <- period.apply(a, endpoints(a, "hours", 3), length)
-# create an empty \pkg{xts} object with the desired index
-e <- xts(,seq(start(a),end(a),by="3 hours"))
-# merge the counts with the empty object and fill with zeros
-out <- merge(e,count,fill=0)
+Use \code{align.time} to round-up the indexes to the periods you are interested
+in, then call \code{period.apply} to apply your function. Finally, merge the
+result with an empty xts object that contains all the regular index values
+you want:
+<<>>=
+sample.xts <- xts(1:6, as.POSIXct(c("2009-09-22 07:43:30",
+  "2009-10-01 03:50:30", "2009-10-01 08:45:00", "2009-10-01 09:48:15",
+  "2009-11-11 10:30:30", "2009-11-11 11:12:45")))
+# align index into regular (e.g. 3-hour) blocks
+aligned.xts <- align.time(sample.xts, n=60*60*3)
+# apply your function to each block
+count <- period.apply(aligned.xts, endpoints(aligned.xts, "hours", 3), length)
+# create an empty xts object with the desired regular index
+empty.xts <- xts(, seq(start(aligned.xts), end(aligned.xts), by="3 hours"))
+# merge the counts with the empty object
+head(out1 <- merge(empty.xts, count))
+# or fill with zeros
+head(out2 <- merge(empty.xts, count, fill=0))
 @
 
-\q{Why do I get a \pkg{zoo} object when I call transform() on my \pkg{xts}
-matrix?}
+\q{Why do I get a \pkg{zoo} object when I call \code{transform} on my
+\pkg{xts} object?}
 %
-There's no \pkg{xts} method for transform, so the \pkg{zoo} method is
+There's no \pkg{xts} method for \code{transform}, so the \pkg{zoo} method is
 dispatched. The \pkg{zoo} method explicitly creates a new \pkg{zoo} object. To
-convert the transformed matrix back to an \pkg{xts} object wrap the transform
-call in \code{as.xts}:
+convert the transformed object back to an \pkg{xts} object wrap the
+\code{transform} call in \code{as.xts}:
 <<eval=FALSE>>=
-myxts = as.xts(transform(myxts, ABC = 1))
+sample.xts <- as.xts(transform(sample.xts, ABC=1))
 @
 
 You might also have to reset the index timezone:
 <<eval=FALSE>>=
-indexTZ(myxts) = Sys.getenv("TZ")
+indexTZ(sample.xts) <- Sys.getenv("TZ")
 @
 
 \q{Why can't I use the \code{\&} operator in \pkg{xts} objects when querying
@@ -225,50 +235,95 @@
 change the behavior of \code{.Primitive("\&")}. You can do something like this
 though:
 <<eval=FALSE>>=
-myts[myts$Symbol == "AAPL" & index(myts) == as.POSIXct("2011-09-21"),]
+sample.xts[sample.xts$Symbol == "AAPL" & index(sample.xts) == as.POSIXct("2011-09-21"),]
 @
 or:
 <<eval=FALSE>>=
-myts[myts$Symbol == "AAPL"]['2011-09-21']
+sample.xts[sample.xts$Symbol == "AAPL"]['2011-09-21']
 @
 
 \q{How do I subset an \pkg{xts} object to only include weekdays (excluding
 Saturday and Sundays)?}
 %
-Use \code{.indexwday()} to only include Mon-Fri days:
+Use \code{.indexwday} to only include Mon-Fri days:
 <<>>=
 data(sample_matrix)
-sample.xts <- as.xts(sample_matrix, descr='my new xts object')
-x <- sample.xts['2007']  
-x[.indexwday(x) %in% 1:5]
+sample.xts <- as.xts(sample_matrix)
+wday.xts <- sample.xts[.indexwday(sample.xts) %in% 1:5]
+head(wday.xts)
 @
 
-\q{I need to quickly convert a data-frame that contains the time-stamps in one
-of the columns. Using \code{as.xts(q)} returns an error. How do I build my
+\q{I need to quickly convert a data.frame that contains the time-stamps in one
+of the columns. Using \code{as.xts(Data)} returns an error. How do I build my
 \pkg{xts} object?}
 %
-The \pkg{xts}() constructor requires two arguments: a vector or a matrix
-carrying data and a vector of type \code{Date}, \code{POSIcXt}, \code{chron},
-\ldots supplying the time index information. If the time is set in one of the
-matrix columns, use this line:
-<<eval=FALSE>>=
-qxts = xts(q[,-1], order.by=q[,1])
+The \code{as.xts} function assumes the date-time index is contained in the
+\code{rownames} of the object to be converted. If this is not the case, you
+need to use the \code{xts} constructor, which requires two arguments: a
+vector or a matrix carrying data and a vector of type \code{Date},
+\code{POSIXct}, \code{chron}, \ldots, supplying the time index information.
+If you are certain the time-stamps are in a specific column, you can use:
+<<>>=
+Data <- data.frame(timestamp=as.Date("1970-01-01"), obs=21)
+sample.xts <- xts(Data[,-1], order.by=Data[,1])
 @
+If you aren't certain, you need to explicitly reference the column name that
+contains the time-stamps:
+<<>>=
+Data <- data.frame(obs=21, timestamp=as.Date("1970-01-01"))
+sample.xts <- xts(Data[,!grepl("timestamp",colnames(Data))],
+  order.by=Data$timestamp)
+@
 
 \q{I have two time-series with different frequency. I want to combine the data
-into a single data frame, but the times are not exactly aligned. I want to have
-one row in the data frame for each ten minute period, with the time index
+into a single \pkg{xts} object, but the times are not exactly aligned. I want
+to have one row in the result for each ten minute period, with the time index
 showing the beginning of the time period.}
 %
-\code{align.time()} creates evenly spaced time-series from a set of indexes,
-\code{merge()} insure two time-series are combined in a single \pkg{xts} object
+\code{align.time} creates evenly spaced time-series from a set of indexes,
+\code{merge} ensure two time-series are combined in a single \pkg{xts} object
 with all original columns and indexes preserved. The new object has one entry
-for each timestamp from both series and values missing are replaced with
-\code{NA}s.
+for each timestamp from both series and missing values are replaced with
+\code{NA}.
 <<eval=FALSE>>=
-xTemps <- align.time(xts(temps[,2],as.POSIXct(temps[,1])), n=600)
-xGas <- align.time(xts(gas[,2],as.POSIXct(gas[,1])), n=600)
-merge(xTemps,xGas)
+x1 <- align.time(xts(Data1$obs, Data1$timestamp), n=600)
+x2 <- align.time(xts(Data2$obs, Data2$timestamp), n=600)
+merge(x1, x2)
 @
 
+\q{Why do I get a warning when running the code below?}
+<<>>=
+data(sample_matrix)
+sample.xts <- as.xts(sample_matrix)
+sample.xts["2007-01"]$Close <- sample.xts["2007-01"]$Close + 1
+#Warning message:
+#In NextMethod(.Generic) :
+#  number of items to replace is not a multiple of replacement length
+@
+%
+This code creates two calls to the subset-replacement function
+\code{xts:::`[<-.xts`}.  The first call replaces the value of \code{Close}
+in a temporary copy of the first row of the object on the left-hand-side of
+the assignment, which works fine. The second call tries to replace
+the first \emph{element} of the object on the left-hand-side of the
+assignment with the modified temporary copy of the first row.  This is
+the problem.
+
+For the command to work, there needs to be a comma in the first
+subset call on the left-hand-side:
+<<eval=FALSE>>=
+sample.xts["2007-01",]$Close <- sample.xts["2007-01"]$Close + 1
+@
+
+This isn't encouraged, because the code isn't clear. Simply remember to
+subset by column first, then row, if you insist on making two calls to
+the subset-replacement function. A cleaner and faster solution is below.
+It's only one function call and it avoids the \code{\$} function (which
+is marginally slower on xts objects).
+<<eval=FALSE>>=
+sample.xts["2007-01","Close"] <- sample.xts["2007-01","Close"] + 1
+@
+
+%%% What is the fastest way to subset an xts object?
+
 \end{document}


From noreply at r-forge.r-project.org  Sat Aug 30 15:32:14 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 30 Aug 2014 15:32:14 +0200 (CEST)
Subject: [Xts-commits] r836 - pkg/xtsExtra/R
Message-ID: <20140830133214.655F71877B6@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-30 15:32:14 +0200 (Sat, 30 Aug 2014)
New Revision: 836

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
modifying x-axis to use axTicksByTime and removing coarse.time arg

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-27 15:28:29 UTC (rev 835)
+++ pkg/xtsExtra/R/plot2.R	2014-08-30 13:32:14 UTC (rev 836)
@@ -111,7 +111,6 @@
                       grid.col="darkgray",
                       labels.col="#333333",
                       format.labels=TRUE,
-                      coarse.time=TRUE,
                       shading=1,
                       bg.col="#FFFFFF",
                       grid2="#F5F5F5"){
@@ -189,7 +188,6 @@
                      grid.col=grid.col,
                      labels.col=labels.col,
                      format.labels=format.labels,
-                     coarse.time=coarse.time,
                      shading=shading,
                      bg.col=bg.col,
                      grid2=grid2)
@@ -280,7 +278,7 @@
   cs$Env$theme$xaxis.las <- xaxis.las
   cs$Env$theme$cex.axis <- cex.axis
   #cs$Env$theme$label.bg <- label.bg
-  cs$Env$theme$coarse.time <- coarse.time
+  #cs$Env$theme$coarse.time <- coarse.time
   cs$Env$format.labels <- format.labels
   cs$Env$grid.ticks.on <- grid.ticks.on
   cs$Env$grid.ticks.lwd <- grid.ticks.lwd
@@ -357,29 +355,22 @@
   
   cs$set_frame(1,FALSE)
   # axis_ticks function to label lower frequency ranges/grid lines
-  cs$Env$axis_ticks <- function(xdata,xsubset) {
-    ticks <- diff(axTicksByTime2(xdata[xsubset],labels=FALSE))/2 + 
-      last(axTicksByTime2(xdata[xsubset],labels=TRUE),-1)
-    if(!coarse.time || length(ticks) == 1)
-      return(unname(ticks))
-    if(min(diff(ticks)) < max(strwidth(names(ticks)))) {
-      ticks <- unname(ticks)
-    }
-    ticks
-  }
+  #cs$Env$axis_ticks <- function(xdata,xsubset) {
+  #  ticks <- diff(axTicksByTime2(xdata[xsubset],labels=FALSE))/2 + 
+  #    last(axTicksByTime2(xdata[xsubset],labels=TRUE),-1)
+  #  if(min(diff(ticks)) < max(strwidth(names(ticks)))) {
+  #    ticks <- unname(ticks)
+  #  }
+  #  ticks
+  #}
   
   # compute the x-axis ticks
-  # need to add if(upper.x.label) to allow for finer control
-  cs$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
+  cs$add(expression(atbt <- axTicksByTime(xdata[xsubset]),
                     segments(atbt, #axTicksByTime2(xdata[xsubset]),
                              get_ylim()[[2]][1],
                              atbt, #axTicksByTime2(xdata[xsubset]),
                              get_ylim()[[2]][2], 
-                             col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty),
-                    axt <- axis_ticks(xdata,xsubset),
-                    text(as.numeric(axt),
-                         par('usr')[3]-0.2*min(strheight(axt)),
-                         names(axt),xpd=TRUE,cex=theme$cex.axis,pos=3)),
+                             col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty)),
          clip=FALSE,expr=TRUE)
   
   # Add frame for the chart "header" to display the name and start/end dates
@@ -517,7 +508,7 @@
                                      NROW(xdata[xsubset]), y_grid_lines(ylim), 
                                      col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty)),
                  # x-axis grid lines
-                 expression(atbt <- axTicksByTime2(xdata[xsubset]),
+                 expression(atbt <- axTicksByTime(xdata[xsubset]),
                             segments(atbt, #axTicksByTime2(xdata[xsubset]),
                                      ylim[1],
                                      atbt, #axTicksByTime2(xdata[xsubset]),
@@ -689,7 +680,8 @@
   plot_object$Env$call_list[[ncalls+1]] <- match.call()
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
-  if(is.logical(x)) no.update <- TRUE else no.update <- FALSE
+  # if(is.logical(x)) no.update <- TRUE else no.update <- FALSE
+  no.update <- TRUE
   #  this merge isn't going to work if x isn't in xdata range. Something like:
   #    na.approx(merge(n=.xts(1:NROW(xdata),.index(xdata)),ta)[,1])
   #  should allow for any time not in the original to be merged in.


From noreply at r-forge.r-project.org  Sat Aug 30 17:42:42 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 30 Aug 2014 17:42:42 +0200 (CEST)
Subject: [Xts-commits] r837 - pkg/xtsExtra/R
Message-ID: <20140830154242.84BF1185CEE@r-forge.r-project.org>

Author: rossbennett34
Date: 2014-08-30 17:42:42 +0200 (Sat, 30 Aug 2014)
New Revision: 837

Modified:
   pkg/xtsExtra/R/plot2.R
Log:
bug #5871 fix title and label compression in multi.panel plots 

Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R	2014-08-30 13:32:14 UTC (rev 836)
+++ pkg/xtsExtra/R/plot2.R	2014-08-30 15:42:42 UTC (rev 837)
@@ -33,6 +33,18 @@
   }
 }
 
+# function from Peter Carl to add labels to the plot window
+add_label <- function(xfrac, yfrac, label, pos=4, ylog, ...) { 
+  u <- par("usr")
+  x <- u[1] + xfrac * (u[2] - u[1]) 
+  y <- u[4] - yfrac * (u[4] - u[3]) 
+  if(ylog){
+    text(x, 10^y, label, pos = pos, ...)
+  } else {
+    text(x, y, label, pos = pos, ...) 
+  }
+}
+
 # chart_Series {{{
 #  Updated: 2010-01-15
 #
@@ -306,6 +318,7 @@
   cs$Env$xsubset <- subset
   cs$Env$column_names <- colnames(x)
   cs$Env$nobs <- NROW(cs$Env$xdata)
+  cs$Env$main <- main
   
   # Compute transformation if specified by panel argument
   # rough prototype for calling a function for the main "panel"
@@ -374,7 +387,7 @@
          clip=FALSE,expr=TRUE)
   
   # Add frame for the chart "header" to display the name and start/end dates
-  cs$add_frame(0,ylim=c(0,1),asp=0.2)
+  cs$add_frame(0,ylim=c(0,1),asp=0.5)
   cs$set_frame(1)
   
   # add observation level ticks on x-axis if < 400 obs.
@@ -390,8 +403,8 @@
          expr=TRUE)
   
   # add main and start/end dates
-  if((isTRUE(multi.panel)) | (multi.panel == 1) | (NCOL(x) == 1))
-    cs$Env$main <- cs$Env$column_names[1] else cs$Env$main <- main
+  #if((isTRUE(multi.panel)) | (multi.panel == 1) | (NCOL(x) == 1))
+  #  cs$Env$main <- cs$Env$column_names[1] else cs$Env$main <- main
   
   text.exp <- c(expression(text(1-1/3,0.5,main,font=2,col='#444444',offset=0,cex=1.1,pos=4)),
                 expression(text(NROW(xdata[xsubset]),0.5,
@@ -414,23 +427,23 @@
   }
   
   # add y-axis grid lines and labels
-  exp <- expression(segments(1, y_grid_lines(constant_ylim), 
-                             NROW(xdata[xsubset]), y_grid_lines(constant_ylim), 
+  exp <- expression(segments(1, y_grid_lines(get_ylim()[[2]]), 
+                             NROW(xdata[xsubset]), y_grid_lines(get_ylim()[[2]]), 
                              col=theme$grid, lwd=grid.ticks.lwd, lty=grid.ticks.lty))
   if(yaxis.left){
     exp <- c(exp, 
              # left y-axis labels
-             expression(text(1-1/3-max(strwidth(y_grid_lines(constant_ylim))), 
-                             y_grid_lines(constant_ylim),
-                             noquote(format(y_grid_lines(constant_ylim), justify="right")),
+             expression(text(1-1/3-max(strwidth(y_grid_lines(get_ylim()[[2]]))), 
+                             y_grid_lines(get_ylim()[[2]]),
+                             noquote(format(y_grid_lines(get_ylim()[[2]]), justify="right")),
                              col=theme$labels, srt=theme$srt, offset=0, pos=4, 
                              cex=theme$cex.axis, xpd=TRUE)))
   }
   if(yaxis.right){
     exp <- c(exp, 
              # right y-axis labels
-             expression(text(NROW(R[xsubset])+1/3, y_grid_lines(constant_ylim),
-                             noquote(format(y_grid_lines(constant_ylim), justify="right")),
+             expression(text(NROW(R[xsubset])+1/3, y_grid_lines(get_ylim()[[2]]),
+                             noquote(format(y_grid_lines(get_ylim()[[2]]), justify="right")),
                              col=theme$labels, srt=theme$srt, offset=0, pos=4, 
                              cex=theme$cex.axis, xpd=TRUE)))
   }
@@ -443,9 +456,13 @@
     # set up based on the code above
     lenv <- new.env()
     lenv$xdata <- cs$Env$R[,1][subset]
-    lenv$main <- cs$Env$colum_names[1]
-    #lenv$ymax <- range(cs$Env$R[subset])[2]
+    lenv$label <- colnames(cs$Env$R[,1])
     lenv$type <- cs$Env$type
+    if(yaxis.same){
+      lenv$ylim <- cs$Env$constant_ylim
+    } else {
+      lenv$ylim <- range(na.omit(cs$Env$R[,1][subset]))
+    }
     exp <- expression(chart.lines(xdata, 
                                   type=type, 
                                   lty=lty,
@@ -454,16 +471,20 @@
                                   colorset=theme$colorset, 
                                   up.col=theme$up.col, 
                                   dn.col=theme$dn.col))
-    #exp <- c(exp, expression(text(1, ymax, adj=c(0,0), pos=4, cex=0.9, offset=0, labels=main)))
     # Add expression for the main plot
     cs$add(exp, env=c(lenv,cs$Env), expr=TRUE)
+    text.exp <- expression(text(x=2,
+                                y=ylim[2]*0.9,
+                                labels=label,
+                                adj=c(0,0),cex=1,offset=0,pos=4))
+    cs$add(text.exp,env=c(lenv, cs$Env),expr=TRUE)
     
     if(NCOL(cs$Env$xdata) > 1){
       for(i in 2:NCOL(cs$Env$xdata)){
         # create a local environment
         lenv <- new.env()
         lenv$xdata <- cs$Env$R[,i][subset]
-        lenv$main <- cs$Env$column_names[i]
+        lenv$label <- cs$Env$column_names[i]
         if(yaxis.same){
           lenv$ylim <- cs$Env$constant_ylim
         } else {
@@ -471,12 +492,12 @@
         }
         lenv$type <- cs$Env$type
         
-        # Add a small frame for the time series info
-        cs$add_frame(ylim=c(0,1),asp=0.2)
+        # Add a small frame
+        cs$add_frame(ylim=c(0,1),asp=0.25)
         cs$next_frame()
         text.exp <- expression(text(x=1,
                                     y=0.5,
-                                    labels=main,
+                                    labels="",
                                     adj=c(0,0),cex=0.9,offset=0,pos=4))
         cs$add(text.exp, env=c(lenv,cs$Env), expr=TRUE)
         
@@ -530,6 +551,11 @@
                                    pos=4, cex=theme$cex.axis, xpd=TRUE)))
         }
         cs$add(exp,env=c(lenv, cs$Env),expr=TRUE,no.update=TRUE)
+        text.exp <- expression(text(x=2,
+                                    y=ylim[2]*0.9,
+                                    labels=label,
+                                    adj=c(0,0),cex=1,offset=0,pos=4))
+        cs$add(text.exp,env=c(lenv, cs$Env),expr=TRUE)
       }
   }
   } else {


From noreply at r-forge.r-project.org  Sun Aug 31 17:40:36 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 31 Aug 2014 17:40:36 +0200 (CEST)
Subject: [Xts-commits] r838 - pkg/xts/R
Message-ID: <20140831154036.E039418714B@r-forge.r-project.org>

Author: bodanker
Date: 2014-08-31 17:40:36 +0200 (Sun, 31 Aug 2014)
New Revision: 838

Modified:
   pkg/xts/R/index.R
Log:
- Fixes bug #5893 (index<-.xts can produce unsorted index)


Modified: pkg/xts/R/index.R
===================================================================
--- pkg/xts/R/index.R	2014-08-30 15:42:42 UTC (rev 837)
+++ pkg/xts/R/index.R	2014-08-31 15:40:36 UTC (rev 838)
@@ -74,6 +74,10 @@
     attr(x, 'index') <- structure(unclass(value)*86400, tclass="Date", tzone="UTC")
   else attr(x, 'index') <- as.numeric(as.POSIXct(value))
 
+  # ensure new index is sorted
+  if(!isOrdered(.index(x)))
+    stop("new index needs to be sorted")
+
   # set the .indexCLASS/tclass attribute to the end-user specified class
   attr(x, '.indexCLASS') <- class(value)
   attr(.index(x), 'tclass') <- class(value)


From noreply at r-forge.r-project.org  Sun Aug 31 17:54:09 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 31 Aug 2014 17:54:09 +0200 (CEST)
Subject: [Xts-commits] r839 - pkg/xtsExtra/R
Message-ID: <20140831155409.D7A7718751E@r-forge.r-project.org>

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


From noreply at r-forge.r-project.org  Sun Aug 31 18:14:09 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 31 Aug 2014 18:14:09 +0200 (CEST)
Subject: [Xts-commits] r840 - pkg/xts/vignettes
Message-ID: <20140831161409.2C3401872BF@r-forge.r-project.org>

Author: bodanker
Date: 2014-08-31 18:14:08 +0200 (Sun, 31 Aug 2014)
New Revision: 840

Modified:
   pkg/xts/vignettes/xts-faq.Rnw
Log:
- Fix typo in xts FAQ vignette


Modified: pkg/xts/vignettes/xts-faq.Rnw
===================================================================
--- pkg/xts/vignettes/xts-faq.Rnw	2014-08-31 15:54:09 UTC (rev 839)
+++ pkg/xts/vignettes/xts-faq.Rnw	2014-08-31 16:14:08 UTC (rev 840)
@@ -155,7 +155,7 @@
 @
 
 \q{I am using \code{apply} to run a custom function on my \pkg{xts} object.
-Why the returned matrix has different dimensions than the original one?}
+Why does the returned matrix has different dimensions than the original one?}
 %
 When working on rows, \code{apply} returns a transposed version of the
 original matrix. Simply call \code{t} on the returned matrix to restore the


From noreply at r-forge.r-project.org  Sun Aug 31 20:09:28 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 31 Aug 2014 20:09:28 +0200 (CEST)
Subject: [Xts-commits] r841 - pkg/xts/vignettes
Message-ID: <20140831180928.8CCBD183C47@r-forge.r-project.org>

Author: bodanker
Date: 2014-08-31 20:09:28 +0200 (Sun, 31 Aug 2014)
New Revision: 841

Modified:
   pkg/xts/vignettes/xts-faq.Rnw
Log:
- Re-try to fix type in FAQ...


Modified: pkg/xts/vignettes/xts-faq.Rnw
===================================================================
--- pkg/xts/vignettes/xts-faq.Rnw	2014-08-31 16:14:08 UTC (rev 840)
+++ pkg/xts/vignettes/xts-faq.Rnw	2014-08-31 18:09:28 UTC (rev 841)
@@ -155,7 +155,7 @@
 @
 
 \q{I am using \code{apply} to run a custom function on my \pkg{xts} object.
-Why does the returned matrix has different dimensions than the original one?}
+Why does the returned matrix have different dimensions than the original one?}
 %
 When working on rows, \code{apply} returns a transposed version of the
 original matrix. Simply call \code{t} on the returned matrix to restore the