Stocks: Exploring leveraged investing with quantmod and R

Loading data with quantmod

We get our data from Yahoo Finance and calculate what would be the cumulated daily return of ETFs leveraged n times. Data for each year is then stored in a separate data frame. This could probably be done in a much leaner way, but until then, I’ll be ok with the for loop solution.

years    <- 2008:2017 
dfList   <- list() # empty list for storing a data frame for each year

for (year in years){
  
  getSymbols(c("^GSPC"),from=paste0(year,"-01-01"),to=paste0(year,"-12-31"),src="yahoo",class=ts)
  x1 = data.frame(cumsum(dailyReturn(GSPC)))
  df = data.frame(date=as.Date(row.names(x1)),x1,
                  x1*3,
                  x1*5,
                  x1*10,
                  x1*15,
                  x1*20)
  names(df) = c("date","x1","x3","x5","x10","x15","x20")
  df = melt(df,id="date")
  dfList[[year]] = df
}

Plotting the data

data.table’s rbindlist function is a very fast and easy way of concatenating a list of data frames. We add year and day number (aka julian day) variables based on dates.

dfConcat      <- rbindlist(dfList)
dfConcat$year <- year(dfConcat$date)
dfConcat$Day  <- yday(dfConcat$date) #julian day

Before creating the plot, we’ll customize some plot settings that we can use for all our plots.

my_theme <- function() {
    theme_bw() +
    theme(panel.background   = element_blank(),
          plot.background    = element_rect(fill = "grey13"),
          panel.border       = element_blank(),                     # facet border
          strip.background   = element_blank(),                     # facet title background
          plot.margin        = unit(c(.5, .5, .5, .5), "cm"),
          text               = element_text(colour = "snow", size = 20),
          axis.text          = element_text(colour = "snow", size = 15),
          plot.title         = element_text(colour = "snow"),
          strip.text.x       = element_text(colour = "snow", face = "bold"),
          panel.spacing      = unit(3, "lines"),
          panel.grid.major   = element_line(colour = "black"),
          panel.grid.minor   = element_line(colour = "black"),
          panel.grid.major.x = element_blank(),
          panel.grid.minor.x = element_blank(),
          legend.background  = element_blank(),
          legend.key         = element_blank(),
          legend.title       = element_blank(),
          legend.position    = c(0.9,0.08))
}

ggplot(dfConcat, aes(x=Day,y=value)) + 
  geom_line(aes(colour = variable)) +
  facet_wrap(~year,ncol=3) +
  my_theme() +
  scale_color_viridis_d(option="C",begin = .2)

Bar charts of annual return

If we’re only interested in the annual return, bar charts are easier to inspect. We can use the ddply function to extract the last row of each year.

annReturn <- ddply(dfConcat, .(variable,year), function(x) x[nrow(x), ])

annReturn %>% ggplot(aes(x=variable,y=value)) +
  geom_bar(stat="identity",aes(fill=variable)) +
  facet_wrap(~year,ncol=3) +
  my_theme() +
  scale_fill_viridis_d(option="C",begin = .2) +
  labs(x = "x leverage", y = "return")

Checking the validity of the method

To check whether our method is reliable, we can scale and compare the original data with data generated by our method for calculating leveraged daily returns.

df <- data.frame(GSPC[,6], cumsum(dailyReturn(GSPC)))
df <- data.frame(date = as.Date(row.names(df)), scale(df))

df %>% 
  ggplot() +
  geom_line(data = df, aes(x = date, y = GSPC.Adjusted, colour = "yellow"), size = 1) +
  geom_line(data = df, aes(x = date, y = daily.returns, colour = "snow"), size = 1) +
  my_theme() +
  theme(legend.position = "top") +
  labs(y = "value") +
  scale_colour_manual(name = 'the colour', 
         values =c('yellow'='yellow','snow'='snow'), labels = c('GSPC.Adjusted   ','daily.returns'))

Luckily, the figure indicates that the data generated by our method is pretty much perfectly correlated with the actual daily return of the SP500.

Plotting a random selection of simulations

Let’s plot some of the simulated data to see if they resemble actual stock price movements.

set.seed(3235)

dfListRandPlot <- list()
pickedDFs      <- sample(1:1000,6)

for (i in pickedDFs){
  
  melted     = melt(dfListRand[[i]],id="days")
  melted$Sim = factor(paste0("Simulation ",i))
  dfListRandPlot[[i]] = melted
}

dfConcatRandPick = rbindlist(dfListRandPlot)

ggplot(dfConcatRandPick, aes(x=days,y=value)) +
  geom_line(aes(colour = variable)) +
  facet_wrap(~Sim,ncol=3) +
  my_theme() +
  theme(legend.position = "top") +
  scale_colour_viridis_d(option="C",begin = .2)

Mean annual returns

We can also make a bar chart illustrating the mean annual returns of all simulations with error bars showing standard deviations.

df <- data.frame()

for (i in dfListRand){
  
  df = rbind(df,i[256,])
}

dfLong = melt(df[,-1])

dfAgg = ddply(dfLong, c("variable"), summarise,
               mean=mean(value),sd=sd(value))

ggplot(dfAgg, aes(x=variable, y=mean,fill=variable)) + 
  geom_bar(position=position_dodge(),stat="identity") +
  geom_errorbar(aes(ymin=mean-sd, ymax=mean+sd), colour = "gray54", width=.2,
                position=position_dodge(.9)) +
  my_theme() +
  theme(legend.position = "top") +
  scale_fill_viridis_d(option="C",begin = .2) +
  labs(x = "x leverage")

Line charts for each year

dfConcat3      <- rbindlist(dfListETFs)
dfConcat3$year <- year(dfConcat3$date)
dfConcat3$Day  <- yday(dfConcat3$date) #julian day
ggplot(dfConcat3, aes(x=Day,y=value)) + 
  geom_line(aes(colour = variable)) +
  facet_wrap(~year,ncol=3) +
  my_theme() +
  scale_colour_viridis_d(option = "C", begin = .4)

dfConcatWide <- spread(dfConcat3, variable, value)
cor(dfConcatWide[,4:7])

##           SP500      UPRO      SPXL        X3
## SP500 1.0000000 0.9864571 0.9865866 1.0000000
## UPRO  0.9864571 1.0000000 0.9992977 0.9864571
## SPXL  0.9865866 0.9992977 1.0000000 0.9865866
## X3    1.0000000 0.9864571 0.9865866 1.0000000

Annual return

annReturn <- ddply(dfConcat3, .(variable,year), function(x) x[nrow(x), ])
annReturnBars <- ggplot(annReturn,aes(x=variable,y=value)) +
  geom_bar(stat="identity",aes(fill=variable))+
  facet_wrap(~year,ncol=2) +
  my_theme() +
  scale_fill_viridis_d(option = "C", begin = .2) +
  theme(legend.position = "right")

annReturnBars

It appears that both UPRO and SPXL track the S&P 500 quite well.