french global factors.r

#get very helpful Ken French data
#for this project we will look at Global Factors
#http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/Global_Factors.zip

require(PerformanceAnalytics)
require(quantmod)
require(RColorBrewer)


#my.url will be the location of the zip file with the data
my.url="http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/Global_Factors.zip"
#this will be the temp file set up for the zip file
my.tempfile<-paste(tempdir(),"\\frenchfactors.zip",sep="")
#my.usefile is the name of the txt file with the data
my.usefile<-paste(tempdir(),"\\Global_Factors.txt",sep="")
download.file(my.url, my.tempfile, method="auto", 
              quiet = FALSE, mode = "wb",cacheOK = TRUE)
unzip(my.tempfile,exdir=tempdir(),junkpath=TRUE)
#read space delimited text file extracted from zip
french_factor <- read.table(file=my.usefile,
                              header = TRUE, sep = "",
                              as.is = TRUE,
                              skip = 6, nrows=261)

#get dates ready for xts index
datestoformat <- rownames(french_factor)
datestoformat <- paste(substr(datestoformat,1,4),
                       substr(datestoformat,5,7),"01",sep="-")

#get xts for analysis
french_factor_xts <- as.xts(french_factor[,1:NCOL(french_factor)],
                              order.by=as.Date(datestoformat))

french_factor_xts <- french_factor_xts/100
#replace -0.9999 which means data does not exist
#know there is a better method to index, but can't find my easy approach
french_factor_xts[which(french_factor_xts < -0.99,arr.ind=TRUE)[,1],
                  unique(which(french_factor_xts < -0.99,arr.ind=TRUE)[,2])] <- 0

colnames(french_factor_xts) <- c("market","size","value","momentum","tbill")

chart.Correlation(french_factor_xts, main="Correlation of Ken French Global Market Factors")
mtext("Source: Kenneth French Data Library http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/Data_Library",
      side=1,line=4,cex=0.5, col="blue",adj=0) 

chart.RollingCorrelation(french_factor_xts[,2:5],french_factor_xts[,1],
                         legend.loc="topleft",width=36,lwd=3,
                         main="Global Factor Rolling Correlation (3 Years)",
                         colorset=c("darkseagreen4","slateblue3","deepskyblue3","tan4"))
mtext("Source: Kenneth French Data Library http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/Data_Library",
      side=1,line=2.25,cex=0.5, col="blue",adj=0) 

require(FactorAnalytics)
chart.RollingStyle(french_factor_xts[,1],french_factor_xts[,2:NCOL(french_factor_xts)],
                   width=12,
                   colorset=c("darkseagreen3","slateblue2","deepskyblue2","tan1"),
                   main="Global Market Rolling 1y French Factor Weights")
mtext("Source: Kenneth French Data Library http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/Data_Library",
      side=1,line=1,cex=0.5, col="blue",adj=0)

chart.Boxplot(french_factor_xts,main="Global Factors Return Distribution",
              sort.by="",mean.symbol=19,symbol.color=c("gray60","darkseagreen4","slateblue3","deepskyblue3","tan3"),
              colorset=c("gray60","darkseagreen4","slateblue3","deepskyblue3","tan3"))
mtext("Source: Kenneth French Data Library http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/Data_Library",
      side=1,cex=0.5, col="blue")

require(fPortfolio)
mycolors = c("gray60","darkseagreen4","slateblue3","deepskyblue3","tan4")
frontier <- portfolioFrontier(as.timeSeries(french_factor_xts))


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 frontier points
#this method gives us much better control than frontierPlot
plot(ans,xlim=c(min(ans[,1]),max(ans[,1])+.01),ylim=c(0,0.0075),type="l",lwd=2, xlab=NA,ylab=NA)
minvariancePoints(frontier,pch=19,col="red")
tangencyPoints(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")
#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)
#title(main="Efficient Frontier Small and Mid Since 1984")

#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="Efficient Frontier 2000-October 2011",xlab="Risk(cov)",ylab="Monthly Return")

title(main="Efficient Frontier of French Global Factors",xlab="Risk(cov)",ylab="Monthly Return")
mtext("Source: Kenneth French Data Library http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/Data_Library",
      side=1,cex=0.5, col="blue",adj=0)

weightsPlot(frontier,col=mycolors)
mtext("Source: Kenneth French Data Library http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/Data_Library",
      side=1,cex=0.5, col="blue",adj=0)