Required Packages

library(TTR)
library(tseries)
library(quantmod)
library(data.table)

Import Fama/French factors Description Here

url = "http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_daily_CSV.zip"

download.file(url, "F-F_Research_Data_Factors_daily_CSV.zip")
unzip("F-F_Research_Data_Factors_daily_CSV.zip")
file.remove("F-F_Research_Data_Factors_daily_CSV.zip")
## [1] TRUE
f <- read.csv("F-F_Research_Data_Factors_daily.CSV", header=F, skip=3)

Get firm stock symbols from AMEX, NYSE, and NASDAQ exchanges

stocks = stockSymbols()
## Fetching AMEX symbols...
## Fetching NASDAQ symbols...
## Fetching NYSE symbols...
stocks = stocks[complete.cases(stocks),]
stocks = stocks[stocks$LastSale>=50,]

tickers=stocks$Symbol
tickers=sample(tickers, 50)

Compute daily returns

r=list()
for(i in 1:length(tickers)){
  r[[i]]=get.hist.quote(tickers[i], quote="AdjClose")
  r[[i]]=xts(r[[i]])
  r[[i]]=dailyReturn(r[[i]], type="log")
}

names(r)=tickers
r=do.call(merge, r)
colnames(r)=tickers
r=r["2016-01-31/"]

Apply uniformly distributed weights to portfolio stocks

r=replace(r, is.na(r), 0)
w= runif(50); w=w/sum(w)
r2=r%*%w
r2= xts(r2, order.by=index(r))
head(r2)
##                     [,1]
## 2016-02-01  4.735923e-04
## 2016-02-02 -1.794565e-02
## 2016-02-03 -8.434458e-05
## 2016-02-04  1.008249e-02
## 2016-02-05 -2.371525e-02
## 2016-02-08 -2.893307e-02
par(mfrow=c(2,1))
plot(r2, main="Portfolio Daily Returns Returns")
plot(cumsum(r2), main="Portfolio Cumulative Returns")

colnames(f) <- c("Date", "Mkt-Rf", "SMB", "HML", "Rf")
f <- f[-1,]
f[,1] <- as.Date(f[["Date"]], "%Y%m%d")
f <- na.exclude(f)
f1 <- xts(f,order.by=f[,"Date"])
f1 <- f1[,-1]
f1=f1["2016-01-31/"]
r2=r2[index(f1)]
plot.zoo(f1, main=NA)
mtext(text="Fama-French Factors from K. French",
      adj=0, outer=T, line=-2, cex=2)

fundXcess <- r2 - as.numeric(f1[,'Rf'])
ffReg <- lm(fundXcess~as.numeric(f1$SMB)
            +as.numeric(f1$HML)
            +as.numeric(f1$`Mkt-Rf`))
summary(ffReg)
## 
## Call:
## lm(formula = fundXcess ~ as.numeric(f1$SMB) + as.numeric(f1$HML) + 
##     as.numeric(f1$`Mkt-Rf`))
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.036076 -0.002676 -0.000140  0.002654  0.034786 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             -0.0025939  0.0002253 -11.511  < 2e-16 ***
## as.numeric(f1$SMB)       0.0032548  0.0004662   6.982 7.68e-12 ***
## as.numeric(f1$HML)      -0.0020218  0.0004434  -4.559 6.21e-06 ***
## as.numeric(f1$`Mkt-Rf`)  0.0095587  0.0003145  30.397  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.005533 on 605 degrees of freedom
## Multiple R-squared:  0.6468, Adjusted R-squared:  0.645 
## F-statistic: 369.3 on 3 and 605 DF,  p-value: < 2.2e-16
myplot <- plot(x=cumsum(r2), col="red", lwd=2, main="", ylim=c(-2.5, 2.5))
l1 <- lines(x=f1[,'Mkt-Rf'], col=3, lwd=1)
l2 <- lines(x=f1[,'SMB'], col=4, lwd=1)
addLegend("topright", legend.names = c("Cumul.Rtns", "Mkt-Rf", "SMB"),
          lty=1, col=c("red", 3, 4), cex=.8)

plot(as.ts(cumsum(f1[,'Mkt-Rf'])), main=NA, ylim=c(-1,50))
lines(as.ts(cumsum(f1[,"HML"])), col=3)
lines(as.ts(cumsum(f1[,'Rf'])), col=4)
lines(as.ts(cumsum(f1[,'SMB'])), col=6)
legend(0, 48, legend=c("Mkt-Rf", "HML", "Rf", "SMB"), 
       col=c("black", 3,4,6), lty=1)
mtext(text="Fama/French Factors from K. French", 
      adj=0, outer=T, line=-2, cex=1.5)