1. #redo analysis with some interactivity
  2. #original post is here
  3. #https://timelyportfolio.blogspot.com/2011/11/after-reading-fine-article-style.html
  4. #use Ken French momentum style indexes for style analysis
  5. #https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/6_Portfolios_ME_Prior_12_2.zip
  6. require(PerformanceAnalytics)
  7. require(FactorAnalytics)
  8. require(quantmod)
  9. my.url="https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/6_Portfolios_ME_Prior_12_2.zip"
  10. my.tempfile<-paste(tempdir(),"\frenchmomentum.zip",sep="")
  11. my.usefile<-paste(tempdir(),"\6_Portfolios_ME_Prior_12_2.txt",sep="")
  12. download.file(my.url, my.tempfile, method="auto",
  13. quiet = FALSE, mode = "wb",cacheOK = TRUE)
  14. unzip(my.tempfile,exdir=tempdir(),junkpath=TRUE)
  15. #read space delimited text file extracted from zip
  16. french_momentum <- read.table(file=my.usefile,
  17. header = TRUE, sep = "",
  18. as.is = TRUE,
  19. skip = 12, nrows=1038)
  20. colnames(french_momentum) <- c(paste("Small",
  21. colnames(french_momentum)[1:3],sep="."),
  22. paste("Large",colnames(french_momentum)[1:3],sep="."))
  23. #get dates ready for xts index
  24. datestoformat <- rownames(french_momentum)
  25. datestoformat <- paste(substr(datestoformat,1,4),
  26. substr(datestoformat,5,7),"01",sep="-")
  27. #get xts for analysis
  28. french_momentum_xts <- as.xts(french_momentum[,1:6],
  29. order.by=as.Date(datestoformat))
  30. french_momentum_xts <- french_momentum_xts/100
  31. #get price series from monthly returns
  32. french_price<-as.xts(
  33. apply(1+coredata(french_momentum_xts[,1:6]),MARGIN=2,cumprod),
  34. index(french_momentum_xts))
  35. #check data for reasonability
  36. plot.zoo(french_price,log="y")
  37. #for this example lets use Bill Millers fund
  38. getSymbols("LMVTX",from="1896-01-01", to=Sys.Date(), adjust=TRUE)
  39. LMVTX <- to.monthly(LMVTX)
  40. index(LMVTX) <- as.Date(format(as.Date(index(LMVTX)),"%Y-%m-01"))
  41. LMVTX.roc <- ROC(LMVTX[,4],type="discrete",n=1)
  42. perfComp <- na.omit(merge(LMVTX.roc,french_momentum_xts))
  43. fit.time <- fitTimeSeriesFactorModel(
  44. assets.names=colnames(perfComp[,1]),
  45. factors.names=colnames(perfComp[,-1]),
  46. data=perfComp,
  47. fit.method="DLS"
  48. )
  49. betasRolling <- rollapply(perfComp, width = 36, by.column=FALSE, by=1, FUN = function(x){
  50. fit.time <- fitTimeSeriesFactorModel(
  51. assets.names=colnames(x[,1]),
  52. factors.names=colnames(x[,-1]),
  53. data=x,
  54. fit.method="OLS"
  55. )
  56. return(fit.time$beta)
  57. })
  58. colnames(betasRolling) <- colnames(perfComp)[-1]
  59. require(reshape2)
  60. betasRolling.melt <- melt(data.frame(index(betasRolling),betasRolling),id.vars=1)
  61. colnames(betasRolling.melt) <- c("date", "factor", "beta")
  62. nBeta <- nPlot(
  63. beta ~ date,
  64. group = "factor",
  65. data = na.omit(betasRolling.melt),
  66. type = "lineChart"
  67. )
  68. #nBeta$chart(stacked = TRUE)
  69. nBeta$xAxis(tickFormat =
  70. "#!function(d) {return d3.time.format('%Y-%m-%d')(new Date(d * 24 * 60 * 60 * 1000));}!#"
  71. )
  72. nBeta