Other R Functions

This page contains R code in blocks.  Reason it is being kept here is because site setup software does not allow the upload of R code as separate files.

plotForecastErrors

 #### below function from https://a-little-book-of-r-for-time-series.readthedocs.io/en/latest/src/timeseries.html
plotForecastErrors <- function(forecasterrors)
{
# make a histogram of the forecast errors:
  mybinsize <- IQR(forecasterrors)/4
  mysd <- sd(forecasterrors)
  mymin <- min(forecasterrors) - mysd*5
  mymax <- max(forecasterrors) + mysd*3
  # generate normally distributed data with mean 0 and standard deviation mysd
  mynorm <- rnorm(10000, mean=0, sd=mysd)
  mymin2 <- min(mynorm)
  mymax2 <- max(mynorm)
  if (mymin2 < mymin) { mymin <- mymin2 }
  if (mymax2 > mymax) { mymax <- mymax2 }
  # make a red histogram of the forecast errors, with the normally distributed data overlaid:
  mybins <- seq(mymin, mymax, mybinsize)
  hist(forecasterrors, col="red", freq=FALSE, breaks=mybins)
  # freq=FALSE ensures the area under the histogram = 1
  # generate normally distributed data with mean 0 and standard deviation mysd
  myhist <- hist(mynorm, plot=FALSE, breaks=mybins)
  # plot the normal curve as a blue line on top of the histogram of forecast errors:
  points(myhist$mids, myhist$density, type="l", col="blue", lwd=2)
} 

autoplot for forecasted data

autoplot.forecast <- function(fcast, ticker, startDate="2000-01-01",  ...){
  # data wrangling
  time <- attr(fcast$x, "tsp")
  time <- seq(time[1], attr(fcast$mean, "tsp")[2],  by=1/time[3])
  
  setMonths=seq(as.Date(startDate), by='months', length=length(time))
  
  lenx <- length(fcast$x)
  lenmn <- length(fcast$mean)
  xmin=time[1]; xmax=max(time)
  z <- list(...)
  if (any(names(z)=="xlim") ) { xmin = z$xlim[1]; xmax = z$xlim[2]   }
  
  dt1 = setMonths[xmin]
  dt2 = setMonths[xmax]
  
  df <- data.frame(time=setMonths,
                   x=c(fcast$x, fcast$mean),
                   fcast=c(rep(NA, lenx), fcast$mean),
                   low1=c(rep(NA, lenx), fcast$lower[, 1]),
                   upp1=c(rep(NA, lenx), fcast$upper[, 1]),
                   low2=c(rep(NA, lenx), fcast$lower[, 2]),
                   upp2=c(rep(NA, lenx), fcast$upper[, 2])
  )
  
  ggplot(df, aes(time, x)) +
    geom_ribbon(aes(ymin=low2, ymax=upp2), fill="red") +
    geom_ribbon(aes(ymin=low1, ymax=upp1), fill="yellow") +
    geom_line() +
    geom_line(data=df[!is.na(df$fcast), ], aes(time, fcast),
              color="blue", na.rm=TRUE) +
    xlim(dt1,dt2)  + 
    #scale_x_continuous("") +
    scale_y_continuous("") +
    labs(title=paste("Forecasts For ", ticker, "\n",  fcast$method), x="Date", y="Log Returns")
}

multiplot.r    In conjunction with ggplot can show multiple plots.  See the referenced website below for more detail

####   function  multiplot  ########

####   From http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_(ggplot2)/

###    multiplot  function for use with ggplot2 to plot multiple plots

# Multiple plot function
#   
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)
  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  numPlots = length(plots)
  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }
  if (numPlots==1) {
    print(plots[[1]])
  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}