[Xts-commits] r816 - in pkg/xtsExtra: . R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 16 13:44:29 CEST 2014
Author: rossbennett34
Date: 2014-07-16 13:44:28 +0200 (Wed, 16 Jul 2014)
New Revision: 816
Modified:
pkg/xtsExtra/NAMESPACE
pkg/xtsExtra/R/plot2.R
pkg/xtsExtra/sandbox/test_plot2.R
Log:
cleaning up plot2_xts code and adding relevant functions to NAMESPACE
Modified: pkg/xtsExtra/NAMESPACE
===================================================================
--- pkg/xtsExtra/NAMESPACE 2014-07-15 20:03:23 UTC (rev 815)
+++ pkg/xtsExtra/NAMESPACE 2014-07-16 11:44:28 UTC (rev 816)
@@ -13,6 +13,16 @@
S3method(plot, xts)
S3method(barplot, xts)
+export("plot2_xts")
+export("chart_pars")
+export("xtsExtraTheme")
+export("addDrawdowns")
+export("addLines")
+export("addReturns")
+export("addRollingPerformance")
+S3method(print, replot_xts)
+S3method(plot, replot_xts)
+
## Analytics -- All blocked out for now
#export("acf")
Modified: pkg/xtsExtra/R/plot2.R
===================================================================
--- pkg/xtsExtra/R/plot2.R 2014-07-15 20:03:23 UTC (rev 815)
+++ pkg/xtsExtra/R/plot2.R 2014-07-16 11:44:28 UTC (rev 816)
@@ -280,69 +280,73 @@
# add main series
cs$set_frame(2)
- if(isTRUE(byColumn)){
- # We need to plot the first "panel" here because the plot area is
- # set up based on the code above
- lenv <- new.env()
- lenv$xdata <- cs$Env$R[,1][subset]
- lenv$name <- 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))
- #exp <- c(exp, expression(text(1, ymax, adj=c(0,0), pos=4, cex=0.9, offset=0, labels=name)))
- # Add expression for the main plot
- cs$add(exp, env=c(lenv,cs$Env), expr=TRUE)
-
- for(i in 2:NCOL(x)){
- # create a local environment
+ if((isTRUE(byColumn)) || (byColumn >= 1L)){
+ if(is.numeric(byColumn)){
+ # split the data up and iterate over each "chunk" of data
+ } else {
+ # We need to plot the first "panel" here because the plot area is
+ # set up based on the code above
lenv <- new.env()
- lenv$xdata <- cs$Env$R[,i][subset]
- lenv$name <- cs$Env$column_names[i]
- lenv$ylim <- range(cs$Env$R[subset])
+ lenv$xdata <- cs$Env$R[,1][subset]
+ lenv$name <- 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))
+ #exp <- c(exp, expression(text(1, ymax, adj=c(0,0), pos=4, cex=0.9, offset=0, labels=name)))
+ # Add expression for the main plot
+ cs$add(exp, env=c(lenv,cs$Env), expr=TRUE)
- # Add a small frame for the time series info
- cs$add_frame(ylim=c(0,1),asp=0.2)
- cs$next_frame()
- text.exp <- expression(text(x=1,
- y=0.5,
- labels=name,
- adj=c(0,0),cex=0.9,offset=0,pos=4))
- cs$add(text.exp, env=c(lenv,cs$Env), expr=TRUE)
-
- # Add the frame for the sub-plots
- # Set the ylim based on the (potentially) transformed data in cs$Env$R
- cs$add_frame(ylim=range(cs$Env$R[cs$Env$xsubset]), asp=NCOL(cs$Env$xdata), fixed=TRUE)
- cs$next_frame()
-
- exp <- expression(chart.lines(xdata[xsubset], type=type))
-
- # define function to plot the y-axis grid lines
- lenv$y_grid_lines <- function(ylim) {
- #pretty(range(xdata[xsubset]))
- p <- pretty(ylim,10)
- p[p > ylim[1] & p < ylim[2]]
+ for(i in 2:NCOL(x)){
+ # create a local environment
+ lenv <- new.env()
+ lenv$xdata <- cs$Env$R[,i][subset]
+ lenv$name <- cs$Env$column_names[i]
+ lenv$ylim <- range(cs$Env$R[subset])
+ lenv$type <- cs$Env$type
+
+ # Add a small frame for the time series info
+ cs$add_frame(ylim=c(0,1),asp=0.2)
+ cs$next_frame()
+ text.exp <- expression(text(x=1,
+ y=0.5,
+ labels=name,
+ adj=c(0,0),cex=0.9,offset=0,pos=4))
+ cs$add(text.exp, env=c(lenv,cs$Env), expr=TRUE)
+
+ # Add the frame for the sub-plots
+ # Set the ylim based on the (potentially) transformed data in cs$Env$R
+ cs$add_frame(ylim=range(cs$Env$R[cs$Env$xsubset]), asp=NCOL(cs$Env$xdata), fixed=TRUE)
+ cs$next_frame()
+
+ exp <- expression(chart.lines(xdata[xsubset], type=type))
+
+ # define function to plot the y-axis grid lines
+ lenv$y_grid_lines <- function(ylim) {
+ #pretty(range(xdata[xsubset]))
+ p <- pretty(ylim,10)
+ p[p > ylim[1] & p < ylim[2]]
+ }
+
+ exp <- c(
+ # y-axis grid lines
+ expression(segments(1,y_grid_lines(ylim),NROW(xdata[xsubset]), y_grid_lines(ylim),
+ col=theme$grid)), # add y-axis grid lines
+ exp, # NOTE 'exp' was defined earlier
+ # 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)),
+ 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)),
+ # 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)))
+ cs$add(exp,env=c(lenv, cs$Env),expr=TRUE,no.update=TRUE)
}
-
- exp <- c(
- # y-axis grid lines
- expression(segments(1,y_grid_lines(ylim),NROW(xdata[xsubset]), y_grid_lines(ylim),
- col=theme$grid)), # add y-axis grid lines
- exp, # NOTE 'exp' was defined earlier
- # 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)),
- 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)),
- # 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)))
- cs$add(exp,env=c(lenv, cs$Env),expr=TRUE,no.update=TRUE)
}
} else {
cs$add(expression(chart.lines(R[xsubset], type=type)),expr=TRUE)
@@ -462,7 +466,6 @@
.index(x$Env$xdata[x$Env$xsubset]), tzone=indexTZ(x$Env$xdata)),ta)[subset.range]
ta.x <- as.numeric(na.approx(ta.adj[,1], rule=2) )
ta.y <- ta.adj[,-1]
- print(head(ta.y))
chart.lines(ta.y, colorset=col, type=type)
}
}
@@ -540,11 +543,11 @@
plot_object
} #}}}
-addReturns <- function(){
+addReturns <- function(type="l"){
# This just plots the raw returns data
lenv <- new.env()
lenv$name <- "Returns"
- lenv$plot_returns <- function(x) {
+ lenv$plot_returns <- function(x, type) {
xdata <- x$Env$xdata
xsubset <- x$Env$xsubset
# Add x-axis grid lines
@@ -553,21 +556,24 @@
axTicksByTime2(xdata[xsubset]),
par("usr")[4],
col=x$Env$theme$grid)
- chart.lines(xdata[xsubset])
+ chart.lines(xdata[xsubset], type=type)
}
- #mapply(function(name,value) { assign(name,value,envir=lenv) },
- # names(list(geometric=geometric,...)),
- # list(geometric=geometric,...))
+ mapply(function(name,value) { assign(name,value,envir=lenv) },
+ names(list(type=type)),
+ list(type=type))
exp <- parse(text=gsub("list","plot_returns",
- as.expression(substitute(list(x=current.xts_chob())))),
+ as.expression(substitute(list(x=current.xts_chob(),
+ type=type)))),
srcfile=NULL)
plot_object <- current.xts_chob()
+
xdata <- plot_object$Env$xdata
- #xsubset <- plot_object$Env$xsubset
lenv$xdata <- xdata
+ lenv$xsubset <- plot_object$Env$xsubset
lenv$col <- col
+ lenv$type <- type
# add the frame for time series info
plot_object$add_frame(ylim=c(0,1),asp=0.25)
Modified: pkg/xtsExtra/sandbox/test_plot2.R
===================================================================
--- pkg/xtsExtra/sandbox/test_plot2.R 2014-07-15 20:03:23 UTC (rev 815)
+++ pkg/xtsExtra/sandbox/test_plot2.R 2014-07-16 11:44:28 UTC (rev 816)
@@ -1,73 +1,48 @@
library(xtsExtra)
library(PerformanceAnalytics)
+source("sandbox/paFUN.R")
-
data(edhec)
-R <- edhec[,1:2]
+R <- edhec[,1:4]
-chart.TimeSeries(R)
+# basic plot with defaults
plot2_xts(R)
-charts.TimeSeries(R)
-# charts.TimeSeries messes up par("mar") so I need to call dev.off()
-dev.off()
-# the titles are gett
+# assign to a variable and then print it results in a plot
+x <- plot2_xts(R)
+class(x)
+x
+
+# small multiples, line plot of each column
plot2_xts(R, byColumn=TRUE)
-chart.Bar(R[,1])
+# bar chart of returns
plot2_xts(R[,1], type="h")
-charts.Bar(R)
-# charts.TimeSeries messes up par("mar") so I need to call dev.off() to reset
-dev.off()
+# bar chart of returns
+# NOTE: only plots the first column of returns data
+plot2_xts(R, type="h")
+
+# small multiples, bar chart of each column
plot2_xts(R, byColumn=TRUE, type="h")
-# Replicates charts.PerformanceSummary
+# Replicate charts.PerformanceSummary
plot2_xts(R, mainPanel=list(name="CumReturns"))
-addReturns()
+addReturns(type="h")
addDrawdowns()
-plot2_xts(R)
+# layout safe
+# layout(matrix(1:4, 2, 2))
+# for(i in 1:4) {plot(plot2_xts(R[,i], type="h"))}
+# layout(matrix(1))
+
+# Rolling performance
+plot2_xts(R, mainPanel=list(name="CumReturns"))
addRollingPerformance()
addRollingPerformance(FUN="StdDev.annualized")
addRollingPerformance(FUN="SharpeRatio.annualized")
-# The main title gets messed up when adding panels
-# plot2_xts(R)
-# x <- current.chob()
-# ls.str(x)
-# ls.str(x$Env)
-#
-# addDrawdowns()
-# addDrawdowns()
-# x <- current.chob()
-# ls.str(x)
-# ls.str(x$Env)
-#
-#
-# chart.TimeSeries(R, auto.grid=FALSE)
-# plot2_xts(R, auto.grid=FALSE)
-#
-#
-# charts.TimeSeries(R)
-# plot2_xts(R, byColumn=TRUE)
-# title("Edhec Returns")
-#
-# cl <- chartLayout(matrix(1:5), 1, c(2,2,1,1,1))
-# plot2_xts(R, byColumn=TRUE, layout=cl)
-# title("Edhec Returns")
-#
-# x <- current.chob()
-# Get the structure of the environments
-# ls.str(x)
-# ls.str(x$Env)
-
-# getSymbols("YHOO", src="yahoo")
-# chart_Series(YHOO)
-# add_RSI()
-# add_MACD()
-
##### 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?
@@ -81,11 +56,5 @@
# chart specifications
# - specifications for common charts (e.g. charts.PerformanceSummary)
-# what is he doing with frame and asp in chart_Series?
-# what are the following variables used for
-# frame
-# asp
-# clip
-
# http://www.lemnica.com/esotericR/Introducing-Closures/
More information about the Xts-commits
mailing list