Last active
December 11, 2015 05:08
-
-
Save timelyportfolio/4550147 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
require(latticeExtra) | |
require(xts) | |
loadfrench <- function(zipfile, txtfile, skip, nrows) { | |
#my.url will be the location of the zip file with the data | |
my.url=paste("http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/",zipfile,".zip",sep="") | |
#this will be the temp file set up for the zip file | |
my.tempfile<-paste(tempdir(),"\\frenchzip.zip",sep="") | |
#my.usefile is the name of the txt file with the data | |
my.usefile<-paste(tempdir(),"\\",txtfile,".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 <- read.table(file=my.usefile, | |
header = FALSE, sep = "", fill=TRUE, #add fill = true to handle bad data | |
as.is = FALSE , | |
skip = skip, nrows=nrows) | |
#get dates ready for xts index | |
datestoformat <- french[,1] | |
datestoformat <- paste(substr(datestoformat,1,4), | |
"12","31",sep="-") | |
#get xts for analysis | |
#unfortunately the last percentile in 1942 is not separated by a space so we will delete last two columns | |
french_xts <- as.xts(french[,1:(NCOL(french)-2)], | |
order.by=as.Date(datestoformat)) | |
#delete missing data which is denoted by -0.9999 | |
french_xts[which(french_xts < -0.99,arr.ind=TRUE)[,1], | |
unique(which(french_xts < -0.99,arr.ind=TRUE)[,2])] <- 0 | |
#divide by 100 to get percent | |
french_xts <- french_xts/100 | |
return(french_xts) | |
} | |
filenames <- c("BE-ME_Breakpoints") | |
BE_ME = loadfrench(zipfile=filenames[1],txtfile=filenames[1],skip=3,nrows=87) | |
#first column is year which we can remove | |
#columns 2 and 3 are counts for positive and negative which we will remove | |
BE_ME = BE_ME[,4:NCOL(BE_ME)] | |
colnames(BE_ME) <- paste(5*0:(NCOL(BE_ME)-1),"pctile",sep="") | |
#do horizon plot of absolute BE_ME breakpoints | |
horizonplot(BE_ME, | |
layout=c(1,NCOL(BE_ME)), | |
strip.left=FALSE, | |
xlab = NULL, | |
ylab = list(rev(colnames(BE_ME)), rot = 0, cex = 0.7), | |
scales = list(x=list(tck=c(1,0))), | |
main="Analysis of Historical BE_ME Breakpoints \n(data courtesy http://mba.tuck.dartmouth.edu/pages/faculty/ken.french)") | |
#do horizon plot of relative to historical mean breakpoints | |
horizonplot(BE_ME/matrix(rep(apply(BE_ME,MARGIN=2,FUN=mean),times=NROW(BE_ME)),ncol=NCOL(BE_ME),byrow=TRUE)-1, | |
layout=c(1,NCOL(BE_ME)), | |
horizonscale=0.25, | |
origin = 0, | |
scales = list(y = list(relation = "same"), x=list(tck=c(1,0))), | |
strip.left=FALSE, | |
xlab = NULL, | |
ylab = list(rev(colnames(BE_ME)), rot = 0, cex = 0.7), | |
main="Analysis of Historical BE_ME Breakpoints - Mean \n(data courtesy http://mba.tuck.dartmouth.edu/pages/faculty/ken.french)") | |
require(RColorBrewer) | |
xyplot(BE_ME,col=c(brewer.pal(9,"Reds"),brewer.pal(9,"Blues")), | |
screens=1, | |
scales = list(x=list(tck=c(1,0))), | |
xlab = NULL, | |
ylab = "ME-BE Breakpoints", | |
main="Analysis of Historical BE_ME Breakpoints\n(data courtesy http://mba.tuck.dartmouth.edu/pages/faculty/ken.french)") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment