spx_skew_heatmap.R

library(Quandl)

## Warning: package 'Quandl' was built under R version 3.2.5

## Loading required package: xts

## Loading required package: zoo

## Warning: package 'zoo' was built under R version 3.2.5

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

library(fTrading)

## Loading required package: timeDate

## Loading required package: timeSeries

## 
## Attaching package: 'timeSeries'

## The following object is masked from 'package:zoo':
## 
##     time<-

## Loading required package: fBasics

## 

## Rmetrics Package fBasics

## Analysing Markets and calculating Basic Statistics

## Copyright (C) 2005-2014 Rmetrics Association Zurich

## Educational Software for Financial Engineering and Computational Science

## Rmetrics is free software and comes with ABSOLUTELY NO WARRANTY.

## https://www.rmetrics.org --- Mail to: info@rmetrics.org

library(quantmod)

## Loading required package: TTR

## Warning: package 'TTR' was built under R version 3.2.4

## 
## Attaching package: 'TTR'

## The following object is masked from 'package:fTrading':
## 
##     SMA

## The following object is masked from 'package:fBasics':
## 
##     volatility

## Version 0.4-0 included new data defaults. See ?getSymbols.

library(TTR)
library(colorspace)
library(dygraphs)

## Warning: package 'dygraphs' was built under R version 3.2.5

calendarHeatMap <- function( rets, calColor = colo ) {
  
  require(quantmod)
  require(ggplot2)
  require(reshape2)
  require(plyr)
  require(scales)
  
  # Make a dataframe
  dat<-data.frame(date=index(rets),rets)
  
  # We will facet by year ~ month, and each subgraph will
  # show week-of-month versus weekday
  # the year is simple
  dat$year<-as.numeric(as.POSIXlt(dat$date)$year+1900)
  
  # the month too 
  dat$month<-as.numeric(as.POSIXlt(dat$date)$mon+1)
  
  # but turn months into ordered facors to control the appearance/ordering in the presentation
  dat$monthf<-factor(dat$month,levels=as.character(1:12),labels=c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"),ordered=TRUE)
  
  # the day of week is again easily found
  dat$weekday = as.POSIXlt(dat$date)$wday
  
  # again turn into factors to control appearance/abbreviation and ordering
  
  # I use the reverse function rev here to order the week top down in the graph
  # you can cut it out to reverse week order
  dat$weekdayf<-factor(dat$weekday,levels=rev(1:7),labels=rev(c("Mon","Tue","Wed","Thu","Fri","Sat","Sun")),ordered=TRUE)
  
  # the monthweek part is a bit trickier 
  # first a factor which cuts the data into month chunks
  dat$yearmonth<-as.yearmon(dat$date)
  dat$yearmonthf<-factor(dat$yearmonth)
  
  # then find the "week of year" for each day
  dat$week <- as.numeric(format(dat$date,"%W"))
  
  # and now for each monthblock we normalize the week to start at 1 
  dat<-ddply(dat,.(yearmonthf),transform,monthweek=1+week-min(week))
  
  # Now for the plot
  Skew = rets
  P<- ggplot(dat, aes(monthweek, weekdayf, fill = Skew)) + 
    geom_tile(colour = "white") + facet_grid(year~monthf) + scale_fill_gradientn(colours = calColor) + ggtitle("S&P500 Skew Heatmap") +  xlab("Week of Month") + ylab("")
  P
  
}


# include my Auth Token for Quandl.  Only needed to pull down 50 or more underlyings a day.
Quandl.api_key("xST9rqFZxHwPFtzmmAbf")

skew <- Quandl("CBOE/SKEW", api_key="xST9rqFZxHwPFtzmmAbf",type="xts")

mahColorz = rev(rainbow(6,1))

calendarHeatMap(window(skew, start = as.Date("2010-01-01")), mahColorz)

## Loading required package: ggplot2

## Warning: package 'ggplot2' was built under R version 3.2.4

## Loading required package: reshape2

## Loading required package: plyr

## Loading required package: scales

skew.ts <- apply.weekly(skew,mean)
skew.sma10w <- SMA(skew.ts,10)
p.data <- na.omit(c(skew.ts,skew.sma10w))
dygraph(p.data, main = "SP500 Skew") %>% dyOptions(stackedGraph = TRUE) %>% dyRangeSelector()