Additional Plots on French Breakpoints as Valuation

[This article was first published on Timely Portfolio, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

I feel like there might be some merit in Slightly Different Measure of Valuation using Ken French’s Market(ME) to Book(BE) Breakpoints by percentile to offer an additional valuation metric for US stocks.  I thought some additional plots might help me flesh out the concept.  This plot struck me as particularly helpful.

From TimelyPortfolio

In the next iteration, I hope to add a look at prospective drawdown or returns.  However, I struggle since the last 30 years all have basically exhibited historical overvaluation.  Since 1926, no period of overvaluation has lasted longer than 14 years except the last 30.

Thanks to the post from http://timotheepoisot.fr/2013/02/17/stacked-barcharts/ which helped me use much more appealing colors than the default lattice set.


R code from GIST:

require(latticeExtra)
require(Hmisc)
require(reshape2)
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="")
#kind of normalize data by dividing each percentile by the percentile mean
BE_ME.adj <- BE_ME/matrix(rep(apply(BE_ME,MARGIN=2,FUN=mean),times=NROW(BE_ME)),
ncol=NCOL(BE_ME),byrow=TRUE)-1
BE_ME.adj.df <- as.data.frame(cbind(as.numeric(format(as.Date(index(BE_ME.adj)),"%Y")),coredata(BE_ME.adj)))
BE_ME.adj.melt <- melt(BE_ME.adj.df,id.vars=1)
#add column for the decade so we can use in plots
BE_ME.adj.melt[,4] <- paste(substr(BE_ME.adj.melt[,1],1,3),"0",sep="")
colnames(BE_ME.adj.melt) <- c("Year","Pctile","value","Decade")
#good way to get decent colors
#stole from http://timotheepoisot.fr/2013/02/17/stacked-barcharts/
pal = colorRampPalette(brewer.pal(5,'Paired'))(20)
p1<-Ecdf(~value|Decade,groups=Year%%10,col=pal[seq(1,20,by=2)],data=BE_ME.adj.melt, #data=BE_ME.adj.melt[which(BE_ME.adj.melt[,"Year"] %% 2 == 0),],
label.curves=TRUE,
layout=c(1,10),
strip=FALSE,strip.left=strip.custom(bg="grey70"),
scales=list(x=list(tck=c(1,0)),y=list(alternating=0,tck=c(0,0))),
ylab=NULL,
xlab="BE_ME/percentile mean",
main=" ") +
layer(panel.abline(v=0, col="grey50"))
p2<-
dotplot(factor(Year)~value|Decade,col=pal[seq(1,20,by=2)],data=BE_ME.adj.melt, #data=BE_ME.adj.melt[which(BE_ME.adj.melt[,"Year"] %% 2 == 0),],
pch=19,
cex=0.6,
strip=FALSE,strip.left=strip.custom(bg="grey70"),
scales=list(x=list(tck=c(1,0)),y=list(relation="free",draw=FALSE)),
layout=c(1,10),
xlab="BE_ME/percentile mean",
main="Kenneth French BE_ME Percentile Breakpoints") +
layer(panel.abline(v=0, col="grey50")) #+
#layer(panel.abline(v=0.25, col="darkolivegreen4")) +
#layer(panel.abline(v=-0.25, col="indianred4"))
#side by side
print(p2,position=c(0,0.015,0.5,1),more=TRUE)
print(p1,position=c(0.45,0.015,1,1))
grid.text("Dot Plot by Year by Decade",x=unit(0.1,"npc"),y=unit(0.96,"npc"),hjust=0)
grid.text("Cumulative Density by Year by Decade",x=unit(0.55,"npc"),y=unit(0.96,"npc"),hjust=0)

To leave a comment for the author, please follow the link and comment on their blog: Timely Portfolio.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)