[Returnanalytics-commits] r2694 - in pkg/FactorAnalytics: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 2 01:13:26 CEST 2013
Author: chenyian
Date: 2013-08-02 01:13:25 +0200 (Fri, 02 Aug 2013)
New Revision: 2694
Modified:
pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R
pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd
Log:
add up/down beta and quadratic term option in fitTimeSeriesFactorModel.R
Modified: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-08-01 23:08:53 UTC (rev 2693)
+++ pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-08-01 23:13:25 UTC (rev 2694)
@@ -1,8 +1,12 @@
#' Fit time series factor model by time series regression techniques.
#'
-#' Fit time series factor model by time series regression techniques. It
+#' @description Fit time series factor model by time series regression techniques. It
#' creates the class of "TimeSeriesFactorModel".
#'
+#' @details add.up.market.returns adds a max(0,Rm-Rf) term in the regression as suggested by
+#' Merton-Henriksson Model (1981) to measure market timing. The coefficient can be interpreted as
+#' number of free put options.
+#'
#' If \code{Robust} is chosen, there is no subsets but all factors will be
#' used. Cp is defined in
#' http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf. p17.
@@ -10,8 +14,8 @@
#' @param assets.names names of assets returns.
#' @param factors.names names of factors returns.
#' @param num.factor.subset scalar. Number of factors selected by all subsets.
-#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object with asset returns
-#' and factors retunrs rownames
+#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object with \code{assets.names}
+#' and \code{factors.names} or \code{excess.market.returns.name} if necassary.
#' @param fit.method "OLS" is ordinary least squares method, "DLS" is
#' discounted least squares method. Discounted least squares (DLS) estimation
#' is weighted least squares estimation with exponentially declining weights
@@ -32,24 +36,38 @@
#' in all models.
#' @param subsets.method control option for all subsets. se exhaustive search,
#' forward selection, backward selection or sequential replacement to search.
-#' @param lars.criteria either choose minimum "Cp": unbiased estimator of the
+#' @param lars.criteria either choose minimum "cp": unbiased estimator of the
#' true rist or "cv" 10 folds cross-validation. Default is "Cp". See detail.
+#' @param add.up.market.returns Logical. If \code{TRUE}, max(0,Rm-Rf) will be added as a regressor.
+#' Default is \code{FALSE}. \code{excess.market.returns.nam} is required if \code{TRUE}. See Detail.
+#' @param add.quadratic.term Logical. If \code{TRUE}, (Rm-Rf)^2 will be added as a regressor.
+#' \code{excess.market.returns.name} is required if \code{TRUE}. Default is \code{FALSE}.
+#' @param excess.market.returns.name colnames
+#' market returns minus risk free rate. (Rm-Rf).
#' @return an S3 object containing
#' \itemize{
-#' \item{asset.fit}{Fit objects for each asset. This is the class "lm" for
+#' \item{asset.fit} {Fit objects for each asset. This is the class "lm" for
#' each object.}
-#' \item{alpha}{N x 1 Vector of estimated alphas.}
-#' \item{beta}{N x K Matrix of estimated betas.}
-#' \item{r2}{N x 1 Vector of R-square values.}
-#' \item{resid.variance}{N x 1 Vector of residual variances.}
-#' \item{call}{function call.}
+#' \item{alpha} {N x 1 Vector of estimated alphas.}
+#' \item{beta} {N x K Matrix of estimated betas.}
+#' \item{r2} {N x 1 Vector of R-square values.}
+#' \item{resid.variance} {N x 1 Vector of residual variances.}
+#' \item{call} {function call.}
#' }
+#'
+#'
+#' interpreted as number
#' @author Eric Zivot and Yi-An Chen.
-#' @references 1. Efron, Hastie, Johnstone and Tibshirani (2002) "Least Angle
+#' @references
+#' \enumerate{
+#' \item Efron, Hastie, Johnstone and Tibshirani (2002) "Least Angle
#' Regression" (with discussion) Annals of Statistics; see also
-#' http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf. 2.
-#' Hastie, Tibshirani and Friedman (2008) Elements of Statistical Learning 2nd
+#' http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf.
+#' \item Hastie, Tibshirani and Friedman (2008) Elements of Statistical Learning 2nd
#' edition, Springer, NY.
+#' \item Christopherson, Carino and Ferson (2009). Portfolio Performance Measurement
+#' and Benchmarking, McGraw Hill.
+#' }
#' @examples
#' \dontrun{
#' # load data from the database
@@ -72,7 +90,8 @@
variable.selection="none",
decay.factor = 0.95,nvmax=8,force.in=NULL,
subsets.method = c("exhaustive", "backward", "forward", "seqrep"),
- lars.criteria = "Cp") {
+ lars.criteria = "Cp",add.up.market.returns = FALSE,add.quadratic.term = FALSE,
+ excess.market.returns.name ) {
require(PerformanceAnalytics)
require(leaps)
@@ -84,7 +103,9 @@
# convert data into xts and hereafter compute in xts
data.xts <- checkData(data)
reg.xts <- merge(data.xts[,assets.names],data.xts[,factors.names])
-
+ if (add.up.market.returns == TRUE || add.quadratic.term == TRUE ) {
+ reg.xts <- merge(reg.xts,data.xts[,excess.market.returns.name])
+ }
# initialize list object to hold regression objects
reg.list = list()
@@ -93,17 +114,38 @@
# residual variances, and R-square values from
# fitted factor models
-Alphas = ResidVars = R2values = rep(0, length(assets.names))
+Alphas = ResidVars = R2values = rep(NA, length(assets.names))
names(Alphas) = names(ResidVars) = names(R2values) = assets.names
-Betas = matrix(0, length(assets.names), length(factors.names))
+Betas = matrix(NA, length(assets.names), length(factors.names))
colnames(Betas) = factors.names
rownames(Betas) = assets.names
-
+if(add.up.market.returns == TRUE ) {
+ Betas <- cbind(Betas,rep(NA,length(assets.names)))
+ colnames(Betas)[dim(Betas)[2]] <- "up.beta"
+}
+
+if(add.quadratic.term == TRUE ) {
+ Betas <- cbind(Betas,rep(NA,length(assets.names)))
+ colnames(Betas)[dim(Betas)[2]] <- "quadratic.term"
+}
+
+#
+### plain vanila method
+#
if (variable.selection == "none") {
if (fit.method == "OLS") {
for (i in assets.names) {
- reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.formula = as.formula(paste(i,"~", ".", sep=" "))
fm.fit = lm(fm.formula, data=reg.df)
fm.summary = summary(fm.fit)
@@ -117,6 +159,15 @@
} else if (fit.method == "DLS") {
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
t.length <- nrow(reg.df)
w <- rep(decay.factor^(t.length-1),t.length)
for (k in 2:t.length) {
@@ -137,6 +188,15 @@
} else if (fit.method=="Robust") {
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.formula = as.formula(paste(i,"~", ".", sep=" "))
fm.fit = lmRob(fm.formula, data=reg.df)
fm.summary = summary(fm.fit)
@@ -151,17 +211,27 @@
stop("invalid method")
}
-
-} else if (variable.selection == "all subsets") {
+#
+### subset methods
+#
+}
+ else if (variable.selection == "all subsets") {
# estimate multiple factor model using loop b/c of unequal histories for the hedge funds
-
-
if (fit.method == "OLS") {
if (num.factor.subset == length(force.in)) {
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, force.in)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.formula = as.formula(paste(i,"~", ".", sep=" "))
fm.fit = lm(fm.formula, data=reg.df)
fm.summary = summary(fm.fit)
@@ -181,6 +251,15 @@
method=subsets.method)
sum.sub <- summary(fm.subsets)
reg.df <- na.omit(reg.xts[,c(i,names(which(sum.sub$which[as.character(num.factor.subset),-1]==TRUE)) )])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.fit = lm(fm.formula, data=reg.df)
fm.summary = summary(fm.fit)
reg.list[[i]] = fm.fit
@@ -197,13 +276,23 @@
-} else if (fit.method == "DLS"){
+}
+else if (fit.method == "DLS"){
if (num.factor.subset == length(force.in)) {
# define weight matrix
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, force.in)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
t.length <- nrow(reg.df)
w <- rep(decay.factor^(t.length-1),t.length)
for (k in 2:t.length) {
@@ -235,6 +324,15 @@
method=subsets.method,weights=w) # w is called from global envio
sum.sub <- summary(fm.subsets)
reg.df <- na.omit(reg.xts[,c(i,names(which(sum.sub$which[as.character(num.factor.subset),-1]==TRUE)) )])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.fit = lm(fm.formula, data=reg.df,weight=w)
fm.summary = summary(fm.fit)
reg.list[[i]] = fm.fit
@@ -249,31 +347,50 @@
}
-} else if (fit.method=="Robust") {
+}
+else if (fit.method=="Robust") {
for (i in assets.names) {
- reg.df = na.omit(reg.xts[, c(i, factors.names)])
- fm.formula = as.formula(paste(i,"~", ".", sep=" "))
- fm.fit = lmRob(fm.formula, data=reg.df)
- fm.summary = summary(fm.fit)
- reg.list[[i]] = fm.fit
- Alphas[i] = coef(fm.fit)[1]
- Betas[i, ] = coef(fm.fit)[-1]
- ResidVars[i] = fm.summary$sigma^2
- R2values[i] = fm.summary$r.squared
- }
+ reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
+ fm.formula = as.formula(paste(i,"~", ".", sep=" "))
+ fm.fit = lmRob(fm.formula, data=reg.df)
+ fm.summary = summary(fm.fit)
+ reg.list[[i]] = fm.fit
+ Alphas[i] = coef(fm.fit)[1]
+ Betas[i, ] = coef(fm.fit)[-1]
+ ResidVars[i] = fm.summary$sigma^2
+ R2values[i] = fm.summary$r.squared
+ }
} else {
stop("invalid method")
}
-} else if (variable.selection == "stepwise") {
+}
+ else if (variable.selection == "stepwise") {
-
if (fit.method == "OLS") {
# loop over all assets and estimate time series regression
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.formula = as.formula(paste(i,"~", ".", sep=" "))
fm.fit = step(lm(fm.formula, data=reg.df),trace=0)
fm.summary = summary(fm.fit)
@@ -286,10 +403,20 @@
}
-} else if (fit.method == "DLS"){
+}
+ else if (fit.method == "DLS"){
# define weight matrix
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, factors.names)])
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
t.length <- nrow(reg.df)
w <- rep(decay.factor^(t.length-1),t.length)
for (k in 2:t.length) {
@@ -308,9 +435,24 @@
R2values[i] = fm.summary$r.squared
}
-} else if (fit.method=="Robust") {
- for (i in assets.names) {
- assign("reg.df" , na.omit(reg.xts[, c(i, factors.names)]),envir = .GlobalEnv )
+}
+ else if (fit.method =="Robust") {
+ for (i in assets.names) {
+ assign("reg.df" , na.omit(reg.xts[, c(i, factors.names)]),envir = .GlobalEnv )
+# reg.df = na.omit(reg.xts[, c(i, factors.names)],envir = .GlobalEnv)
+ if(add.up.market.returns == TRUE) {
+ stop("This function does not support add.up.market.returns and stepwise variable.selection
+ together Please choose either one.")
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ stop("This function does not support add.up.market.returns and stepwise variable.selection
+ together. Please choose either one.")
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
fm.formula = as.formula(paste(i,"~", ".", sep=" "))
lmRob.obj <- lmRob(fm.formula, data=reg.df)
fm.fit = step.lmRob(lmRob.obj,trace=FALSE)
@@ -330,10 +472,19 @@
for (i in assets.names) {
reg.df = na.omit(reg.xts[, c(i, factors.names)])
- reg.df = as.matrix(reg.df)
+ if(add.up.market.returns == TRUE) {
+ up.beta <- apply(reg.xts[,excess.market.returns.name],1,max,0)
+ reg.df = merge(reg.df,up.beta)
+ }
+ if(add.quadratic.term == TRUE) {
+ quadratic.term <- reg.xts[,excess.market.returns.name]^2
+ reg.df = merge(reg.df,quadratic.term)
+ colnames(reg.df)[dim(reg.df)[2]] <- "quadratic.term"
+ }
+ reg.df = as.matrix(na.omit(reg.df))
lars.fit = lars(reg.df[,factors.names],reg.df[,i],type=variable.selection,trace=FALSE)
sum.lars <- summary(lars.fit)
- if (lars.criteria == "Cp") {
+ if (lars.criteria == "cp") {
s<- which.min(sum.lars$Cp)
} else {
lars.cv <- cv.lars(reg.df[,factors.names],reg.df[,i],trace=FALSE,
Modified: pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd
===================================================================
--- pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd 2013-08-01 23:08:53 UTC (rev 2693)
+++ pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd 2013-08-01 23:13:25 UTC (rev 2694)
@@ -8,7 +8,8 @@
variable.selection = "none", decay.factor = 0.95,
nvmax = 8, force.in = NULL,
subsets.method = c("exhaustive", "backward", "forward", "seqrep"),
- lars.criteria = "Cp")
+ lars.criteria = "Cp", add.up.market.returns = FALSE,
+ add.quadratic.term = FALSE, excess.market.returns.name)
}
\arguments{
\item{assets.names}{names of assets returns.}
@@ -19,8 +20,9 @@
selected by all subsets.}
\item{data}{a vector, matrix, data.frame, xts, timeSeries
- or zoo object with asset returns and factors retunrs
- rownames}
+ or zoo object with \code{assets.names} and
+ \code{factors.names} or \code{excess.market.returns.name}
+ if necassary.}
\item{fit.method}{"OLS" is ordinary least squares method,
"DLS" is discounted least squares method. Discounted
@@ -55,18 +57,33 @@
exhaustive search, forward selection, backward selection
or sequential replacement to search.}
- \item{lars.criteria}{either choose minimum "Cp": unbiased
+ \item{lars.criteria}{either choose minimum "cp": unbiased
estimator of the true rist or "cv" 10 folds
cross-validation. Default is "Cp". See detail.}
+
+ \item{add.up.market.returns}{Logical. If \code{TRUE},
+ max(0,Rm-Rf) will be added as a regressor. Default is
+ \code{FALSE}. \code{excess.market.returns.nam} is
+ required if \code{TRUE}. See Detail.}
+
+ \item{add.quadratic.term}{Logical. If \code{TRUE},
+ (Rm-Rf)^2 will be added as a regressor.
+ \code{excess.market.returns.name} is required if
+ \code{TRUE}. Default is \code{FALSE}.}
+
+ \item{excess.market.returns.name}{colnames market returns
+ minus risk free rate. (Rm-Rf).}
}
\value{
- an S3 object containing \itemize{ \item{asset.fit}{Fit
+ an S3 object containing \itemize{ \item{asset.fit} {Fit
objects for each asset. This is the class "lm" for each
- object.} \item{alpha}{N x 1 Vector of estimated alphas.}
- \item{beta}{N x K Matrix of estimated betas.} \item{r2}{N
- x 1 Vector of R-square values.} \item{resid.variance}{N x
- 1 Vector of residual variances.} \item{call}{function
- call.} }
+ object.} \item{alpha} {N x 1 Vector of estimated alphas.}
+ \item{beta} {N x K Matrix of estimated betas.} \item{r2}
+ {N x 1 Vector of R-square values.} \item{resid.variance}
+ {N x 1 Vector of residual variances.} \item{call}
+ {function call.} }
+
+ interpreted as number
}
\description{
Fit time series factor model by time series regression
@@ -74,6 +91,11 @@
"TimeSeriesFactorModel".
}
\details{
+ add.up.market.returns adds a max(0,Rm-Rf) term in the
+ regression as suggested by Merton-Henriksson Model (1981)
+ to measure market timing. The coefficient can be
+ interpreted as number of free put options.
+
If \code{Robust} is chosen, there is no subsets but all
factors will be used. Cp is defined in
http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf.
@@ -100,11 +122,13 @@
Eric Zivot and Yi-An Chen.
}
\references{
- 1. Efron, Hastie, Johnstone and Tibshirani (2002) "Least
- Angle Regression" (with discussion) Annals of Statistics;
- see also
+ \enumerate{ \item Efron, Hastie, Johnstone and Tibshirani
+ (2002) "Least Angle Regression" (with discussion) Annals
+ of Statistics; see also
http://www-stat.stanford.edu/~hastie/Papers/LARS/LeastAngle_2002.pdf.
- 2. Hastie, Tibshirani and Friedman (2008) Elements of
- Statistical Learning 2nd edition, Springer, NY.
+ \item Hastie, Tibshirani and Friedman (2008) Elements of
+ Statistical Learning 2nd edition, Springer, NY. \item
+ Christopherson, Carino and Ferson (2009). Portfolio
+ Performance Measurement and Benchmarking, McGraw Hill. }
}
More information about the Returnanalytics-commits
mailing list