Permalink
Browse files

add

  • Loading branch information...
1 parent bf1280d commit 69a6493539a35fa7e45de221bf40686b0bfa7d42 @tavisrudd committed Mar 22, 2011
Showing with 93 additions and 0 deletions.
  1. +93 −0 lattice_timeseries_plots.R
View
@@ -0,0 +1,93 @@
+require(zoo)
+require(Cairo)
+require(lattice)
+#require(grid)
+require(timeDate)
+
+d <- read.csv("/home/tavis/r_workspace/unit_stats_by_day.csv")
+order.stats <- zoo(base::cbind(d[2:47]), as.Date(d$day))
+
+## http://stackoverflow.com/questions/1169376/cumulative-sums-moving-averages-and-sql-group-by-equivalents-in-r
+get.weeks <- function(x) {7 * ceiling(as.numeric(x-1)/7) + as.Date(3)}
+get.months <- function(x) {as.Date(as.yearmon(x))}
+get.qtrs <- function(x) {as.Date(as.yearqtr(x))}
+
+by.bizday <- function(data) {
+ days <- time(data)
+ data[isBizday(as.timeDate(days), holidays=holidayNYSE(2006:2010))]
+}
+by.week <- function(data) aggregate(data, get.weeks, sum)
+by.month <- function(data) aggregate(data, get.months, sum)
+by.qtr <- function(data) aggregate(data, get.qtrs, sum)
+
+order.stats.by.bizday <- by.bizday(order.stats)
+order.stats.by.week <- by.week(order.stats)
+order.stats.by.month <- by.month(order.stats)
+order.stats.by.qtr <- by.qtr(order.stats)
+
+################################################################################
+#subset.cols <- c('orders', 'units', 'sales')
+subset.cols <- c('units', 'PFM', 'CAST_PARTIALS', 'CAPTEK')
+
+days <- time(order.stats)
+monthboundaries <- seq(as.Date(as.yearmon(min(days))),
+ max(days)+6,
+ "months")
+yearboundaries <- seq(as.Date(format(min(days),"%Y-01-01")),
+ max(days)+6,
+ "years")
+jan <- format(monthboundaries, "%m") == "01"
+monthticks <- monthboundaries[!jan]
+mlab <- substr(months(monthticks), 1, 1)
+
+plot.volume.ts <- function(data=by.week(order.stats[, subset.cols]),
+ type="S",
+ show.trend=TRUE,
+ trend.span=1/10) {
+ xyplot(data,
+ plot.type = "multiple",
+ type=type,
+ lwd=.3,
+ main="Unit Volume By Product Type",
+ ylab="Units",
+ xlab="Month/Year",
+ between=list(y=.5),
+ transparent=TRUE,
+ xscale.components=function(...) {
+ ans <- xscale.components.default(...)
+ ans$top <- TRUE
+ ans
+ },
+ panel=function(x,y, ...) {
+ panel.axis("bottom",
+ check.overlap=TRUE,
+ outside=FALSE,
+ half=FALSE,
+ rot=0,
+ labels=mlab,
+ tck=.1,
+ at=monthticks,
+ text.col="grey",
+ )
+ panel.grid(v=0)
+ panel.abline(v=monthticks,
+ col="grey",
+ lwd=.2,
+ lty=1)
+ panel.abline(v=yearboundaries,
+ col="black",
+ lwd=.5,
+ lty=1)
+ panel.plot.default(x,y,...)
+ if (show.trend) {
+ panel.loess(x,y, span=trend.span, col="red")
+ }
+ })
+}
+
+if (0 && dev.cur()==1) {
+ ##CairoX11()
+ CairoPNG(filename='/tmp/test.png', width=800, height=600)
+}
+
+plot.volume.ts()

0 comments on commit 69a6493

Please sign in to comment.