R finance charts with the svgPanZoom htmlwidget

code.R

# some finance with the svgPanZoom htmlwidget

library(quantmod)
library(fPortfolio)
library(PerformanceAnalytics)
library(svgPanZoom)
library(SVGAnnotation)
library(pipeR)

funds = list(
  "VFINX"
  ,"VEXAX"
  ,"VBMFX"
  ,"VWIGX"
  ,"VTRIX"
  ,"VEIEX"
)

funds  %>>%
  lapply(
    function(x){getSymbols(x,from="1900-01-01",auto.assign=F)}[,6]
  ) %>>%
  ( do.call( merge, . ) ) %>>%
  na.omit %>>%
  ( ~ prices ) %>>%
  ( ./lag(.,k=1) - 1 ) -> returns
# change the column names to the tickers
colnames(prices) <- colnames(returns) <-  unlist(funds)
# set the first to 0
returns[1,] <- 0

# now let's do an efficient frontier using fPortfolio
svgPanZoom(
  svgPlot(
    {
      # some colors thanks to RColorBrewer
      mycolors = RColorBrewer::brewer.pal(9,"Set1")[-6]
      
      frontier <- portfolioFrontier(as.timeSeries(returns))
      
      pointsFrontier = frontierPoints(frontier, frontier = "both", auto=TRUE)
      targetRisk = getTargetRisk(frontier@portfolio)[,1]
      targetReturn = getTargetReturn(frontier@portfolio)[,1]
      ans = cbind(Risk = targetRisk, Return = targetReturn)
      
      colnames(ans) = c("targetRisk", "targetReturn")
      rownames(ans) = as.character(1:NROW(ans))
      
      plot(
        ans
        ,type="l"
        ,lwd=2
        ,lty=3
        ,xlab=NA
        ,ylab=NA
        ,bty="L"
      )
      
      minvariancePoints(frontier,pch=19,col="red")
      tangencyPoints(frontier,pch=19,col="blue")
      #tangencyLines(frontier,pch=19,col="blue")
      equalWeightsPoints(frontier,pch=15,col="grey")
      singleAssetPoints(frontier,pch=19,cex=1.5,col=mycolors)
      twoAssetsLines(frontier,lty=3,col="grey")
      #sharpeRatioLines(frontier,col="orange",lwd=2)
      #legend("topleft",legend=colnames(portfolio.xts),pch=19,col=mycolors,
      #	cex=0.65)
      
      #label assets
      stats <- getStatistics(frontier)
      text(y=stats$mean,x=sqrt(diag(stats$Cov)),labels=names(stats$mean),pos=4,col=mycolors,cex=0.7)
      
      #set up function from equalWeightsPoints to also label the point
      equalLabel <- function (object, return = c("mean", "mu"), risk = c("Cov", "Sigma", 
                                                                         "CVaR", "VaR"), auto = TRUE, ...) 
      {
        return = match.arg(return)
        risk = match.arg(risk)
        data = getSeries(object)
        spec = getSpec(object)
        constraints = getConstraints(object)
        numberOfAssets = getNAssets(object)
        setWeights(spec) = rep(1/numberOfAssets, times = numberOfAssets)
        ewPortfolio = feasiblePortfolio(data, spec, constraints)
        assets = frontierPoints(ewPortfolio, return = return, risk = risk, 
                                auto = auto)
        text(assets, labels = "Equal-Weight", pos=4,...)
        invisible(assets)
      }
      equalLabel(frontier,cex=0.7,col="grey")
      
      
      title(main=paste0(
        "Efficient Frontier Vanguard Funds "
        , format(head(index(returns),1), "%Y")
        ," to "
        , format(tail(index(returns),1), "%Y")
      ))    
    }
    , height = 10
    , width = 16
  )
)

#  now let's svgPanZoom one of my favorite charts
#   from PerformanceAnalytics
svgPanZoom(
  svgPlot({
    returns %>>%
      (cumprod( 1 + . )) %>>%
      (.[endpoints(.,"months")]) %>>%
      ( ./lag(.,k=1) - 1 ) %>>%
      chart.SnailTrail(
        colorset = RColorBrewer::brewer.pal(9,"Set1")[-6]
        ,add.names="none"
        ,width = 36
        ,step = 36
        ,legend.loc = "topright"
      )
  },height= 10, width = 16)
)