From noreply at r-forge.r-project.org Tue Jun 3 21:00:07 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 3 Jun 2014 21:00:07 +0200 (CEST) Subject: [Returnanalytics-commits] r3403 - in pkg/PortfolioAnalytics: . R man src Message-ID: <20140603190007.6B3F0186DB6@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-03 21:00:06 +0200 (Tue, 03 Jun 2014) New Revision: 3403 Added: pkg/PortfolioAnalytics/R/stat.factor.model.R pkg/PortfolioAnalytics/man/center.Rd pkg/PortfolioAnalytics/man/cokurtosisMF.Rd pkg/PortfolioAnalytics/man/cokurtosisSF.Rd pkg/PortfolioAnalytics/man/coskewnessMF.Rd pkg/PortfolioAnalytics/man/coskewnessSF.Rd pkg/PortfolioAnalytics/man/covarianceMF.Rd pkg/PortfolioAnalytics/man/covarianceSF.Rd pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd pkg/PortfolioAnalytics/man/extract.coskewness.Rd pkg/PortfolioAnalytics/man/extract.covariance.Rd pkg/PortfolioAnalytics/man/statistical.factor.model.Rd pkg/PortfolioAnalytics/src/ pkg/PortfolioAnalytics/src/residualcokurtosisMF.c pkg/PortfolioAnalytics/src/residualcokurtosisSF.c Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/NAMESPACE Log: Adding moment estimates using statistical factor model based on Boudt paper Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2014-05-28 23:31:44 UTC (rev 3402) +++ pkg/PortfolioAnalytics/DESCRIPTION 2014-06-03 19:00:06 UTC (rev 3403) @@ -66,3 +66,4 @@ 'inverse.volatility.weight.R' 'utils.R' 'chart.concentration.R' + 'stat.factor.model.R' Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-05-28 23:31:44 UTC (rev 3402) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-03 19:00:06 UTC (rev 3403) @@ -3,6 +3,7 @@ export(applyFUN) export(box_constraint) export(CCCgarch.MM) +export(center) export(chart.Concentration) export(chart.EfficientFrontier) export(chart.EfficientFrontierOverlay) @@ -21,6 +22,9 @@ export(diversification_constraint) export(diversification) export(equal.weight) +export(extract.cokurtosis) +export(extract.coskewness) +export(extract.covariance) export(extractEfficientFrontier) export(extractGroups) export(extractObjectiveMeasures) @@ -69,6 +73,7 @@ export(set.portfolio.moments_v1) export(set.portfolio.moments_v2) export(set.portfolio.moments) +export(statistical.factor.model) export(trailingFUN) export(transaction_cost_constraint) export(turnover_constraint) Added: pkg/PortfolioAnalytics/R/stat.factor.model.R =================================================================== --- pkg/PortfolioAnalytics/R/stat.factor.model.R (rev 0) +++ pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,570 @@ +############################################################################### +# R (http://r-project.org/) Numeric Methods for Optimization of Portfolios +# +# Copyright (c) 2004-2014 Brian G. Peterson, Peter Carl, Ross Bennett, Kris Boudt +# +# This library is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: charts.DE.R 3378 2014-04-28 21:43:21Z rossbennett34 $ +# +############################################################################### + +# Note that many of these functions were provided by Kris Boudt and modified +# only slightly to work with this package + +#' Statistical Factor Model +#' +#' Fit a statistical factor model using Principal Component Analysis (PCA) +#' +#' @details +#' The statistical factor model is fitted using \code{prcomp}. The factor +#' loadings, factor realizations, and residuals are computed and returned +#' given the number of factors used for the model. +#' +#' @param R xts of asset returns +#' @param k number of factors to use +#' @param \dots additional arguments passed to \code{prcomp} +#' @return +#' #' \itemize{ +#' \item{factor_loadings}{ N x k matrix of factor loadings (i.e. betas)} +#' \item{factor_realizations}{ m x k matrix of factor realizations} +#' \item{residuals}{ m x N matrix of model residuals representing idiosyncratic +#' risk factors} +#' } +#' Where N is the number of assets, k is the number of factors, and m is the +#' number of observations. +#' @export +statistical.factor.model <- function(R, k=1, ...){ + if(!is.xts(R)){ + R <- try(as.xts(R)) + if(inherits(R, "try-error")) stop("R must be an xts object or coercible to an xts object") + } + # dimensions of R + m <- nrow(R) + N <- ncol(R) + + # checks for R + if(m < N) stop("fewer observations than assets") + x <- coredata(R) + + # Make sure k is an integer + if(k <= 0) stop("k must be a positive integer") + k <- as.integer(k) + + # Fit a statistical factor model using Principal Component Analysis (PCA) + fit <- prcomp(x, ...=...) + + # Extract the betas + # (N x k) + betas <- fit$rotation[, 1:k] + + # Compute the estimated factor realizations + # (m x N) %*% (N x k) = (m x k) + f <- x %*% betas + + # Compute the residuals + # These can be computed manually or by fitting a linear model + tmp <- x - f %*% t(betas) + b0 <- colMeans(tmp) + res <- tmp - matrix(rep(b0, m), ncol=N, byrow=TRUE) + + # Compute residuals via fitting a linear model + # tmp.model <- lm(x ~ f) + # tmp.beta <- coef(tmp.model)[2:(k+1),] + # tmp.resid <- resid(tmp.model) + # all.equal(t(tmp.beta), betas, check.attributes=FALSE) + # all.equal(res, tmp.resid) + + # structure and return + # stfm = *st*atistical *f*actor *m*odel + structure(list(factor_loadings=betas, + factor_realizations=f, + residuals=res, + m=m, + k=k, + N=N), + class="stfm") +} + + +#' Center +#' +#' Center a matrix +#' +#' This function is used primarily to center a time series of asset returns or +#' factors. Each column should represent the returns of an asset or factor +#' realizations. The expected value is taken as the sample mean. +#' +#' x.centered = x - mean(x) +#' +#' @param x matrix +#' @return matrix of centered data +#' @export +center <- function(x){ + if(!is.matrix(x)) stop("x must be a matrix") + n <- nrow(x) + p <- ncol(x) + meanx <- colMeans(x) + x.centered <- x - matrix(rep(meanx, n), ncol=p, byrow=TRUE) + x.centered +} + +##### Single Factor Model Comoments ##### + +#' Covariance Matrix Estimate +#' +#' Estimate covariance matrix using a single factor statistical factor model +#' +#' @details +#' This function estimates an (N x N) covariance matrix from a single factor +#' statistical factor model with k=1 factors, where N is the number of assets. +#' +#' @param beta vector of length N or (N x 1) matrix of factor loadings +#' (i.e. the betas) from a single factor statistical factor model +#' @param stockM2 vector of length N of the variance (2nd moment) of the +#' model residuals (i.e. idiosyncratic variance of the stock) +#' @param factorM2 scalar value of the 2nd moment of the factor realizations +#' from a single factor statistical factor model +#' @return (N x N) covariance matrix +covarianceSF <- function(beta, stockM2, factorM2){ + # Beta of the stock with the factor index + beta = as.numeric(beta) + + N = length(beta) + + # Idiosyncratic variance of the stock + stockM2 = as.numeric(stockM2) + + if(length(stockM2) != N) stop("dimensions do not match for beta and stockM2") + + # Variance of the factor + factorM2 = as.numeric(factorM2) + + # Coerce beta to a matrix + beta = matrix(beta, ncol = 1) + + # Compute estimate + # S = (beta %*% t(beta)) * factorM2 + S = tcrossprod(beta) * factorM2 + D = diag(stockM2) + return(S + D) +} + +#' Coskewness Matrix Estimate +#' +#' Estimate coskewness matrix using a single factor statistical factor model +#' +#' @details +#' This function estimates an (N x N^2) coskewness matrix from a single factor +#' statistical factor model with k=1 factors, where N is the number of assets. +#' +#' @param beta vector of length N or (N x 1) matrix of factor loadings +#' (i.e. the betas) from a single factor statistical factor model +#' @param stockM3 vector of length N of the 3rd moment of the model residuals +#' @param factorM3 scalar of the 3rd moment of the factor realizations from a +#' single factor statistical factor model +#' @return (N x N^2) coskewness matrix +coskewnessSF <- function(beta, stockM3, factorM3){ + # Beta of the stock with the factor index + beta = as.numeric(beta) + N = length(beta) + + # Idiosyncratic third moment of the stock + stockM3 = as.numeric(stockM3) + + if(length(stockM3) != N) stop("dimensions do not match for beta and stockM3") + + # Third moment of the factor + factorM3 = as.numeric(factorM3) + + # Coerce beta to a matrix + beta = matrix(beta, ncol = 1) + + # Compute estimate + # S = ((beta %*% t(beta)) %x% t(beta)) * factorM3 + S = (tcrossprod(beta) %x% t(beta)) * factorM3 + D = matrix(0, nrow=N, ncol=N^2) + for(i in 1:N){ + col = (i - 1) * N + i + D[i, col] = stockM3[i] + } + return(S + D) +} + +#' Cokurtosis Matrix Estimate +#' +#' Estimate cokurtosis matrix using a single factor statistical factor model +#' +#' @details +#' This function estimates an (N x N^3) cokurtosis matrix from a statistical +#' factor model with k factors, where N is the number of assets. +#' +#' @param beta vector of length N or (N x 1) matrix of factor loadings +#' (i.e. the betas) from a single factor statistical factor model +#' @param stockM2 vector of length N of the 2nd moment of the model residuals +#' @param stockM4 vector of length N of the 4th moment of the model residuals +#' @param factorM2 scalar of the 2nd moment of the factor realizations from a +#' single factor statistical factor model +#' @param factorM4 scalar of the 4th moment of the factor realizations from a +#' single factor statistical factor model +#' @return (N x N^3) cokurtosis matrix +cokurtosisSF <- function(beta, stockM2, stockM4, factorM2, factorM4){ + # Beta of the stock with the factor index + beta = as.numeric(beta) + N = length(beta) + + # Idiosyncratic second moment of the stock + stockM2 = as.numeric(stockM2) + + if(length(stockM2) != N) stop("dimensions do not match for beta and stockM2") + + # Idiosyncratic fourth moment of the stock + stockM4 = as.numeric(stockM4) + + if(length(stockM4) != N) stop("dimensions do not match for beta and stockM4") + + # Second moment of the factor + factorM2 = as.numeric(factorM2) + + # Fourth moment of the factor + factorM4 = as.numeric(factorM4) + + # Compute estimate + # S = ((beta %*% t(beta)) %x% t(beta) %x% t(beta)) * factorM4 + S = (tcrossprod(beta) %x% t(beta) %x% t(beta)) * factorM4 + D = .residualcokurtosisSF(NN=N, sstockM2=stockM2, sstockM4=stockM4, mfactorM2=factorM2, bbeta=beta) + return(S + D) +} + +# Wrapper function to compute the residual cokurtosis matrix of a statistical +# factor model with k = 1. +# Note that this function was orignally written in C++ (using Rcpp) by +# Joshua Ulrich and re-written using the C API by Ross Bennett +.residualcokurtosisSF <- function(NN, sstockM2, sstockM4, mfactorM2, bbeta){ + # NN : integer + # sstockM2 : vector of length NN + # sstockM4 : vector of length NN + # mfactorM2 : double + # bbeta : vector of length NN + + # Should I add checks here? These are passed from cokurtosisSF which already has checks + .Call('residualcokurtosisSF', NN, sstockM2, sstockM4, bbeta, PACKAGE="PortfolioAnalytics") +} + +##### Multiple Factor Model Comoments ##### + +#' Covariance Matrix Estimate +#' +#' Estimate covariance matrix using a statistical factor model +#' +#' @details +#' This function estimates an (N x N) covariance matrix from a statistical +#' factor model with k factors, where N is the number of assets. +#' +#' @param beta (N x k) matrix of factor loadings (i.e. the betas) from a +#' statistical factor model +#' @param stockM2 vector of length N of the variance (2nd moment) of the +#' model residuals (i.e. idiosyncratic variance of the stock) +#' @param factorM2 (k x k) matrix of the covariance (2nd moment) of the factor +#' realizations from a statistical factor model +#' @return (N x N) covariance matrix +covarianceMF <- function(beta, stockM2, factorM2){ + # Formula for covariance matrix estimate + # Sigma = beta %*% factorM2 %*% beta**T + Delta + # Delta is a diagonal matrix with the 2nd moment of residuals on the diagonal + + # N = number of assets + # k = number of factors + + # Use the dimensions of beta for checks of stockM2 and factorM2 + # beta should be an (N x k) matrix + if(!is.matrix(beta)) stop("beta must be a matrix") + N <- nrow(beta) + k <- ncol(beta) + + # stockM2 should be a vector of length N + stockM2 <- as.numeric(stockM2) + if(length(stockM2) != N) stop("dimensions do not match for beta and stockM2") + + # factorM2 should be a (k x k) matrix + if(!is.matrix(factorM2)) stop("factorM2 must be a matrix") + if((nrow(factorM2) != k) | (ncol(factorM2) != k)){ + stop("dimensions do not match for beta and factorM2") + } + + # Compute covariance matrix + S <- beta %*% tcrossprod(factorM2, beta) + D <- diag(stockM2) + return(S + D) +} + +#' Coskewness Matrix Estimate +#' +#' Estimate coskewness matrix using a statistical factor model +#' +#' @details +#' This function estimates an (N x N^2) coskewness matrix from a statistical +#' factor model with k factors, where N is the number of assets. +#' +#' @param beta (N x k) matrix of factor loadings (i.e. the betas) from a +#' statistical factor model +#' @param stockM3 vector of length N of the 3rd moment of the model residuals +#' @param factorM3 (k x k^2) matrix of the 3rd moment of the factor +#' realizations from a statistical factor model +#' @return (N x N^2) coskewness matrix +coskewnessMF <- function(beta, stockM3, factorM3){ + # Formula for coskewness matrix estimate + # Phi = beta %*% factorM3 %*% (beta**T %x% beta**T) + Omega + # %x% is the kronecker product + # Omega is the (N x N^2) matrix matrix of zeros except for the i,j elements + # where j = (i - 1) * N + i, which is corresponding to the expected third + # moment of the idiosyncratic factors + + # N = number of assets + # k = number of factors + + # Use the dimensions of beta for checks of stockM2 and factorM2 + # beta should be an (N x k) matrix + if(!is.matrix(beta)) stop("beta must be a matrix") + N <- nrow(beta) + k <- ncol(beta) + + # stockM3 should be a vector of length N + stockM3 <- as.numeric(stockM3) + if(length(stockM3) != N) stop("dimensions do not match for beta and stockM3") + + # factorM3 should be an (k x k^2) matrix + if(!is.matrix(factorM3)) stop("factorM3 must be a matrix") + if((nrow(factorM3) != k) | (ncol(factorM3) != k^2)){ + stop("dimensions do not match for beta and factorM3") + } + + # Compute coskewness matrix + beta.t <- t(beta) + S <- (beta %*% factorM3) %*% (beta.t %x% beta.t) + D <- matrix(0, nrow=N, ncol=N^2) + for(i in 1:N){ + col <- (i - 1) * N + i + D[i, col] <- stockM3[i] + } + return(S + D) +} + +#' Cokurtosis Matrix Estimate +#' +#' Estimate cokurtosis matrix using a statistical factor model +#' +#' @details +#' This function estimates an (N x N^3) cokurtosis matrix from a statistical +#' factor model with k factors, where N is the number of assets. +#' +#' @param beta (N x k) matrix of factor loadings (i.e. the betas) from a +#' statistical factor model +#' @param stockM2 vector of length N of the 2nd moment of the model residuals +#' @param stockM4 vector of length N of the 4th moment of the model residuals +#' @param factorM2 (k x k) matrix of the 2nd moment of the factor +#' realizations from a statistical factor model +#' @param factorM4 (k x k^3) matrix of the 4th moment of the factor +#' realizations from a statistical factor model +#' @return (N x N^3) cokurtosis matrix +cokurtosisMF <- function(beta , stockM2 , stockM4 , factorM2 , factorM4){ + + # Formula for cokurtosis matrix estimate + # Psi = beta %*% factorM4 %*% (beta**T %x% beta**T %x% beta**T) + Y + # %x% is the kronecker product + # Y is the residual matrix. + # see Asset allocation with higher order moments and factor models for + # definition of Y + + # N = number of assets + # k = number of factors + + # Use the dimensions of beta for checks of stockM2 and factorM2 + # beta should be an (N x k) matrix + if(!is.matrix(beta)) stop("beta must be a matrix") + N <- nrow(beta) + k <- ncol(beta) + + # stockM2 should be a vector of length N + stockM2 <- as.numeric(stockM2) + if(length(stockM2) != N) stop("dimensions do not match for beta and stockM2") + + # stockM4 should be a vector of length N + stockM4 <- as.numeric(stockM4) + if(length(stockM4) != N) stop("dimensions do not match for beta and stockM4") + + # factorM2 should be a (k x k) matrix + if(!is.matrix(factorM2)) stop("factorM2 must be a matrix") + if((nrow(factorM2) != k) | (ncol(factorM2) != k)){ + stop("dimensions do not match for beta and factorM2") + } + + # factorM4 should be a (k x k^3) matrix + if(!is.matrix(factorM4)) stop("factorM4 must be a matrix") + if((nrow(factorM4) != k) | (ncol(factorM4) != k^3)){ + stop("dimensions do not match for beta and factorM4") + } + + # Compute cokurtosis matrix + beta.t <- t(beta) + S <- (beta %*% factorM4) %*% (beta.t %x% beta.t %x% beta.t) + # betacov + betacov <- as.numeric(beta %*% tcrossprod(factorM2, beta)) + # Compute the residual cokurtosis matrix + D <- .residualcokurtosisMF(NN=N, sstockM2=stockM2, sstockM4=stockM4, bbetacov=betacov) + return( S + D ) +} + +# Wrapper function to compute the residual cokurtosis matrix of a statistical +# factor model with k > 1. +# Note that this function was orignally written in C++ (using Rcpp) by +# Joshua Ulrich and re-written using the C API by Ross Bennett +.residualcokurtosisMF <- function(NN, sstockM2, sstockM4, bbetacov){ + # NN : integer, number of assets + # sstockM2 : numeric vector of length NN + # ssstockM4 : numeric vector of length NN + # bbetacov : numeric vector of length NN * NN + + # Should I add checks here? These are passed from cokurtosisSF which already has checks + .Call('residualcokurtosisMF', NN, sstockM2, sstockM4, bbetacov, PACKAGE="PortfolioAnalytics") +} + +##### Extract Moments ##### + +#' Covariance Estimate +#' +#' Extract the covariance matrix estimate from a statistical factor model +#' +#' @param model statistical factor model estimated via +#' \code{\link{statistical.factor.model}} +#' @param \dots not currently used +#' @return covariance matrix estimate +#' @seealso \code{\link{statistical.factor.model}} +#' @author Ross Bennett +#' @export +extractCovariance <- function(model, ...){ + if(!inherits(model, "stfm")) stop("model must be of class 'stfm'") + + # Extract elements from the model + beta <- model$factor_loadings + f <- model$factor_realizations + res <- model$residuals + m <- model$m + k <- model$k + N <- model$N + + # Residual moments + denom <- m - k - 1 + stockM2 <- colSums(res^2) / denom + + # Factor moments + factorM2 <- cov(f) + + # Compute covariance estimate + if(k == 1){ + out <- covarianceSF(beta, stockM2, factorM2) + } else if(k > 1){ + out <- covarianceMF(beta, stockM2, factorM2) + } else { + # invalid k + message("invalid k, returning NULL") + out <- NULL + } + return(out) +} + +#' Coskewness Estimate +#' +#' Extract the coskewness matrix estimate from a statistical factor model +#' +#' @param model statistical factor model estimated via +#' \code{\link{statistical.factor.model}} +#' @param \dots not currently used +#' @return coskewness matrix estimate +#' @seealso \code{\link{statistical.factor.model}} +#' @author Ross Bennett +#' @export +extractCoskewness <- function(model, ...){ + if(!inherits(model, "stfm")) stop("model must be of class 'stfm'") + + # Extract elements from the model + beta <- model$factor_loadings + f <- model$factor_realizations + res <- model$residuals + m <- model$m + k <- model$k + N <- model$N + + # Residual moments + denom <- m - k - 1 + stockM3 <- colSums(res^3) / denom + + # Factor moments + # f.centered <- center(f) + # factorM3 <- M3.MM(f.centered) + factorM3 <- PerformanceAnalytics:::M3.MM(f) + + # Compute covariance estimate + if(k == 1){ + # Single factor model + out <- coskewnessSF(beta, stockM3, factorM3) + } else if(k > 1){ + # Multi-factor model + out <- coskewnessMF(beta, stockM3, factorM3) + } else { + # invalid k + message("invalid k, returning NULL") + out <- NULL + } + return(out) +} + +#' Cokurtosis Estimate +#' +#' Extract the cokurtosis matrix estimate from a statistical factor model +#' +#' @param model statistical factor model estimated via +#' \code{\link{statistical.factor.model}} +#' @param \dots not currently used +#' @return cokurtosis matrix estimate +#' @seealso \code{\link{statistical.factor.model}} +#' @author Ross Bennett +#' @export +extractCokurtosis <- function(model, ...){ + if(!inherits(model, "stfm")) stop("model must be of class 'stfm'") + + # Extract elements from the model + beta <- model$factor_loadings + f <- model$factor_realizations + res <- model$residuals + m <- model$m + k <- model$k + N <- model$N + + # Residual moments + denom <- m - k - 1 + stockM2 <- colSums(res^2) / denom + stockM4 <- colSums(res^4) / denom + + # Factor moments + factorM2 <- cov(f) + # f.centered <- center(f) + # factorM4 <- M4.MM(f.centered) + factorM4 <- PerformanceAnalytics:::M4.MM(f) + + # Compute covariance estimate + if(k == 1){ + # Single factor model + out <- cokurtosisSF(beta, stockM2, stockM4, factorM2, factorM4) + } else if(k > 1){ + # Multi-factor model + out <- cokurtosisMF(beta, stockM2, stockM4, factorM2, factorM4) + } else { + # invalid k + message("invalid k, returning NULL") + out <- NULL + } + return(out) +} + Added: pkg/PortfolioAnalytics/man/center.Rd =================================================================== --- pkg/PortfolioAnalytics/man/center.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/center.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,24 @@ +\name{center} +\alias{center} +\title{Center} +\usage{ + center(x) +} +\arguments{ + \item{x}{matrix} +} +\value{ + matrix of centered data +} +\description{ + Center a matrix +} +\details{ + This function is used primarily to center a time series + of asset returns or factors. Each column should represent + the returns of an asset or factor realizations. The + expected value is taken as the sample mean. + + x.centered = x - mean(x) +} + Added: pkg/PortfolioAnalytics/man/cokurtosisMF.Rd =================================================================== --- pkg/PortfolioAnalytics/man/cokurtosisMF.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/cokurtosisMF.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,35 @@ +\name{cokurtosisMF} +\alias{cokurtosisMF} +\title{Cokurtosis Matrix Estimate} +\usage{ + cokurtosisMF(beta, stockM2, stockM4, factorM2, factorM4) +} +\arguments{ + \item{beta}{(N x k) matrix of factor loadings (i.e. the + betas) from a statistical factor model} + + \item{stockM2}{vector of length N of the 2nd moment of + the model residuals} + + \item{stockM4}{vector of length N of the 4th moment of + the model residuals} + + \item{factorM2}{(k x k) matrix of the 2nd moment of the + factor realizations from a statistical factor model} + + \item{factorM4}{(k x k^3) matrix of the 4th moment of the + factor realizations from a statistical factor model} +} +\value{ + (N x N^3) cokurtosis matrix +} +\description{ + Estimate cokurtosis matrix using a statistical factor + model +} +\details{ + This function estimates an (N x N^3) cokurtosis matrix + from a statistical factor model with k factors, where N + is the number of assets. +} + Added: pkg/PortfolioAnalytics/man/cokurtosisSF.Rd =================================================================== --- pkg/PortfolioAnalytics/man/cokurtosisSF.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/cokurtosisSF.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,38 @@ +\name{cokurtosisSF} +\alias{cokurtosisSF} +\title{Cokurtosis Matrix Estimate} +\usage{ + cokurtosisSF(beta, stockM2, stockM4, factorM2, factorM4) +} +\arguments{ + \item{beta}{vector of length N or (N x 1) matrix of + factor loadings (i.e. the betas) from a single factor + statistical factor model} + + \item{stockM2}{vector of length N of the 2nd moment of + the model residuals} + + \item{stockM4}{vector of length N of the 4th moment of + the model residuals} + + \item{factorM2}{scalar of the 2nd moment of the factor + realizations from a single factor statistical factor + model} + + \item{factorM4}{scalar of the 4th moment of the factor + realizations from a single factor statistical factor + model} +} +\value{ + (N x N^3) cokurtosis matrix +} +\description{ + Estimate cokurtosis matrix using a single factor + statistical factor model +} +\details{ + This function estimates an (N x N^3) cokurtosis matrix + from a statistical factor model with k factors, where N + is the number of assets. +} + Added: pkg/PortfolioAnalytics/man/coskewnessMF.Rd =================================================================== --- pkg/PortfolioAnalytics/man/coskewnessMF.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/coskewnessMF.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,29 @@ +\name{coskewnessMF} +\alias{coskewnessMF} +\title{Coskewness Matrix Estimate} +\usage{ + coskewnessMF(beta, stockM3, factorM3) +} +\arguments{ + \item{beta}{(N x k) matrix of factor loadings (i.e. the + betas) from a statistical factor model} + + \item{stockM3}{vector of length N of the 3rd moment of + the model residuals} + + \item{factorM3}{(k x k^2) matrix of the 3rd moment of the + factor realizations from a statistical factor model} +} +\value{ + (N x N^2) coskewness matrix +} +\description{ + Estimate coskewness matrix using a statistical factor + model +} +\details{ + This function estimates an (N x N^2) coskewness matrix + from a statistical factor model with k factors, where N + is the number of assets. +} + Added: pkg/PortfolioAnalytics/man/coskewnessSF.Rd =================================================================== --- pkg/PortfolioAnalytics/man/coskewnessSF.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/coskewnessSF.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,31 @@ +\name{coskewnessSF} +\alias{coskewnessSF} +\title{Coskewness Matrix Estimate} +\usage{ + coskewnessSF(beta, stockM3, factorM3) +} +\arguments{ + \item{beta}{vector of length N or (N x 1) matrix of + factor loadings (i.e. the betas) from a single factor + statistical factor model} + + \item{stockM3}{vector of length N of the 3rd moment of + the model residuals} + + \item{factorM3}{scalar of the 3rd moment of the factor + realizations from a single factor statistical factor + model} +} +\value{ + (N x N^2) coskewness matrix +} +\description{ + Estimate coskewness matrix using a single factor + statistical factor model +} +\details{ + This function estimates an (N x N^2) coskewness matrix + from a single factor statistical factor model with k=1 + factors, where N is the number of assets. +} + Added: pkg/PortfolioAnalytics/man/covarianceMF.Rd =================================================================== --- pkg/PortfolioAnalytics/man/covarianceMF.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/covarianceMF.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,31 @@ +\name{covarianceMF} +\alias{covarianceMF} +\title{Covariance Matrix Estimate} +\usage{ + covarianceMF(beta, stockM2, factorM2) +} +\arguments{ + \item{beta}{(N x k) matrix of factor loadings (i.e. the + betas) from a statistical factor model} + + \item{stockM2}{vector of length N of the variance (2nd + moment) of the model residuals (i.e. idiosyncratic + variance of the stock)} + + \item{factorM2}{(k x k) matrix of the covariance (2nd + moment) of the factor realizations from a statistical + factor model} +} +\value{ + (N x N) covariance matrix +} +\description{ + Estimate covariance matrix using a statistical factor + model +} +\details{ + This function estimates an (N x N) covariance matrix from + a statistical factor model with k factors, where N is the + number of assets. +} + Added: pkg/PortfolioAnalytics/man/covarianceSF.Rd =================================================================== --- pkg/PortfolioAnalytics/man/covarianceSF.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/covarianceSF.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,32 @@ +\name{covarianceSF} +\alias{covarianceSF} +\title{Covariance Matrix Estimate} +\usage{ + covarianceSF(beta, stockM2, factorM2) +} +\arguments{ + \item{beta}{vector of length N or (N x 1) matrix of + factor loadings (i.e. the betas) from a single factor + statistical factor model} + + \item{stockM2}{vector of length N of the variance (2nd + moment) of the model residuals (i.e. idiosyncratic + variance of the stock)} + + \item{factorM2}{scalar value of the 2nd moment of the + factor realizations from a single factor statistical + factor model} +} +\value{ + (N x N) covariance matrix +} +\description{ + Estimate covariance matrix using a single factor + statistical factor model +} +\details{ + This function estimates an (N x N) covariance matrix from + a single factor statistical factor model with k=1 + factors, where N is the number of assets. +} + Added: pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,26 @@ +\name{extract.cokurtosis} +\alias{extract.cokurtosis} +\title{Cokurtosis Estimate} +\usage{ + extract.cokurtosis(model, ...) +} +\arguments{ + \item{model}{statistical factor model estimated via + \code{\link{statistical.factor.model}}} + + \item{\dots}{not currently used} +} +\value{ + cokurtosis matrix estimate +} +\description{ + Extract the cokurtosis matrix estimate from a statistical + factor model +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{statistical.factor.model}} +} + Added: pkg/PortfolioAnalytics/man/extract.coskewness.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extract.coskewness.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extract.coskewness.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,26 @@ +\name{extract.coskewness} +\alias{extract.coskewness} +\title{Coskewness Estimate} +\usage{ + extract.coskewness(model, ...) +} +\arguments{ + \item{model}{statistical factor model estimated via + \code{\link{statistical.factor.model}}} + + \item{\dots}{not currently used} +} +\value{ + coskewness matrix estimate +} +\description{ + Extract the coskewness matrix estimate from a statistical + factor model +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{statistical.factor.model}} +} + Added: pkg/PortfolioAnalytics/man/extract.covariance.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extract.covariance.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extract.covariance.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,26 @@ +\name{extract.covariance} +\alias{extract.covariance} +\title{Covariance Estimate} +\usage{ + extract.covariance(model, ...) +} +\arguments{ + \item{model}{statistical factor model estimated via + \code{\link{statistical.factor.model}}} + + \item{\dots}{not currently used} +} +\value{ + covariance matrix estimate +} +\description{ + Extract the covariance matrix estimate from a statistical + factor model +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{statistical.factor.model}} +} + Added: pkg/PortfolioAnalytics/man/statistical.factor.model.Rd =================================================================== --- pkg/PortfolioAnalytics/man/statistical.factor.model.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/statistical.factor.model.Rd 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,33 @@ +\name{statistical.factor.model} +\alias{statistical.factor.model} +\title{Statistical Factor Model} +\usage{ + statistical.factor.model(R, k = 1, ...) +} +\arguments{ + \item{R}{xts of asset returns} + + \item{k}{number of factors to use} + + \item{\dots}{additional arguments passed to + \code{prcomp}} +} +\value{ + #' \itemize{ \item{factor_loadings}{ N x k matrix of + factor loadings (i.e. betas)} \item{factor_realizations}{ + m x k matrix of factor realizations} \item{residuals}{ m + x N matrix of model residuals representing idiosyncratic + risk factors} } Where N is the number of assets, k is the + number of factors, and m is the number of observations. +} +\description{ + Fit a statistical factor model using Principal Component + Analysis (PCA) +} +\details{ + The statistical factor model is fitted using + \code{prcomp}. The factor loadings, factor realizations, + and residuals are computed and returned given the number + of factors used for the model. +} + Added: pkg/PortfolioAnalytics/src/residualcokurtosisMF.c =================================================================== --- pkg/PortfolioAnalytics/src/residualcokurtosisMF.c (rev 0) +++ pkg/PortfolioAnalytics/src/residualcokurtosisMF.c 2014-06-03 19:00:06 UTC (rev 3403) @@ -0,0 +1,159 @@ + +#include +#include + +SEXP residualcokurtosisMF_C(SEXP NN, SEXP sstockM2, SEXP sstockM4, SEXP bbetacov){ + /* + arguments + NN : integer, number of assets + sstockM2 : vector of length NN, 2nd moment of the model residuals + sstockM4 : vector of length NN, 4th moment of the model residuals + bbetacov : vector of length NN * NN, beta and factor covariance + + Note that this function was orignally written in C++ (using Rcpp) by + Joshua Ulrich and re-written using the C API by Ross Bennett + */ + + // // declare pointers for the vectors + double *stockM2, *stockM4, *betacov; + + // Do I need to protect these if they are function arguments? + // use REAL() to access the C array inside the numeric vector passed in from R + stockM2 = REAL(sstockM2); + stockM4 = REAL(sstockM4); + betacov = REAL(bbetacov); + [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3403 From noreply at r-forge.r-project.org Tue Jun 3 21:04:47 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 3 Jun 2014 21:04:47 +0200 (CEST) Subject: [Returnanalytics-commits] r3404 - in pkg/PortfolioAnalytics: . R man Message-ID: <20140603190448.001AF186EEB@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-03 21:04:47 +0200 (Tue, 03 Jun 2014) New Revision: 3404 Added: pkg/PortfolioAnalytics/man/extractCokurtosis.Rd pkg/PortfolioAnalytics/man/extractCoskewness.Rd pkg/PortfolioAnalytics/man/extractCovariance.Rd Removed: pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd pkg/PortfolioAnalytics/man/extract.coskewness.Rd pkg/PortfolioAnalytics/man/extract.covariance.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/stat.factor.model.R Log: Update to man files and correct how the C functions for residual cokurtosis are called Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-06-03 19:00:06 UTC (rev 3403) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-03 19:04:47 UTC (rev 3404) @@ -22,9 +22,9 @@ export(diversification_constraint) export(diversification) export(equal.weight) -export(extract.cokurtosis) -export(extract.coskewness) -export(extract.covariance) +export(extractCokurtosis) +export(extractCoskewness) +export(extractCovariance) export(extractEfficientFrontier) export(extractGroups) export(extractObjectiveMeasures) @@ -151,3 +151,4 @@ S3method(summary,optimize.portfolio) S3method(summary,portfolio) S3method(update,constraint) +useDynLib("PortfolioAnalytics") Modified: pkg/PortfolioAnalytics/R/stat.factor.model.R =================================================================== --- pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:00:06 UTC (rev 3403) +++ pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:04:47 UTC (rev 3404) @@ -241,6 +241,7 @@ # factor model with k = 1. # Note that this function was orignally written in C++ (using Rcpp) by # Joshua Ulrich and re-written using the C API by Ross Bennett +#' @useDynLib "PortfolioAnalytics" .residualcokurtosisSF <- function(NN, sstockM2, sstockM4, mfactorM2, bbeta){ # NN : integer # sstockM2 : vector of length NN @@ -420,6 +421,7 @@ # factor model with k > 1. # Note that this function was orignally written in C++ (using Rcpp) by # Joshua Ulrich and re-written using the C API by Ross Bennett +#' @useDynLib "PortfolioAnalytics" .residualcokurtosisMF <- function(NN, sstockM2, sstockM4, bbetacov){ # NN : integer, number of assets # sstockM2 : numeric vector of length NN Deleted: pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd 2014-06-03 19:00:06 UTC (rev 3403) +++ pkg/PortfolioAnalytics/man/extract.cokurtosis.Rd 2014-06-03 19:04:47 UTC (rev 3404) @@ -1,26 +0,0 @@ -\name{extract.cokurtosis} -\alias{extract.cokurtosis} -\title{Cokurtosis Estimate} -\usage{ - extract.cokurtosis(model, ...) -} -\arguments{ - \item{model}{statistical factor model estimated via - \code{\link{statistical.factor.model}}} - - \item{\dots}{not currently used} -} -\value{ - cokurtosis matrix estimate -} -\description{ - Extract the cokurtosis matrix estimate from a statistical - factor model -} -\author{ - Ross Bennett -} -\seealso{ - \code{\link{statistical.factor.model}} -} - Deleted: pkg/PortfolioAnalytics/man/extract.coskewness.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extract.coskewness.Rd 2014-06-03 19:00:06 UTC (rev 3403) +++ pkg/PortfolioAnalytics/man/extract.coskewness.Rd 2014-06-03 19:04:47 UTC (rev 3404) @@ -1,26 +0,0 @@ -\name{extract.coskewness} -\alias{extract.coskewness} -\title{Coskewness Estimate} -\usage{ - extract.coskewness(model, ...) -} -\arguments{ - \item{model}{statistical factor model estimated via - \code{\link{statistical.factor.model}}} - - \item{\dots}{not currently used} -} -\value{ - coskewness matrix estimate -} -\description{ - Extract the coskewness matrix estimate from a statistical - factor model -} -\author{ - Ross Bennett -} -\seealso{ - \code{\link{statistical.factor.model}} -} - Deleted: pkg/PortfolioAnalytics/man/extract.covariance.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extract.covariance.Rd 2014-06-03 19:00:06 UTC (rev 3403) +++ pkg/PortfolioAnalytics/man/extract.covariance.Rd 2014-06-03 19:04:47 UTC (rev 3404) @@ -1,26 +0,0 @@ -\name{extract.covariance} -\alias{extract.covariance} -\title{Covariance Estimate} -\usage{ - extract.covariance(model, ...) -} -\arguments{ - \item{model}{statistical factor model estimated via - \code{\link{statistical.factor.model}}} - - \item{\dots}{not currently used} -} -\value{ - covariance matrix estimate -} -\description{ - Extract the covariance matrix estimate from a statistical - factor model -} -\author{ - Ross Bennett -} -\seealso{ - \code{\link{statistical.factor.model}} -} - Added: pkg/PortfolioAnalytics/man/extractCokurtosis.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractCokurtosis.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extractCokurtosis.Rd 2014-06-03 19:04:47 UTC (rev 3404) @@ -0,0 +1,26 @@ +\name{extractCokurtosis} +\alias{extractCokurtosis} +\title{Cokurtosis Estimate} +\usage{ + extractCokurtosis(model, ...) +} +\arguments{ + \item{model}{statistical factor model estimated via + \code{\link{statistical.factor.model}}} + + \item{\dots}{not currently used} +} +\value{ + cokurtosis matrix estimate +} +\description{ + Extract the cokurtosis matrix estimate from a statistical + factor model +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{statistical.factor.model}} +} + Added: pkg/PortfolioAnalytics/man/extractCoskewness.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractCoskewness.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extractCoskewness.Rd 2014-06-03 19:04:47 UTC (rev 3404) @@ -0,0 +1,26 @@ +\name{extractCoskewness} +\alias{extractCoskewness} +\title{Coskewness Estimate} +\usage{ + extractCoskewness(model, ...) +} +\arguments{ + \item{model}{statistical factor model estimated via + \code{\link{statistical.factor.model}}} + + \item{\dots}{not currently used} +} +\value{ + coskewness matrix estimate +} +\description{ + Extract the coskewness matrix estimate from a statistical + factor model +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{statistical.factor.model}} +} + Added: pkg/PortfolioAnalytics/man/extractCovariance.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractCovariance.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extractCovariance.Rd 2014-06-03 19:04:47 UTC (rev 3404) @@ -0,0 +1,26 @@ +\name{extractCovariance} +\alias{extractCovariance} +\title{Covariance Estimate} +\usage{ + extractCovariance(model, ...) +} +\arguments{ + \item{model}{statistical factor model estimated via + \code{\link{statistical.factor.model}}} + + \item{\dots}{not currently used} +} +\value{ + covariance matrix estimate +} +\description{ + Extract the covariance matrix estimate from a statistical + factor model +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{statistical.factor.model}} +} + From noreply at r-forge.r-project.org Tue Jun 3 21:52:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 3 Jun 2014 21:52:09 +0200 (CEST) Subject: [Returnanalytics-commits] r3405 - in pkg/PortfolioAnalytics: R sandbox src Message-ID: <20140603195209.3E824186CEE@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-03 21:52:08 +0200 (Tue, 03 Jun 2014) New Revision: 3405 Added: pkg/PortfolioAnalytics/sandbox/scriptMF.R pkg/PortfolioAnalytics/sandbox/scriptSF.R Modified: pkg/PortfolioAnalytics/R/stat.factor.model.R pkg/PortfolioAnalytics/src/residualcokurtosisMF.c pkg/PortfolioAnalytics/src/residualcokurtosisSF.c Log: Fixing calls to residual cokurtosis functions and adding script for multi factor and single factor model examples Modified: pkg/PortfolioAnalytics/R/stat.factor.model.R =================================================================== --- pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:04:47 UTC (rev 3404) +++ pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:52:08 UTC (rev 3405) @@ -212,7 +212,7 @@ cokurtosisSF <- function(beta, stockM2, stockM4, factorM2, factorM4){ # Beta of the stock with the factor index beta = as.numeric(beta) - N = length(beta) + N = as.integer(length(beta)) # Idiosyncratic second moment of the stock stockM2 = as.numeric(stockM2) @@ -250,7 +250,7 @@ # bbeta : vector of length NN # Should I add checks here? These are passed from cokurtosisSF which already has checks - .Call('residualcokurtosisSF', NN, sstockM2, sstockM4, bbeta, PACKAGE="PortfolioAnalytics") + .Call('residualcokurtosisSF', NN, sstockM2, sstockM4, mfactorM2, bbeta, PACKAGE="PortfolioAnalytics") } ##### Multiple Factor Model Comoments ##### Added: pkg/PortfolioAnalytics/sandbox/scriptMF.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/scriptMF.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/scriptMF.R 2014-06-03 19:52:08 UTC (rev 3405) @@ -0,0 +1,69 @@ +library(PortfolioAnalytics) + +# Use edhec data +data(edhec) + +R <- edhec[,1:10] + +# Dimensions of data +m <- nrow(R) +N <- ncol(R) + +# Number of factors to use +k <- 3 + +##### Step 1 ##### +fit <- statistical.factor.model(R, k) +names(fit) +beta <- fit$factor_loadings +f <- fit$factor_realizations +res <- fit$residuals + +##### Step 2 ##### +# Compute the moments of the factors and idiosyncratic risk factors +# Note: The idiosyncratic factors are the residuals in the model (i.e. the +# unexplained asset return variation) + +# Check for equality with functions from Kris Boudt and functions I have +# included in the package + +# residual moments +denom <- m - k - 1 +stockM2 <- colSums(res^2) / denom +stockM3 <- colSums(res^3) / denom +stockM4 <- colSums(res^4) / denom + +# Compute the centered factors +# f.centered <- center(f) + +# factor moments +# (k x k) +factorM2 <- cov(f) + +# (k x k^2) +factorM3 <- PerformanceAnalytics:::M3.MM(f) + +# (k x k^3) +factorM4 <- PerformanceAnalytics:::M4.MM(f) + +##### Step 3 ##### +# Compute the covariance, coskewness, and cokurtosis estimates from the statistical +# factor model. + +# covariance matrix +all.equal( + PortfolioAnalytics:::covarianceMF(beta, stockM2, factorM2), + extractCovariance(fit) +) + +# coskewness matrix +all.equal( + PortfolioAnalytics:::coskewnessMF(beta, stockM3, factorM3), + extractCoskewness(fit) +) + +# cokurtosis matrix +all.equal( + PortfolioAnalytics:::cokurtosisMF(beta, stockM2,stockM4, factorM2, factorM4), + extractCokurtosis(fit) +) Added: pkg/PortfolioAnalytics/sandbox/scriptSF.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/scriptSF.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/scriptSF.R 2014-06-03 19:52:08 UTC (rev 3405) @@ -0,0 +1,69 @@ +library(PortfolioAnalytics) + +# Use edhec data +data(edhec) + +R <- edhec[,1:10] + +# Dimensions of data +m <- nrow(R) +N <- ncol(R) + +# Number of factors to use +k <- 1 + +##### Step 1 ##### +fit <- statistical.factor.model(R, k) +names(fit) +beta <- fit$factor_loadings +f <- fit$factor_realizations +res <- fit$residuals + +##### Step 2 ##### +# Compute the moments of the factors and idiosyncratic risk factors +# Note: The idiosyncratic factors are the residuals in the model (i.e. the +# unexplained asset return variation) + +# Check for equality with functions from Kris Boudt and functions I have +# included in the package + +# residual moments +denom <- m - k - 1 +stockM2 <- colSums(res^2) / denom +stockM3 <- colSums(res^3) / denom +stockM4 <- colSums(res^4) / denom + +# Compute the centered factors +# f.centered <- center(f) + +# factor moments +# scalar +factorM2 <- cov(f) + +# scalar +factorM3 <- PerformanceAnalytics:::M3.MM(f) + +# scalar +factorM4 <- PerformanceAnalytics:::M4.MM(f) + +##### Step 3 ##### +# Compute the covariance, coskewness, and cokurtosis estimates from the statistical +# factor model. + +# covariance matrix +all.equal( + PortfolioAnalytics:::covarianceSF(beta, stockM2, factorM2), + extractCovariance(fit) +) + +# coskewness matrix +all.equal( + PortfolioAnalytics:::coskewnessSF(beta, stockM3, factorM3), + extractCoskewness(fit) +) + +# # cokurtosis matrix +all.equal( + PortfolioAnalytics:::cokurtosisSF(beta, stockM2, stockM4, factorM2, factorM4), + extractCokurtosis(fit) +) Modified: pkg/PortfolioAnalytics/src/residualcokurtosisMF.c =================================================================== --- pkg/PortfolioAnalytics/src/residualcokurtosisMF.c 2014-06-03 19:04:47 UTC (rev 3404) +++ pkg/PortfolioAnalytics/src/residualcokurtosisMF.c 2014-06-03 19:52:08 UTC (rev 3405) @@ -2,7 +2,7 @@ #include #include -SEXP residualcokurtosisMF_C(SEXP NN, SEXP sstockM2, SEXP sstockM4, SEXP bbetacov){ +SEXP residualcokurtosisMF(SEXP NN, SEXP sstockM2, SEXP sstockM4, SEXP bbetacov){ /* arguments NN : integer, number of assets Modified: pkg/PortfolioAnalytics/src/residualcokurtosisSF.c =================================================================== --- pkg/PortfolioAnalytics/src/residualcokurtosisSF.c 2014-06-03 19:04:47 UTC (rev 3404) +++ pkg/PortfolioAnalytics/src/residualcokurtosisSF.c 2014-06-03 19:52:08 UTC (rev 3405) @@ -63,7 +63,8 @@ if( (i==j) || (i==k) || (i==l) || (j==k) || (j==l) || (k==l) ) { if( (i==j) && (i==k) && (i==l) ) { // These are the kurtosis estimates of the individual assets: E[u^4] - kijkl = 6*pow(beta[i],2)*factorM2*stockM2[i]+stockM4[i]; + // kijkl = 6*R_pow_di(beta[i],2)*factorM2*stockM2[i]+stockM4[i]; + kijkl = 6*beta[i]*beta[i]*factorM2*stockM2[i]+stockM4[i]; } else { if( ((i==j) && (i==k)) || ((i==j) && (i==l)) || ((i==k) && (i==l)) || ((j==k) && (j==l)) ) { // kiij E[ U[,i]^3*U[,j] ] = r3*sqrt( vm6[i]*vm2[j] ) @@ -83,13 +84,16 @@ if( ((i==j) && (k==l)) || ((i==k) && (j==l)) || ((i==l) && (j==k)) ) { // kiijj = E[ U[,i]^2*U[,j]^2 ] = r5*sqrt( vm4[i]*vm4[j] ) if( (i==j) && (k==l) ) { - kijkl = pow(beta[i],2)*factorM2*stockM2[k] + pow(beta[k],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[k]; + //kijkl = R_pow_di(beta[i],2)*factorM2*stockM2[k] + R_pow_di(beta[k],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[k]; + kijkl = beta[i]*beta[i]*factorM2*stockM2[k] + beta[k]*beta[k]*factorM2*stockM2[i]+stockM2[i]*stockM2[k]; } else if( (i==k) && (j==l) ) { - kijkl = pow(beta[i],2)*factorM2*stockM2[j] + pow(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j]; + //kijkl = R_pow_di(beta[i],2)*factorM2*stockM2[j] + R_pow_di(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j]; + kijkl = beta[i]*beta[i]*factorM2*stockM2[j] + beta[j]*beta[j]*factorM2*stockM2[i]+stockM2[i]*stockM2[j]; } else if( (i==l) && (j==k) ) { - kijkl = pow(beta[i],2)*factorM2*stockM2[j] + pow(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j]; + //kijkl = R_pow_di(beta[i],2)*factorM2*stockM2[j] + R_pow_di(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j]; + kijkl = beta[i]*beta[i]*factorM2*stockM2[j] + beta[j]*beta[j]*factorM2*stockM2[i]+stockM2[i]*stockM2[j]; } } else { // kiijk = E[ U[,i]^2*U[,j]*U[,k] ] = r6*sqrt( vm4[i]*r5*sqrt( vm4[j]*vm4[k] ) ) From noreply at r-forge.r-project.org Wed Jun 4 02:47:01 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 4 Jun 2014 02:47:01 +0200 (CEST) Subject: [Returnanalytics-commits] r3406 - in pkg/PortfolioAnalytics: . R man Message-ID: <20140604004701.EBCF5186EC0@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-04 02:47:01 +0200 (Wed, 04 Jun 2014) New Revision: 3406 Added: pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/moment.functions.R Log: Adding function to set portfolio moments using statistical factor model based on Boudt paper Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-06-03 19:52:08 UTC (rev 3405) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-04 00:47:01 UTC (rev 3406) @@ -50,6 +50,7 @@ export(optimize.portfolio.rebalancing) export(optimize.portfolio) export(portfolio_risk_objective) +export(portfolio.moments.boudt) export(portfolio.spec) export(pos_limit_fail) export(position_limit_constraint) Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-03 19:52:08 UTC (rev 3405) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-04 00:47:01 UTC (rev 3406) @@ -250,6 +250,73 @@ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) return(momentargs) } + +#' Portfolio Moments +#' +#' Set portfolio moments for use by lower level optimization functions using +#' a statistical factor model based on the work of Kris Boudt. +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param portfolio an object of type \code{portfolio} specifying the +#' constraints and objectives for the optimization, see +#' \code{\link{portfolio.spec}} +#' @param momentargs list containing arguments to be passed down to lower level +#' functions, default NULL +#' @param k number of factors used for fitting statistical factor model +#' @param \dots any other passthru parameters +#' @export +portfolio.moments.boudt <- function(R, portfolio, momentargs=NULL, k=1, ...){ + + # Fit the statistical factor model + fit <- statistical.factor.model(R=R, k=k) + + if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list() + if(is.null(portfolio$objectives)) { + warning("no objectives specified in portfolio") + next() + } else { + for (objective in portfolio$objectives){ + switch(objective$name, + mean = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1) + }, + var =, + sd =, + StdDev = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) + }, + mVaR =, + VaR = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) + if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit) + if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit) + }, + es =, + mES =, + CVaR =, + cVaR =, + ETL=, + mETL=, + ES = { + # We don't want to calculate these moments if we have an ES + # objective and are solving as an LP problem. + if(hasArg(ROI)) ROI=match.call(expand.dots=TRUE)$ROI else ROI=FALSE + if(!ROI){ + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) + if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit) + if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit) + } + } + ) # end switch on objectives + } + } + return(momentargs) +} + ############################################################################### # $Id$ ############################################################################### Added: pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd =================================================================== --- pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd 2014-06-04 00:47:01 UTC (rev 3406) @@ -0,0 +1,29 @@ +\name{portfolio.moments.boudt} +\alias{portfolio.moments.boudt} +\title{Portfolio Moments} +\usage{ + portfolio.moments.boudt(R, portfolio, momentargs = NULL, + k = 1, ...) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{portfolio}{an object of type \code{portfolio} + specifying the constraints and objectives for the + optimization, see \code{\link{portfolio.spec}}} + + \item{momentargs}{list containing arguments to be passed + down to lower level functions, default NULL} + + \item{k}{number of factors used for fitting statistical + factor model} + + \item{\dots}{any other passthru parameters} +} +\description{ + Set portfolio moments for use by lower level optimization + functions using a statistical factor model based on the + work of Kris Boudt. +} + From noreply at r-forge.r-project.org Thu Jun 5 02:44:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 5 Jun 2014 02:44:46 +0200 (CEST) Subject: [Returnanalytics-commits] r3407 - in pkg/PortfolioAnalytics: R demo man Message-ID: <20140605004446.B7333185183@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-05 02:44:46 +0200 (Thu, 05 Jun 2014) New Revision: 3407 Added: pkg/PortfolioAnalytics/demo/higher_moments_boudt.R Modified: pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/R/stat.factor.model.R pkg/PortfolioAnalytics/demo/00Index pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd Log: Adding checks for wrapper functions for residual cokurtosis matrices. Adding demo for using portfolio.moments.boudt. Fix portfolio.moments.boudt to use cleaned returns to fit model. Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-04 00:47:01 UTC (rev 3406) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-05 00:44:46 UTC (rev 3407) @@ -256,6 +256,9 @@ #' Set portfolio moments for use by lower level optimization functions using #' a statistical factor model based on the work of Kris Boudt. #' +#' @note If any of the objectives in the \code{portfolio} object have +#' \code{clean} as an argument, the cleaned returns are used to fit the model. +#' #' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns #' @param portfolio an object of type \code{portfolio} specifying the @@ -269,6 +272,18 @@ portfolio.moments.boudt <- function(R, portfolio, momentargs=NULL, k=1, ...){ # Fit the statistical factor model + # If any of the objectives have clean as an argument, we fit the factor + # model with cleaned returns. Is this the desired behavior we want? + clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean)) + if(!is.null(clean)){ + if(length(unique(clean)) > 1){ + warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1])) + } + # This sets R as the cleaned returns for the rest of the function + # This is proably fine since the only other place R is used is for the + # mu estimate + R <- Return.clean(R, method=clean[1]) + } fit <- statistical.factor.model(R=R, k=k) if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list() @@ -284,12 +299,12 @@ var =, sd =, StdDev = { - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1); + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1) if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) }, mVaR =, VaR = { - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1) if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit) if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit) @@ -305,7 +320,7 @@ # objective and are solving as an LP problem. if(hasArg(ROI)) ROI=match.call(expand.dots=TRUE)$ROI else ROI=FALSE if(!ROI){ - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1) if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit) if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit) Modified: pkg/PortfolioAnalytics/R/stat.factor.model.R =================================================================== --- pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-04 00:47:01 UTC (rev 3406) +++ pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-05 00:44:46 UTC (rev 3407) @@ -249,7 +249,12 @@ # mfactorM2 : double # bbeta : vector of length NN - # Should I add checks here? These are passed from cokurtosisSF which already has checks + if(!is.integer(NN)) NN <- as.integer(NN) + if(length(sstockM2) != NN) stop("sstockM2 must be a vector of length NN") + if(length(sstockM4) != NN) stop("sstockM4 must be a vector of length NN") + if(!is.double(mfactorM2)) mfactorM2 <- as.double(mfactorM2) + if(length(bbeta) != NN) stop("bbeta must be a vector of length NN") + .Call('residualcokurtosisSF', NN, sstockM2, sstockM4, mfactorM2, bbeta, PACKAGE="PortfolioAnalytics") } @@ -428,7 +433,11 @@ # ssstockM4 : numeric vector of length NN # bbetacov : numeric vector of length NN * NN - # Should I add checks here? These are passed from cokurtosisSF which already has checks + if(!is.integer(NN)) NN <- as.integer(NN) + if(length(sstockM2) != NN) stop("sstockM2 must be a vector of length NN") + if(length(sstockM4) != NN) stop("sstockM4 must be a vector of length NN") + if(length(bbetacov) != NN*NN) stop("bbetacov must be a vector of length NN*NN") + .Call('residualcokurtosisMF', NN, sstockM2, sstockM4, bbetacov, PACKAGE="PortfolioAnalytics") } Modified: pkg/PortfolioAnalytics/demo/00Index =================================================================== --- pkg/PortfolioAnalytics/demo/00Index 2014-06-04 00:47:01 UTC (rev 3406) +++ pkg/PortfolioAnalytics/demo/00Index 2014-06-05 00:44:46 UTC (rev 3407) @@ -29,3 +29,4 @@ chart_concentration Demonstrate chart.Concentration multiple_portfolio_optimization Demonstrate passing a list of portfolios to optimize.portfolio and optimize.portfolio.rebalancing regime_switching Demonstrate optimization with support for regime switching to switch portfolios based on the regime. +higher_moments_boudt Demonstrate using a statistical factor model to estimate moments based on work by Kris Boudt. Added: pkg/PortfolioAnalytics/demo/higher_moments_boudt.R =================================================================== --- pkg/PortfolioAnalytics/demo/higher_moments_boudt.R (rev 0) +++ pkg/PortfolioAnalytics/demo/higher_moments_boudt.R 2014-06-05 00:44:46 UTC (rev 3407) @@ -0,0 +1,48 @@ +library(PortfolioAnalytics) + +# Examples of solving optimization problems using a statistical factor model +# to estimate the higher moments + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES", + arguments=list(p=0.9, clean="boudt")) + +# This is not necessary for the optimization, but demonstrates how the +# moments are estimated using portfolio.moments.boudt +cleanR <- Return.clean(R, "boudt") +fit <- statistical.factor.model(cleanR, 3) +sigma <- extractCovariance(fit) +m3 <- extractCoskewness(fit) +m4 <- extractCokurtosis(fit) + +moments.boudt <- portfolio.moments.boudt(R, init.portf, k=3) +all.equal(moments.boudt$sigma, sigma) +all.equal(moments.boudt$m3, m3) +all.equal(moments.boudt$m4, m4) + +# Generate set of random portfolios +rp <- random_portfolios(init.portf, 5000) + +# Optimization with sample estimates +# The default for momentFUN is set.portfolio.moments which computes +# the sample estimates of the moments +minES.lo.sample <- optimize.portfolio(R=R, portfolio=init.portf, + rp=rp, optimize_method="random", + trace=TRUE) + +# Optimization with statistical factor model estimates of the moments +minES.lo.boudt <- optimize.portfolio(R=R, portfolio=init.portf, + momentFUN=portfolio.moments.boudt, + k=3, rp=rp, + optimize_method="random", + trace=TRUE) + + Modified: pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd =================================================================== --- pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd 2014-06-04 00:47:01 UTC (rev 3406) +++ pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd 2014-06-05 00:44:46 UTC (rev 3407) @@ -26,4 +26,9 @@ functions using a statistical factor model based on the work of Kris Boudt. } +\note{ + If any of the objectives in the \code{portfolio} object + have \code{clean} as an argument, the cleaned returns are + used to fit the model. +} From noreply at r-forge.r-project.org Sat Jun 7 04:07:48 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 7 Jun 2014 04:07:48 +0200 (CEST) Subject: [Returnanalytics-commits] r3408 - pkg/PerformanceAnalytics/sandbox Message-ID: <20140607020748.837B7187156@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-07 04:07:47 +0200 (Sat, 07 Jun 2014) New Revision: 3408 Added: pkg/PerformanceAnalytics/sandbox/test_Return.rebalancing.R Modified: pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R Log: adding refactored return.rebalancing function with roxygen documentation and a test script Modified: pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R 2014-06-05 00:44:46 UTC (rev 3407) +++ pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R 2014-06-07 02:07:47 UTC (rev 3408) @@ -116,7 +116,7 @@ from = as.Date(index(weights[i,]))+1 to = as.Date(index(weights[i+1,])) returns = R[paste0(from,"::",to)] - print(return) + #print(returns) # get returns between rebalance dates for(j in 1:NROW(returns)){ @@ -163,4 +163,417 @@ result<-reclass(result, R) return(result) } -} \ No newline at end of file +} + +Return.rebalancing2 <- function (R, weights=NULL, on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), verbose=FALSE, ..., adj.capital=FALSE) { + on = on[1] + R = checkData(R, method="xts") + # find the right unit to subtract from the first return date to create a start date + freq = periodicity(R) + switch(freq$scale, + seconds = { stop("Use a returns series of daily frequency or higher.") }, + minute = { stop("Use a returns series of daily frequency or higher.") }, + hourly = { stop("Use a returns series of daily frequency or higher.") }, + daily = { time_unit = "day" }, + weekly = { time_unit = "week" }, + monthly = { time_unit= "month" }, + quarterly = { time_unit = "quarter" }, + yearly = { time_unit = "year"} + ) + # calculates the end of the prior period + start_date = seq(as.Date(index(R)[1]), length = 2, by = paste("-1", time_unit))[2] + + if(is.null(weights)){ + # generate equal weight vector for return columns + weights = rep(1/NCOL(R), NCOL(R)) + } + if(is.vector(weights)) { # weights are a vector + if(is.na(endpoints)) { # and endpoints are not specified + # then use the weights only at the beginning of the returns series, without rebalancing + weights = xts(weights, order.by=as.Date(start_date)) + } + else { # and endpoints are specified + # generate a time series of the given weights at the endpoints + weight_dates = c(as.Date(start_date),time(R[endpoints(R, on=on)])) + weights = xts(matrix(rep(1/NCOL(R), length(weight_dates)*NCOL(R)), ncol=NCOL(R)), order.by=weight_dates) + } + colnames(weights) = colnames(R) + } + else { # check the beginning_weights object for errors + # check that weights are given in a form that is probably a time series + weights = checkData(weights, method="xts") + # make sure that frequency(weights) NCOL(weights)){ + R <- R[, 1:NCOL(weights)] + warning("number of assets in beginning_weights is less than number of columns in returns, so subsetting returns.") + } else { + stop("number of assets is greater than number of columns in returns object") + } + } + } # we should have good weights objects at this point + + leverage = 1 + # create an empty variables for storage + #x.capital_adj = NULL + x.capital_adj = xts(matrix(0, NROW(R), 1), as.Date(index(R))) + + #x.starting_weights = NULL + x.starting_weights = xts(matrix(0, NROW(R), NCOL(R)), as.Date(index(R))) + + #x.ending_weights = NULL + x.ending_weights = x.starting_weights + + x.sum_ending_weights = xts(matrix(1, ncol=1), order.by=as.Date(start_date)) + + #x.sum_starting_weights = NULL + x.sum_starting_weights = xts(matrix(0, nrow(R), 1), as.Date(index(R))) + + #x.contributions = NULL + x.contributions = x.starting_weights + + #x.portfolio_return = NULL + x.portfolio_return = xts(matrix(0, NROW(R), 1), as.Date(index(R))) + + # loop over rebalance periods + start_date=index(weights)[1] + + # counter + k <- 1 + for(i in 1:(NROW(weights)-1)) { + # identify rebalance from and to dates (weights[i,], weights[i+1]) + from = as.Date(index(weights[i,]))+1 + to = as.Date(index(weights[i+1,])) + returns = R[paste0(from,"::",to)] + #print(returns) + + # get returns between rebalance dates + for(j in 1:NROW(returns)){ + if(j==1) {# if first period of rebalance + if(!adj.capital) + starting_weights = as.numeric(last(x.sum_ending_weights,1)) * weights[i,] + else + starting_weights = weights[i,] + } + else + starting_weights = last(x.ending_weights,1) + contributions = coredata(starting_weights) * coredata(returns[j,]) + ending_weights = contributions + starting_weights # has the wrong date + portfolio_return = sum(contributions) + sum_prior_ending_weights = last(x.sum_ending_weights,1) + sum_starting_weights = sum(starting_weights) + sum_ending_weights = sum(ending_weights) + capital_adj = sum(starting_weights) - sum_prior_ending_weights + + # store results + #x.starting_weights = rbind(x.starting_weights, xts(starting_weights, order.by=index(returns[j,]))) + x.starting_weights[k,] = starting_weights + + #x.contributions = rbind(x.contributions, xts(contributions, order.by=index(returns[j,]))) + x.contributions[k,] = contributions + + #x.ending_weights = rbind(x.ending_weights, xts(ending_weights, order.by=index(returns[j,]))) + x.ending_weights[k,] = ending_weights + + #x.portfolio_return = rbind(x.portfolio_return, xts(portfolio_return, order.by=index(returns[j,]))) + x.portfolio_return[k,] = portfolio_return + + #x.sum_starting_weights = rbind(x.sum_starting_weights, xts(sum_starting_weights, order.by=index(returns[j,]))) + x.sum_starting_weights[k,] = sum_starting_weights + + x.sum_ending_weights = rbind(x.sum_ending_weights, xts(sum_ending_weights, order.by=index(returns[j,]))) + #x.sum_ending_weights[k,] = sum_ending_weights + + #x.capital_adj = rbind(x.capital_adj, xts(capital_adj, order.by=index(returns[j,]))) + x.capital_adj[k,] = capital_adj + k <- k + 1 + } + } + colnames(x.portfolio_return) = "Portfolio" + colnames(x.capital_adj) = "Implied Capital Change" + if(verbose){ # return full list of calculations + result = list(Starting_Weights = x.starting_weights, + Contributions = x.contributions, + Ending_Weights = x.ending_weights, + Portfolio_Return = x.portfolio_return, + Sum_Ending_Weights = x.sum_ending_weights, + Implied_Capital_Adj = x.capital_adj + ) + return(result) + } + else { # return resulting time series only + result=x.portfolio_return + result<-reclass(result, R) + return(result) + } +} + + +#' Calculate weighted returns for a portfolio of assets +#' +#' Using a time series of returns and any regular or irregular time series of weights +#' for each asset, this function calculates the returns of a portfolio with the same +#' periodicity of the returns data. +#' +#' By default, this function calculates the time series of portfolio returns given asset +#' returns and weights. In verbose mode, the function returns a list of intermediary +#' calculations that users may find helpful, including both asset contribution and +#' asset value through time. +#' +#' When asset return and weights are matched by period, contribution is simply the +#' weighted return of the asset. c_i = w_i * R_i Contributions are summable across the +#' portfolio to calculate the total portfolio return. +#' +#' Contribution cannot be aggregated through time. For example, say we have an equal +#' weighted portfolio of five assets with monthly returns. The geometric return of the +#' portfolio over several months won't match any aggregation of the individual +#' contributions of the assets, particularly if any rebalancing was done during the +#' period. +#' +#' To aggregate contributions through time such that they are summable to the geometric +#' returns of the portfolio, the calculation must track changes in the notional value of +#' the assets and portfolio. For example, contribution during a quarter will be +#' calculated as the change in value of the position through those three months, divided +#' by the original value of the portfolio. Approaching it this way makes the +#' calculation robust to weight changes as well. c_pi = V_(t-p)i - V_t)/V_ti +#' +#' If the user does not specify weights, an equal weight portfolio is assumed. +#' Alternatively, a vector or single-row matrix of weights that matches the length +#' of the asset columns may be specified. In either case, if no rebalancing period is +#' specified, the weights will be applied at the beginning of the asset time series +#' and no further rebalancing will take place. If a rebalancing period is specified, +#' the portfolio will be rebalanced to the starting weights at the interval specified. +#' +#' Return.rebalancing will work only on daily or lower frequencies. If you are +#' rebalancing intraday, you should be using a trades/prices framework like +#' {\link{\code{blotter}}}, not a weights/returns framework. +#' +#' Irregular rebalancing can be done by specifying a time series of weights. The +#' function uses the date index of the weights for xts-style subsetting of rebalancing +#' periods. +#' +#' Weights specified for rebalancing should be thought of as "end-of-period" weights. +#' Rebalancing periods can be thought of as taking effect immediately after the close +#' of the bar. So, a March 31 rebalancing date will actually be in effect for April 1. +#' A December 31 rebalancing date will be in effect on Jan 1, and so forth. This +#' convention was chosen because it fits with common usage, and because it simplifies +#' xts Date subsetting via endpoints. +#' +#' In verbose mode, the function returns a list of data and intermediary calculations. +#' \itemize{ +#' \item{\code{returns}:}{ The portfolio returns.} +#' \item{\code{contribution}:}{ The per period contribution to portfolio +#' return of each asset. Contribution is calculated as BOP weight times the +#' period's return divided by BOP value. Period contributions are summed +#' across the individual assets to calculate portfolio return} +#' \item{\code{BOP.Weight}:}{ Beginning of Period (BOP) Weight for each +#' asset. An asset's BOP weight is calculated using the input weights +#' (or assumed weights, see below) and rebalancing parameters given. The next +#' period's BOP weight is either the EOP weights from the prior period or +#' input weights given on a rebalance period.} +#' \item{\code{EOP.Weight:}}{ End of Period (BOP) Weight for each asset. +#' An asset's EOP weight is the sum of the asset's BOP weight and +#' contribution for the period divided by the sum of the contributions and +#' initial weights for the portfolio.} +#' \item{\code{BOP.Value:}}{ BOP Value for each asset. The BOP value for each +#' asset is the asset's EOP value from the prior period, unless there is a +#' rebalance event. If there is a rebalance event, the BOP value of the +#' asset is the rebalance weight times the EOP value of the portfolio. That +#' effectively provides a zero-transaction cost change to the position values +#' as of that date to reflect the rebalance. Note that the sum of the BOP +#' values of the assets is the same as the prior period's EOP portfolio value.} +#' \item{\code{EOP.Value:}}{ EOP Value for each asset. The EOP value is for +#' each asset is calculated as (1 + asset return) times the asset's BOP value. +#' The EOP portfolio value is the sum of EOP value across assets.} +#' } +#' +#' To calculate BOP and EOP position value, we create an index for each position. The +#' sum of that value across assets represents an indexed value of the total portfolio. +#' The change in value contained in slot seven is the asset's period return times its +#' BOP value. +#' +#' From the value calculations, we can calculate different aggregations through time +#' for the asset contributions. Those are calculated as the EOP asset value less the +#' BOP asset value; that quantity is divided by the BOP portfolio value. +#' Across assets, those will sum to equal the geometric chained returns of the +#' portfolio for that same time period. The function does not do this directly, however. +#' +#' @aliases Return.portfolio Return.rebalancing +#' @param R An xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param weights A time series or single-row matrix/vector containing asset +#' weights, as decimal percentages, treated as beginning of period weights. See Details below. +#' @param rebalance_on Default "none"; alternatively "daily" "weekly" "monthly" "annual" to specify calendar-period rebalancing supported by \code{endpoints}. +#' @param value The beginning of period total portfolio value. This is used for calculating position value. +#' @param verbose If verbose is TRUE, return a list of intermediary calculations. +#' See Details below. +#' @param \dots any other passthru parameters. Not currently used. +#' @return returns a time series of returns weighted by the \code{weights} +#' parameter, or a list that includes intermediate calculations +#' @author Peter Carl, Ross Bennett, Brian Peterson +#' @seealso \code{\link{Return.calculate}} \code{\link{xts::endpoints}} \cr +#' @references Bacon, C. \emph{Practical Portfolio Performance Measurement and +#' Attribution}. Wiley. 2004. Chapter 2\cr +#' @keywords ts multivariate distribution models +#' @examples +#' data(edhec) +#' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly") # returns time series +#' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly", verbose=TRUE) # returns list +#' @export +Return.rebalancing3 <- function(R, + weights=NULL, + rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), + value=1, + verbose=FALSE, + ...){ + R = checkData(R, method="xts") + rebalance_on = rebalance_on[1] + + # find the right unit to subtract from the first return date to create a start date + freq = periodicity(R) + switch(freq$scale, + seconds = { stop("Use a returns series of daily frequency or higher.") }, + minute = { stop("Use a returns series of daily frequency or higher.") }, + hourly = { stop("Use a returns series of daily frequency or higher.") }, + daily = { time_unit = "day" }, + weekly = { time_unit = "week" }, + monthly = { time_unit= "month" }, + quarterly = { time_unit = "quarter" }, + yearly = { time_unit = "year"} + ) + + # calculates the end of the prior period + start_date = seq(as.Date(index(R)[1]), length = 2, by = paste("-1", time_unit))[2] + + if(is.null(weights)){ + # generate equal weight vector for return columns + weights = rep(1 / NCOL(R), NCOL(R)) + } + if(is.vector(weights)) { # weights are a vector + if(is.na(rebalance_on)) { # and endpoints are not specified + # then use the weights only at the beginning of the returns series, without rebalancing + weights = xts(matrix(weights, nrow=1), order.by=as.Date(start_date)) + } else { # and endpoints are specified + # generate a time series of the given weights at the endpoints + weight_dates = c(as.Date(start_date), index(R[endpoints(R, on=rebalance_on)])) + weights = xts(matrix(rep(weights, length(weight_dates)), ncol=NCOL(R), byrow=TRUE), order.by=as.Date(weight_dates)) + } + colnames(weights) = colnames(R) + } else { # check the beginning_weights object for errors + # check that weights are given in a form that is probably a time series + weights = checkData(weights, method="xts") + # make sure that frequency(weights) NCOL(weights)){ + R = R[, 1:NCOL(weights)] + warning("number of assets in beginning_weights is less than number of columns in returns, so subsetting returns.") + } else { + stop("number of assets is greater than number of columns in returns object") + } + } + } # we should have good weights objects at this point + + if(as.Date(last(index(R))) < (as.Date(index(weights[1,]))+1)){ + stop(paste('last date in series',as.Date(last(index(R))),'occurs before beginning of first rebalancing period',as.Date(first(index(weights)))+1)) + } + + # Subset the R object if the first rebalance date is after the first date + # in the return series + if(as.Date(index(weights[1,])) > as.Date(first(index(R)))) { + R <- R[paste0(as.Date(index(weights[1,]))+1, "/")] + } + + # bop = beginning of period + # eop = end of period + # Initialize objects + bop_value = matrix(0, NROW(R), NCOL(R)) + colnames(bop_value) = colnames(R) + eop_value = bop_value + if(verbose){ + bop_weights = bop_value + eop_weights = bop_value + period_contrib = bop_value + } + ret = eop_value_total = bop_value_total = vector("numeric", NROW(R)) + + # The end_value is the end of period total value from the prior period + end_value <- value + + # initialize counter + k = 1 + for(i in 1:NROW(weights)) { + # identify rebalance from and to dates (weights[i,], weights[i+1]) and + # subset the R(eturns) object + from = as.Date(index(weights[i,]))+1 + if (i == nrow(weights)){ + to = as.Date(index(last(R))) # this is correct + } else { + to = as.Date(index(weights[(i+1),])) + } + returns = R[paste0(from, "::", to)] + + # Only enter the loop if we have a valid returns object + if(nrow(returns) >= 1){ + # inner loop counter + jj = 1 + for(j in 1:nrow(returns)){ + # We need to know when we are at the start of this inner loop so we can + # set the correct beginning of period value. We start a new inner loop + # at each rebalance date. + # Compute beginning of period values + if(jj == 1){ + bop_value[k,] = end_value * weights[i,] + } else { + bop_value[k,] = eop_value[k-1,] + } + bop_value_total[k] = sum(bop_value[k,]) + + # Compute end of period values + eop_value[k,] = (1 + coredata(returns[j,])) * bop_value[k,] + eop_value_total[k] = sum(eop_value[k,]) + + if(verbose){ + # Compute bop and eop weights + bop_weights[k,] = bop_value[k,] / bop_value_total[k] + eop_weights[k,] = eop_value[k,] / eop_value_total[k] + # Compute period contribution + period_contrib[k,] = returns[j,] * bop_value[k,] / sum(bop_value[k,]) + } + + # Compute portfolio returns + # Could also compute this by summing contribution, but this way we + # don't have to compute contribution if verbose=FALSE + ret[k] = eop_value_total[k] / end_value - 1 + + # Update end_value + end_value = eop_value_total[k] + + # increment the counters + jj = jj + 1 + k = k + 1 + } + } + } + R.idx = index(R) + ret = xts(ret, R.idx) + colnames(ret) = "portfolio.returns" + + if(verbose){ + out = list() + out$returns = ret + out$contribution = xts(period_contrib, R.idx) + out$BOP.Weight = xts(bop_weights, R.idx) + out$EOP.Weight = xts(eop_weights, R.idx) + out$BOP.Value = xts(bop_value, R.idx) + out$EOP.Value = xts(eop_value, R.idx) + } else { + out = ret + } + return(out) +} + Added: pkg/PerformanceAnalytics/sandbox/test_Return.rebalancing.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/test_Return.rebalancing.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/test_Return.rebalancing.R 2014-06-07 02:07:47 UTC (rev 3408) @@ -0,0 +1,42 @@ +library(PerformanceAnalytics) +data(edhec) +R <- edhec["1997",1:5] +colnames(R) <- c("CA", "CTA", "Distr", "EM", "EMN") + +# Note: I verified these results by semi-random spot checks with the +# spreadsheet calculations. Will add more comprehensive tests as time permits. + +# Case 1: User inputs returns only +# Equally weighted portfolio with no rebalancing +out1 <- Return.rebalancing3(R) + + +# Case 2: User input weights with no rebalancing +out2 <- Return.rebalancing3(R, weights=c(0, 0.2, 0.4, 0.1, 0.3), + verbose=TRUE) + + +# Case 3: User input weights and rebalancing frequency +out3 <- Return.rebalancing3(R, weights=c(0, 0.2, 0.4, 0.1, 0.3), + rebalance_on="quarters") + +# Case 4: User input xts object for weights +rebal_dates <- c("1996-12-31", "1997-03-31", "1997-06-30", "1997-09-30") +weights <- xts(matrix(1/ncol(R), nrow=length(rebal_dates), ncol=ncol(R)), + as.Date(rebal_dates)) +out4 <- Return.rebalancing3(R, weights, value=5, verbose=TRUE) +all.equal(rowSums(out4$contribution), as.numeric(out4$returns)) + +out4a <- Return.rebalancing3(R, rebalance_on="quarters", value=5, verbose=TRUE) +all.equal(out4, out4a) + +# out4 and out4a should match Peter's spreadsheet exactly + +# Weights that start after first observation in returns +rebal_dates <- c("1997-03-31", "1997-06-30", "1997-09-30") +weights <- xts(matrix(1/ncol(R), nrow=length(rebal_dates), ncol=ncol(R)), as.Date(rebal_dates)) +out4b <- Return.rebalancing3(R, weights) + +# Case 5: Equally weighted portfolio with monthly rebalancing +out5 <- Return.rebalancing3(R, rebalance_on="months", value=1) + From noreply at r-forge.r-project.org Sat Jun 7 17:14:49 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 7 Jun 2014 17:14:49 +0200 (CEST) Subject: [Returnanalytics-commits] r3409 - pkg/PerformanceAnalytics/sandbox Message-ID: <20140607151449.24B3F1863E1@r-forge.r-project.org> Author: peter_carl Date: 2014-06-07 17:14:48 +0200 (Sat, 07 Jun 2014) New Revision: 3409 Modified: pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R Log: - added to examples Modified: pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R 2014-06-07 02:07:47 UTC (rev 3408) +++ pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R 2014-06-07 15:14:48 UTC (rev 3409) @@ -421,6 +421,13 @@ #' data(edhec) #' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly") # returns time series #' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly", verbose=TRUE) # returns list +#' # with a weights object +#' data(weights) # rebalance at the beginning of the year to various weights through time +#' chart.StackedBar(weights) +#' x <- Return.rebalancing(edhec["2000::",1:11], weights=weights,verbose=TRUE) +#' chart.CumReturns(x$returns) +#' chart.StackedBar(x$BOP.Weight) +#' chart.StackedBar(x$BOP.Value) #' @export Return.rebalancing3 <- function(R, weights=NULL, From noreply at r-forge.r-project.org Sat Jun 7 17:21:20 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 7 Jun 2014 17:21:20 +0200 (CEST) Subject: [Returnanalytics-commits] r3410 - pkg/PerformanceAnalytics/R Message-ID: <20140607152120.A2FDA18707A@r-forge.r-project.org> Author: peter_carl Date: 2014-06-07 17:21:20 +0200 (Sat, 07 Jun 2014) New Revision: 3410 Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R Log: - Refactored and replaced the function, thanks Ross Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-07 15:14:48 UTC (rev 3409) +++ pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-07 15:21:20 UTC (rev 3410) @@ -1,231 +1,273 @@ -#' @rdname Return.portfolio -#' @export -Return.rebalancing <- function (R, weights, ...) -{ # @author Brian G. Peterson - - if (is.vector(weights)){ - stop("Use Return.portfolio for single weighting vector. This function is for building portfolios over rebalancing periods.") - } - weights=checkData(weights,method="xts") - R=checkData(R,method="xts") - - if(as.Date(first(index(R))) > (as.Date(index(weights[1,]))+1)) { - warning(paste('data series starts on',as.Date(first(index(R))),', which is after the first rebalancing period',as.Date(first(index(weights)))+1)) - } - if(as.Date(last(index(R))) < (as.Date(index(weights[1,]))+1)){ - stop(paste('last date in series',as.Date(last(index(R))),'occurs before beginning of first rebalancing period',as.Date(first(index(weights)))+1)) - } - # loop: - for (row in 1:nrow(weights)){ - from =as.Date(index(weights[row,]))+1 - if (row == nrow(weights)){ - to = as.Date(index(last(R))) # this is correct - } else { - to = as.Date(index(weights[(row+1),])) - } - if(row==1){ - startingwealth=1 - } - tmpR<-R[paste(from,to,sep="/"),] - if (nrow(tmpR)>=1){ - resultreturns=Return.portfolio(tmpR,weights=weights[row,], ...=...) - if(row==1){ - result = resultreturns - } else { - result = rbind(result,resultreturns) - } - } - startingwealth=last(cumprod(1+result)*startingwealth) - } - result<-reclass(result, R) - result -} - -# ------------------------------------------------------------------------------ -# Return.portfolio - - - - -#' Calculates weighted returns for a portfolio of assets +#' Calculate weighted returns for a portfolio of assets +#' +#' Using a time series of returns and any regular or irregular time series of weights +#' for each asset, this function calculates the returns of a portfolio with the same +#' periodicity of the returns data. +#' +#' By default, this function calculates the time series of portfolio returns given asset +#' returns and weights. In verbose mode, the function returns a list of intermediary +#' calculations that users may find helpful, including both asset contribution and +#' asset value through time. #' -#' Calculates weighted returns for a portfolio of assets. If you have a single -#' weighting vector, or want the equal weighted portfolio, use -#' \code{Return.portfolio}. If you have a portfolio that is periodically -#' rebalanced, and multiple time periods with different weights, use -#' \code{Return.rebalancing}. Both functions will subset the return series to -#' only include returns for assets for which \code{weight} is provided. +#' When asset return and weights are matched by period, contribution is simply the +#' weighted return of the asset. c_i = w_i * R_i Contributions are summable across the +#' portfolio to calculate the total portfolio return. #' -#' \code{Return.rebalancing} uses the date in the weights time series or matrix -#' for xts-style subsetting of rebalancing periods. Rebalancing periods can be -#' thought of as taking effect immediately after the close of the bar. So, a -#' March 31 rebalancing date will actually be in effect for April 1. A -#' December 31 rebalancing date will be in effect on Jan 1, and so forth. This -#' convention was chosen because it fits with common usage, and because it -#' simplifies xts Date subsetting via \code{endpoints}. +#' Contribution cannot be aggregated through time. For example, say we have an equal +#' weighted portfolio of five assets with monthly returns. The geometric return of the +#' portfolio over several months won't match any aggregation of the individual +#' contributions of the assets, particularly if any rebalancing was done during the +#' period. #' -#' \code{Return.rebalancing} will rebalance only on daily or lower frequencies. -#' If you are rebalancing intraday, you should be using a trading/prices -#' framework, not a weights-based return framework. +#' To aggregate contributions through time such that they are summable to the geometric +#' returns of the portfolio, the calculation must track changes in the notional value of +#' the assets and portfolio. For example, contribution during a quarter will be +#' calculated as the change in value of the position through those three months, divided +#' by the original value of the portfolio. Approaching it this way makes the +#' calculation robust to weight changes as well. c_pi = V_(t-p)i - V_t)/V_ti #' +#' If the user does not specify weights, an equal weight portfolio is assumed. +#' Alternatively, a vector or single-row matrix of weights that matches the length +#' of the asset columns may be specified. In either case, if no rebalancing period is +#' specified, the weights will be applied at the beginning of the asset time series +#' and no further rebalancing will take place. If a rebalancing period is specified, +#' the portfolio will be rebalanced to the starting weights at the interval specified. +#' +#' Return.rebalancing will work only on daily or lower frequencies. If you are +#' rebalancing intraday, you should be using a trades/prices framework like +#' {\link{\code{blotter}}}, not a weights/returns framework. +#' +#' Irregular rebalancing can be done by specifying a time series of weights. The +#' function uses the date index of the weights for xts-style subsetting of rebalancing +#' periods. +#' +#' Weights specified for rebalancing should be thought of as "end-of-period" weights. +#' Rebalancing periods can be thought of as taking effect immediately after the close +#' of the bar. So, a March 31 rebalancing date will actually be in effect for April 1. +#' A December 31 rebalancing date will be in effect on Jan 1, and so forth. This +#' convention was chosen because it fits with common usage, and because it simplifies +#' xts Date subsetting via endpoints. +#' +#' In verbose mode, the function returns a list of data and intermediary calculations. +#' \itemize{ +#' \item{\code{returns}:}{ The portfolio returns.} +#' \item{\code{contribution}:}{ The per period contribution to portfolio +#' return of each asset. Contribution is calculated as BOP weight times the +#' period's return divided by BOP value. Period contributions are summed +#' across the individual assets to calculate portfolio return} +#' \item{\code{BOP.Weight}:}{ Beginning of Period (BOP) Weight for each +#' asset. An asset's BOP weight is calculated using the input weights +#' (or assumed weights, see below) and rebalancing parameters given. The next +#' period's BOP weight is either the EOP weights from the prior period or +#' input weights given on a rebalance period.} +#' \item{\code{EOP.Weight:}}{ End of Period (BOP) Weight for each asset. +#' An asset's EOP weight is the sum of the asset's BOP weight and +#' contribution for the period divided by the sum of the contributions and +#' initial weights for the portfolio.} +#' \item{\code{BOP.Value:}}{ BOP Value for each asset. The BOP value for each +#' asset is the asset's EOP value from the prior period, unless there is a +#' rebalance event. If there is a rebalance event, the BOP value of the +#' asset is the rebalance weight times the EOP value of the portfolio. That +#' effectively provides a zero-transaction cost change to the position values +#' as of that date to reflect the rebalance. Note that the sum of the BOP +#' values of the assets is the same as the prior period's EOP portfolio value.} +#' \item{\code{EOP.Value:}}{ EOP Value for each asset. The EOP value is for +#' each asset is calculated as (1 + asset return) times the asset's BOP value. +#' The EOP portfolio value is the sum of EOP value across assets.} +#' } +#' +#' To calculate BOP and EOP position value, we create an index for each position. The +#' sum of that value across assets represents an indexed value of the total portfolio. +#' The change in value contained in slot seven is the asset's period return times its +#' BOP value. +#' +#' From the value calculations, we can calculate different aggregations through time +#' for the asset contributions. Those are calculated as the EOP asset value less the +#' BOP asset value; that quantity is divided by the BOP portfolio value. +#' Across assets, those will sum to equal the geometric chained returns of the +#' portfolio for that same time period. The function does not do this directly, however. +#' #' @aliases Return.portfolio Return.rebalancing -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' @param R An xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns -#' @param weights a time series or single-row matrix/vector containing asset -#' weights, as percentages -#' @param wealth.index TRUE/FALSE whether to return a wealth index, default -#' FALSE -#' @param contribution if contribution is TRUE, add the weighted return -#' contributed by the asset in this period -#' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining (FALSE) to aggregate returns, -#' default TRUE -#' @param \dots any other passthru parameters +#' @param weights A time series or single-row matrix/vector containing asset +#' weights, as decimal percentages, treated as beginning of period weights. See Details below. +#' @param rebalance_on Default "none"; alternatively "daily" "weekly" "monthly" "annual" to specify calendar-period rebalancing supported by \code{endpoints}. +#' @param value The beginning of period total portfolio value. This is used for calculating position value. +#' @param verbose If verbose is TRUE, return a list of intermediary calculations. +#' See Details below. +#' @param \dots any other passthru parameters. Not currently used. #' @return returns a time series of returns weighted by the \code{weights} -#' parameter, possibly including contribution for each period -#' @author Brian G. Peterson -#' @seealso \code{\link{Return.calculate}} \cr +#' parameter, or a list that includes intermediate calculations +#' @author Peter Carl, Ross Bennett, Brian Peterson +#' @seealso \code{\link{Return.calculate}} \code{\link{xts::endpoints}} \cr #' @references Bacon, C. \emph{Practical Portfolio Performance Measurement and #' Attribution}. Wiley. 2004. Chapter 2\cr #' @keywords ts multivariate distribution models #' @examples -#' -#' #' data(edhec) -#' data(weights) -#' -#' # calculate an equal weighted portfolio return -#' round(Return.portfolio(edhec),4) -#' -#' # now return the contribution too -#' round(Return.portfolio(edhec,contribution=TRUE),4) -#' -#' # calculate a portfolio return with rebalancing -#' round(Return.rebalancing(edhec,weights),4) -#' +#' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly") # returns time series +#' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly", verbose=TRUE) # returns list +#' # with a weights object +#' data(weights) # rebalance at the beginning of the year to various weights through time +#' chart.StackedBar(weights) +#' x <- Return.rebalancing(edhec["2000::",1:11], weights=weights,verbose=TRUE) +#' chart.CumReturns(x$returns) +#' chart.StackedBar(x$BOP.Weight) +#' chart.StackedBar(x$BOP.Value) #' @export -Return.portfolio <- function (R, weights=NULL, wealth.index = FALSE, contribution=FALSE,geometric=TRUE, ...) -{ # @author Brian G. Peterson - - # Function to calculate weighted portfolio returns - # - # old function pfpolioReturn in RMetrics used continuous compunding, which isn't accurate. - # new function lets weights float after initial period, and produces correct results. - # - # R data structure of component returns - # - # weights usually a numeric vector which has the length of the number - # of assets. The weights measures the normalized weights of - # the individual assets. By default 'NULL', then an equally - # weighted set of assets is assumed. - # - # method: "simple", "compound" - # - # wealth.index if wealth.index is TRUE, return a wealth index, if false, return a return vector for each period - # - # contribution if contribution is TRUE, add the weighted return contributed by the asset in this period - - # Setup: - R=checkData(R,method="xts") - if(!nrow(R)>=1){ - warning("no data passed for R(eturns)") - return(NULL) +Return.rebalancing3 <- function(R, + weights=NULL, + rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), + value=1, + verbose=FALSE, + ...){ + R = checkData(R, method="xts") + rebalance_on = rebalance_on[1] + + # find the right unit to subtract from the first return date to create a start date + freq = periodicity(R) + switch(freq$scale, + seconds = { stop("Use a returns series of daily frequency or higher.") }, + minute = { stop("Use a returns series of daily frequency or higher.") }, + hourly = { stop("Use a returns series of daily frequency or higher.") }, + daily = { time_unit = "day" }, + weekly = { time_unit = "week" }, + monthly = { time_unit= "month" }, + quarterly = { time_unit = "quarter" }, + yearly = { time_unit = "year"} + ) + + # calculates the end of the prior period + start_date = seq(as.Date(index(R)[1]), length = 2, by = paste("-1", time_unit))[2] + + if(is.null(weights)){ + # generate equal weight vector for return columns + weights = rep(1 / NCOL(R), NCOL(R)) + } + if(is.vector(weights)) { # weights are a vector + if(is.na(rebalance_on)) { # and endpoints are not specified + # then use the weights only at the beginning of the returns series, without rebalancing + weights = xts(matrix(weights, nrow=1), order.by=as.Date(start_date)) + } else { # and endpoints are specified + # generate a time series of the given weights at the endpoints + weight_dates = c(as.Date(start_date), index(R[endpoints(R, on=rebalance_on)])) + weights = xts(matrix(rep(weights, length(weight_dates)), ncol=NCOL(R), byrow=TRUE), order.by=as.Date(weight_dates)) } - # take only the first method - if(hasArg(method) & !is.null(list(...)$method)) - method = list(...)$method[1] - else if(!isTRUE(geometric)) - method='simple' - else method=FALSE - - if (is.null(weights)){ - # set up an equal weighted portfolio - weights = t(rep(1/ncol(R), ncol(R))) - warning("weighting vector is null, calulating an equal weighted portfolio") - colnames(weights)<-colnames(R) - } else{ - weights=checkData(weights,method="matrix") # do this to make sure we have columns, and not just a vector - } - if (nrow(weights)>1){ - if ((nrow(weights)==ncol(R) |nrow(weights)==ncol(R[,names(weights)]) ) & (ncol(weights)==1)) { - weights = t(weights) #this was a vector that got transformed - } else { - stop("Use Return.rebalancing for multiple weighting periods. This function is for portfolios with a single set of weights.") - } - } - if (is.null(colnames(weights))) { colnames(weights)<-colnames(R) } - - #Function: - - - # construct the wealth index - if(method=="simple" | nrow(R) == 1) { - # weights=as.vector(weights) - weightedreturns = R[,colnames(weights)] * as.vector(weights) # simple weighted returns - returns = R[,colnames(weights)] %*% as.vector(weights) # simple compound returns - if(wealth.index) { - wealthindex = as.matrix(cumsum(returns),ncol=1) # simple wealth index + colnames(weights) = colnames(R) + } else { # check the beginning_weights object for errors + # check that weights are given in a form that is probably a time series + weights = checkData(weights, method="xts") + # make sure that frequency(weights) NCOL(weights)){ + R = R[, 1:NCOL(weights)] + warning("number of assets in beginning_weights is less than number of columns in returns, so subsetting returns.") } else { - result = returns + stop("number of assets is greater than number of columns in returns object") } - } else { - #things are a little more complicated for the geometric case - - # first construct an unweighted wealth index of the assets - wealthindex.assets=cumprod(1+R[,colnames(weights)]) - - wealthindex.weighted = matrix(nrow=nrow(R),ncol=ncol(R[,colnames(weights)])) - colnames(wealthindex.weighted)=colnames(wealthindex.assets) - rownames(wealthindex.weighted)=as.character(index(wealthindex.assets)) - # weight the results - for (col in colnames(weights)){ - wealthindex.weighted[,col]=weights[,col]*wealthindex.assets[,col] - } - wealthindex=apply(wealthindex.weighted,1,sum) - - # weighted cumulative returns - weightedcumcont=t(apply (wealthindex.assets,1, function(x,weights){ as.vector((x-1)* weights)},weights=weights)) - weightedreturns=diff(rbind(0,weightedcumcont)) # compound returns - colnames(weightedreturns)=colnames(wealthindex.assets) - if (!wealth.index){ - result=as.matrix(apply(weightedreturns,1,sum),ncol=1) - } else { - wealthindex=matrix(cumprod(1 + as.matrix(apply(weightedreturns,1, sum), ncol = 1)),ncol=1) - } } - - - if (!wealth.index){ - colnames(result)="portfolio.returns" + } # we should have good weights objects at this point + + if(as.Date(last(index(R))) < (as.Date(index(weights[1,]))+1)){ + stop(paste('last date in series',as.Date(last(index(R))),'occurs before beginning of first rebalancing period',as.Date(first(index(weights)))+1)) + } + + # Subset the R object if the first rebalance date is after the first date + # in the return series + if(as.Date(index(weights[1,])) > as.Date(first(index(R)))) { + R <- R[paste0(as.Date(index(weights[1,]))+1, "/")] + } + + # bop = beginning of period + # eop = end of period + # Initialize objects + bop_value = matrix(0, NROW(R), NCOL(R)) + colnames(bop_value) = colnames(R) + eop_value = bop_value + if(verbose){ + bop_weights = bop_value + eop_weights = bop_value + period_contrib = bop_value + } + ret = eop_value_total = bop_value_total = vector("numeric", NROW(R)) + + # The end_value is the end of period total value from the prior period + end_value <- value + + # initialize counter + k = 1 + for(i in 1:NROW(weights)) { + # identify rebalance from and to dates (weights[i,], weights[i+1]) and + # subset the R(eturns) object + from = as.Date(index(weights[i,]))+1 + if (i == nrow(weights)){ + to = as.Date(index(last(R))) # this is correct } else { - wealthindex=reclass(wealthindex,match.to=R) - result=wealthindex - colnames(result)="portfolio.wealthindex" + to = as.Date(index(weights[(i+1),])) } - - if (contribution==TRUE){ - # show the contribution to the returns in each period. - result=cbind(weightedreturns, coredata(result)) + returns = R[paste0(from, "::", to)] + + # Only enter the loop if we have a valid returns object + if(nrow(returns) >= 1){ + # inner loop counter + jj = 1 + for(j in 1:nrow(returns)){ + # We need to know when we are at the start of this inner loop so we can + # set the correct beginning of period value. We start a new inner loop + # at each rebalance date. + # Compute beginning of period values + if(jj == 1){ + bop_value[k,] = end_value * weights[i,] + } else { + bop_value[k,] = eop_value[k-1,] + } + bop_value_total[k] = sum(bop_value[k,]) + + # Compute end of period values + eop_value[k,] = (1 + coredata(returns[j,])) * bop_value[k,] + eop_value_total[k] = sum(eop_value[k,]) + + if(verbose){ + # Compute bop and eop weights + bop_weights[k,] = bop_value[k,] / bop_value_total[k] + eop_weights[k,] = eop_value[k,] / eop_value_total[k] + # Compute period contribution + period_contrib[k,] = returns[j,] * bop_value[k,] / sum(bop_value[k,]) + } + + # Compute portfolio returns + # Could also compute this by summing contribution, but this way we + # don't have to compute contribution if verbose=FALSE + ret[k] = eop_value_total[k] / end_value - 1 + + # Update end_value + end_value = eop_value_total[k] + + # increment the counters + jj = jj + 1 + k = k + 1 + } } - rownames(result)<-NULL # avoid a weird problem with rbind, per Jeff - result<-reclass(result, R) - result -} # end function Return.portfolio - -pfolioReturn <- function (x, weights=NULL, ...) -{ # @author Brian G. Peterson - # pfolioReturn wrapper - replaces RMetrics pfolioReturn fn - - Return.portfolio(R=x, weights=weights, ...=...) + } + R.idx = index(R) + ret = xts(ret, R.idx) + colnames(ret) = "portfolio.returns" + + if(verbose){ + out = list() + out$returns = ret + out$contribution = xts(period_contrib, R.idx) + out$BOP.Weight = xts(bop_weights, R.idx) + out$EOP.Weight = xts(eop_weights, R.idx) + out$BOP.Value = xts(bop_value, R.idx) + out$EOP.Value = xts(eop_value, R.idx) + } else { + out = ret + } + return(out) } -############################################################################### -# R (http://r-project.org/) Econometrics for Performance and Risk Analysis -# -# Copyright (c) 2004-2014 Peter Carl and Brian G. Peterson -# -# This R package is distributed under the terms of the GNU Public License (GPL) -# for full details see the file COPYING -# -# $Id$ -# -############################################################################### \ No newline at end of file From noreply at r-forge.r-project.org Mon Jun 9 17:32:11 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 17:32:11 +0200 (CEST) Subject: [Returnanalytics-commits] r3411 - pkg/PortfolioAnalytics/R Message-ID: <20140609153211.910F618715D@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-09 17:32:11 +0200 (Mon, 09 Jun 2014) New Revision: 3411 Modified: pkg/PortfolioAnalytics/R/charts.risk.R pkg/PortfolioAnalytics/R/extractstats.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: fixing a few bugs Modified: pkg/PortfolioAnalytics/R/charts.risk.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.risk.R 2014-06-07 15:21:20 UTC (rev 3410) +++ pkg/PortfolioAnalytics/R/charts.risk.R 2014-06-09 15:32:11 UTC (rev 3411) @@ -220,7 +220,7 @@ # Get the objective measures at each rebalance period rebal.obj <- extractObjectiveMeasures(object) - if(inherits(opt.rebal$portfolio, "regime.portfolios")){ + if(inherits(object$portfolio, "regime.portfolios")){ # If the optimize.portfolio.rebalancing object is run with regime switching, # the output of extractObjectiveMeasures is a list of length N where each # element is the objective measures of the corresponding regime. (i.e. Modified: pkg/PortfolioAnalytics/R/extractstats.R =================================================================== --- pkg/PortfolioAnalytics/R/extractstats.R 2014-06-07 15:21:20 UTC (rev 3410) +++ pkg/PortfolioAnalytics/R/extractstats.R 2014-06-09 15:32:11 UTC (rev 3411) @@ -495,7 +495,7 @@ extractObjectiveMeasures.optimize.portfolio.rebalancing <- function(object){ if(!inherits(object, "optimize.portfolio.rebalancing")) stop("object must be of class 'optimize.portfolio.rebalancing'") - if(inherits(opt.rebal$portfolio, "regime.portfolios")){ + if(inherits(object$portfolio, "regime.portfolios")){ result <- extractObjRegime(object) } else { rebal_object <- object$opt_rebal Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-07 15:21:20 UTC (rev 3410) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-09 15:32:11 UTC (rev 3411) @@ -1456,7 +1456,6 @@ } else { rp = NULL } - print(dim(rp)) if(is.null(training_period)) {if(nrow(R)<36) training_period=nrow(R) else training_period=36} if (is.null(trailing_periods)){ From noreply at r-forge.r-project.org Mon Jun 9 17:33:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 17:33:44 +0200 (CEST) Subject: [Returnanalytics-commits] r3412 - pkg/PortfolioAnalytics/sandbox Message-ID: <20140609153344.9A80A18716D@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-09 17:33:44 +0200 (Mon, 09 Jun 2014) New Revision: 3412 Added: pkg/PortfolioAnalytics/sandbox/multi_layer_script.R Log: Adding script for multi_layer optimization that will be functionalized Added: pkg/PortfolioAnalytics/sandbox/multi_layer_script.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/multi_layer_script.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/multi_layer_script.R 2014-06-09 15:33:44 UTC (rev 3412) @@ -0,0 +1,91 @@ +library(PortfolioAnalytics) + +# Script for multilayer optimization + +# We need to support the different arguments/parameters for +# optimize.portfolio.rebalancing for each sub-portfolio +# * R +# * optimize_method +# * search_size +# * trace +# * ... +# * rp +# * rebalance_on +# * training_period +# * trailings_period + +# The returns need to have the same periodicity + +# Each sub-portfolio may have a different rebalancing frequency, training, and +# trailing parameters, as well as optimization method + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# The first sub-portfolio, portf1, will contain assets 1:5 of the edhec +# with an objective to minimize standard deviation. +portf1 <- portfolio.spec(assets=funds[1:5]) +portf1 <- add.constraint(portfolio=portf1, type="full_investment") +portf1 <- add.constraint(portfolio=portf1, type="long_only") +portf1 <- add.objective(portfolio=portf1, type="risk", name="StdDev") + +# The second sub-portfolio, portf2, will contain assets 6:10 of the edhec +# with an objective to minimize expected shortfall. +portf2 <- portfolio.spec(assets=funds[6:10]) +portf2 <- add.constraint(portfolio=portf2, type="full_investment") +portf2 <- add.constraint(portfolio=portf2, type="long_only") +portf2 <- add.objective(portfolio=portf2, type="risk", name="ES", + arguments=list(p=0.9)) + +# Run optimize.portfolio.rebalancing for each sub-portfolio to get proxy +# returns +proxy1 <- optimize.portfolio.rebalancing(R[,1:5], + portf1, + optimize_method="ROI", + rebalance_on="quarters", + training_period=60) +proxy1 +proxy1.ret <- summary(proxy1)$portfolio_returns + +proxy2 <- optimize.portfolio.rebalancing(R[,6:10], + portf2, + optimize_method="ROI", + rebalance_on="quarters", + training_period=48) +proxy2 +proxy2.ret <- summary(proxy2)$portfolio_returns + +# A different training period was used so the returns do not exactly align +ret <- cbind(proxy1.ret, proxy2.ret) +head(ret, 14) + +# Get rid of the NAs +ret <- na.omit(ret) +colnames(ret) <- c("proxy1", "proxy2") +head(ret) + +# Construct portfolio for the top level optimization of the proxy portfolios +portf <- portfolio.spec(assets=colnames(ret)) +portf <- add.constraint(portfolio=portf, type="weight_sum", min_sum=0.99, max_sum=1.01) +portf <- add.constraint(portfolio=portf, type="long_only") +portf <- add.objective(portfolio=portf, type="risk", name="ES", + arguments=list(p=0.9)) +portf <- add.objective(portfolio=portf, type="risk_budget", name="ES", + arguments=list(p=0.9), min_concentration=TRUE) + +opt <- optimize.portfolio(ret, portf, + optimize_method="random", + search_size=4000, + trace=TRUE) +opt + +opt.bt <- optimize.portfolio.rebalancing(ret, portf, + optimize_method="random", + search_size=4000, + trace=TRUE, + rebalance_on="months", + training_period=48) +opt.bt +opt.ret <- summary(opt.bt)$portfolio_returns +charts.PerformanceSummary(cbind(opt.ret, ret)) From noreply at r-forge.r-project.org Mon Jun 9 17:59:57 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 17:59:57 +0200 (CEST) Subject: [Returnanalytics-commits] r3413 - pkg/PerformanceAnalytics/R Message-ID: <20140609155957.B8C22186DED@r-forge.r-project.org> Author: braverock Date: 2014-06-09 17:59:57 +0200 (Mon, 09 Jun 2014) New Revision: 3413 Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R Log: - fix so the package will build, still need answers to missing args geometric, wealth_index, and contribution Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-09 15:33:44 UTC (rev 3412) +++ pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-09 15:59:57 UTC (rev 3413) @@ -105,9 +105,10 @@ #' Attribution}. Wiley. 2004. Chapter 2\cr #' @keywords ts multivariate distribution models #' @examples +#' #' data(edhec) -#' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly") # returns time series -#' Return.rebalancing(edhec["1997",1:5], rebalance="quarterly", verbose=TRUE) # returns list +#' Return.rebalancing(edhec["1997",1:5], rebalance_on="quarterly") # returns time series +#' Return.rebalancing(edhec["1997",1:5], rebalance_on="quarterly", verbose=TRUE) # returns list #' # with a weights object #' data(weights) # rebalance at the beginning of the year to various weights through time #' chart.StackedBar(weights) @@ -115,8 +116,11 @@ #' chart.CumReturns(x$returns) #' chart.StackedBar(x$BOP.Weight) #' chart.StackedBar(x$BOP.Value) -#' @export -Return.rebalancing3 <- function(R, +#' +#' @rdname Return.portfolio +#' @export Return.portfolio +#' @export Return.rebalancing +Return.portfolio <- Return.rebalancing <- function(R, weights=NULL, rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), value=1, From noreply at r-forge.r-project.org Mon Jun 9 18:06:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 18:06:31 +0200 (CEST) Subject: [Returnanalytics-commits] r3414 - pkg/PerformanceAnalytics/R Message-ID: <20140609160631.253DB187312@r-forge.r-project.org> Author: braverock Date: 2014-06-09 18:06:30 +0200 (Mon, 09 Jun 2014) New Revision: 3414 Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R Log: - add back copyright/license block, lost in the prototyping Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-09 15:59:57 UTC (rev 3413) +++ pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-09 16:06:30 UTC (rev 3414) @@ -275,3 +275,14 @@ return(out) } +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2014 Peter Carl and Brian G. Peterson +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id$ +# +############################################################################### From noreply at r-forge.r-project.org Mon Jun 9 18:43:51 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 18:43:51 +0200 (CEST) Subject: [Returnanalytics-commits] r3415 - pkg/PerformanceAnalytics Message-ID: <20140609164351.7E56F18577D@r-forge.r-project.org> Author: braverock Date: 2014-06-09 18:43:51 +0200 (Mon, 09 Jun 2014) New Revision: 3415 Modified: pkg/PerformanceAnalytics/DESCRIPTION Log: - bump version because of new Return.portfolio and Return.rebalancing Modified: pkg/PerformanceAnalytics/DESCRIPTION =================================================================== --- pkg/PerformanceAnalytics/DESCRIPTION 2014-06-09 16:06:30 UTC (rev 3414) +++ pkg/PerformanceAnalytics/DESCRIPTION 2014-06-09 16:43:51 UTC (rev 3415) @@ -1,7 +1,7 @@ Package: PerformanceAnalytics Type: Package Title: Econometric tools for performance and risk analysis. -Version: 1.1.4 +Version: 1.1.6 Date: $Date$ Author: Peter Carl, Brian G. Peterson Maintainer: Brian G. Peterson From noreply at r-forge.r-project.org Wed Jun 11 22:19:10 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 11 Jun 2014 22:19:10 +0200 (CEST) Subject: [Returnanalytics-commits] r3416 - pkg/PerformanceAnalytics/R Message-ID: <20140611201910.B29C0185018@r-forge.r-project.org> Author: peter_carl Date: 2014-06-11 22:19:10 +0200 (Wed, 11 Jun 2014) New Revision: 3416 Modified: pkg/PerformanceAnalytics/R/Return.excess.R Log: - fixes error when Rf unlabeled - thanks Dave Demers Modified: pkg/PerformanceAnalytics/R/Return.excess.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.excess.R 2014-06-09 16:43:51 UTC (rev 3415) +++ pkg/PerformanceAnalytics/R/Return.excess.R 2014-06-11 20:19:10 UTC (rev 3416) @@ -65,6 +65,10 @@ if(!is.null(dim(Rf))){ Rf = checkData(Rf) coln.Rf=colnames(Rf) + if(is.null(coln.Rf)){ + colnames(Rf) = "Rf" + coln.Rf = colnames(Rf) + } Rft=cbind(R,Rf) Rft=na.locf(Rft[,make.names(coln.Rf)]) Rf=Rft[which(index(R) %in% index(Rft))] From noreply at r-forge.r-project.org Fri Jun 13 01:31:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 13 Jun 2014 01:31:38 +0200 (CEST) Subject: [Returnanalytics-commits] r3417 - pkg/FactorAnalytics/R Message-ID: <20140612233138.F3771187313@r-forge.r-project.org> Author: gyollin Date: 2014-06-13 01:31:38 +0200 (Fri, 13 Jun 2014) New Revision: 3417 Modified: pkg/FactorAnalytics/R/factorModelMonteCarlo.R Log: Edits to support new function signature of the rst function from the sn package Modified: pkg/FactorAnalytics/R/factorModelMonteCarlo.R =================================================================== --- pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-06-11 20:19:10 UTC (rev 3416) +++ pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-06-12 23:31:38 UTC (rev 3417) @@ -77,7 +77,7 @@ #' # skew-t distribution #' # build residualData matrix #' residualData <- cbind(rnorm(6),c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,6,10,100)) -#' colnames(residualData) <- c("location","scale","shape","df") +#' colnames(residualData) <- c("xi","omega","alpha","nu") #' rownames(residualData) <- colnames(managers.df[,(1:6)]) #' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="skew-t", #' residualData, Alpha.mat=NULL, boot.method="random", @@ -133,10 +133,10 @@ "ekurt"]) } else if (residual.dist == "skew-t") { - residualsSim[, i] = rst(n.boot, location = residualData[i, - "location"], scale = residualData[i, "scale"], - shape = residualData[i, "shape"], df = residualData[i, - "df"]) + residualsSim[, i] = rst(n.boot, xi = residualData[i, + "xi"], omega = residualData[i, "omega"], + alpha = residualData[i, "alpha"], nu = residualData[i, + "nu"]) } else { stop("Invalid residual distribution") From noreply at r-forge.r-project.org Fri Jun 13 01:33:04 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 13 Jun 2014 01:33:04 +0200 (CEST) Subject: [Returnanalytics-commits] r3418 - pkg/FactorAnalytics Message-ID: <20140612233304.69046187332@r-forge.r-project.org> Author: gyollin Date: 2014-06-13 01:33:04 +0200 (Fri, 13 Jun 2014) New Revision: 3418 Modified: pkg/FactorAnalytics/DESCRIPTION Log: Added Suggests: testthat Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2014-06-12 23:31:38 UTC (rev 3417) +++ pkg/FactorAnalytics/DESCRIPTION 2014-06-12 23:33:04 UTC (rev 3418) @@ -2,10 +2,29 @@ Type: Package Title: factor analysis Version: 1.0 -Date: 2014-05-10 +Date: 2014-06-12 Author: Eric Zivot and Yi-An Chen Maintainer: Yi-An Chen -Description: An R package for estimation and risk analysis of linear factor models for asset returns and portfolios. It contains three major fitting method for the factor models: fitting macroeconomic factor model, fitting fundamental factor model and fitting statistical factor model and some risk analysis tools like VaR, ES to use the result of the fitting method. It also provides the different type of distribution to fit the fat-tail behavior of the financial returns, including edgeworth expansion type distribution. +Description: An R package for estimation and risk analysis of linear factor + models for asset returns and portfolios. It contains three major fitting + method for the factor models: fitting macroeconomic factor model, fitting + fundamental factor model and fitting statistical factor model and some risk + analysis tools like VaR, ES to use the result of the fitting method. It + also provides the different type of distribution to fit the fat-tail + behavior of the financial returns, including edgeworth expansion type + distribution. License: GPL-2 -Depends: robust, robustbase, leaps, lars, MASS, PerformanceAnalytics, sn, tseries, strucchange,xts,ellipse, zoo +Depends: + robust, + robustbase, + leaps, + lars, + MASS, + PerformanceAnalytics, + sn, + tseries, + strucchange,xts,ellipse, + zoo +Suggests: + testthat LazyLoad: yes From noreply at r-forge.r-project.org Fri Jun 13 01:38:40 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 13 Jun 2014 01:38:40 +0200 (CEST) Subject: [Returnanalytics-commits] r3419 - in pkg/FactorAnalytics/inst: . extdata tests Message-ID: <20140612233841.1184118741D@r-forge.r-project.org> Author: gyollin Date: 2014-06-13 01:38:40 +0200 (Fri, 13 Jun 2014) New Revision: 3419 Added: pkg/FactorAnalytics/inst/extdata/ pkg/FactorAnalytics/inst/extdata/factorDataSet.csv pkg/FactorAnalytics/inst/extdata/timeSeriesReturns.csv pkg/FactorAnalytics/inst/tests/ pkg/FactorAnalytics/inst/tests/test-fitTSFM.r Log: Unit tests Added: pkg/FactorAnalytics/inst/extdata/factorDataSet.csv =================================================================== --- pkg/FactorAnalytics/inst/extdata/factorDataSet.csv (rev 0) +++ pkg/FactorAnalytics/inst/extdata/factorDataSet.csv 2014-06-12 23:38:40 UTC (rev 3419) @@ -0,0 +1,4771 @@ +"DATE","PERMNO","GVKEY","CUSIP","TICKER","NAME","RETURN","GSECTOR","SECTOR","MARKETCAP","ENTVALUE","P2B","EV2S","EV2OIBDA" +2000-01-31,24643,1356,"013817101","AA","ALCOA INC",-0.160392,15,"Materials",25.9563915,29.0593915,4.36902735229759,1.61118826236416,7.82007306243272 +2000-01-31,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",-0.007669,40,"Financials",66.23250625,93.81950625,6.45981724861016,3.89551180244146,20.3778249891399 +2000-01-31,19561,2285,"097023105","BA","BOEING CO",0.073906,20,"Industrials",32.8524453125,36.8784453125,2.77118897617039,0.930334140073158,10.5126697013968 +2000-01-31,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",-0.034869,40,"Financials",86.928475375,213.459475375,1.92226074421742,3.77456987153416,10.8841258094534 +2000-01-31,18542,2817,"149123101","CAT","CATERPILLAR INC",-0.091368,20,"Industrials",13.7474786875,27.2344786875,2.50136075100073,1.38414711768144,8.15403553517964 +2000-01-31,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",0.02217,45,"InformationTechnology",377.2275,373.2595,22.830448465775,21.4172308928162,74.473164405427 +2000-01-31,14541,2991,"166764100","CVX","CHEVRON CORP",-0.034632,10,"Energy",60.252796125,67.352796125,3.34644799361289,1.612390982596,7.36257063019239 +2000-01-31,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",-0.104364,15,"Materials",55.4334501875,65.7504501875,4.27298621656517,2.16483768561504,8.62414089552728 +2000-01-31,26403,3980,"254687106","DIS","DISNEY (WALT) CO",0.241453,25,"ConsumerDiscretionary",85.41225,95.09525,3.65697251241651,3.76943277310924,24.1358502538071 +2000-01-31,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",-0.136511,20,"Industrials",512.65116,690.54616,11.5207685738685,5.76897376775271,19.6826519211036 +2000-01-31,66181,5680,"437076102","HD","HOME DEPOT INC",-0.176364,25,"ConsumerDiscretionary",130.481950125,131.090950125,10.5730451442347,3.57234985080118,31.0936788721537 +2000-01-31,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",-0.048352,45,"InformationTechnology",108.262124,107.072124,5.60769315238786,2.2931578000514,21.8158361858191 +2000-01-31,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",0.040556,45,"InformationTechnology",211.554766,236.087766,10.9778821026413,3.05054483667563,22.0725286088257 +2000-01-31,59328,6008,"458140100","INTC","INTEL CORP",0.201974,45,"InformationTechnology",441.8586875,432.3406875,12.2388357615711,13.5224786531965,30.7671995089667 +2000-01-31,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",-0.077078,35,"HealthCare",97.67033125,97.13033125,5.69506304664723,3.2637880124328,5.34740867925567 +2000-01-31,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",0.043894,40,"Financials",71.856973125,124.622973125,3.11811556194402,2.10582921806354,6.51930179561624 +2000-01-31,11308,3144,"191216100","KO","COCA-COLA CO",-0.013948,30,"ConsumerStaples",116.118118,120.799118,13.044048303752,7.09581285244361,26.5609318381706 +2000-01-31,43449,7154,"580135101","MCD","MCDONALD'S CORP",-0.072868,25,"ConsumerDiscretionary",49.940475,56.982575,5.30655024386097,4.26031573359651,14.3157911265199 +2000-01-31,22592,7435,"88579Y101","MMM","3M CO",-0.043423,20,"Industrials",35.0538345625,37.3208345625,5.60054873981467,2.28962175230061,9.39598050415408 +2000-01-31,22752,7257,"58933Y105","MRK","MERCK & CO",0.173023,35,"HealthCare",142.961242375,145.467542375,11.8133189861755,4.10860266101973,15.686876415369 +2000-01-31,10107,12141,"594918104","MSFT","MICROSOFT CORP",-0.16167,45,"InformationTechnology",556.9625,535.7575,13.9968460997185,23.6809361739745,44.6464583333333 +2000-01-31,21936,8530,"717081103","PFE","PFIZER INC",0.115607,35,"HealthCare",141.1309940625,141.5919940625,13.8526692248233,4.94316415523321,15.0501694369154 +2000-01-31,18163,8762,"742718109","PG","PROCTER & GAMBLE CO",-0.074661,30,"ConsumerStaples",73.89635,85.19935,6.11319904037062,2.1772296330369,10.591664594729 +2000-01-31,59459,9380,"79299X952","SPC.2","ST PAUL COS",-0.103896,40,"Financials",7.2345,8.1195,1.10231601401798,0.94588769804287,3.75207948243993 +2000-01-31,66093,9899,"00206R102","T","AT&T INC",-0.115513,50,"Telecommunications",143.297455,168.948455,5.13040904371487,3.36470276029634,7.91105333395767 +2000-01-31,92655,10903,"91324P102","UNH","UNITEDHEALTH GROUP INC",-0.002353,35,"HealthCare",9.677793375,8.949793375,2.64420584016393,0.438801401010002,6.67895027985075 +2000-01-31,17830,10983,"913017109","UTX","UNITED TECHNOLOGIES CORP",-0.185577,20,"Industrials",29.956941,33.564941,4.25766642978965,1.31318235524257,9.54634271899886 +2000-01-31,65875,2136,"92343V104","VZ","VERIZON COMMUNICATIONS INC",0.012345,50,"Telecommunications",94.478223,119.451223,5.68050883838384,2.05496874139829,5.11524593182597 +2000-01-31,55976,11259,"931142103","WMT","WAL-MART STORES INC",-0.207957,30,"ConsumerStaples",244.02075,264.24675,9.4457207555934,1.2736501793013,15.4892584994138 +2000-01-31,11850,4503,"30231G102","XOM","EXXON MOBIL CORP",0.035687,10,"Energy",271.3004375,283.6944375,4.19937214611872,1.48437859721641,9.63374210472698 +2000-02-29,24643,1356,"013817101","AA","ALCOA INC",-0.013453,15,"Materials",25.9563915,29.0593915,4.36902735229759,1.61118826236416,7.82007306243272 +2000-02-29,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",-0.185508,40,"Financials",66.23250625,93.81950625,6.45981724861016,3.89551180244146,20.3778249891399 +2000-02-29,19561,2285,"097023105","BA","BOEING CO",-0.166798,20,"Industrials",32.8524453125,36.8784453125,2.77118897617039,0.930334140073158,10.5126697013968 +2000-02-29,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",-0.050323,40,"Financials",86.928475375,213.459475375,1.92226074421742,3.77456987153416,10.8841258094534 +2000-02-29,18542,2817,"149123101","CAT","CATERPILLAR INC",-0.173785,20,"Industrials",13.7474786875,27.2344786875,2.50136075100073,1.38414711768144,8.15403553517964 +2000-02-29,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",0.207192,45,"InformationTechnology",485.3660281,480.7130281,24.2367935733546,24.3621035931482,88.3014379316679 +2000-02-29,14541,2991,"166764100","CVX","CHEVRON CORP",-0.099103,10,"Energy",60.252796125,67.352796125,3.34644799361289,1.612390982596,7.36257063019239 +2000-02-29,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",-0.138136,15,"Materials",55.4334501875,65.7504501875,4.27298621656517,2.16483768561504,8.62414089552728 +2000-02-29,26403,3980,"254687106","DIS","DISNEY (WALT) CO",-0.077453,25,"ConsumerDiscretionary",85.41225,95.09525,3.65697251241651,3.76943277310924,24.1358502538071 +2000-02-29,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",-0.009355,20,"Industrials",512.65116,690.54616,11.5207685738685,5.76897376775271,19.6826519211036 +2000-02-29,66181,5680,"437076102","HD","HOME DEPOT INC",0.020971,25,"ConsumerDiscretionary",130.5523465,130.1273465,10.0339978864038,2.92763108576314,28.1904996750433 +2000-02-29,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",0.242494,45,"InformationTechnology",135.616815,134.215815,6.97294539565016,2.78965362071832,28.4596723918575 +2000-02-29,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",-0.083563,45,"InformationTechnology",211.554766,236.087766,10.9778821026413,3.05054483667563,22.0725286088257 +2000-02-29,59328,6008,"458140100","INTC","INTEL CORP",0.142438,45,"InformationTechnology",441.8586875,432.3406875,12.2388357615711,13.5224786531965,30.7671995089667 +2000-02-29,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",-0.160145,35,"HealthCare",97.67033125,97.13033125,5.69506304664723,3.2637880124328,5.34740867925567 +2000-02-29,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",-0.013168,40,"Financials",71.856973125,124.622973125,3.11811556194402,2.10582921806354,6.51930179561624 +2000-02-29,11308,3144,"191216100","KO","COCA-COLA CO",-0.153428,30,"ConsumerStaples",116.118118,120.799118,13.044048303752,7.09581285244361,26.5609318381706 +2000-02-29,43449,7154,"580135101","MCD","MCDONALD'S CORP",-0.153846,25,"ConsumerDiscretionary",49.940475,56.982575,5.30655024386097,4.26031573359651,14.3157911265199 +2000-02-29,22592,7435,"88579Y101","MMM","3M CO",-0.051883,20,"Industrials",35.0538345625,37.3208345625,5.60054873981467,2.28962175230061,9.39598050415408 +2000-02-29,22752,7257,"58933Y105","MRK","MERCK & CO",-0.218874,35,"HealthCare",142.961242375,145.467542375,11.8133189861755,4.10860266101973,15.686876415369 +2000-02-29,10107,12141,"594918104","MSFT","MICROSOFT CORP",-0.086845,45,"InformationTechnology",556.9625,535.7575,13.9968460997185,23.6809361739745,44.6464583333333 +2000-02-29,21936,8530,"717081103","PFE","PFIZER INC",-0.109775,35,"HealthCare",141.1309940625,141.5919940625,13.8526692248233,4.94316415523321,15.0501694369154 +2000-02-29,18163,8762,"742718109","PG","PROCTER & GAMBLE CO",-0.130489,30,"ConsumerStaples",73.89635,85.19935,6.11319904037062,2.1772296330369,10.591664594729 +2000-02-29,59459,9380,"79299X952","SPC.2","ST PAUL COS",-0.258799,40,"Financials",7.2345,8.1195,1.10231601401798,0.94588769804287,3.75207948243993 +2000-02-29,66093,9899,"00206R102","T","AT&T INC",-0.112245,50,"Telecommunications",143.297455,168.948455,5.13040904371487,3.36470276029634,7.91105333395767 +2000-02-29,92655,10903,"91324P102","UNH","UNITEDHEALTH GROUP INC",-0.035377,35,"HealthCare",9.677793375,8.949793375,2.64420584016393,0.438801401010002,6.67895027985075 +2000-02-29,17830,10983,"913017109","UTX","UNITED TECHNOLOGIES CORP",-0.034002,20,"Industrials",29.956941,33.564941,4.25766642978965,1.31318235524257,9.54634271899886 +2000-02-29,65875,2136,"92343V104","VZ","VERIZON COMMUNICATIONS INC",-0.209889,50,"Telecommunications",94.478223,119.451223,5.68050883838384,2.05496874139829,5.11524593182597 +2000-02-29,55976,11259,"931142103","WMT","WAL-MART STORES INC",-0.107306,30,"ConsumerStaples",247.297938875,266.402938875,9.11160012066615,1.53291906734067,21.3463893329327 +2000-02-29,11850,4503,"30231G102","XOM","EXXON MOBIL CORP",-0.092105,10,"Energy",271.3004375,283.6944375,4.19937214611872,1.48437859721641,9.63374210472698 +2000-03-31,24643,1356,"013817101","AA","ALCOA INC",0.025547,15,"Materials",25.9563915,29.0593915,4.36902735229759,1.61118826236416,7.82007306243272 +2000-03-31,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",0.109921,40,"Financials",66.23250625,93.81950625,6.45981724861016,3.89551180244146,20.3778249891399 +2000-03-31,19561,2285,"097023105","BA","BOEING CO",0.023689,20,"Industrials",32.8524453125,36.8784453125,2.77118897617039,0.930334140073158,10.5126697013968 +2000-03-31,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",0.150815,40,"Financials",86.928475375,213.459475375,1.92226074421742,3.77456987153416,10.8841258094534 +2000-03-31,18542,2817,"149123101","CAT","CATERPILLAR INC",0.124777,20,"Industrials",13.7474786875,27.2344786875,2.50136075100073,1.38414711768144,8.15403553517964 +2000-03-31,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",0.16974,45,"InformationTechnology",485.3660281,480.7130281,24.2367935733546,24.3621035931482,88.3014379316679 +2000-03-31,14541,2991,"166764100","CVX","CHEVRON CORP",0.237657,10,"Energy",60.252796125,67.352796125,3.34644799361289,1.612390982596,7.36257063019239 +2000-03-31,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",0.048267,15,"Materials",55.4334501875,65.7504501875,4.27298621656517,2.16483768561504,8.62414089552728 +2000-03-31,26403,3980,"254687106","DIS","DISNEY (WALT) CO",0.231343,25,"ConsumerDiscretionary",85.41225,95.09525,3.65697251241651,3.76943277310924,24.1358502538071 +2000-03-31,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",0.178735,20,"Industrials",512.65116,690.54616,11.5207685738685,5.76897376775271,19.6826519211036 +2000-03-31,66181,5680,"437076102","HD","HOME DEPOT INC",0.116368,25,"ConsumerDiscretionary",130.5523465,130.1273465,10.0339978864038,2.92763108576314,28.1904996750433 +2000-03-31,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",-0.010892,45,"InformationTechnology",135.616815,134.215815,6.97294539565016,2.78965362071832,28.4596723918575 +2000-03-31,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",0.148418,45,"InformationTechnology",211.554766,236.087766,10.9778821026413,3.05054483667563,22.0725286088257 +2000-03-31,59328,6008,"458140100","INTC","INTEL CORP",0.167589,45,"InformationTechnology",441.8586875,432.3406875,12.2388357615711,13.5224786531965,30.7671995089667 +2000-03-31,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",-0.024306,35,"HealthCare",97.67033125,97.13033125,5.69506304664723,3.2637880124328,5.34740867925567 +2000-03-31,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",0.094976,40,"Financials",71.856973125,124.622973125,3.11811556194402,2.10582921806354,6.51930179561624 +2000-03-31,11308,3144,"191216100","KO","COCA-COLA CO",-0.031208,30,"ConsumerStaples",116.118118,120.799118,13.044048303752,7.09581285244361,26.5609318381706 +2000-03-31,43449,7154,"580135101","MCD","MCDONALD'S CORP",0.181818,25,"ConsumerDiscretionary",49.940475,56.982575,5.30655024386097,4.26031573359651,14.3157911265199 +2000-03-31,22592,7435,"88579Y101","MMM","3M CO",0.004252,20,"Industrials",35.0538345625,37.3208345625,5.60054873981467,2.28962175230061,9.39598050415408 +2000-03-31,22752,7257,"58933Y105","MRK","MERCK & CO",0.013848,35,"HealthCare",142.961242375,145.467542375,11.8133189861755,4.10860266101973,15.686876415369 +2000-03-31,10107,12141,"594918104","MSFT","MICROSOFT CORP",0.188811,45,"InformationTechnology",556.9625,535.7575,13.9968460997185,23.6809361739745,44.6464583333333 +2000-03-31,21936,8530,"717081103","PFE","PFIZER INC",0.138132,35,"HealthCare",141.1309940625,141.5919940625,13.8526692248233,4.94316415523321,15.0501694369154 +2000-03-31,18163,8762,"742718109","PG","PROCTER & GAMBLE CO",-0.357041,30,"ConsumerStaples",73.89635,85.19935,6.11319904037062,2.1772296330369,10.591664594729 +2000-03-31,59459,9380,"79299X952","SPC.2","ST PAUL COS",0.537207,40,"Financials",7.2345,8.1195,1.10231601401798,0.94588769804287,3.75207948243993 +2000-03-31,66093,9899,"00206R102","T","AT&T INC",0.106732,50,"Telecommunications",143.297455,168.948455,5.13040904371487,3.36470276029634,7.91105333395767 +2000-03-31,92655,10903,"91324P102","UNH","UNITEDHEALTH GROUP INC",0.166846,35,"HealthCare",9.677793375,8.949793375,2.64420584016393,0.438801401010002,6.67895027985075 +2000-03-31,17830,10983,"913017109","UTX","UNITED TECHNOLOGIES CORP",0.240491,20,"Industrials",29.956941,33.564941,4.25766642978965,1.31318235524257,9.54634271899886 +2000-03-31,65875,2136,"92343V104","VZ","VERIZON COMMUNICATIONS INC",0.249042,50,"Telecommunications",94.478223,119.451223,5.68050883838384,2.05496874139829,5.11524593182597 +2000-03-31,55976,11259,"931142103","WMT","WAL-MART STORES INC",0.157238,30,"ConsumerStaples",247.297938875,266.402938875,9.11160012066615,1.53291906734067,21.3463893329327 +2000-03-31,11850,4503,"30231G102","XOM","EXXON MOBIL CORP",0.034855,10,"Energy",271.3004375,283.6944375,4.19937214611872,1.48437859721641,9.63374210472698 +2000-04-30,24643,1356,"013817101","AA","ALCOA INC",-0.076512,15,"Materials",25.114029,33.036029,2.28641924617626,1.48303236667265,7.99516674733785 +2000-04-30,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",0.005388,40,"Financials",69.482625,94.147625,6.61172566371681,3.69496173469388,20.4490931798436 +2000-04-30,19561,2285,"097023105","BA","BOEING CO",0.049587,20,"Industrials",36.0780410625,37.7960410625,2.99427679164246,0.63668285598174,7.50517098143368 +2000-04-30,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",-0.065554,40,"Financials",70.765143,210.152143,1.54556290132355,3.68791490593851,11.3009326199183 +2000-04-30,18542,2817,"149123101","CAT","CATERPILLAR INC",0.008241,20,"Industrials",11.71106175,25.97806175,2.14566906375962,1.21098553747902,6.58672965263692 +2000-04-30,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",-0.103274,45,"InformationTechnology",485.3660281,480.7130281,24.2367935733546,24.3621035931482,88.3014379316679 +2000-04-30,14541,2991,"166764100","CVX","CHEVRON CORP",-0.079108,10,"Energy",55.35440475,61.17340475,2.95223492,1.27849449820264,5.62876377898417 +2000-04-30,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",-0.103896,15,"Materials",45.60583125,55.49083125,3.5054443697156,1.75293250094769,7.16195550464636 +2000-04-30,26403,3980,"254687106","DIS","DISNEY (WALT) CO",0.05,25,"ConsumerDiscretionary",80.37680625,89.41680625,3.37349140644674,3.69307807079134,16.1986967844203 +2000-04-30,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",0.010442,20,"Industrials",524.634916,709.889916,11.4237325204137,5.42281538179485,18.1594678195027 +2000-04-30,66181,5680,"437076102","HD","HOME DEPOT INC",-0.124031,25,"ConsumerDiscretionary",130.5523465,130.1273465,10.0339978864038,2.92763108576314,28.1904996750433 +2000-04-30,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",0.015992,45,"InformationTechnology",135.616815,134.215815,6.97294539565016,2.78965362071832,28.4596723918575 +2000-04-30,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",-0.055085,45,"InformationTechnology",192.9072415625,218.8202415625,10.19217211193,2.52667592215718,16.4625520284758 +2000-04-30,59328,6008,"458140100","INTC","INTEL CORP",-0.038844,45,"InformationTechnology",448.7889375,436.3999375,12.2552959448389,13.1445764307229,27.9743549679487 +2000-04-30,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",0.174377,35,"HealthCare",141.715154375,140.520154375,7.88226010206352,4.58018756111473,7.73618995678265 +2000-04-30,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",-0.167254,40,"Financials",57.0357390625,99.6037390625,2.37095689484952,1.72169914717728,5.77613889251334 +2000-04-30,11308,3144,"191216100","KO","COCA-COLA CO",0.006658,30,"ConsumerStaples",142.244543125,146.777543125,15.4882995562936,6.68751335543102,21.5595686141304 +2000-04-30,43449,7154,"580135101","MCD","MCDONALD'S CORP",0.018395,25,"ConsumerDiscretionary",43.50055625,51.05725625,4.83387852674156,3.58487728542942,11.6134237671731 +2000-04-30,22592,7435,"88579Y101","MMM","3M CO",-0.021877,20,"Industrials",32.61159,35.23959,5.07731433909388,2.07633690784822,8.75735337972167 +2000-04-30,22752,7257,"58933Y105","MRK","MERCK & CO",0.118712,35,"HealthCare",176.2169645,179.5286645,13.85462414498,4.73590441331645,17.3096402194454 +2000-04-30,10107,12141,"594918104","MSFT","MICROSOFT CORP",-0.343529,45,"InformationTechnology",422.64,398.842,10.216592535293,17.1796175051688,34.9126400560224 +2000-04-30,21936,8530,"717081103","PFE","PFIZER INC",0.152137,35,"HealthCare",303.058848,303.876848,20.2403558405129,10.8698257261411,36.1242092249168 +2000-04-30,18163,8762,"742718109","PG","PROCTER & GAMBLE CO",0.063186,30,"ConsumerStaples",74.76088575,85.28688575,6.24673176387032,2.20698907333609,11.6194667234332 +2000-04-30,59459,9380,"79299X952","SPC.2","ST PAUL COS",0.043956,40,"Financials",7.268625,8.323625,1.08811751497006,1.05952456720978,6.32494300911854 +2000-04-30,66093,9899,"00206R102","T","AT&T INC",0.046083,50,"Telecommunications",146.5985565,172.5245565,5.16646895154185,3.26973990789174,8.11498384289746 +2000-04-30,92655,10903,"91324P102","UNH","UNITEDHEALTH GROUP INC",0.118449,35,"HealthCare",13.89604475,13.19304475,3.74657448099218,0.631850802203065,9.4506051217765 +2000-04-30,17830,10983,"913017109","UTX","UNITED TECHNOLOGIES CORP",-0.015826,20,"Industrials",27.563567625,31.172567625,3.86423210780878,1.11954344293205,7.11702457191781 +2000-04-30,65875,2136,"92343V104","VZ","VERIZON COMMUNICATIONS INC",-0.024376,50,"Telecommunications",138.10817175,189.75317175,4.04108648613062,2.82892795858429,7.22593951827875 +2000-04-30,55976,11259,"931142103","WMT","WAL-MART STORES INC",-0.019912,30,"ConsumerStaples",247.297938875,266.402938875,9.11160012066615,1.53291906734067,21.3463893329327 +2000-04-30,11850,4503,"30231G102","XOM","EXXON MOBIL CORP",-0.003208,10,"Energy",273.494,282.257,4.08590295207362,1.42614543543726,8.75161230311299 +2000-05-31,24643,1356,"013817101","AA","ALCOA INC",-0.095376,15,"Materials",25.114029,33.036029,2.28641924617626,1.48303236667265,7.99516674733785 +2000-05-31,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",0.083612,40,"Financials",69.482625,94.147625,6.61172566371681,3.69496173469388,20.4490931798436 +2000-05-31,19561,2285,"097023105","BA","BOEING CO",-0.01222,20,"Industrials",36.0780410625,37.7960410625,2.99427679164246,0.63668285598174,7.50517098143368 +2000-05-31,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",0.141582,40,"Financials",70.765143,210.152143,1.54556290132355,3.68791490593851,11.3009326199183 +2000-05-31,18542,2817,"149123101","CAT","CATERPILLAR INC",-0.030111,20,"Industrials",11.71106175,25.97806175,2.14566906375962,1.21098553747902,6.58672965263692 +2000-05-31,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",-0.178724,45,"InformationTechnology",467.092875,461.567875,17.6281418651168,20.1734211101399,68.767561829559 +2000-05-31,14541,2991,"166764100","CVX","CHEVRON CORP",0.093539,10,"Energy",55.35440475,61.17340475,2.95223492,1.27849449820264,5.62876377898417 +2000-05-31,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",0.040316,15,"Materials",45.60583125,55.49083125,3.5054443697156,1.75293250094769,7.16195550464636 +2000-05-31,26403,3980,"254687106","DIS","DISNEY (WALT) CO",-0.031746,25,"ConsumerDiscretionary",80.37680625,89.41680625,3.37349140644674,3.69307807079134,16.1986967844203 +2000-05-31,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",0.005167,20,"Industrials",524.634916,709.889916,11.4237325204137,5.42281538179485,18.1594678195027 +2000-05-31,66181,5680,"437076102","HD","HOME DEPOT INC",-0.136062,25,"ConsumerDiscretionary",119.825469,119.678469,8.62922864755869,2.37099748395277,19.8537606171201 +2000-05-31,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",-0.109722,45,"InformationTechnology",107.9531353125,107.9161353125,7.38848369806995,2.28287644509435,18.8007204377178 +2000-05-31,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",-0.03583,45,"InformationTechnology",192.9072415625,218.8202415625,10.19217211193,2.52667592215718,16.4625520284758 +2000-05-31,59328,6008,"458140100","INTC","INTEL CORP",-0.01652,45,"InformationTechnology",448.7889375,436.3999375,12.2552959448389,13.1445764307229,27.9743549679487 +2000-05-31,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",0.088727,35,"HealthCare",141.715154375,140.520154375,7.88226010206352,4.58018756111473,7.73618995678265 +2000-05-31,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",0.035529,40,"Financials",57.0357390625,99.6037390625,2.37095689484952,1.72169914717728,5.77613889251334 +2000-05-31,11308,3144,"191216100","KO","COCA-COLA CO",0.12963,30,"ConsumerStaples",142.244543125,146.777543125,15.4882995562936,6.68751335543102,21.5595686141304 +2000-05-31,43449,7154,"580135101","MCD","MCDONALD'S CORP",-0.059113,25,"ConsumerDiscretionary",43.50055625,51.05725625,4.83387852674156,3.58487728542942,11.6134237671731 +2000-05-31,22592,7435,"88579Y101","MMM","3M CO",-0.003405,20,"Industrials",32.61159,35.23959,5.07731433909388,2.07633690784822,8.75735337972167 +2000-05-31,22752,7257,"58933Y105","MRK","MERCK & CO",0.077914,35,"HealthCare",176.2169645,179.5286645,13.85462414498,4.73590441331645,17.3096402194454 +2000-05-31,10107,12141,"594918104","MSFT","MICROSOFT CORP",-0.103047,45,"InformationTechnology",422.64,398.842,10.216592535293,17.1796175051688,34.9126400560224 +2000-05-31,21936,8530,"717081103","PFE","PFIZER INC",0.06,35,"HealthCare",303.058848,303.876848,20.2403558405129,10.8698257261411,36.1242092249168 +2000-05-31,18163,8762,"742718109","PG","PROCTER & GAMBLE CO",0.112971,30,"ConsumerStaples",74.76088575,85.28688575,6.24673176387032,2.20698907333609,11.6194667234332 +2000-05-31,59459,9380,"79299X952","SPC.2","ST PAUL COS",0.052632,40,"Financials",7.268625,8.323625,1.08811751497006,1.05952456720978,6.32494300911854 +2000-05-31,66093,9899,"00206R102","T","AT&T INC",-0.002853,50,"Telecommunications",146.5985565,172.5245565,5.16646895154185,3.26973990789174,8.11498384289746 +2000-05-31,92655,10903,"91324P102","UNH","UNITEDHEALTH GROUP INC",0.118088,35,"HealthCare",13.89604475,13.19304475,3.74657448099218,0.631850802203065,9.4506051217765 +2000-05-31,17830,10983,"913017109","UTX","UNITED TECHNOLOGIES CORP",-0.024925,20,"Industrials",27.563567625,31.172567625,3.86423210780878,1.11954344293205,7.11702457191781 +2000-05-31,65875,2136,"92343V104","VZ","VERIZON COMMUNICATIONS INC",-0.107595,50,"Telecommunications",138.10817175,189.75317175,4.04108648613062,2.82892795858429,7.22593951827875 +2000-05-31,55976,11259,"931142103","WMT","WAL-MART STORES INC",0.047404,30,"ConsumerStaples",245.369334,266.683334,8.7332479356492,1.43107309822272,18.5505936282693 +2000-05-31,11850,4503,"30231G102","XOM","EXXON MOBIL CORP",0.078069,10,"Energy",273.494,282.257,4.08590295207362,1.42614543543726,8.75161230311299 +2000-06-30,24643,1356,"013817101","AA","ALCOA INC",-0.007487,15,"Materials",25.114029,33.036029,2.28641924617626,1.48303236667265,7.99516674733785 +2000-06-30,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",-0.034722,40,"Financials",69.482625,94.147625,6.61172566371681,3.69496173469388,20.4490931798436 +2000-06-30,19561,2285,"097023105","BA","BOEING CO",0.0704,20,"Industrials",36.0780410625,37.7960410625,2.99427679164246,0.63668285598174,7.50517098143368 +2000-06-30,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",-0.224352,40,"Financials",70.765143,210.152143,1.54556290132355,3.68791490593851,11.3009326199183 +2000-06-30,18542,2817,"149123101","CAT","CATERPILLAR INC",-0.114379,20,"Industrials",11.71106175,25.97806175,2.14566906375962,1.21098553747902,6.58672965263692 +2000-06-30,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",0.116356,45,"InformationTechnology",467.092875,461.567875,17.6281418651168,20.1734211101399,68.767561829559 +2000-06-30,14541,2991,"166764100","CVX","CHEVRON CORP",-0.082488,10,"Energy",55.35440475,61.17340475,2.95223492,1.27849449820264,5.62876377898417 +2000-06-30,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",-0.107143,15,"Materials",45.60583125,55.49083125,3.5054443697156,1.75293250094769,7.16195550464636 +2000-06-30,26403,3980,"254687106","DIS","DISNEY (WALT) CO",-0.074516,25,"ConsumerDiscretionary",80.37680625,89.41680625,3.37349140644674,3.69307807079134,16.1986967844203 +2000-06-30,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",0.005931,20,"Industrials",524.634916,709.889916,11.4237325204137,5.42281538179485,18.1594678195027 +2000-06-30,66181,5680,"437076102","HD","HOME DEPOT INC",0.023867,25,"ConsumerDiscretionary",119.825469,119.678469,8.62922864755869,2.37099748395277,19.8537606171201 +2000-06-30,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",0.29448,45,"InformationTechnology",107.9531353125,107.9161353125,7.38848369806995,2.28287644509435,18.8007204377178 +2000-06-30,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",0.020373,45,"InformationTechnology",192.9072415625,218.8202415625,10.19217211193,2.52667592215718,16.4625520284758 +2000-06-30,59328,6008,"458140100","INTC","INTEL CORP",0.07218,45,"InformationTechnology",448.7889375,436.3999375,12.2552959448389,13.1445764307229,27.9743549679487 +2000-06-30,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",0.138268,35,"HealthCare",141.715154375,140.520154375,7.88226010206352,4.58018756111473,7.73618995678265 +2000-06-30,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",-0.074895,40,"Financials",57.0357390625,99.6037390625,2.37095689484952,1.72169914717728,5.77613889251334 +2000-06-30,11308,3144,"191216100","KO","COCA-COLA CO",0.079297,30,"ConsumerStaples",142.244543125,146.777543125,15.4882995562936,6.68751335543102,21.5595686141304 +2000-06-30,43449,7154,"580135101","MCD","MCDONALD'S CORP",-0.080279,25,"ConsumerDiscretionary",43.50055625,51.05725625,4.83387852674156,3.58487728542942,11.6134237671731 +2000-06-30,22592,7435,"88579Y101","MMM","3M CO",-0.037901,20,"Industrials",32.61159,35.23959,5.07731433909388,2.07633690784822,8.75735337972167 +2000-06-30,22752,7257,"58933Y105","MRK","MERCK & CO",0.026801,35,"HealthCare",176.2169645,179.5286645,13.85462414498,4.73590441331645,17.3096402194454 +2000-06-30,10107,12141,"594918104","MSFT","MICROSOFT CORP",0.278721,45,"InformationTechnology",422.64,398.842,10.216592535293,17.1796175051688,34.9126400560224 +2000-06-30,21936,8530,"717081103","PFE","PFIZER INC",0.077139,35,"HealthCare",303.058848,303.876848,20.2403558405129,10.8698257261411,36.1242092249168 +2000-06-30,18163,8762,"742718109","PG","PROCTER & GAMBLE CO",-0.139098,30,"ConsumerStaples",74.76088575,85.28688575,6.24673176387032,2.20698907333609,11.6194667234332 +2000-06-30,59459,9380,"79299X952","SPC.2","ST PAUL COS",-0.0828,40,"Financials",7.268625,8.323625,1.08811751497006,1.05952456720978,6.32494300911854 +2000-06-30,66093,9899,"00206R102","T","AT&T INC",-0.010014,50,"Telecommunications",146.5985565,172.5245565,5.16646895154185,3.26973990789174,8.11498384289746 +2000-06-30,92655,10903,"91324P102","UNH","UNITEDHEALTH GROUP INC",0.150042,35,"HealthCare",13.89604475,13.19304475,3.74657448099218,0.631850802203065,9.4506051217765 +2000-06-30,17830,10983,"913017109","UTX","UNITED TECHNOLOGIES CORP",-0.025853,20,"Industrials",27.563567625,31.172567625,3.86423210780878,1.11954344293205,7.11702457191781 +2000-06-30,65875,2136,"92343V104","VZ","VERIZON COMMUNICATIONS INC",-0.039007,50,"Telecommunications",138.10817175,189.75317175,4.04108648613062,2.82892795858429,7.22593951827875 +2000-06-30,55976,11259,"931142103","WMT","WAL-MART STORES INC",-0.005431,30,"ConsumerStaples",245.369334,266.683334,8.7332479356492,1.43107309822272,18.5505936282693 +2000-06-30,11850,4503,"30231G102","XOM","EXXON MOBIL CORP",-0.057764,10,"Energy",273.494,282.257,4.08590295207362,1.42614543543726,8.75161230311299 +2000-07-31,24643,1356,"013817101","AA","ALCOA INC",0.043103,15,"Materials",21.8943253125,29.7023253125,2.00167538055403,1.17903800065497,6.51938659185689 +2000-07-31,59176,1447,"025816109","AXP","AMERICAN EXPRESS CO",0.089065,40,"Financials",80.73675,107.90075,7.20028092392758,4.21619060643951,23.4363053866203 +2000-07-31,19561,2285,"097023105","BA","BOEING CO",0.171898,20,"Industrials",53.872497,55.383497,4.43285583806468,1.16577201734445,11.4334221717589 +2000-07-31,59408,7647,"060505104","BAC","BANK OF AMERICA CORP",0.101744,40,"Financials",85.414407,225.008407,1.82567932029497,3.76999542590979,11.6899629571904 +2000-07-31,18542,2817,"149123101","CAT","CATERPILLAR INC",0.015572,20,"Industrials",11.60166375,25.86366375,2.09227479711452,1.35298513025738,8.48545398622047 +2000-07-31,76076,20779,"17275R102","CSCO","CISCO SYSTEMS INC",0.029499,45,"InformationTechnology",467.092875,461.567875,17.6281418651168,20.1734211101399,68.767561829559 +2000-07-31,14541,2991,"166764100","CVX","CHEVRON CORP",-0.068534,10,"Energy",54.71489925,59.12789925,2.89251952051174,1.23905907900251,5.01423840315468 +2000-07-31,11703,4087,"263534109","DD","DU PONT (E I) DE NEMOURS",0.035714,15,"Materials",43.030440375,52.438440375,3.31054318933682,2.03407449088441,10.852326236548 +2000-07-31,26403,3980,"254687106","DIS","DISNEY (WALT) CO",-0.003221,25,"ConsumerDiscretionary",79.097175,87.716175,3.28204045643154,3.58434843903236,21.3525255598832 +2000-07-31,12060,5047,"369604103","GE","GENERAL ELECTRIC CO",-0.026903,20,"Industrials",571.614015375,760.543015375,11.9722277803959,6.02993003436985,21.4842659710452 +2000-07-31,66181,5680,"437076102","HD","HOME DEPOT INC",0.036295,25,"ConsumerDiscretionary",119.825469,119.678469,8.62922864755869,2.37099748395277,19.8537606171201 +2000-07-31,27828,5606,"428236103","HPQ","HEWLETT-PACKARD CO",-0.125626,45,"InformationTechnology",107.9531353125,107.9161353125,7.38848369806995,2.28287644509435,18.8007204377178 +2000-07-31,12490,6066,"459200101","IBM","INTL BUSINESS MACHINES CORP",0.026241,45,"InformationTechnology",199.61775,225.95575,10.3428886010363,2.59349605160461,17.4294777846344 +2000-07-31,59328,6008,"458140100","INTC","INTEL CORP",-0.001403,45,"InformationTechnology",279.715625,266.654625,7.4185287097202,7.63528304317947,22.5215054898649 +2000-07-31,22111,6266,"478160104","JNJ","JOHNSON & JOHNSON",-0.086503,35,"HealthCare",130.60656675,128.33156675,7.06516102726388,4.31337613437752,14.9361693144786 +2000-07-31,47896,2968,"46625H100","JPM","JPMORGAN CHASE & CO",0.085645,40,"Financials",60.5048398125,113.8928398125,2.11466656691248,1.93405854864319,7.35551794190778 +2000-07-31,11308,3144,"191216100","KO","COCA-COLA CO",0.067465,30,"ConsumerStaples",136.676539125,140.320539125,13.8786087657392,6.48071952360059,22.6323450201613 +2000-07-31,43449,7154,"580135101","MCD","MCDONALD'S CORP",-0.043643,25,"ConsumerDiscretionary",39.58486875,46.90186875,4.4951645734207,3.12762528340891,10.6556408465104 +2000-07-31,22592,7435,"88579Y101","MMM","3M CO",0.091667,20,"Industrials",35.942707125,38.393707125,5.58376683625913,2.24787512441452,8.74173659494536 [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3419 From noreply at r-forge.r-project.org Fri Jun 13 01:40:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 13 Jun 2014 01:40:33 +0200 (CEST) Subject: [Returnanalytics-commits] r3420 - in pkg/FactorAnalytics: . tests Message-ID: <20140612234033.1BC871811D0@r-forge.r-project.org> Author: gyollin Date: 2014-06-13 01:40:32 +0200 (Fri, 13 Jun 2014) New Revision: 3420 Added: pkg/FactorAnalytics/tests/ pkg/FactorAnalytics/tests/run-testthat-factorAnalytics.R Log: Add package test Added: pkg/FactorAnalytics/tests/run-testthat-factorAnalytics.R =================================================================== --- pkg/FactorAnalytics/tests/run-testthat-factorAnalytics.R (rev 0) +++ pkg/FactorAnalytics/tests/run-testthat-factorAnalytics.R 2014-06-12 23:40:32 UTC (rev 3420) @@ -0,0 +1,3 @@ +library("testthat") +library(factorAnalytics) +test_package("factorAnalytics") \ No newline at end of file From noreply at r-forge.r-project.org Mon Jun 16 19:50:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 16 Jun 2014 19:50:14 +0200 (CEST) Subject: [Returnanalytics-commits] r3421 - pkg/PortfolioAnalytics/R Message-ID: <20140616175014.18515186EF3@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-16 19:50:13 +0200 (Mon, 16 Jun 2014) New Revision: 3421 Added: pkg/PortfolioAnalytics/R/mult.layer.portfolio.R Log: Adding code to specify multiple layers and add sub portfolios for multi layer optimization Added: pkg/PortfolioAnalytics/R/mult.layer.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/mult.layer.portfolio.R (rev 0) +++ pkg/PortfolioAnalytics/R/mult.layer.portfolio.R 2014-06-16 17:50:13 UTC (rev 3421) @@ -0,0 +1,119 @@ + + +# I am going to start with two levels. Once that is working, I will generalize +# to any arbitrary number of levels. + +#' Multple Layer Portfolio Specification +#' +#' Create and specify a multiple layer portfolio +#' +#' The \code{sub.portfolios} slot is a list where each element contains the +#' portfolio object and rebalancing parameters for the optimization of the +#' sub portfolio. +#' This allows, for example, each sub portfolio to have different rebalancing +#' frequencies (i.e. monthly or quarterly), optimization methods, etc. +#' +#' Each sub portfolio is optimized with \code{optimize.portfolio.rebalancing} +#' to create a time series of proxy returns. +#' +#' The "top level" portfolio is used to specify the constraints and objectives +#' to control the optimization given the proxy returns of each sub portfolio. +#' +#' @param portfolio the "top level" portfolio +#' @param levels number of levels of sub-portfolios +#' @param \dots any additional parameters +#' @return a \code{mult.portfolio.spec} object with the top level portfolio +#' and sub portfolios with optimization parameters for each sub portfolio +#' @author Ross Bennett +#' @export +mult.portfolio.spec <- function(portfolio, levels=2, ...){ + structure(c(list(top.portfolio = portfolio, + sub.portfolios = list()), + list(...)), + class="mult.portfolio.spec") +} + +# constructor for sub.portfolio object +sub.portfolio <- function(portfolio, + optimize_method = c("DEoptim","random","ROI","pso","GenSA"), + search_size = 20000, + rp = NULL, + rebalance_on = NULL, + training_period = NULL, + trailing_periods = NULL, + ...){ + # Check to make sure that the portfolio passed in is a portfolio object + if (!is.portfolio(portfolio)) stop("portfolio passed in is not of class 'portfolio'") + + # structure and return + return(structure( c(list(portfolio = portfolio, + optimize_method = optimize_method[1], + search_size = search_size, + rp = rp, + rebalance_on = rebalance_on, + training_period = NULL, + trailing_periods= NULL), + list(...)), + class="sub.portfolio" + ) # end structure + ) +} + +#' Add sub-portfolio +#' +#' Add a sub-portfolio to a multiple layer portfolio specification object +#' +#' @param mult.portfolio a \code{mult.portfolio.spec} object +#' @param portfolio a \code{portfolio} object to add as a sub portfolio. +#' @param optimize_method optimization method for the sub portfolio +#' @param search_size integer, how many portfolios to test, default 20,000 +#' @param rp matrix of random portfolio weights, default NULL, mostly for automated use by rebalancing optimization or repeated tests on same portfolios +#' @param rebalance_on haracter string of period to rebalance on. See +#' \code{\link[xts]{endpoints}} for valid names. +#' @param training_period an integer of the number of periods to use as +#' a training data in the front of the returns data +#' @param trailing_periods an integer with the number of periods to roll over +#' (i.e. width of the moving or rolling window), the default is NULL will +#' run using the returns data from inception +#' @param \dots additonal passthrough parameters to \code{\link{optimize.portfolio.rebalancing}} +#' @param indexnum the index number of the sub portfolio. If \code{indexnum=NULL} +#' (the default), then the sub portfolio object is appended to the list of +#' sub portfolios in the \code{mult.portfolio} object. If \code{indexnum} is +#' specified, the portfolio in that index number is overwritten. +#' @seealso \code{\link{mult.portfolio.spec}} \code{\link{portfolio.spec}} \code{\link{optimize.portfolio}} \code{\link{optimize.portfolio.rebalancing}} +#' @author +#' @export +add.sub.portfolio <- function(mult.portfolio, + portfolio, + optimize_method = c("DEoptim","random","ROI","pso","GenSA"), + search_size = 20000, + rp = NULL, + rebalance_on = NULL, + training_period = NULL, + trailing_periods = NULL, + ..., + indexnum = NULL){ + # Check to make sure that the portfolio passed in is a portfolio mult.portfolio + if(!inherits(mult.portfolio, "mult.portfolio.spec")) stop("mult.portfolio must be of class 'mult.portfolio.spec'") + + # construct a sub portfolio object + tmp_portfolio <- sub.portfolio(portfolio=portfolio, + optimize_method=optimize_method[1], + search_size=search_size, + rp=rp, + rebalance_on=rebalance_on, + training_period=training_period, + trailing_periods=trailing_periods, + ...=...) + + if(inherits(tmp_portfolio, "sub.portfolio")){ + if(!hasArg(indexnum) | (hasArg(indexnum) & is.null(indexnum))){ + indexnum <- length(mult.portfolio$sub.portfolios)+1 + } + mult.portfolio$sub.portfolios[[indexnum]] <- tmp_portfolio + } + return(mult.portfolio) +} + + + From noreply at r-forge.r-project.org Mon Jun 16 23:23:55 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 16 Jun 2014 23:23:55 +0200 (CEST) Subject: [Returnanalytics-commits] r3422 - in pkg/PortfolioAnalytics: R man Message-ID: <20140616212355.873201858FD@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-16 23:23:54 +0200 (Mon, 16 Jun 2014) New Revision: 3422 Added: pkg/PortfolioAnalytics/man/add.sub.portfolio.Rd pkg/PortfolioAnalytics/man/mult.portfolio.spec.Rd Modified: pkg/PortfolioAnalytics/R/mult.layer.portfolio.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Adding support for mult layer optimization in optimize.portfolio and optimize.portfolio.R. Adding .Rd files for multi layer optimization. Modified: pkg/PortfolioAnalytics/R/mult.layer.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/mult.layer.portfolio.R 2014-06-16 17:50:13 UTC (rev 3421) +++ pkg/PortfolioAnalytics/R/mult.layer.portfolio.R 2014-06-16 21:23:54 UTC (rev 3422) @@ -51,8 +51,8 @@ search_size = search_size, rp = rp, rebalance_on = rebalance_on, - training_period = NULL, - trailing_periods= NULL), + training_period = training_period, + trailing_periods = trailing_periods), list(...)), class="sub.portfolio" ) # end structure @@ -81,7 +81,7 @@ #' sub portfolios in the \code{mult.portfolio} object. If \code{indexnum} is #' specified, the portfolio in that index number is overwritten. #' @seealso \code{\link{mult.portfolio.spec}} \code{\link{portfolio.spec}} \code{\link{optimize.portfolio}} \code{\link{optimize.portfolio.rebalancing}} -#' @author +#' @author Ross Bennett #' @export add.sub.portfolio <- function(mult.portfolio, portfolio, @@ -115,5 +115,51 @@ return(mult.portfolio) } +# This function calls optimize.portfolio.rebalancing on each sub portfolio +# according to the given optimization parameters and returns an xts object +# representing the proxy returns of each sub portfolio +proxy.mult.portfolio <- function(R, mult.portfolio, ...){ + # Check to make sure that the mult.portfolio passed in is a + # mult.portfolio.spec object + if(!inherits(mult.portfolio, "mult.portfolio.spec")){ + stop("mult.portfolio must be of class 'mult.portfolio.spec'") + } + + n.sub.portfolios <- length(mult.portfolio$sub.portfolios) + ret <- vector("list", n.sub.portfolios) + + # Loop through the sub portfolios and call optimize.portfolio.rebalancing + # on each sub portfolio and its optimization parameters + for(i in 1:n.sub.portfolios){ + #print(paste("sub portfolio", i)) + tmp <- mult.portfolio$sub.portfolios[[i]] + + # We need to subset the R object based on the names of portfolio$assets in + # the sub portfolio + # This requires that asset names match colnames(R) + R.tmp <- R[,names(tmp$portfolio$assets)] + if(ncol(R.tmp) != length(tmp$portfolio$assets)){ + stop("R object of returns not subset correctly. Make sure the names of + the assets in the sub portfolio match the column names of the R object") + } + # This needs to support + .formals <- formals(optimize.portfolio.rebalancing) + .formals <- PortfolioAnalytics:::modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) + .formals <- PortfolioAnalytics:::modify.args(formals=.formals, arglist=tmp, dots=TRUE) + .formals$... <- NULL + #print(.formals) + opt <- try(do.call(optimize.portfolio.rebalancing, .formals), silent=TRUE) + if(inherits(opt, "try-error")) { + message(paste("optimize.portfolio.rebalancing for sub portfolio", i, "generated an error or warning:", opt)) + next() + } + ret.tmp <- Return.rebalancing(R.tmp, extractWeights(opt)) + colnames(ret.tmp) <- paste("proxy", i, sep=".") + ret[[i]] <- ret.tmp + #print(ret[[i]]) + } + proxy.ret <- na.omit(do.call(cbind, ret)) + return(proxy.ret) +} Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-16 17:50:13 UTC (rev 3421) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-16 21:23:54 UTC (rev 3422) @@ -493,6 +493,19 @@ regime.switching <- FALSE } + # This is the case where the user has passed in a mult.portfolio.spec + # object for multiple layer portfolio optimization. + if(inherits(portfolio, "mult.portfolio.spec")){ + # This function calls optimize.portfolio.rebalancing on each sub portfolio + # according to the given optimization parameters and returns an xts object + # representing the proxy returns of each sub portfolio. + R <- proxy.mult.portfolio(R=R, mult.portfolio=portfolio) + + # The optimization is controlled by the constraints and objectives in the + # top level portfolio so now set the 'portfolio' to the top level portfolio + portfolio <- portfolio$top.portfolio + } + optimize_method <- optimize_method[1] tmptrace <- NULL start_t <- Sys.time() @@ -1406,6 +1419,18 @@ return(out) } + # This is the case where the user has passed in a mult.portfolio.spec + # object for multiple layer portfolio optimization. + if(inherits(portfolio, "mult.portfolio.spec")){ + # The optimization is controlled by the constraints and objectives in the + # top level portfolio + portfolio <- portfolio$top.portfolio + # This function calls optimize.portfolio.rebalancing on each sub portfolio + # according to the given optimization parameters and returns an xts object + # representing the proxy returns of each sub portfolio. + R <- proxy.mult.portfolio(R=R, mult.portfolio=portfolio) + } + # Store the call to return later call <- match.call() Added: pkg/PortfolioAnalytics/man/add.sub.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.sub.portfolio.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/add.sub.portfolio.Rd 2014-06-16 21:23:54 UTC (rev 3422) @@ -0,0 +1,48 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{add.sub.portfolio} +\alias{add.sub.portfolio} +\title{Add sub-portfolio} +\usage{ +add.sub.portfolio(mult.portfolio, portfolio, optimize_method = c("DEoptim", + "random", "ROI", "pso", "GenSA"), search_size = 20000, rp = NULL, + rebalance_on = NULL, training_period = NULL, trailing_periods = NULL, + ..., indexnum = NULL) +} +\arguments{ +\item{mult.portfolio}{a \code{mult.portfolio.spec} object} + +\item{portfolio}{a \code{portfolio} object to add as a sub portfolio.} + +\item{optimize_method}{optimization method for the sub portfolio} + +\item{search_size}{integer, how many portfolios to test, default 20,000} + +\item{rp}{matrix of random portfolio weights, default NULL, mostly for automated use by rebalancing optimization or repeated tests on same portfolios} + +\item{rebalance_on}{haracter string of period to rebalance on. See +\code{\link[xts]{endpoints}} for valid names.} + +\item{training_period}{an integer of the number of periods to use as +a training data in the front of the returns data} + +\item{trailing_periods}{an integer with the number of periods to roll over +(i.e. width of the moving or rolling window), the default is NULL will +run using the returns data from inception} + +\item{\dots}{additonal passthrough parameters to \code{\link{optimize.portfolio.rebalancing}}} + +\item{indexnum}{the index number of the sub portfolio. If \code{indexnum=NULL} +(the default), then the sub portfolio object is appended to the list of +sub portfolios in the \code{mult.portfolio} object. If \code{indexnum} is +specified, the portfolio in that index number is overwritten.} +} +\description{ +Add a sub-portfolio to a multiple layer portfolio specification object +} +\author{ +Ross Bennett +} +\seealso{ +\code{\link{mult.portfolio.spec}} \code{\link{portfolio.spec}} \code{\link{optimize.portfolio}} \code{\link{optimize.portfolio.rebalancing}} +} + Added: pkg/PortfolioAnalytics/man/mult.portfolio.spec.Rd =================================================================== --- pkg/PortfolioAnalytics/man/mult.portfolio.spec.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/mult.portfolio.spec.Rd 2014-06-16 21:23:54 UTC (rev 3422) @@ -0,0 +1,38 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{mult.portfolio.spec} +\alias{mult.portfolio.spec} +\title{Multple Layer Portfolio Specification} +\usage{ +mult.portfolio.spec(portfolio, levels = 2, ...) +} +\arguments{ +\item{portfolio}{the "top level" portfolio} + +\item{levels}{number of levels of sub-portfolios} + +\item{\dots}{any additional parameters} +} +\value{ +a \code{mult.portfolio.spec} object with the top level portfolio +and sub portfolios with optimization parameters for each sub portfolio +} +\description{ +Create and specify a multiple layer portfolio +} +\details{ +The \code{sub.portfolios} slot is a list where each element contains the +portfolio object and rebalancing parameters for the optimization of the +sub portfolio. +This allows, for example, each sub portfolio to have different rebalancing +frequencies (i.e. monthly or quarterly), optimization methods, etc. + +Each sub portfolio is optimized with \code{optimize.portfolio.rebalancing} +to create a time series of proxy returns. + +The "top level" portfolio is used to specify the constraints and objectives +to control the optimization given the proxy returns of each sub portfolio. +} +\author{ +Ross Bennett +} + From noreply at r-forge.r-project.org Mon Jun 16 23:26:51 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 16 Jun 2014 23:26:51 +0200 (CEST) Subject: [Returnanalytics-commits] r3423 - in pkg/PortfolioAnalytics: . man Message-ID: <20140616212651.B12111872F6@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-16 23:26:51 +0200 (Mon, 16 Jun 2014) New Revision: 3423 Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/man/CCCgarch.MM.Rd pkg/PortfolioAnalytics/man/HHI.Rd pkg/PortfolioAnalytics/man/add.constraint.Rd pkg/PortfolioAnalytics/man/add.objective.Rd pkg/PortfolioAnalytics/man/applyFUN.Rd pkg/PortfolioAnalytics/man/barplotGroupWeights.Rd pkg/PortfolioAnalytics/man/box_constraint.Rd pkg/PortfolioAnalytics/man/center.Rd pkg/PortfolioAnalytics/man/chart.Concentration.Rd pkg/PortfolioAnalytics/man/chart.EfficientFrontier.Rd pkg/PortfolioAnalytics/man/chart.EfficientFrontierOverlay.Rd pkg/PortfolioAnalytics/man/chart.GroupWeights.Rd pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd pkg/PortfolioAnalytics/man/chart.RiskReward.Rd pkg/PortfolioAnalytics/man/chart.Weights.EF.Rd pkg/PortfolioAnalytics/man/chart.Weights.Rd pkg/PortfolioAnalytics/man/check_constraints.Rd pkg/PortfolioAnalytics/man/cokurtosisMF.Rd pkg/PortfolioAnalytics/man/cokurtosisSF.Rd pkg/PortfolioAnalytics/man/combine.optimizations.Rd pkg/PortfolioAnalytics/man/combine.portfolios.Rd pkg/PortfolioAnalytics/man/constrained_objective.Rd pkg/PortfolioAnalytics/man/constraint.Rd pkg/PortfolioAnalytics/man/constraint_ROI.Rd pkg/PortfolioAnalytics/man/constraint_v2.Rd pkg/PortfolioAnalytics/man/coskewnessMF.Rd pkg/PortfolioAnalytics/man/coskewnessSF.Rd pkg/PortfolioAnalytics/man/covarianceMF.Rd pkg/PortfolioAnalytics/man/covarianceSF.Rd pkg/PortfolioAnalytics/man/create.EfficientFrontier.Rd pkg/PortfolioAnalytics/man/diversification.Rd pkg/PortfolioAnalytics/man/diversification_constraint.Rd pkg/PortfolioAnalytics/man/equal.weight.Rd pkg/PortfolioAnalytics/man/etl_milp_opt.Rd pkg/PortfolioAnalytics/man/etl_opt.Rd pkg/PortfolioAnalytics/man/extractCokurtosis.Rd pkg/PortfolioAnalytics/man/extractCoskewness.Rd pkg/PortfolioAnalytics/man/extractCovariance.Rd pkg/PortfolioAnalytics/man/extractEfficientFrontier.Rd pkg/PortfolioAnalytics/man/extractGroups.Rd pkg/PortfolioAnalytics/man/extractObjectiveMeasures.Rd pkg/PortfolioAnalytics/man/extractStats.Rd pkg/PortfolioAnalytics/man/extractWeights.Rd pkg/PortfolioAnalytics/man/factor_exposure_constraint.Rd pkg/PortfolioAnalytics/man/fn_map.Rd pkg/PortfolioAnalytics/man/generatesequence.Rd pkg/PortfolioAnalytics/man/get_constraints.Rd pkg/PortfolioAnalytics/man/gmv_opt.Rd pkg/PortfolioAnalytics/man/gmv_opt_ptc.Rd pkg/PortfolioAnalytics/man/gmv_opt_toc.Rd pkg/PortfolioAnalytics/man/group_constraint.Rd pkg/PortfolioAnalytics/man/group_fail.Rd pkg/PortfolioAnalytics/man/insert_constraints.Rd pkg/PortfolioAnalytics/man/insert_objectives.Rd pkg/PortfolioAnalytics/man/inverse.volatility.weight.Rd pkg/PortfolioAnalytics/man/is.constraint.Rd pkg/PortfolioAnalytics/man/is.objective.Rd pkg/PortfolioAnalytics/man/is.portfolio.Rd pkg/PortfolioAnalytics/man/leverage_exposure_constraint.Rd pkg/PortfolioAnalytics/man/maxret_milp_opt.Rd pkg/PortfolioAnalytics/man/maxret_opt.Rd pkg/PortfolioAnalytics/man/meanetl.efficient.frontier.Rd pkg/PortfolioAnalytics/man/meanvar.efficient.frontier.Rd pkg/PortfolioAnalytics/man/minmax_objective.Rd pkg/PortfolioAnalytics/man/name.replace.Rd pkg/PortfolioAnalytics/man/objective.Rd pkg/PortfolioAnalytics/man/optimize.portfolio.Rd pkg/PortfolioAnalytics/man/optimize.portfolio.parallel.Rd pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd pkg/PortfolioAnalytics/man/plot.Rd pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd pkg/PortfolioAnalytics/man/portfolio.spec.Rd pkg/PortfolioAnalytics/man/portfolio_risk_objective.Rd pkg/PortfolioAnalytics/man/pos_limit_fail.Rd pkg/PortfolioAnalytics/man/position_limit_constraint.Rd pkg/PortfolioAnalytics/man/print.constraint.Rd pkg/PortfolioAnalytics/man/print.efficient.frontier.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.rebalancing.Rd pkg/PortfolioAnalytics/man/print.portfolio.Rd pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.rebalancing.Rd pkg/PortfolioAnalytics/man/quadratic_utility_objective.Rd pkg/PortfolioAnalytics/man/random_portfolios.Rd pkg/PortfolioAnalytics/man/random_portfolios_v1.Rd pkg/PortfolioAnalytics/man/random_walk_portfolios.Rd pkg/PortfolioAnalytics/man/randomize_portfolio.Rd pkg/PortfolioAnalytics/man/randomize_portfolio_v1.Rd pkg/PortfolioAnalytics/man/regime.portfolios.Rd pkg/PortfolioAnalytics/man/return_constraint.Rd pkg/PortfolioAnalytics/man/return_objective.Rd pkg/PortfolioAnalytics/man/risk_budget_objective.Rd pkg/PortfolioAnalytics/man/rp_grid.Rd pkg/PortfolioAnalytics/man/rp_sample.Rd pkg/PortfolioAnalytics/man/rp_simplex.Rd pkg/PortfolioAnalytics/man/rp_transform.Rd pkg/PortfolioAnalytics/man/scatterFUN.Rd pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd pkg/PortfolioAnalytics/man/set.portfolio.moments_v1.Rd pkg/PortfolioAnalytics/man/statistical.factor.model.Rd pkg/PortfolioAnalytics/man/summary.efficient.frontier.Rd pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/summary.optimize.portfolio.rebalancing.Rd pkg/PortfolioAnalytics/man/summary.portfolio.Rd pkg/PortfolioAnalytics/man/trailingFUN.Rd pkg/PortfolioAnalytics/man/transaction_cost_constraint.Rd pkg/PortfolioAnalytics/man/turnover.Rd pkg/PortfolioAnalytics/man/turnover_constraint.Rd pkg/PortfolioAnalytics/man/turnover_objective.Rd pkg/PortfolioAnalytics/man/update.constraint.Rd pkg/PortfolioAnalytics/man/update_constraint_v1tov2.Rd pkg/PortfolioAnalytics/man/var.portfolio.Rd pkg/PortfolioAnalytics/man/weight_concentration_objective.Rd pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd Log: Modified man/files after updating to roxygen2 version 4.0.1 Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/DESCRIPTION 2014-06-16 21:26:51 UTC (rev 3423) @@ -32,38 +32,3 @@ testthat License: GPL Copyright: (c) 2004-2014 -Collate: - 'charts.DE.R' - 'charts.RP.R' - 'constrained_objective.R' - 'constraints.R' - 'constraints_ROI.R' - 'extract.efficient.frontier.R' - 'extractstats.R' - 'generics.R' - 'moment.functions.R' - 'objective.R' - 'optimize.portfolio.R' - 'random_portfolios.R' - 'trailingFUN.R' - 'objectiveFUN.R' - 'portfolio.R' - 'constraintsFUN.R' - 'constraint_fn_map.R' - 'optFUN.R' - 'charts.ROI.R' - 'applyFUN.R' - 'charts.PSO.R' - 'charts.GenSA.R' - 'chart.Weights.R' - 'chart.RiskReward.R' - 'charts.efficient.frontier.R' - 'charts.risk.R' - 'charts.groups.R' - 'charts.multiple.R' - 'utility.combine.R' - 'equal.weight.R' - 'inverse.volatility.weight.R' - 'utils.R' - 'chart.concentration.R' - 'stat.factor.model.R' Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,8 +1,82 @@ +# Generated by roxygen2 (4.0.1): do not edit by hand + +S3method(chart.EfficientFrontier,efficient.frontier) +S3method(chart.EfficientFrontier,optimize.portfolio) +S3method(chart.EfficientFrontier,optimize.portfolio.ROI) +S3method(chart.RiskBudget,opt.list) +S3method(chart.RiskBudget,optimize.portfolio) +S3method(chart.RiskBudget,optimize.portfolio.rebalancing) +S3method(chart.RiskReward,opt.list) +S3method(chart.RiskReward,optimize.portfolio.DEoptim) +S3method(chart.RiskReward,optimize.portfolio.GenSA) +S3method(chart.RiskReward,optimize.portfolio.ROI) +S3method(chart.RiskReward,optimize.portfolio.pso) +S3method(chart.RiskReward,optimize.portfolio.random) +S3method(chart.Weights,opt.list) +S3method(chart.Weights,optimize.portfolio.DEoptim) +S3method(chart.Weights,optimize.portfolio.GenSA) +S3method(chart.Weights,optimize.portfolio.ROI) +S3method(chart.Weights,optimize.portfolio.pso) +S3method(chart.Weights,optimize.portfolio.random) +S3method(chart.Weights,optimize.portfolio.rebalancing) +S3method(chart.Weights.EF,efficient.frontier) +S3method(chart.Weights.EF,optimize.portfolio) +S3method(extractObjectiveMeasures,opt.list) +S3method(extractObjectiveMeasures,opt.rebal.list) +S3method(extractObjectiveMeasures,optimize.portfolio) +S3method(extractObjectiveMeasures,optimize.portfolio.rebalancing) +S3method(extractObjectiveMeasures,summary.optimize.portfolio.rebalancing) +S3method(extractStats,opt.list) +S3method(extractStats,opt.rebal.list) +S3method(extractStats,optimize.portfolio.DEoptim) +S3method(extractStats,optimize.portfolio.GenSA) +S3method(extractStats,optimize.portfolio.ROI) +S3method(extractStats,optimize.portfolio.eqwt) +S3method(extractStats,optimize.portfolio.invol) +S3method(extractStats,optimize.portfolio.parallel) +S3method(extractStats,optimize.portfolio.pso) +S3method(extractStats,optimize.portfolio.random) +S3method(extractStats,optimize.portfolio.rebalancing) +S3method(extractWeights,opt.list) +S3method(extractWeights,opt.rebal.list) +S3method(extractWeights,optimize.portfolio) +S3method(extractWeights,optimize.portfolio.rebalancing) +S3method(extractWeights,summary.optimize.portfolio.rebalancing) +S3method(plot,optimize.portfolio) +S3method(plot,optimize.portfolio.DEoptim) +S3method(plot,optimize.portfolio.GenSA) +S3method(plot,optimize.portfolio.ROI) +S3method(plot,optimize.portfolio.pso) +S3method(plot,optimize.portfolio.random) +S3method(print,constraint) +S3method(print,efficient.frontier) +S3method(print,opt.list) +S3method(print,opt.rebal.list) +S3method(print,optimize.portfolio.DEoptim) +S3method(print,optimize.portfolio.GenSA) +S3method(print,optimize.portfolio.ROI) +S3method(print,optimize.portfolio.pso) +S3method(print,optimize.portfolio.random) +S3method(print,optimize.portfolio.rebalancing) +S3method(print,portfolio) +S3method(print,portfolio.list) +S3method(print,regime.portfolios) +S3method(print,summary.optimize.portfolio) +S3method(print,summary.optimize.portfolio.rebalancing) +S3method(summary,efficient.frontier) +S3method(summary,optimize.portfolio) +S3method(summary,optimize.portfolio.rebalancing) +S3method(summary,portfolio) +S3method(update,constraint) +export(CCCgarch.MM) +export(HHI) export(add.constraint) export(add.objective) +export(add.objective_v1) +export(add.objective_v2) +export(add.sub.portfolio) export(applyFUN) export(box_constraint) -export(CCCgarch.MM) export(center) export(chart.Concentration) export(chart.EfficientFrontier) @@ -10,17 +84,18 @@ export(chart.GroupWeights) export(chart.RiskBudget) export(chart.RiskReward) +export(chart.Weights) export(chart.Weights.EF) -export(chart.Weights) export(combine.optimizations) export(combine.portfolios) +export(constrained_objective) +export(constrained_objective_v1) export(constrained_objective_v2) -export(constrained_objective) +export(constraint) export(constraint_ROI) -export(constraint) export(create.EfficientFrontier) +export(diversification) export(diversification_constraint) -export(diversification) export(equal.weight) export(extractCokurtosis) export(extractCoskewness) @@ -34,7 +109,6 @@ export(fn_map) export(generatesequence) export(group_constraint) -export(HHI) export(insert_objectives) export(inverse.volatility.weight) export(is.constraint) @@ -44,24 +118,27 @@ export(meanetl.efficient.frontier) export(meanvar.efficient.frontier) export(minmax_objective) +export(mult.portfolio.spec) export(objective) -export(optimize.portfolio_v2) +export(optimize.portfolio) export(optimize.portfolio.parallel) export(optimize.portfolio.rebalancing) -export(optimize.portfolio) -export(portfolio_risk_objective) +export(optimize.portfolio.rebalancing_v1) +export(optimize.portfolio_v1) +export(optimize.portfolio_v2) export(portfolio.moments.boudt) export(portfolio.spec) +export(portfolio_risk_objective) export(pos_limit_fail) export(position_limit_constraint) export(quadratic_utility_objective) +export(random_portfolios) export(random_portfolios_v1) export(random_portfolios_v2) -export(random_portfolios) export(random_walk_portfolios) +export(randomize_portfolio) export(randomize_portfolio_v1) export(randomize_portfolio_v2) -export(randomize_portfolio) export(regime.portfolios) export(return_constraint) export(return_objective) @@ -71,85 +148,17 @@ export(rp_simplex) export(rp_transform) export(scatterFUN) +export(set.portfolio.moments) export(set.portfolio.moments_v1) export(set.portfolio.moments_v2) -export(set.portfolio.moments) export(statistical.factor.model) export(trailingFUN) export(transaction_cost_constraint) +export(turnover) export(turnover_constraint) export(turnover_objective) -export(turnover) export(update_constraint_v1tov2) export(var.portfolio) export(weight_concentration_objective) export(weight_sum_constraint) -S3method(chart.EfficientFrontier,efficient.frontier) -S3method(chart.EfficientFrontier,optimize.portfolio.ROI) -S3method(chart.EfficientFrontier,optimize.portfolio) -S3method(chart.RiskBudget,opt.list) -S3method(chart.RiskBudget,optimize.portfolio.rebalancing) -S3method(chart.RiskBudget,optimize.portfolio) -S3method(chart.RiskReward,opt.list) -S3method(chart.RiskReward,optimize.portfolio.DEoptim) -S3method(chart.RiskReward,optimize.portfolio.GenSA) -S3method(chart.RiskReward,optimize.portfolio.pso) -S3method(chart.RiskReward,optimize.portfolio.random) -S3method(chart.RiskReward,optimize.portfolio.ROI) -S3method(chart.Weights,opt.list) -S3method(chart.Weights,optimize.portfolio.DEoptim) -S3method(chart.Weights,optimize.portfolio.GenSA) -S3method(chart.Weights,optimize.portfolio.pso) -S3method(chart.Weights,optimize.portfolio.random) -S3method(chart.Weights,optimize.portfolio.rebalancing) -S3method(chart.Weights,optimize.portfolio.ROI) -S3method(chart.Weights.EF,efficient.frontier) -S3method(chart.Weights.EF,optimize.portfolio) -S3method(extractObjectiveMeasures,opt.list) -S3method(extractObjectiveMeasures,opt.rebal.list) -S3method(extractObjectiveMeasures,optimize.portfolio.rebalancing) -S3method(extractObjectiveMeasures,optimize.portfolio) -S3method(extractObjectiveMeasures,summary.optimize.portfolio.rebalancing) -S3method(extractStats,opt.list) -S3method(extractStats,opt.rebal.list) -S3method(extractStats,optimize.portfolio.DEoptim) -S3method(extractStats,optimize.portfolio.eqwt) -S3method(extractStats,optimize.portfolio.GenSA) -S3method(extractStats,optimize.portfolio.invol) -S3method(extractStats,optimize.portfolio.parallel) -S3method(extractStats,optimize.portfolio.pso) -S3method(extractStats,optimize.portfolio.random) -S3method(extractStats,optimize.portfolio.rebalancing) -S3method(extractStats,optimize.portfolio.ROI) -S3method(extractWeights,opt.list) -S3method(extractWeights,opt.rebal.list) -S3method(extractWeights,optimize.portfolio.rebalancing) -S3method(extractWeights,optimize.portfolio) -S3method(extractWeights,summary.optimize.portfolio.rebalancing) -S3method(plot,optimize.portfolio.DEoptim) -S3method(plot,optimize.portfolio.GenSA) -S3method(plot,optimize.portfolio.pso) -S3method(plot,optimize.portfolio.random) -S3method(plot,optimize.portfolio.ROI) -S3method(plot,optimize.portfolio) -S3method(print,constraint) -S3method(print,efficient.frontier) -S3method(print,opt.list) -S3method(print,opt.rebal.list) -S3method(print,optimize.portfolio.DEoptim) -S3method(print,optimize.portfolio.GenSA) -S3method(print,optimize.portfolio.pso) -S3method(print,optimize.portfolio.random) -S3method(print,optimize.portfolio.rebalancing) -S3method(print,optimize.portfolio.ROI) -S3method(print,portfolio.list) -S3method(print,portfolio) -S3method(print,regime.portfolios) -S3method(print,summary.optimize.portfolio.rebalancing) -S3method(print,summary.optimize.portfolio) -S3method(summary,efficient.frontier) -S3method(summary,optimize.portfolio.rebalancing) -S3method(summary,optimize.portfolio) -S3method(summary,portfolio) -S3method(update,constraint) useDynLib("PortfolioAnalytics") Modified: pkg/PortfolioAnalytics/man/CCCgarch.MM.Rd =================================================================== --- pkg/PortfolioAnalytics/man/CCCgarch.MM.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/CCCgarch.MM.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{CCCgarch.MM} \alias{CCCgarch.MM} \title{compute comoments for use by lower level optimization functions when the conditional covariance matrix is a CCC GARCH model} @@ -2,19 +3,15 @@ \usage{ - CCCgarch.MM(R, momentargs = NULL, ...) +CCCgarch.MM(R, momentargs = NULL, ...) } \arguments{ - \item{R}{an xts, vector, matrix, data frame, timeSeries - or zoo object of asset returns} +\item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} - \item{momentargs}{list containing arguments to be passed - down to lower level functions, default NULL} +\item{momentargs}{list containing arguments to be passed down to lower level functions, default NULL} - \item{\dots}{any other passthru parameters} +\item{\dots}{any other passthru parameters} } \description{ - it first estimates the conditional GARCH variances, then - filters out the time-varying volatility and estimates the - higher order comoments on the innovations rescaled such - that their unconditional covariance matrix is the - conditional covariance matrix forecast +it first estimates the conditional GARCH variances, then filters out the +time-varying volatility and estimates the higher order comoments on the innovations +rescaled such that their unconditional covariance matrix is the conditional covariance matrix forecast } Modified: pkg/PortfolioAnalytics/man/HHI.Rd =================================================================== --- pkg/PortfolioAnalytics/man/HHI.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/HHI.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{HHI} \alias{HHI} \title{Concentration of weights} @@ -2,15 +3,14 @@ \usage{ - HHI(weights, groups = NULL) +HHI(weights, groups = NULL) } \arguments{ - \item{weights}{set of portfolio weights} +\item{weights}{set of portfolio weights} - \item{groups}{list of vectors of grouping} +\item{groups}{list of vectors of grouping} } \description{ - This function computes the concentration of weights using - the Herfindahl Hirschman Index +This function computes the concentration of weights using the Herfindahl Hirschman Index } \author{ - Ross Bennett +Ross Bennett } Modified: pkg/PortfolioAnalytics/man/add.constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.constraint.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/add.constraint.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{add.constraint} \alias{add.constraint} \title{General interface for adding and/or updating optimization constraints.} @@ -2,63 +3,37 @@ \usage{ - add.constraint(portfolio, type, enabled = TRUE, - message = FALSE, ..., indexnum = NULL) +add.constraint(portfolio, type, enabled = TRUE, message = FALSE, ..., + indexnum = NULL) } \arguments{ - \item{portfolio}{an object of class 'portfolio' to add - the constraint to, specifying the constraints for the - optimization, see \code{\link{portfolio.spec}}} +\item{portfolio}{an object of class 'portfolio' to add the constraint to, specifying the constraints for the optimization, see \code{\link{portfolio.spec}}} - \item{type}{character type of the constraint to add or - update, currently 'weight_sum' (also 'leverage' or - 'weight'), 'box', 'group', 'turnover', 'diversification', - 'position_limit', 'return', or 'factor_exposure'} +\item{type}{character type of the constraint to add or update, currently 'weight_sum' (also 'leverage' or 'weight'), 'box', 'group', 'turnover', 'diversification', 'position_limit', 'return', or 'factor_exposure'} - \item{enabled}{TRUE/FALSE. The default is enabled=TRUE.} +\item{enabled}{TRUE/FALSE. The default is enabled=TRUE.} - \item{message}{TRUE/FALSE. The default is message=FALSE. - Display messages if TRUE.} +\item{message}{TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.} - \item{\dots}{any other passthru parameters to specify - constraints} +\item{\dots}{any other passthru parameters to specify constraints} - \item{indexnum}{if you are updating a specific - constraint, the index number in the $constraints list to - update} +\item{indexnum}{if you are updating a specific constraint, the index number in the $constraints list to update} } \description{ - This is the main function for adding and/or updating - constraints to the \code{\link{portfolio.spec}} object. +This is the main function for adding and/or updating constraints to the \code{\link{portfolio.spec}} object. } \details{ - The following constraint types may be specified: - \itemize{ \item{\code{weight_sum}, \code{weight}, - \code{leverage}}{ Specify constraint on the sum of the - weights, see \code{\link{weight_sum_constraint}} } - \item{\code{full_investment}}{ Special case to set - \code{min_sum=1} and \code{max_sum=1} of weight sum - constraints } \item{\code{dollar_neutral}, - \code{active}}{ Special case to set \code{min_sum=0} and - \code{max_sum=0} of weight sum constraints } - \item{\code{box}}{ box constraints for the individual - asset weights, see \code{\link{box_constraint}} } - \item{\code{long_only}}{ Special case to set \code{min=0} - and \code{max=1} of box constraints } - \item{\code{group}}{ specify the sum of weights within - groups and the number of assets with non-zero weights in - groups, see \code{\link{group_constraint}} } - \item{\code{turnover}}{ Specify a constraint for target - turnover. Turnover is calculated from a set of initial - weights, see \code{\link{turnover_constraint}} } - \item{\code{diversification}}{ target diversification of - a set of weights, see - \code{\link{diversification_constraint}} } - \item{\code{position_limit}}{ Specify the number of - non-zero, long, and/or short positions, see - \code{\link{position_limit_constraint}} } - \item{\code{return}}{ Specify the target mean return, see - \code{\link{return_constraint}}} - \item{\code{factor_exposure}}{ Specify risk factor - exposures, see \code{\link{factor_exposure_constraint}}} - } +The following constraint types may be specified: +\itemize{ +\item{\code{weight_sum}, \code{weight}, \code{leverage}}{ Specify constraint on the sum of the weights, see \code{\link{weight_sum_constraint}} } +\item{\code{full_investment}}{ Special case to set \code{min_sum=1} and \code{max_sum=1} of weight sum constraints } +\item{\code{dollar_neutral}, \code{active}}{ Special case to set \code{min_sum=0} and \code{max_sum=0} of weight sum constraints } +\item{\code{box}}{ box constraints for the individual asset weights, see \code{\link{box_constraint}} } +\item{\code{long_only}}{ Special case to set \code{min=0} and \code{max=1} of box constraints } +\item{\code{group}}{ specify the sum of weights within groups and the number of assets with non-zero weights in groups, see \code{\link{group_constraint}} } +\item{\code{turnover}}{ Specify a constraint for target turnover. Turnover is calculated from a set of initial weights, see \code{\link{turnover_constraint}} } +\item{\code{diversification}}{ target diversification of a set of weights, see \code{\link{diversification_constraint}} } +\item{\code{position_limit}}{ Specify the number of non-zero, long, and/or short positions, see \code{\link{position_limit_constraint}} } +\item{\code{return}}{ Specify the target mean return, see \code{\link{return_constraint}}} +\item{\code{factor_exposure}}{ Specify risk factor exposures, see \code{\link{factor_exposure_constraint}}} } +} \examples{ @@ -127,17 +102,17 @@ indexnum=2) } \author{ - Ross Bennett +Ross Bennett } \seealso{ - \code{\link{portfolio.spec}} - \code{\link{weight_sum_constraint}}, - \code{\link{box_constraint}}, - \code{\link{group_constraint}}, - \code{\link{turnover_constraint}}, - \code{\link{diversification_constraint}}, - \code{\link{position_limit_constraint}}, - \code{\link{return_constraint}}, - \code{\link{factor_exposure_constraint}} +\code{\link{portfolio.spec}} +\code{\link{weight_sum_constraint}}, +\code{\link{box_constraint}}, +\code{\link{group_constraint}}, +\code{\link{turnover_constraint}}, +\code{\link{diversification_constraint}}, +\code{\link{position_limit_constraint}}, +\code{\link{return_constraint}}, +\code{\link{factor_exposure_constraint}} } Modified: pkg/PortfolioAnalytics/man/add.objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.objective.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/add.objective.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{add.objective} \alias{add.objective} \alias{add.objective_v1} @@ -4,56 +5,41 @@ \alias{add.objective_v2} \title{General interface for adding optimization objectives, including risk, return, and risk budget} \usage{ - add.objective_v1(constraints, type, name, - arguments = NULL, enabled = TRUE, ..., indexnum = NULL) +add.objective_v1(constraints, type, name, arguments = NULL, enabled = TRUE, + ..., indexnum = NULL) - add.objective_v2(portfolio, constraints = NULL, type, - name, arguments = NULL, enabled = TRUE, ..., - indexnum = NULL) +add.objective_v2(portfolio, constraints = NULL, type, name, + arguments = NULL, enabled = TRUE, ..., indexnum = NULL) - add.objective(portfolio, constraints = NULL, type, name, - arguments = NULL, enabled = TRUE, ..., indexnum = NULL) +add.objective(portfolio, constraints = NULL, type, name, arguments = NULL, + enabled = TRUE, ..., indexnum = NULL) } \arguments{ - \item{portfolio}{an object of type 'portfolio' to add the - objective to, specifying the portfolio for the - optimization, see \code{\link{portfolio}}} +\item{portfolio}{an object of type 'portfolio' to add the objective to, specifying the portfolio for the optimization, see \code{\link{portfolio}}} - \item{constraints}{a 'v1_constraint' object for backwards - compatibility, see \code{\link{constraint}}} +\item{constraints}{a 'v1_constraint' object for backwards compatibility, see \code{\link{constraint}}} - \item{type}{character type of the objective to add or - update, currently 'return','risk', 'risk_budget', - 'quadratic_utility', or 'weight_concentration'} +\item{type}{character type of the objective to add or update, currently 'return','risk', 'risk_budget', 'quadratic_utility', or 'weight_concentration'} - \item{name}{name of the objective, should correspond to a - function, though we will try to make allowances} +\item{name}{name of the objective, should correspond to a function, though we will try to make allowances} - \item{arguments}{default arguments to be passed to an - objective function when executed} +\item{arguments}{default arguments to be passed to an objective function when executed} - \item{enabled}{TRUE/FALSE} +\item{enabled}{TRUE/FALSE} - \item{\dots}{any other passthru parameters} +\item{\dots}{any other passthru parameters} - \item{indexnum}{if you are updating a specific objective, - the index number in the $objectives list to update} +\item{indexnum}{if you are updating a specific objective, the index number in the $objectives list to update} } \description{ - This function is the main function for adding and - updating business objectives in an object of type - \code{\link{portfolio.spec}}. +This function is the main function for adding and updating business objectives in an object of type \code{\link{portfolio.spec}}. } \details{ - In general, you will define your objective as one of the - following types: 'return', 'risk', 'risk_budget', - 'quadratic utility', or 'weight_concentration'. These - have special handling and intelligent defaults for - dealing with the function most likely to be used as - objectives, including mean, median, VaR, ES, etc. +In general, you will define your objective as one of the following types: 'return', 'risk', 'risk_budget', 'quadratic utility', or 'weight_concentration'. +These have special handling and intelligent defaults for dealing with the function most likely to be +used as objectives, including mean, median, VaR, ES, etc. - Objectives of type 'turnover' and 'minmax' are also - supported. +Objectives of type 'turnover' and 'minmax' are also supported. } \examples{ data(edhec) @@ -105,9 +91,9 @@ name="HHI", conc_aversion=0.01) } \author{ - Brian G. Peterson and Ross Bennett +Brian G. Peterson and Ross Bennett } \seealso{ - \code{\link{objective}}, \code{\link{portfolio.spec}} +\code{\link{objective}}, \code{\link{portfolio.spec}} } Modified: pkg/PortfolioAnalytics/man/applyFUN.Rd =================================================================== --- pkg/PortfolioAnalytics/man/applyFUN.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/applyFUN.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{applyFUN} \alias{applyFUN} \title{Apply a risk or return function to a set of weights} @@ -2,21 +3,19 @@ \usage{ - applyFUN(R, weights, FUN = "mean", arguments) +applyFUN(R, weights, FUN = "mean", arguments) } \arguments{ - \item{R}{xts object of asset returns} +\item{R}{xts object of asset returns} - \item{weights}{a matrix of weights generated from - random_portfolios or \code{optimize.portfolio}} +\item{weights}{a matrix of weights generated from random_portfolios or \code{optimize.portfolio}} - \item{FUN}{name of a function} +\item{FUN}{name of a function} - \item{arguments}{named list of arguments to FUN} +\item{arguments}{named list of arguments to FUN} } \description{ - This function is used to calculate risk or return metrics - given a matrix of weights and is primarily used as a - convenience function used in chart.Scatter functions +This function is used to calculate risk or return metrics given a matrix of +weights and is primarily used as a convenience function used in chart.Scatter functions } \author{ - Ross Bennett +Ross Bennett } Modified: pkg/PortfolioAnalytics/man/barplotGroupWeights.Rd =================================================================== --- pkg/PortfolioAnalytics/man/barplotGroupWeights.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/barplotGroupWeights.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{barplotGroupWeights} \alias{barplotGroupWeights} \title{barplot of group weights by group or category} @@ -2,45 +3,39 @@ \usage{ - barplotGroupWeights(object, ..., - grouping = c("groups", "category"), - main = "Group Weights", las = 3, xlab = NULL, - cex.lab = 0.8, element.color = "darkgray", - cex.axis = 0.8) +barplotGroupWeights(object, ..., grouping = c("groups", "category"), + main = "Group Weights", las = 3, xlab = NULL, cex.lab = 0.8, + element.color = "darkgray", cex.axis = 0.8) } \arguments{ - \item{object}{object of class \code{optimize.portfolio}} +\item{object}{object of class \code{optimize.portfolio}} - \item{...}{passthrough parameters to \code{\link{plot}}} +\item{...}{passthrough parameters to \code{\link{plot}}} - \item{grouping}{\itemize{ \item{groups: }{group the - weights by group constraints} \item{category_labels: - }{group the weights by category_labels in portfolio - object} }} +\item{grouping}{\itemize{ + \item{groups: }{group the weights by group constraints} + \item{category_labels: }{group the weights by category_labels in portfolio object} +}} - \item{main}{an overall title for the plot: see - \code{\link{title}}} +\item{main}{an overall title for the plot: see \code{\link{title}}} - \item{las}{numeric in \{0,1,2,3\}; the style of axis - labels \describe{ \item{0:}{always parallel to the axis - [\emph{default}],} \item{1:}{always horizontal,} +\item{las}{numeric in \{0,1,2,3\}; the style of axis labels +\describe{ + \item{0:}{always parallel to the axis [\emph{default}],} + \item{1:}{always horizontal,} \item{2:}{always perpendicular to the axis,} - \item{3:}{always vertical.} }} + \item{3:}{always vertical.} +}} - \item{xlab}{a title for the x axis: see - \code{\link{title}}} +\item{xlab}{a title for the x axis: see \code{\link{title}}} - \item{cex.lab}{The magnification to be used for x and y - labels relative to the current setting of \code{cex}} +\item{cex.lab}{The magnification to be used for x and y labels relative to the current setting of \code{cex}} - \item{element.color}{color for the default border and - axis} +\item{element.color}{color for the default border and axis} - \item{cex.axis}{The magnification to be used for x and y - axis relative to the current setting of \code{cex}} +\item{cex.axis}{The magnification to be used for x and y axis relative to the current setting of \code{cex}} } \description{ - This function is called by chart.GroupWeights function if - chart.type="barplot" +This function is called by chart.GroupWeights function if chart.type="barplot" } \author{ - Ross Bennett +Ross Bennett } Modified: pkg/PortfolioAnalytics/man/box_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/box_constraint.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/box_constraint.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{box_constraint} \alias{box_constraint} \title{constructor for box_constraint.} @@ -2,41 +3,30 @@ \usage{ - box_constraint(type = "box", assets, min, max, min_mult, - max_mult, enabled = TRUE, message = FALSE, ...) +box_constraint(type = "box", assets, min, max, min_mult, max_mult, + enabled = TRUE, message = FALSE, ...) } \arguments{ - \item{type}{character type of the constraint} +\item{type}{character type of the constraint} - \item{assets}{number of assets, or optionally a named - vector of assets specifying initial weights} +\item{assets}{number of assets, or optionally a named vector of assets specifying initial weights} - \item{min}{numeric or named vector specifying minimum - weight box constraints} +\item{min}{numeric or named vector specifying minimum weight box constraints} - \item{max}{numeric or named vector specifying minimum - weight box constraints} +\item{max}{numeric or named vector specifying minimum weight box constraints} - \item{min_mult}{numeric or named vector specifying - minimum multiplier box constraint from initial weight in - \code{assets}} +\item{min_mult}{numeric or named vector specifying minimum multiplier box constraint from initial weight in \code{assets}} - \item{max_mult}{numeric or named vector specifying - maximum multiplier box constraint from initial weight in - \code{assets}} +\item{max_mult}{numeric or named vector specifying maximum multiplier box constraint from initial weight in \code{assets}} - \item{enabled}{TRUE/FALSE} +\item{enabled}{TRUE/FALSE} - \item{message}{TRUE/FALSE. The default is message=FALSE. - Display messages if TRUE.} +\item{message}{TRUE/FALSE. The default is message=FALSE. Display messages if TRUE.} - \item{\dots}{any other passthru parameters to specify box - constraints} +\item{\dots}{any other passthru parameters to specify box constraints} } \value{ - an object of class 'box_constraint' +an object of class 'box_constraint' } \description{ - Box constraints specify the upper and lower bounds on the - weights of the assets. This function is called by - add.constraint when type="box" is specified. See - \code{\link{add.constraint}}. +Box constraints specify the upper and lower bounds on the weights of the assets. +This function is called by add.constraint when type="box" is specified. See \code{\link{add.constraint}}. } @@ -58,9 +48,9 @@ pspec <- add.constraint(pspec, type="box", min=c(0.05, 0.10, 0.08, 0.06), max=c(0.45, 0.55, 0.35, 0.65)) } \author{ - Ross Bennett +Ross Bennett } \seealso{ - \code{\link{add.constraint}} +\code{\link{add.constraint}} } Modified: pkg/PortfolioAnalytics/man/center.Rd =================================================================== --- pkg/PortfolioAnalytics/man/center.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/center.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{center} \alias{center} \title{Center} @@ -2,20 +3,19 @@ \usage{ - center(x) +center(x) } \arguments{ - \item{x}{matrix} +\item{x}{matrix} } \value{ - matrix of centered data +matrix of centered data } \description{ - Center a matrix +Center a matrix } \details{ - This function is used primarily to center a time series - of asset returns or factors. Each column should represent - the returns of an asset or factor realizations. The - expected value is taken as the sample mean. +This function is used primarily to center a time series of asset returns or +factors. Each column should represent the returns of an asset or factor +realizations. The expected value is taken as the sample mean. - x.centered = x - mean(x) +x.centered = x - mean(x) } Modified: pkg/PortfolioAnalytics/man/chart.Concentration.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Concentration.Rd 2014-06-16 21:23:54 UTC (rev 3422) +++ pkg/PortfolioAnalytics/man/chart.Concentration.Rd 2014-06-16 21:26:51 UTC (rev 3423) @@ -1,3 +1,4 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand \name{chart.Concentration} \alias{chart.Concentration} \title{Classic risk reward scatter and concentration} @@ -2,53 +3,42 @@ \usage{ - chart.Concentration(object, ..., return.col = "mean", - risk.col = "ES", chart.assets = FALSE, - conc.type = c("weights", "pct_contrib"), - col = heat.colors(20), element.color = "darkgray", - cex.axis = 0.8, xlim = NULL, ylim = NULL) +chart.Concentration(object, ..., return.col = "mean", risk.col = "ES", + chart.assets = FALSE, conc.type = c("weights", "pct_contrib"), + col = heat.colors(20), element.color = "darkgray", cex.axis = 0.8, + xlim = NULL, ylim = NULL) } \arguments{ - \item{object}{optimal portfolio created by - \code{\link{optimize.portfolio}}.} +\item{object}{optimal portfolio created by \code{\link{optimize.portfolio}}.} - \item{\dots}{any other passthru parameters.} +\item{\dots}{any other passthru parameters.} - \item{return.col}{string matching the objective of a - 'return' objective, on vertical axis.} +\item{return.col}{string matching the objective of a 'return' objective, on vertical axis.} - \item{risk.col}{string matching the objective of a 'risk' [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3423 From noreply at r-forge.r-project.org Tue Jun 17 22:13:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 17 Jun 2014 22:13:06 +0200 (CEST) Subject: [Returnanalytics-commits] r3424 - pkg/FactorAnalytics/R Message-ID: <20140617201306.5AB21185B64@r-forge.r-project.org> Author: pragnya Date: 2014-06-17 22:13:06 +0200 (Tue, 17 Jun 2014) New Revision: 3424 Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R Log: Changed the description of fitStatisticalFactorModel Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2014-06-16 21:26:51 UTC (rev 3423) +++ pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2014-06-17 20:13:06 UTC (rev 3424) @@ -1,405 +1,410 @@ -#' Fit statistical factor model using principle components analysis -#' -#' Fit statistical factor model using principle components. This function is -#' mainly adapted from S+FinMetric function \code{mfactor}. -#' -#' -#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object with asset returns -#' and factors retunrs names. If data does not have xts class, rownames must provide -#' xts compatible time index. -#' @param k numbers of factors if it is scalar or method of choosing optimal -#' number of factors. "bn" represents Bai and Ng (2002) method and "ck" -#' represents Connor and korajczyk (1993) method. Default is k = 1. -#' @param refine \code{TRUE} By default, the APCA fit will use the -#' Connor-Korajczyk refinement. -#' @param check check if some variables has identical values. Default is FALSE. -#' @param max.k scalar, select the number that maximum number of factors to be -#' considered. -#' @param sig significant level when ck method uses. -#' @param na.rm if allow missing values. Default is FALSE. -#' -#' -#' @return -#' \itemize{ -#' \item{factors}{ T x K the estimated factors.} -#' \item{loadings}{ K x N the asset specific factor loadings beta_i. -#' estimated from regress the asset returns on factors.} -#' \item{alpha}{ 1 x N the estimated intercepts alpha_i} -#' \item{ret.cov}{ N x N asset returns sample variance covariance matrix.} -#' \item{r2}{ regression r square value from regress the asset returns on -#' factors.} -#' \item{k}{ the number of the facotrs.} -#' \item{eigen}{ eigenvalues from the sample covariance matrix.} -#' \item{residuals}{ T x N matrix of residuals from regression.} -#' \item{asset.ret}{ asset returns} -#' \item{asset.fit}{ List of regression lm class of individual returns on -#' factors.} -#' \item{resid.variance}{ vector of residual variances.} -#' \item{mimic}{ N x K matrix of factor mimicking portfolio returns.} -#' } -#' @author Eric Zivot and Yi-An Chen -#' @references Zivot and Wang, (2006) "Modeling Financial Time Series with S-PLUS, 2nd edition" -#' @examples -#' -#' # load data for fitStatisticalFactorModel.r -#' # data from finmetric berndt.dat and folio.dat -#' -#' data(stat.fm.data) -#' ## -#' # sfm.dat is for pca -#' # sfm.apca.dat is for apca -#' class(sfm.dat) -#' class(sfm.apca.dat) -#' -#' # pca -#' args(fitStatisticalFactorModel) -#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=2) -#' class(sfm.pca.fit) -#' names(sfm.pca.fit) -#' sfm.pca.fit$factors -#' sfm.pca.fit$loadings -#' sfm.pca.fit$r2 -#' sfm.pca.fit$residuals -#' sfm.pca.fit$resid.variance -#' sfm.pca.fit$mimic -#' # apca -#' sfm.apca.fit <- fitStatisticalFactorModel(sfm.apca.dat,k=1) -#' names(sfm.apca.fit) -#' sfm.apca.res <- sfm.apca.fit$residuals -#' sfm.apca.mimic <- sfm.apca.fit$mimic -#' # apca with bai and Ng method -#' sfm.apca.fit.bn <- fitStatisticalFactorModel(sfm.apca.dat,k="bn") -#' class(sfm.apca.fit.bn) -#' names(sfm.apca.fit.bn) -#' sfm.apca.fit.bn$mimic -#' -#' # apca with ck method -#' sfm.apca.fit.ck <- fitStatisticalFactorModel(sfm.apca.dat,k="ck") -#' class(sfm.apca.fit.ck) -#' names(sfm.apca.fit.ck) -#' sfm.apca.fit.ck$mimic -#' -#' @export -#' -fitStatisticalFactorModel <- -function(data, k = 1, refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05, na.rm = FALSE){ - -# load package -require(MASS) -require(PerformanceAnalytics) - - - - - # function of test - mfactor.test <- function(data, method = "bn", refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05){ - - if(is.null(max.k)) { - max.k <- min(10, nrow(data) - 1) - } else if (max.k >= nrow(data)) { - stop("max.k must be less than the number of observations.") - } - if(check) { - if(mfactor.check(data)) { - warning("Some variables have identical observations.") - return(list(factors = NA, loadings = NA, k = NA)) - } - } - method <- casefold(method) - if(method == "bn") { - ans <- mfactor.bn(data, max.k, refine = refine) - } - else if(method == "ck") { - ans <- mfactor.ck(data, max.k, refine = refine, sig = sig) - } - else { - stop("Invalid choice for optional argument method.") - } - return(ans) - -} - - -# function of ck -mfactor.ck <- function(data, max.k, sig = 0.05, refine = TRUE) { - - n <- ncol(data) - m <- nrow(data) - idx <- 2 * (1:(m/2)) - # - f <- mfactor.apca(data, k = 1, refine = refine, check = FALSE) - f1 <- cbind(1, f$factors) - B <- backsolve(chol(crossprod(f1)), diag(2)) - eps <- data - f1 %*% crossprod(t(B)) %*% crossprod(f1, data) - s <- eps^2/(1 - 2/m - 1/n) - # - for(i in 2:max.k) { - f.old <- f - s.old <- s - f <- mfactor.apca(data, k = i, refine = refine, check = FALSE) - f1 <- cbind(1, f$factors) - B <- backsolve(chol(crossprod(f1)), diag(i + 1)) - eps <- data - f1 %*% crossprod(t(B)) %*% crossprod(f1, data) - s <- eps^2/(1 - (i + 1)/m - i/n) - delta <- rowMeans(s.old[idx - 1, , drop = FALSE]) - rowMeans( - s[idx, , drop = FALSE]) - if(t.test(delta, alternative = "greater")$p.value > sig) { - return(f.old) - } - } - return(f) -} - -# funciton of check - mfactor.check <- function(data) { - temp <- apply(data, 2, range) - if(any(abs(temp[2, ] - temp[1, ]) < .Machine$single.eps)) { - TRUE - } - else { - FALSE - } -} - - # function of bn - mfactor.bn <- function(data, max.k, refine = TRUE) { - - # Parameters: - # data : T x N return matrix - # max.k : maxinum number of factors to be considered - # Returns: - # k : the optimum number of factors - n <- ncol(data) - m <- nrow(data) - s <- vector("list", max.k) - for(i in 1:max.k) { - f <- cbind(1, mfactor.apca(data, k = i, refine = refine, check = - FALSE)$factors) - B <- backsolve(chol(crossprod(f)), diag(i + 1)) - eps <- data - f %*% crossprod(t(B)) %*% crossprod(f, data) - sigma <- colSums(eps^2)/(m - i - 1) - s[[i]] <- mean(sigma) - } - s <- unlist(s) - idx <- 1:max.k - Cp1 <- s[idx] + (idx * s[max.k] * (n + m))/(n * m) * log((n * m)/ - (n + m)) - Cp2 <- s[idx] + (idx * s[max.k] * (n + m))/(n * m) * log(min(n, m)) - if(order(Cp1)[1] != order(Cp2)[1]) { - warning("Cp1 and Cp2 did not yield same result. The smaller one is used." ) - } - k <- min(order(Cp1)[1], order(Cp2)[1]) - f <- mfactor.apca(data, k = k, refine = refine, check = FALSE) - return(f) - } - - - # function of pca - mfactor.pca <- function(data, k, check = FALSE, ret.cov = NULL) { - - if(check) { - if(mfactor.check(data)) { - warning("Some variables have identical observations.") - return(list(factors = NA, loadings = NA, k = NA)) - } - } - n <- ncol(data) - m <- nrow(data) - if(is.null(dimnames(data))) { - dimnames(data) <- list(1:m, paste("V", 1:n, sep = ".")) - } - data.names <- dimnames(data)[[2]] - # demean - xc <- t(t(data) - colMeans(data)) - if(is.null(ret.cov)) { - ret.cov <- crossprod(xc)/m - } - eigen.tmp <- eigen(ret.cov, symmetric = TRUE) - # compute loadings beta - B <- t(eigen.tmp$vectors[, 1:k, drop = FALSE]) - # compute estimated factors - f <- data %*% eigen.tmp$vectors[, 1:k, drop = FALSE] - tmp <- data - f %*% B - alpha <- colMeans(tmp) - # compute residuals - resid <- t(t(tmp) - alpha) - r2 <- (1 - colSums(resid^2)/colSums(xc^2)) - ret.cov <- t(B) %*% var(f) %*% B - diag(ret.cov) <- diag(ret.cov) + colSums(resid^2)/(m - k - 1) - dimnames(B) <- list(paste("F", 1:k, sep = "."), data.names) - dimnames(f) <- list(dimnames(data)[[1]], paste("F", 1:k, sep = ".")) - dimnames(ret.cov) <- list(data.names, data.names) - names(alpha) <- data.names - -# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { - f <- xts(f,index(data.xts)) - resid <- xts(resid,index(data.xts)) -# } - - - # create lm list for plot - reg.list = list() -# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { - for (i in data.names) { - reg.xts = merge(data.xts[,i],f) - colnames(reg.xts)[1] <- i - fm.formula = as.formula(paste(i,"~", ".", sep=" ")) - fm.fit = lm(fm.formula, data=reg.xts) - reg.list[[i]] = fm.fit - } -# } else { -# for (i in data.names) { -# reg.df = as.data.frame(cbind(data[,i],coredata(f))) -# colnames(reg.df)[1] <- i -# fm.formula = as.formula(paste(i,"~", ".", sep=" ")) -# fm.fit = lm(fm.formula, data=reg.df) -# reg.list[[i]] = fm.fit -# } -# } - - ans <- list(factors = f, loadings = B, k = k, alpha = alpha, ret.cov = ret.cov, - r2 = r2, eigen = eigen.tmp$values, residuals=resid, asset.ret = data, - asset.fit=reg.list) - - return(ans) - -} - - # funciont of apca - mfactor.apca <- function(data, k, refine = TRUE, check = FALSE, ret.cov = NULL) { - - if(check) { - if(mfactor.check(data)) { - warning("Some variables have identical observations.") - return(list(factors = NA, loadings = NA, k = NA)) - } - } - n <- ncol(data) - m <- nrow(data) - if(is.null(dimnames(data))) { - dimnames(data) <- list(1:m, paste("V", 1:n, sep = ".")) - } - data.names <- dimnames(data)[[2]] - xc <- t(t(data) - colMeans(data)) - if(is.null(ret.cov)) { - ret.cov <- crossprod(t(xc))/n - } - eig.tmp <- eigen(ret.cov, symmetric = TRUE) - f <- eig.tmp$vectors[, 1:k, drop = FALSE] - f1 <- cbind(1, f) - B <- backsolve(chol(crossprod(f1)), diag(k + 1)) - B <- crossprod(t(B)) %*% crossprod(f1, data) - sigma <- colSums((data - f1 %*% B)^2)/(m - k - 1) - if(refine) { - xs <- t(xc)/sqrt(sigma) - ret.cov <- crossprod(xs)/n - eig.tmp <- eigen(ret.cov, symmetric = TRUE) - f <- eig.tmp$vectors[, 1:k, drop = FALSE] - f1 <- cbind(1, f) - B <- backsolve(chol(crossprod(f1)), diag(k + 1)) - B <- crossprod(t(B)) %*% crossprod(f1, data) - sigma <- colSums((data - f1 %*% B)^2)/(m - k - 1) - } - alpha <- B[1, ] - B <- B[-1, , drop = FALSE] - ret.cov <- t(B) %*% var(f) %*% B - diag(ret.cov) <- diag(ret.cov) + sigma - dimnames(B) <- list(paste("F", 1:k, sep = "."), data.names) - dimnames(f) <- list(dimnames(data)[[1]], paste("F", 1:k, sep = ".")) - names(alpha) <- data.names - resid <- t(t(data) - alpha) - f %*% B - r2 <- (1 - colSums(resid^2)/colSums(xc^2)) - -# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { - f <- xts(f,index(data.xts)) - resid <- xts(resid,index(data.xts)) -# } - - # create lm list for plot - reg.list = list() -# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { - for (i in data.names) { - reg.xts = merge(data.xts[,i],f) - colnames(reg.xts)[1] <- i - fm.formula = as.formula(paste(i,"~", ".", sep=" ")) - fm.fit = lm(fm.formula, data=reg.xts) - reg.list[[i]] = fm.fit - } -# } else { -# for (i in data.names) { -# reg.df = as.data.frame(cbind(data[,i],coredata(f))) -# colnames(reg.df)[1] <- i -# fm.formula = as.formula(paste(i,"~", ".", sep=" ")) -# fm.fit = lm(fm.formula, data=reg.df) -# reg.list[[i]] = fm.fit -# } -# } - - - ans <- list(factors = f, loadings = B, k = k, alpha = alpha, ret.cov = ret.cov, - r2 = r2, eigen = eig.tmp$values, residuals=resid,asset.ret = data, - asset.fit=reg.list) - return(ans) -} - -# check data -data.xts <- checkData(data,method="xts") - - - call <- match.call() - pos <- rownames(coredata(data.xts)) - data.m <- as.matrix(coredata(data.xts)) - if(any(is.na(data.m))) { - if(na.rm) { - data.m <- na.omit(data.m) - } else { - stop("Missing values are not allowed if na.rm=F.") - } - } - # use PCA if T > N - if(ncol(data.m) < nrow(data.m)) { - if(is.character(k)) { - stop("k must be the number of factors for PCA.") - } - if(k >= ncol(data.m)) { - stop("Number of factors must be smaller than number of variables." - ) - } - ans <- mfactor.pca(data.m, k, check = check) - } else if(is.character(k)) { - ans <- mfactor.test(data.m, k, refine = refine, check = - check, max.k = max.k, sig = sig) - } else { # use aPCA if T <= N - if(k >= ncol(data.m)) { - stop("Number of factors must be smaller than number of variables." - ) - } - ans <- mfactor.apca(data.m, k, refine = refine, check = - check) - } - - # mimic function - f <- ans$factors - - if(is.data.frame(f)) { - f <- as.matrix(f) - } - - if(nrow(data.m) < ncol(data.m)) { - mimic <- ginv(data.m) %*% f - } else { - mimic <- qr.solve(data.m, f) - } - - mimic <- t(t(mimic)/colSums(mimic)) - dimnames(mimic)[[1]] <- dimnames(data.m)[[2]] - - ans$mimic <- mimic - ans$resid.variance <- apply(ans$residuals,2,var) - ans$call <- call - ans$data <- data - ans$assets.names <- colnames(data.m) -class(ans) <- "StatFactorModel" - return(ans) -} - +#' Fit a statistical factor model using principal component analysis +#' +#' Fits a statistical factor model using principal component analysis. +#' This is an adaptation of the S+FinMetric function \code{mfactor}. +#' +#' +#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object with +#' asset returns and factors names. If data is not of class xts, rownames must +#' provide an xts compatible time index. +#' @param k numbers of factors. Can be a scalar value or a method for +#' determining the optimal number of factors. k="bn" corresponds to Bai and +#' Ng (2002) and k="ck" corresponds to Connor and Korajczyk (1993). Defaults to 1. +#' @param refine a logical value that when set to \code{TRUE}, specifies the +#' Connor-Korajczyk refinement for APCA (Asymptotic Principal Component Analysis). +#' Defaults to \code{TRUE}. +#' @param check Checks if any two assets have identical values. Defaults to +#' \code{FALSE}. +#' @param max.k a scalar that specifies the maximum number of factors to be +#' considered. +#' @param sig desired level of significant when "ck"" method is specified. +#' @param na.rm a logical value to specify if missing values should be removed. +#' Defaults to FALSE. +#' +#' +#' @return +#' \itemize{ +#' \item{factors}{ T x K matrix of estimated factors.} +#' \item{loadings}{ K x N matrix of asset specific factor loadings beta_i, +#' estimated by regressing the asset returns on factors.} +#' \item{alpha}{ 1 x N vector of estimated intercepts alpha_i} +#' \item{ret.cov}{ N x N matrix of asset returns' sample covariance matrix.} +#' \item{r2}{ r-squared value from regressing the asset returns on the factors.} +#' \item{k}{ the number of facotrs.} +#' \item{eigen}{ eigenvalues from the sample covariance matrix.} +#' \item{residuals}{ T x N matrix of residuals from regression.} +#' \item{asset.ret}{ asset returns} +#' \item{asset.fit}{ List of regression lm class of individual returns on +#' factors.} +#' \item{resid.variance}{ vector of residual variances.} +#' \item{mimic}{ N x K matrix of factor mimicking portfolio returns.} +#' } +#' Where N is the number of assets, K is the number of factors, and T is the +#' number of observations. +#' +#' @author Eric Zivot and Yi-An Chen +#' @references Zivot and Wang, (2006) "Modeling Financial Time Series with S-PLUS, 2nd edition" +#' @examples +#' +#' # load data for fitStatisticalFactorModel.r +#' # data from finmetric berndt.dat and folio.dat +#' +#' data(stat.fm.data) +#' ## +#' # sfm.dat is for pca +#' # sfm.apca.dat is for apca +#' class(sfm.dat) +#' class(sfm.apca.dat) +#' +#' # pca +#' args(fitStatisticalFactorModel) +#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=2) +#' class(sfm.pca.fit) +#' names(sfm.pca.fit) +#' sfm.pca.fit$factors +#' sfm.pca.fit$loadings +#' sfm.pca.fit$r2 +#' sfm.pca.fit$residuals +#' sfm.pca.fit$resid.variance +#' sfm.pca.fit$mimic +#' # apca +#' sfm.apca.fit <- fitStatisticalFactorModel(sfm.apca.dat,k=1) +#' names(sfm.apca.fit) +#' sfm.apca.res <- sfm.apca.fit$residuals +#' sfm.apca.mimic <- sfm.apca.fit$mimic +#' # apca with bai and Ng method +#' sfm.apca.fit.bn <- fitStatisticalFactorModel(sfm.apca.dat,k="bn") +#' class(sfm.apca.fit.bn) +#' names(sfm.apca.fit.bn) +#' sfm.apca.fit.bn$mimic +#' +#' # apca with ck method +#' sfm.apca.fit.ck <- fitStatisticalFactorModel(sfm.apca.dat,k="ck") +#' class(sfm.apca.fit.ck) +#' names(sfm.apca.fit.ck) +#' sfm.apca.fit.ck$mimic +#' +#' @export +#' +fitStatisticalFactorModel <- +function(data, k = 1, refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05, na.rm = FALSE){ + +# load package +require(MASS) +require(PerformanceAnalytics) + + + + + # function of test + mfactor.test <- function(data, method = "bn", refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05){ + + if(is.null(max.k)) { + max.k <- min(10, nrow(data) - 1) + } else if (max.k >= nrow(data)) { + stop("max.k must be less than the number of observations.") + } + if(check) { + if(mfactor.check(data)) { + warning("Some variables have identical observations.") + return(list(factors = NA, loadings = NA, k = NA)) + } + } + method <- casefold(method) + if(method == "bn") { + ans <- mfactor.bn(data, max.k, refine = refine) + } + else if(method == "ck") { + ans <- mfactor.ck(data, max.k, refine = refine, sig = sig) + } + else { + stop("Invalid choice for optional argument method.") + } + return(ans) + +} + + +# function of ck +mfactor.ck <- function(data, max.k, sig = 0.05, refine = TRUE) { + + n <- ncol(data) + m <- nrow(data) + idx <- 2 * (1:(m/2)) + # + f <- mfactor.apca(data, k = 1, refine = refine, check = FALSE) + f1 <- cbind(1, f$factors) + B <- backsolve(chol(crossprod(f1)), diag(2)) + eps <- data - f1 %*% crossprod(t(B)) %*% crossprod(f1, data) + s <- eps^2/(1 - 2/m - 1/n) + # + for(i in 2:max.k) { + f.old <- f + s.old <- s + f <- mfactor.apca(data, k = i, refine = refine, check = FALSE) + f1 <- cbind(1, f$factors) + B <- backsolve(chol(crossprod(f1)), diag(i + 1)) + eps <- data - f1 %*% crossprod(t(B)) %*% crossprod(f1, data) + s <- eps^2/(1 - (i + 1)/m - i/n) + delta <- rowMeans(s.old[idx - 1, , drop = FALSE]) - rowMeans( + s[idx, , drop = FALSE]) + if(t.test(delta, alternative = "greater")$p.value > sig) { + return(f.old) + } + } + return(f) +} + +# funciton of check + mfactor.check <- function(data) { + temp <- apply(data, 2, range) + if(any(abs(temp[2, ] - temp[1, ]) < .Machine$single.eps)) { + TRUE + } + else { + FALSE + } +} + + # function of bn + mfactor.bn <- function(data, max.k, refine = TRUE) { + + # Parameters: + # data : T x N return matrix + # max.k : maxinum number of factors to be considered + # Returns: + # k : the optimum number of factors + n <- ncol(data) + m <- nrow(data) + s <- vector("list", max.k) + for(i in 1:max.k) { + f <- cbind(1, mfactor.apca(data, k = i, refine = refine, check = + FALSE)$factors) + B <- backsolve(chol(crossprod(f)), diag(i + 1)) + eps <- data - f %*% crossprod(t(B)) %*% crossprod(f, data) + sigma <- colSums(eps^2)/(m - i - 1) + s[[i]] <- mean(sigma) + } + s <- unlist(s) + idx <- 1:max.k + Cp1 <- s[idx] + (idx * s[max.k] * (n + m))/(n * m) * log((n * m)/ + (n + m)) + Cp2 <- s[idx] + (idx * s[max.k] * (n + m))/(n * m) * log(min(n, m)) + if(order(Cp1)[1] != order(Cp2)[1]) { + warning("Cp1 and Cp2 did not yield same result. The smaller one is used." ) + } + k <- min(order(Cp1)[1], order(Cp2)[1]) + f <- mfactor.apca(data, k = k, refine = refine, check = FALSE) + return(f) + } + + + # function of pca + mfactor.pca <- function(data, k, check = FALSE, ret.cov = NULL) { + + if(check) { + if(mfactor.check(data)) { + warning("Some variables have identical observations.") + return(list(factors = NA, loadings = NA, k = NA)) + } + } + n <- ncol(data) + m <- nrow(data) + if(is.null(dimnames(data))) { + dimnames(data) <- list(1:m, paste("V", 1:n, sep = ".")) + } + data.names <- dimnames(data)[[2]] + # demean + xc <- t(t(data) - colMeans(data)) + if(is.null(ret.cov)) { + ret.cov <- crossprod(xc)/m + } + eigen.tmp <- eigen(ret.cov, symmetric = TRUE) + # compute loadings beta + B <- t(eigen.tmp$vectors[, 1:k, drop = FALSE]) + # compute estimated factors + f <- data %*% eigen.tmp$vectors[, 1:k, drop = FALSE] + tmp <- data - f %*% B + alpha <- colMeans(tmp) + # compute residuals + resid <- t(t(tmp) - alpha) + r2 <- (1 - colSums(resid^2)/colSums(xc^2)) + ret.cov <- t(B) %*% var(f) %*% B + diag(ret.cov) <- diag(ret.cov) + colSums(resid^2)/(m - k - 1) + dimnames(B) <- list(paste("F", 1:k, sep = "."), data.names) + dimnames(f) <- list(dimnames(data)[[1]], paste("F", 1:k, sep = ".")) + dimnames(ret.cov) <- list(data.names, data.names) + names(alpha) <- data.names + +# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { + f <- xts(f,index(data.xts)) + resid <- xts(resid,index(data.xts)) +# } + + + # create lm list for plot + reg.list = list() +# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { + for (i in data.names) { + reg.xts = merge(data.xts[,i],f) + colnames(reg.xts)[1] <- i + fm.formula = as.formula(paste(i,"~", ".", sep=" ")) + fm.fit = lm(fm.formula, data=reg.xts) + reg.list[[i]] = fm.fit + } +# } else { +# for (i in data.names) { +# reg.df = as.data.frame(cbind(data[,i],coredata(f))) +# colnames(reg.df)[1] <- i +# fm.formula = as.formula(paste(i,"~", ".", sep=" ")) +# fm.fit = lm(fm.formula, data=reg.df) +# reg.list[[i]] = fm.fit +# } +# } + + ans <- list(factors = f, loadings = B, k = k, alpha = alpha, ret.cov = ret.cov, + r2 = r2, eigen = eigen.tmp$values, residuals=resid, asset.ret = data, + asset.fit=reg.list) + + return(ans) + +} + + # funciont of apca + mfactor.apca <- function(data, k, refine = TRUE, check = FALSE, ret.cov = NULL) { + + if(check) { + if(mfactor.check(data)) { + warning("Some variables have identical observations.") + return(list(factors = NA, loadings = NA, k = NA)) + } + } + n <- ncol(data) + m <- nrow(data) + if(is.null(dimnames(data))) { + dimnames(data) <- list(1:m, paste("V", 1:n, sep = ".")) + } + data.names <- dimnames(data)[[2]] + xc <- t(t(data) - colMeans(data)) + if(is.null(ret.cov)) { + ret.cov <- crossprod(t(xc))/n + } + eig.tmp <- eigen(ret.cov, symmetric = TRUE) + f <- eig.tmp$vectors[, 1:k, drop = FALSE] + f1 <- cbind(1, f) + B <- backsolve(chol(crossprod(f1)), diag(k + 1)) + B <- crossprod(t(B)) %*% crossprod(f1, data) + sigma <- colSums((data - f1 %*% B)^2)/(m - k - 1) + if(refine) { + xs <- t(xc)/sqrt(sigma) + ret.cov <- crossprod(xs)/n + eig.tmp <- eigen(ret.cov, symmetric = TRUE) + f <- eig.tmp$vectors[, 1:k, drop = FALSE] + f1 <- cbind(1, f) + B <- backsolve(chol(crossprod(f1)), diag(k + 1)) + B <- crossprod(t(B)) %*% crossprod(f1, data) + sigma <- colSums((data - f1 %*% B)^2)/(m - k - 1) + } + alpha <- B[1, ] + B <- B[-1, , drop = FALSE] + ret.cov <- t(B) %*% var(f) %*% B + diag(ret.cov) <- diag(ret.cov) + sigma + dimnames(B) <- list(paste("F", 1:k, sep = "."), data.names) + dimnames(f) <- list(dimnames(data)[[1]], paste("F", 1:k, sep = ".")) + names(alpha) <- data.names + resid <- t(t(data) - alpha) - f %*% B + r2 <- (1 - colSums(resid^2)/colSums(xc^2)) + +# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { + f <- xts(f,index(data.xts)) + resid <- xts(resid,index(data.xts)) +# } + + # create lm list for plot + reg.list = list() +# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) { + for (i in data.names) { + reg.xts = merge(data.xts[,i],f) + colnames(reg.xts)[1] <- i + fm.formula = as.formula(paste(i,"~", ".", sep=" ")) + fm.fit = lm(fm.formula, data=reg.xts) + reg.list[[i]] = fm.fit + } +# } else { +# for (i in data.names) { +# reg.df = as.data.frame(cbind(data[,i],coredata(f))) +# colnames(reg.df)[1] <- i +# fm.formula = as.formula(paste(i,"~", ".", sep=" ")) +# fm.fit = lm(fm.formula, data=reg.df) +# reg.list[[i]] = fm.fit +# } +# } + + + ans <- list(factors = f, loadings = B, k = k, alpha = alpha, ret.cov = ret.cov, + r2 = r2, eigen = eig.tmp$values, residuals=resid,asset.ret = data, + asset.fit=reg.list) + return(ans) +} + +# check data +data.xts <- checkData(data,method="xts") + + + call <- match.call() + pos <- rownames(coredata(data.xts)) + data.m <- as.matrix(coredata(data.xts)) + if(any(is.na(data.m))) { + if(na.rm) { + data.m <- na.omit(data.m) + } else { + stop("Missing values are not allowed if na.rm=F.") + } + } + # use PCA if T > N + if(ncol(data.m) < nrow(data.m)) { + if(is.character(k)) { + stop("k must be the number of factors for PCA.") + } + if(k >= ncol(data.m)) { + stop("Number of factors must be smaller than number of variables." + ) + } + ans <- mfactor.pca(data.m, k, check = check) + } else if(is.character(k)) { + ans <- mfactor.test(data.m, k, refine = refine, check = + check, max.k = max.k, sig = sig) + } else { # use aPCA if T <= N + if(k >= ncol(data.m)) { + stop("Number of factors must be smaller than number of variables." + ) + } + ans <- mfactor.apca(data.m, k, refine = refine, check = + check) + } + + # mimic function + f <- ans$factors + + if(is.data.frame(f)) { + f <- as.matrix(f) + } + + if(nrow(data.m) < ncol(data.m)) { + mimic <- ginv(data.m) %*% f + } else { + mimic <- qr.solve(data.m, f) + } + + mimic <- t(t(mimic)/colSums(mimic)) + dimnames(mimic)[[1]] <- dimnames(data.m)[[2]] + + ans$mimic <- mimic + ans$resid.variance <- apply(ans$residuals,2,var) + ans$call <- call + ans$data <- data + ans$assets.names <- colnames(data.m) +class(ans) <- "StatFactorModel" + return(ans) +} + From noreply at r-forge.r-project.org Wed Jun 18 19:26:43 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 18 Jun 2014 19:26:43 +0200 (CEST) Subject: [Returnanalytics-commits] r3425 - in pkg/PortfolioAnalytics: R demo sandbox Message-ID: <20140618172643.40E011874D5@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-18 19:26:42 +0200 (Wed, 18 Jun 2014) New Revision: 3425 Added: pkg/PortfolioAnalytics/demo/multi_layer_optimization.R pkg/PortfolioAnalytics/sandbox/mult_layer_script.R Removed: pkg/PortfolioAnalytics/sandbox/multi_layer_script.R Modified: pkg/PortfolioAnalytics/R/mult.layer.portfolio.R pkg/PortfolioAnalytics/demo/00Index Log: Adding better multi layer script to sandbox. Adding demo. Improving checks in function to compute the proxy returns for sub portfolios. Modified: pkg/PortfolioAnalytics/R/mult.layer.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/mult.layer.portfolio.R 2014-06-17 20:13:06 UTC (rev 3424) +++ pkg/PortfolioAnalytics/R/mult.layer.portfolio.R 2014-06-18 17:26:42 UTC (rev 3425) @@ -126,6 +126,9 @@ } n.sub.portfolios <- length(mult.portfolio$sub.portfolios) + if(n.sub.portfolios <= 1) stop("Must have more than 1 sub portfolio") + + # Initialize list to store the returns for each sub portfolio ret <- vector("list", n.sub.portfolios) # Loop through the sub portfolios and call optimize.portfolio.rebalancing @@ -142,21 +145,21 @@ stop("R object of returns not subset correctly. Make sure the names of the assets in the sub portfolio match the column names of the R object") } - # This needs to support + # This needs to support anything in ... that could be passed to optimize.portfolio .formals <- formals(optimize.portfolio.rebalancing) .formals <- PortfolioAnalytics:::modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) .formals <- PortfolioAnalytics:::modify.args(formals=.formals, arglist=tmp, dots=TRUE) .formals$... <- NULL #print(.formals) opt <- try(do.call(optimize.portfolio.rebalancing, .formals), silent=TRUE) - if(inherits(opt, "try-error")) { - message(paste("optimize.portfolio.rebalancing for sub portfolio", i, "generated an error or warning:", opt)) - next() - } - ret.tmp <- Return.rebalancing(R.tmp, extractWeights(opt)) - colnames(ret.tmp) <- paste("proxy", i, sep=".") - ret[[i]] <- ret.tmp - #print(ret[[i]]) + if(!inherits(opt, "try-error")) { + ret.tmp <- Return.rebalancing(R.tmp, extractWeights(opt)) + colnames(ret.tmp) <- paste("proxy", i, sep=".") + ret[[i]] <- ret.tmp + #print(ret[[i]]) + } else { + stop(paste("optimize.portfolio.rebalancing for sub portfolio", i, "generated an error or warning:", opt)) + } } proxy.ret <- na.omit(do.call(cbind, ret)) return(proxy.ret) Modified: pkg/PortfolioAnalytics/demo/00Index =================================================================== --- pkg/PortfolioAnalytics/demo/00Index 2014-06-17 20:13:06 UTC (rev 3424) +++ pkg/PortfolioAnalytics/demo/00Index 2014-06-18 17:26:42 UTC (rev 3425) @@ -30,3 +30,4 @@ multiple_portfolio_optimization Demonstrate passing a list of portfolios to optimize.portfolio and optimize.portfolio.rebalancing regime_switching Demonstrate optimization with support for regime switching to switch portfolios based on the regime. higher_moments_boudt Demonstrate using a statistical factor model to estimate moments based on work by Kris Boudt. +multi_layer_optimization Demonstrate multi layer optimization of optimization problem with two layers and two sub portfolios in the lower layer. Added: pkg/PortfolioAnalytics/demo/multi_layer_optimization.R =================================================================== --- pkg/PortfolioAnalytics/demo/multi_layer_optimization.R (rev 0) +++ pkg/PortfolioAnalytics/demo/multi_layer_optimization.R 2014-06-18 17:26:42 UTC (rev 3425) @@ -0,0 +1,79 @@ + +# Demonstrate multi layer portfolio optimization +# The top level (i.e. layer) optimization problem is to minimize modified ES +# with equal component contribution to modified ES of the two portfolios in +# the lower layer. +# The sub portfolios consist of different assets and different objectives +# relative to each other. The out of sample returns for each sub portfolio +# are calculated based on their respective constraints, objectives, and +# optimization parameters. The out of sample returns are then used as the +# returns input for the top level optimization. + +library(PortfolioAnalytics) + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# The first sub-portfolio, portf1, will contain assets 1:5 of edhec +# with an objective to minimize standard deviation. +portf1 <- portfolio.spec(assets=funds[1:5]) +portf1 <- add.constraint(portfolio=portf1, type="weight_sum", + min_sum=0.99, max_sum=1.01) +portf1 <- add.constraint(portfolio=portf1, type="long_only") +portf1 <- add.objective(portfolio=portf1, type="risk", name="StdDev") + +# The second sub-portfolio, portf2, will contain assets 6:10 of edhec +# with an objective to minimize expected shortfall. +portf2 <- portfolio.spec(assets=funds[6:10]) +# portf2 <- portfolio.spec(assets=5) +portf2 <- add.constraint(portfolio=portf2, type="weight_sum", + min_sum=0.99, max_sum=1.01) +portf2 <- add.constraint(portfolio=portf2, type="long_only") +portf2 <- add.objective(portfolio=portf2, type="risk", name="ES", + arguments=list(p=0.9)) + +# portf1 and portf2 have the same constraints so they can used the same +# set of random portfolios +set.seed(123) +rp <- random_portfolios(portf2, 2000) + + +# The 'top level' portfolio has objectives for equal contribution to risk +# where modified ES is the risk measure +portf <- portfolio.spec(assets=paste("proxy",1:2, sep=".")) +portf <- add.constraint(portfolio=portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +portf <- add.constraint(portfolio=portf, type="long_only") +portf <- add.objective(portfolio=portf, type="risk", name="ES", + arguments=list(p=0.9)) +portf <- add.objective(portfolio=portf, type="risk_budget", name="ES", + arguments=list(p=0.9), min_concentration=TRUE) + +# Specify a mult-layer portfolio +mult.portf <- mult.portfolio.spec(portf) + +# Add portf1 as a sub portfolio with optimization parameters specific to +# running optimize.portfolio.rebalancing with portf1 +mult.portf <- add.sub.portfolio(mult.portf, portf1, rp=rp, + optimize_method="random", + rebalance_on="quarters", + training_period=136) + +# Add portf2 as a sub portfolio with optimization parameters specific to +# running optimize.portfolio.rebalancing with portf2 +mult.portf <- add.sub.portfolio(mult.portf, portf2, rp=rp, + optimize_method="random", + rebalance_on="months", + training_period=136, + trailing_periods=48) + +# Generate random portfolios for the top layer optimization +set.seed(123) +rp.top <- random_portfolios(portf, 1000) + +# Run the multi layer optimization +opt.mult <- optimize.portfolio(R, mult.portf, + optimize_method="random", + trace=TRUE, rp=rp.top) + Added: pkg/PortfolioAnalytics/sandbox/mult_layer_script.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/mult_layer_script.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/mult_layer_script.R 2014-06-18 17:26:42 UTC (rev 3425) @@ -0,0 +1,96 @@ + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# The first sub-portfolio, portf1, will contain assets 1:5 of edhec +# with an objective to minimize standard deviation. +portf1 <- portfolio.spec(assets=funds[1:5]) +portf1 <- add.constraint(portfolio=portf1, type="weight_sum", + min_sum=0.99, max_sum=1.01) +portf1 <- add.constraint(portfolio=portf1, type="long_only") +portf1 <- add.objective(portfolio=portf1, type="risk", name="StdDev") + +# The second sub-portfolio, portf2, will contain assets 6:10 of edhec +# with an objective to minimize expected shortfall. +portf2 <- portfolio.spec(assets=funds[6:10]) +# portf2 <- portfolio.spec(assets=5) +portf2 <- add.constraint(portfolio=portf2, type="weight_sum", + min_sum=0.99, max_sum=1.01) +portf2 <- add.constraint(portfolio=portf2, type="long_only") +portf2 <- add.objective(portfolio=portf2, type="risk", name="ES", + arguments=list(p=0.9)) + +# portf1 and portf2 have the same constraints so they can used the same +# set of random portfolios +set.seed(123) +rp <- random_portfolios(portf2, 2000) + + +# The 'top level' portfolio has objectives for equal contribution to risk +# where modified ES is the risk measure +portf <- portfolio.spec(assets=paste("proxy",1:2, sep=".")) +portf <- add.constraint(portfolio=portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +portf <- add.constraint(portfolio=portf, type="long_only") +portf <- add.objective(portfolio=portf, type="risk", name="ES", + arguments=list(p=0.9)) +portf <- add.objective(portfolio=portf, type="risk_budget", name="ES", + arguments=list(p=0.9), min_concentration=TRUE) + +# Specify a mult-layer portfolio +mult.portf <- mult.portfolio.spec(portf) + +# Add portf1 as a sub portfolio with optimization parameters specific to +# running optimize.portfolio.rebalancing with portf1 +mult.portf <- add.sub.portfolio(mult.portf, portf1, rp=rp, + optimize_method="random", + rebalance_on="quarters", + training_period=136) + +# Add portf2 as a sub portfolio with optimization parameters specific to +# running optimize.portfolio.rebalancing with portf2 +mult.portf <- add.sub.portfolio(mult.portf, portf2, rp=rp, + optimize_method="random", + rebalance_on="months", + training_period=136, + trailing_periods=48) + +# Compute the out of sample backtesting returns for each sub portfolio +proxy.ret <- PortfolioAnalytics:::proxy.mult.portfolio(R, mult.portf) + +# Verify that proxy.mult.portfolio is computing returns correctly +opt1 <- optimize.portfolio.rebalancing(R[,1:5], + portf1, + optimize_method="random", + rp=rp, + rebalance_on="quarters", + training_period=136) +ret1 <- summary(opt1)$portfolio_returns + +opt2 <- optimize.portfolio.rebalancing(R[,6:10], + portf2, + optimize_method="random", + rp=rp, + rebalance_on="months", + training_period=136, + trailing_periods=48) +ret2 <- summary(opt2)$portfolio_returns +ret <- na.omit(cbind(ret1, ret2)) + +all.equal(ret, proxy.ret, check.attributes=FALSE) + +# Verify that multi layer optimization is done correctly in optimize.portfolio +set.seed(123) +rp.top <- random_portfolios(portf, 1000) + +opt <- optimize.portfolio(proxy.ret, portf, + optimize_method="random", + trace=TRUE, rp=rp.top) + +opt.mult <- optimize.portfolio(R, mult.portf, + optimize_method="random", + trace=TRUE, rp=rp.top) + +all.equal(extractObjectiveMeasures(opt), extractObjectiveMeasures(opt.mult)) +all.equal(extractWeights(opt), extractWeights(opt.mult)) Deleted: pkg/PortfolioAnalytics/sandbox/multi_layer_script.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/multi_layer_script.R 2014-06-17 20:13:06 UTC (rev 3424) +++ pkg/PortfolioAnalytics/sandbox/multi_layer_script.R 2014-06-18 17:26:42 UTC (rev 3425) @@ -1,91 +0,0 @@ -library(PortfolioAnalytics) - -# Script for multilayer optimization - -# We need to support the different arguments/parameters for -# optimize.portfolio.rebalancing for each sub-portfolio -# * R -# * optimize_method -# * search_size -# * trace -# * ... -# * rp -# * rebalance_on -# * training_period -# * trailings_period - -# The returns need to have the same periodicity - -# Each sub-portfolio may have a different rebalancing frequency, training, and -# trailing parameters, as well as optimization method - -data(edhec) -R <- edhec[, 1:10] -funds <- colnames(R) - -# The first sub-portfolio, portf1, will contain assets 1:5 of the edhec -# with an objective to minimize standard deviation. -portf1 <- portfolio.spec(assets=funds[1:5]) -portf1 <- add.constraint(portfolio=portf1, type="full_investment") -portf1 <- add.constraint(portfolio=portf1, type="long_only") -portf1 <- add.objective(portfolio=portf1, type="risk", name="StdDev") - -# The second sub-portfolio, portf2, will contain assets 6:10 of the edhec -# with an objective to minimize expected shortfall. -portf2 <- portfolio.spec(assets=funds[6:10]) -portf2 <- add.constraint(portfolio=portf2, type="full_investment") -portf2 <- add.constraint(portfolio=portf2, type="long_only") -portf2 <- add.objective(portfolio=portf2, type="risk", name="ES", - arguments=list(p=0.9)) - -# Run optimize.portfolio.rebalancing for each sub-portfolio to get proxy -# returns -proxy1 <- optimize.portfolio.rebalancing(R[,1:5], - portf1, - optimize_method="ROI", - rebalance_on="quarters", - training_period=60) -proxy1 -proxy1.ret <- summary(proxy1)$portfolio_returns - -proxy2 <- optimize.portfolio.rebalancing(R[,6:10], - portf2, - optimize_method="ROI", - rebalance_on="quarters", - training_period=48) -proxy2 -proxy2.ret <- summary(proxy2)$portfolio_returns - -# A different training period was used so the returns do not exactly align -ret <- cbind(proxy1.ret, proxy2.ret) -head(ret, 14) - -# Get rid of the NAs -ret <- na.omit(ret) -colnames(ret) <- c("proxy1", "proxy2") -head(ret) - -# Construct portfolio for the top level optimization of the proxy portfolios -portf <- portfolio.spec(assets=colnames(ret)) -portf <- add.constraint(portfolio=portf, type="weight_sum", min_sum=0.99, max_sum=1.01) -portf <- add.constraint(portfolio=portf, type="long_only") -portf <- add.objective(portfolio=portf, type="risk", name="ES", - arguments=list(p=0.9)) -portf <- add.objective(portfolio=portf, type="risk_budget", name="ES", - arguments=list(p=0.9), min_concentration=TRUE) - -opt <- optimize.portfolio(ret, portf, - optimize_method="random", - search_size=4000, - trace=TRUE) -opt - -opt.bt <- optimize.portfolio.rebalancing(ret, portf, - optimize_method="random", - search_size=4000, - trace=TRUE, - rebalance_on="months", - training_period=48) -opt.bt -opt.ret <- summary(opt.bt)$portfolio_returns -charts.PerformanceSummary(cbind(opt.ret, ret)) From noreply at r-forge.r-project.org Thu Jun 19 01:59:02 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 19 Jun 2014 01:59:02 +0200 (CEST) Subject: [Returnanalytics-commits] r3426 - pkg/PerformanceAnalytics/R Message-ID: <20140618235902.53AAE186D73@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-19 01:59:01 +0200 (Thu, 19 Jun 2014) New Revision: 3426 Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R Log: Modifying Return.rebalancing to support wealth index and contribution args as well as adding separate functions for arithmetic and geometric returns Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-18 17:26:42 UTC (rev 3425) +++ pkg/PerformanceAnalytics/R/Return.portfolio.R 2014-06-18 23:59:01 UTC (rev 3426) @@ -78,8 +78,7 @@ #' #' To calculate BOP and EOP position value, we create an index for each position. The #' sum of that value across assets represents an indexed value of the total portfolio. -#' The change in value contained in slot seven is the asset's period return times its -#' BOP value. +#' Note that BOP and EOP position values are only computed when \code{geometric = TRUE}. #' #' From the value calculations, we can calculate different aggregations through time #' for the asset contributions. Those are calculated as the EOP asset value less the @@ -91,7 +90,13 @@ #' @param R An xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns #' @param weights A time series or single-row matrix/vector containing asset -#' weights, as decimal percentages, treated as beginning of period weights. See Details below. +#' weights, as decimal percentages, treated as beginning of period weights. +#' See Details below. +#' @param wealth.index TRUE/FALSE whether to return a wealth index. Default FALSE +#' @param contribution if contribution is TRUE, add the weighted return +#' contributed by the asset in a given period. Default FALSE +#' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic (FALSE) +#' to aggregate returns. Default TRUE. #' @param rebalance_on Default "none"; alternatively "daily" "weekly" "monthly" "annual" to specify calendar-period rebalancing supported by \code{endpoints}. #' @param value The beginning of period total portfolio value. This is used for calculating position value. #' @param verbose If verbose is TRUE, return a list of intermediary calculations. @@ -121,11 +126,14 @@ #' @export Return.portfolio #' @export Return.rebalancing Return.portfolio <- Return.rebalancing <- function(R, - weights=NULL, - rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), - value=1, - verbose=FALSE, - ...){ + weights=NULL, + wealth.index=FALSE, + contribution=FALSE, + geometric=TRUE, + rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), + value=1, + verbose=FALSE, + ...){ R = checkData(R, method="xts") rebalance_on = rebalance_on[1] @@ -186,16 +194,124 @@ R <- R[paste0(as.Date(index(weights[1,]))+1, "/")] } + + if(geometric){ + out = Return.portfolio.geometric(R=R, + weights=weights, + wealth.index=wealth.index, + contribution=contribution, + rebalance_on=rebalance_on, + value=value, + verbose=verbose, + ...=...) + } else { + out = Return.portfolio.arithmetic(R=R, + weights=weights, + wealth.index=wealth.index, + contribution=contribution, + rebalance_on=rebalance_on, + verbose=verbose, + ...=...) + } + return(out) +} + +Return.portfolio.arithmetic <- function(R, + weights=NULL, + wealth.index=FALSE, + contribution=FALSE, + rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), + verbose=FALSE, + ...) +{ # bop = beginning of period # eop = end of period # Initialize objects + bop_weights = matrix(0, NROW(R), NCOL(R)) + colnames(bop_weights) = colnames(R) + eop_weights = period_contrib = bop_weights + ret = vector("numeric", NROW(R)) + + # initialize counter + k = 1 + for(i in 1:NROW(weights)) { + # identify rebalance from and to dates (weights[i,], weights[i+1]) and + # subset the R(eturns) object + from = as.Date(index(weights[i,]))+1 + if (i == nrow(weights)){ + to = as.Date(index(last(R))) # this is correct + } else { + to = as.Date(index(weights[(i+1),])) + } + returns = R[paste0(from, "::", to)] + + # Only enter the loop if we have a valid returns object + if(nrow(returns) >= 1){ + # inner loop counter + jj = 1 + for(j in 1:nrow(returns)){ + # For arithmetic returns, the beginning of period weights are always + # equal to the rebalance weights + bop_weights[k,] = weights[i,] + period_contrib[k,] = coredata(returns[j,]) * bop_weights[k,] + eop_weights[k,] = (period_contrib[k,] + bop_weights[k,]) / sum(c(period_contrib[k,], bop_weights[k,])) + ret[k] = sum(period_contrib[k,]) + + # increment the counters + k = k + 1 + } + } + } + R.idx = index(R) + ret = xts(ret, R.idx) + colnames(ret) = "portfolio.returns" + + if(wealth.index){ + result = cumsum(ret) + 1 + colnames(result) = "portfolio.wealthindex" + } else { + result = ret + } + + if(verbose){ + out = list() + out$returns = ret + out$contribution = xts(period_contrib, R.idx) + out$BOP.Weight = xts(bop_weights, R.idx) + out$EOP.Weight = xts(eop_weights, R.idx) + if(wealth.index){ + out$wealthindex = result + } + } else if(contribution){ + out = cbind(result, xts(period_contrib, R.idx)) + } else { + out = result + } + return(out) +} + +Return.portfolio.geometric <- function(R, + weights=NULL, + wealth.index=FALSE, + contribution=FALSE, + rebalance_on=c(NA, 'years', 'quarters', 'months', 'weeks', 'days'), + value=1, + verbose=FALSE, + ...) +{ + # bop = beginning of period + # eop = end of period + # Initialize objects bop_value = matrix(0, NROW(R), NCOL(R)) colnames(bop_value) = colnames(R) eop_value = bop_value - if(verbose){ - bop_weights = bop_value - eop_weights = bop_value + + if(verbose | contribution){ period_contrib = bop_value + if(verbose){ + bop_weights = bop_value + eop_weights = bop_value + } } ret = eop_value_total = bop_value_total = vector("numeric", NROW(R)) @@ -235,12 +351,14 @@ eop_value[k,] = (1 + coredata(returns[j,])) * bop_value[k,] eop_value_total[k] = sum(eop_value[k,]) - if(verbose){ - # Compute bop and eop weights - bop_weights[k,] = bop_value[k,] / bop_value_total[k] - eop_weights[k,] = eop_value[k,] / eop_value_total[k] + if(contribution | verbose){ # Compute period contribution period_contrib[k,] = returns[j,] * bop_value[k,] / sum(bop_value[k,]) + if(verbose){ + # Compute bop and eop weights + bop_weights[k,] = bop_value[k,] / bop_value_total[k] + eop_weights[k,] = eop_value[k,] / eop_value_total[k] + } } # Compute portfolio returns @@ -261,6 +379,13 @@ ret = xts(ret, R.idx) colnames(ret) = "portfolio.returns" + if(wealth.index){ + result = cumprod(1 + ret) + colnames(result) = "portfolio.wealthindex" + } else { + result = ret + } + if(verbose){ out = list() out$returns = ret @@ -269,8 +394,13 @@ out$EOP.Weight = xts(eop_weights, R.idx) out$BOP.Value = xts(bop_value, R.idx) out$EOP.Value = xts(eop_value, R.idx) + if(wealth.index){ + out$wealthindex = result + } + } else if(contribution){ + out = cbind(result, xts(period_contrib, R.idx)) } else { - out = ret + out = result } return(out) } From noreply at r-forge.r-project.org Thu Jun 19 23:35:30 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 19 Jun 2014 23:35:30 +0200 (CEST) Subject: [Returnanalytics-commits] r3427 - pkg/PortfolioAnalytics/sandbox Message-ID: <20140619213530.44D54187090@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-19 23:35:29 +0200 (Thu, 19 Jun 2014) New Revision: 3427 Added: pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R Log: Adding black litterman formula from Meucci Copied: pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R (from rev 3420, pkg/Meucci/R/BlackLittermanFormula.R) =================================================================== --- pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R 2014-06-19 21:35:29 UTC (rev 3427) @@ -0,0 +1,30 @@ +#' @title Computes the Black-Litterman formula for the moments of the posterior normal. +#' +#' @description This function computes the Black-Litterman formula for the moments of the posterior normal, as described in +#' A. Meucci, "Risk and Asset Allocation", Springer, 2005. +#' +#' @param Mu [vector] (N x 1) prior expected values. +#' @param Sigma [matrix] (N x N) prior covariance matrix. +#' @param P [matrix] (K x N) pick matrix. +#' @param v [vector] (K x 1) vector of views. +#' @param Omega [matrix] (K x K) matrix of confidence. +#' +#' @return BLMu [vector] (N x 1) posterior expected values. +#' @return BLSigma [matrix] (N x N) posterior covariance matrix. +#' +#' @references +#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. +#' +#' See Meucci's script for "BlackLittermanFormula.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +BlackLittermanFormula = function( Mu, Sigma, P, v, Omega) +{ + BLMu = Mu + Sigma %*% t( P ) %*% ( solve( P %*% Sigma %*% t( P ) + Omega ) %*% ( v - P %*% Mu ) ); + BLSigma = Sigma - Sigma %*% t( P ) %*% ( solve( P %*% Sigma %*% t( P ) + Omega ) %*% ( P %*% Sigma ) ); + + return( list( BLMu = BLMu , BLSigma = BLSigma ) ); + +} \ No newline at end of file From noreply at r-forge.r-project.org Fri Jun 20 00:32:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 20 Jun 2014 00:32:14 +0200 (CEST) Subject: [Returnanalytics-commits] r3428 - in pkg/PortfolioAnalytics: . R man sandbox Message-ID: <20140619223214.1CDC51874AE@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-20 00:32:13 +0200 (Fri, 20 Jun 2014) New Revision: 3428 Added: pkg/PortfolioAnalytics/R/black_litterman.R pkg/PortfolioAnalytics/man/BlackLittermanFormula.Rd pkg/PortfolioAnalytics/man/black.litterman.Rd Removed: pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R Modified: pkg/PortfolioAnalytics/NAMESPACE Log: functionalizing the Black Litterman script from Meucci package and moving to R. Also adding man files for black litterman functions Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-06-19 21:35:29 UTC (rev 3427) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-19 22:32:13 UTC (rev 3428) @@ -76,6 +76,7 @@ export(add.objective_v2) export(add.sub.portfolio) export(applyFUN) +export(black.litterman) export(box_constraint) export(center) export(chart.Concentration) Copied: pkg/PortfolioAnalytics/R/black_litterman.R (from rev 3427, pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R) =================================================================== --- pkg/PortfolioAnalytics/R/black_litterman.R (rev 0) +++ pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-19 22:32:13 UTC (rev 3428) @@ -0,0 +1,75 @@ + +#' @title Computes the Black-Litterman formula for the moments of the posterior normal. +#' +#' @description This function computes the Black-Litterman formula for the moments of the posterior normal, as described in +#' A. Meucci, "Risk and Asset Allocation", Springer, 2005. +#' +#' @param Mu [vector] (N x 1) prior expected values. +#' @param Sigma [matrix] (N x N) prior covariance matrix. +#' @param P [matrix] (K x N) pick matrix. +#' @param v [vector] (K x 1) vector of views. +#' @param Omega [matrix] (K x K) matrix of confidence. +#' +#' @return BLMu [vector] (N x 1) posterior expected values. +#' @return BLSigma [matrix] (N x N) posterior covariance matrix. +#' +#' @references +#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. +#' +#' See Meucci's script for "BlackLittermanFormula.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +BlackLittermanFormula = function( Mu, Sigma, P, v, Omega) +{ + BLMu = Mu + Sigma %*% t( P ) %*% ( solve( P %*% Sigma %*% t( P ) + Omega ) %*% ( v - P %*% Mu ) ); + BLSigma = Sigma - Sigma %*% t( P ) %*% ( solve( P %*% Sigma %*% t( P ) + Omega ) %*% ( P %*% Sigma ) ); + + return( list( BLMu = BLMu , BLSigma = BLSigma ) ); + +} + +#' Black Litterman Estimates +#' +#' Compute the Black Litterman estimate of moments for the posterior normal. +#' +#' @note This function is largely based on the work of Xavier Valls to port +#' the matlab code of Attilio Meucci to \R as documented in the Meucci package. +#' +#' @param R returns +#' @param P a K x N pick matrix +#' @param Mu vector of length N of the prior expected values. The sample mean +#' is used if \code{mu} is not provided as an argument. +#' @param Sigma an N x N matrix of the prior covariance matrix. The sample covariance +#' is used if \code{Sigma} is not provided as an argument. +#' @return \itemize{ +#' \item{BLMu:}{ posterior expected values} +#' \item{BLSigma:}{ posterior covariance matrix} +#' } +#' @author Ross Bennett, Xavier Valls +#' @references +#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. +#' @seealso \code{\link{BlackLittermanFormula}} +#' @export +black.litterman <- function(R, P, Mu, Sigma){ + + # Compute the sample estimate if mu is null + if(hasArg(Mu)){ + if(length(Mu) != NCOL(R)) stop("length of Mu must equal number of columns of R") + } else { + Mu <- colMeans(R) + } + + # Compute the sample estimate if sigma is null + if(hasArg(Sigma)){ + if(!all(dim(Sigma) == NCOL(R))) stop("dimensions of Sigma must equal number of columns of R") + } else { + Sigma <- cov(R) + } + + # Compute the Omega matrix and views value + Omega = tcrossprod(P %*% Sigma, P) + Views = as.numeric(sqrt( diag( Omega ) )) + B = BlackLittermanFormula( Mu, Sigma, P, Views, Omega ) + return(B) +} + Added: pkg/PortfolioAnalytics/man/BlackLittermanFormula.Rd =================================================================== --- pkg/PortfolioAnalytics/man/BlackLittermanFormula.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/BlackLittermanFormula.Rd 2014-06-19 22:32:13 UTC (rev 3428) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{BlackLittermanFormula} +\alias{BlackLittermanFormula} +\title{Computes the Black-Litterman formula for the moments of the posterior normal.} +\usage{ +BlackLittermanFormula(Mu, Sigma, P, v, Omega) +} +\arguments{ +\item{Mu}{[vector] (N x 1) prior expected values.} + +\item{Sigma}{[matrix] (N x N) prior covariance matrix.} + +\item{P}{[matrix] (K x N) pick matrix.} + +\item{v}{[vector] (K x 1) vector of views.} + +\item{Omega}{[matrix] (K x K) matrix of confidence.} +} +\value{ +BLMu [vector] (N x 1) posterior expected values. + +BLSigma [matrix] (N x N) posterior covariance matrix. +} +\description{ +This function computes the Black-Litterman formula for the moments of the posterior normal, as described in +A. Meucci, "Risk and Asset Allocation", Springer, 2005. +} +\author{ +Xavier Valls \email{flamejat at gmail.com} +} +\references{ +A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. + +See Meucci's script for "BlackLittermanFormula.m" +} + Added: pkg/PortfolioAnalytics/man/black.litterman.Rd =================================================================== --- pkg/PortfolioAnalytics/man/black.litterman.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-19 22:32:13 UTC (rev 3428) @@ -0,0 +1,41 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{black.litterman} +\alias{black.litterman} +\title{Black Litterman Estimates} +\usage{ +black.litterman(R, P, Mu, Sigma) +} +\arguments{ +\item{R}{returns} + +\item{P}{a K x N pick matrix} + +\item{Mu}{vector of length N of the prior expected values. The sample mean +is used if \code{mu} is not provided as an argument.} + +\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample covariance +is used if \code{Sigma} is not provided as an argument.} +} +\value{ +\itemize{ + \item{BLMu:}{ posterior expected values} + \item{BLSigma:}{ posterior covariance matrix} +} +} +\description{ +Compute the Black Litterman estimate of moments for the posterior normal. +} +\note{ +This function is largely based on the work of Xavier Valls to port +the matlab code of Attilio Meucci to \R as documented in the Meucci package. +} +\author{ +Ross Bennett, Xavier Valls +} +\references{ +A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. +} +\seealso{ +\code{\link{BlackLittermanFormula}} +} + Deleted: pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R 2014-06-19 21:35:29 UTC (rev 3427) +++ pkg/PortfolioAnalytics/sandbox/BlackLittermanFormula.R 2014-06-19 22:32:13 UTC (rev 3428) @@ -1,30 +0,0 @@ -#' @title Computes the Black-Litterman formula for the moments of the posterior normal. -#' -#' @description This function computes the Black-Litterman formula for the moments of the posterior normal, as described in -#' A. Meucci, "Risk and Asset Allocation", Springer, 2005. -#' -#' @param Mu [vector] (N x 1) prior expected values. -#' @param Sigma [matrix] (N x N) prior covariance matrix. -#' @param P [matrix] (K x N) pick matrix. -#' @param v [vector] (K x 1) vector of views. -#' @param Omega [matrix] (K x K) matrix of confidence. -#' -#' @return BLMu [vector] (N x 1) posterior expected values. -#' @return BLSigma [matrix] (N x N) posterior covariance matrix. -#' -#' @references -#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. -#' -#' See Meucci's script for "BlackLittermanFormula.m" -#' -#' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export - -BlackLittermanFormula = function( Mu, Sigma, P, v, Omega) -{ - BLMu = Mu + Sigma %*% t( P ) %*% ( solve( P %*% Sigma %*% t( P ) + Omega ) %*% ( v - P %*% Mu ) ); - BLSigma = Sigma - Sigma %*% t( P ) %*% ( solve( P %*% Sigma %*% t( P ) + Omega ) %*% ( P %*% Sigma ) ); - - return( list( BLMu = BLMu , BLSigma = BLSigma ) ); - -} \ No newline at end of file From noreply at r-forge.r-project.org Fri Jun 20 01:04:30 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 20 Jun 2014 01:04:30 +0200 (CEST) Subject: [Returnanalytics-commits] r3429 - pkg/PortfolioAnalytics/R Message-ID: <20140619230430.3F8A51874FD@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-20 01:04:29 +0200 (Fri, 20 Jun 2014) New Revision: 3429 Modified: pkg/PortfolioAnalytics/R/black_litterman.R pkg/PortfolioAnalytics/R/moment.functions.R Log: Adding function to set portfolio moments using black litterman model. Modified: pkg/PortfolioAnalytics/R/black_litterman.R =================================================================== --- pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-19 22:32:13 UTC (rev 3428) +++ pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-19 23:04:29 UTC (rev 3429) @@ -38,9 +38,9 @@ #' @param R returns #' @param P a K x N pick matrix #' @param Mu vector of length N of the prior expected values. The sample mean -#' is used if \code{mu} is not provided as an argument. -#' @param Sigma an N x N matrix of the prior covariance matrix. The sample covariance -#' is used if \code{Sigma} is not provided as an argument. +#' is used if \code{Mu=NULL}. +#' @param Sigma an N x N matrix of the prior covariance matrix. The sample +#' covariance is used if \code{Sigma=NULL}. #' @return \itemize{ #' \item{BLMu:}{ posterior expected values} #' \item{BLSigma:}{ posterior covariance matrix} @@ -50,21 +50,19 @@ #' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. #' @seealso \code{\link{BlackLittermanFormula}} #' @export -black.litterman <- function(R, P, Mu, Sigma){ +black.litterman <- function(R, P, Mu=NULL, Sigma=NULL){ # Compute the sample estimate if mu is null - if(hasArg(Mu)){ - if(length(Mu) != NCOL(R)) stop("length of Mu must equal number of columns of R") - } else { - Mu <- colMeans(R) + if(is.null(Mu)){ + Mu <- colMeans(R) } + if(length(Mu) != NCOL(R)) stop("length of Mu must equal number of columns of R") # Compute the sample estimate if sigma is null - if(hasArg(Sigma)){ - if(!all(dim(Sigma) == NCOL(R))) stop("dimensions of Sigma must equal number of columns of R") - } else { + if(is.null(Sigma)){ Sigma <- cov(R) } + if(!all(dim(Sigma) == NCOL(R))) stop("dimensions of Sigma must equal number of columns of R") # Compute the Omega matrix and views value Omega = tcrossprod(P %*% Sigma, P) Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-19 22:32:13 UTC (rev 3428) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-19 23:04:29 UTC (rev 3429) @@ -332,6 +332,94 @@ return(momentargs) } +#' Portfolio Moments +#' +#' Set portfolio moments for use by lower level optimization functions using +#' a basic Black Litterman model. +#' +#' @note If any of the objectives in the \code{portfolio} object have +#' \code{clean} as an argument, the cleaned returns are used to fit the model. +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param portfolio an object of type \code{portfolio} specifying the +#' constraints and objectives for the optimization, see +#' \code{\link{portfolio.spec}} +#' @param momentargs list containing arguments to be passed down to lower level +#' functions, default NULL +#' @param P a K x N pick matrix representing views +#' @param Mu vector of length N of the prior expected values. The sample mean +#' is used if \code{Mu=NULL}. +#' @param Sigma an N x N matrix of the prior covariance matrix. The sample +#' covariance is used if \code{Sigma=NULL}. +#' @param \dots any other passthru parameters +#' @export +portfolio.moments.bl <- function(R, portfolio, momentargs=NULL, P, Mu=NULL, Sigma=NULL, ...){ + + + # If any of the objectives have clean as an argument, we fit the factor + # model with cleaned returns. Is this the desired behavior we want? + clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean)) + if(!is.null(clean)){ + if(length(unique(clean)) > 1){ + warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1])) + } + # This sets R as the cleaned returns for the rest of the function + # This is proably fine since the only other place R is used is for the + # mu estimate + R <- Return.clean(R, method=clean[1]) + } + + # Compute the Black Litterman estimates + B <- black.litterman(R=R, P=P, Mu=Mu, Sigma=Sigma) + + if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list() + if(is.null(portfolio$objectives)) { + warning("no objectives specified in portfolio") + next() + } else { + for (objective in portfolio$objectives){ + switch(objective$name, + mean = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + }, + var =, + sd =, + StdDev = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + }, + mVaR =, + VaR = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) + }, + es =, + mES =, + CVaR =, + cVaR =, + ETL=, + mETL=, + ES = { + # We don't want to calculate these moments if we have an ES + # objective and are solving as an LP problem. + if(hasArg(ROI)) ROI=match.call(expand.dots=TRUE)$ROI else ROI=FALSE + if(!ROI){ + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) + } + } + ) # end switch on objectives + } + } + return(momentargs) +} + + ############################################################################### # $Id$ ############################################################################### From noreply at r-forge.r-project.org Fri Jun 20 02:08:49 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 20 Jun 2014 02:08:49 +0200 (CEST) Subject: [Returnanalytics-commits] r3430 - / pkg/FactorAnalytics pkg/FactorAnalytics/R pkg/FactorAnalytics/man Message-ID: <20140620000849.65FCA187522@r-forge.r-project.org> Author: pragnya Date: 2014-06-20 02:08:48 +0200 (Fri, 20 Jun 2014) New Revision: 3430 Modified: / pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r pkg/FactorAnalytics/man/CornishFisher.Rd pkg/FactorAnalytics/man/factorModelCovariance.Rd pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd pkg/FactorAnalytics/man/factorModelPerformanceAttribution.Rd pkg/FactorAnalytics/man/factorModelSdDecomposition.Rd pkg/FactorAnalytics/man/factorModelVaRDecomposition.Rd pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd pkg/FactorAnalytics/man/plot.FM.attribution.Rd pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/plot.StatFactorModel.Rd pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/predict.StatFactorModel.Rd pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/print.FM.attribution.Rd pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/print.StatFactorModel.Rd pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/summary.FM.attribution.Rd pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/summary.StatFactorModel.Rd pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd Log: Rd files updated by Roxygen2. Added ... to plot.TimeSeriesFactorModel and predict.FundamentalFactorModel. Removed dependencies robustbase, MASS, zoo, xts and added doParallel. Property changes on: ___________________________________________________________________ Added: svn:ignore + .Rproj.user .Rhistory .RData Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2014-06-19 23:04:29 UTC (rev 3429) +++ pkg/FactorAnalytics/DESCRIPTION 2014-06-20 00:08:48 UTC (rev 3430) @@ -1,30 +1,12 @@ -Package: factorAnalytics -Type: Package -Title: factor analysis -Version: 1.0 -Date: 2014-06-12 -Author: Eric Zivot and Yi-An Chen -Maintainer: Yi-An Chen -Description: An R package for estimation and risk analysis of linear factor - models for asset returns and portfolios. It contains three major fitting - method for the factor models: fitting macroeconomic factor model, fitting - fundamental factor model and fitting statistical factor model and some risk - analysis tools like VaR, ES to use the result of the fitting method. It - also provides the different type of distribution to fit the fat-tail - behavior of the financial returns, including edgeworth expansion type - distribution. -License: GPL-2 -Depends: - robust, - robustbase, - leaps, - lars, - MASS, - PerformanceAnalytics, - sn, - tseries, - strucchange,xts,ellipse, - zoo -Suggests: - testthat -LazyLoad: yes +Package: factorAnalytics +Type: Package +Title: Factor Analytics +Version: 1.0 +Date: 2014-06-18 +Author: Eric Zivot and Yi-An Chen +Maintainer: Yi-An Chen +Description: An R package for the estimation and risk analysis of linear factor models for asset returns and portfolios. It contains model fitting methods for the three major types of factor models: time series (or, macroeconomic) factor model, fundamental factor model and statistical factor model. They allow for different types of distributions to be specified for modeling the fat-tailed behavior of financial returns, including Edgeworth expansions. Risk analysis measures such as VaR and ES are also provided for the results of the fitted models. +License: GPL-2 +Depends: R (? 2.15.1), robust, leaps, lars, PerformanceAnalytics, sn, tseries, strucchange, ellipse, doParallel +Suggests: testthat +LazyLoad: yes Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-19 23:04:29 UTC (rev 3429) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-20 00:08:48 UTC (rev 3430) @@ -1,28 +1,30 @@ -S3method(print,FM.attribution) -S3method(plot,FM.attribution) -S3method(summary,FM.attribution) -export(factorModelPerformanceAttribution) -export(dCornishFisher) -export(factorModelCovariance) -export(factorModelEsDecomposition) -export(factorModelMonteCarlo) -export(factorModelSdDecomposition) -export(factorModelVaRDecomposition) -export(fitFundamentalFactorModel) -export(fitStatisticalFactorModel) -export(fitTimeSeriesFactorModel) -export(pCornishFisher) -export(qCornishFisher) -export(rCornishFisher) -S3method(plot,FundamentalFactorModel) -S3method(plot,StatFactorModel) -S3method(plot,TimeSeriesFactorModel) -S3method(predict,FundamentalFactorModel) -S3method(predict,StatFactorModel) -S3method(predict,TimeSeriesFactorModel) -S3method(print,FundamentalFactorModel) -S3method(print,StatFactorModel) -S3method(print,TimeSeriesFactorModel) -S3method(summary,FundamentalFactorModel) -S3method(summary,StatFactorModel) -S3method(summary,TimeSeriesFactorModel) +# Generated by roxygen2 (4.0.1): do not edit by hand + +S3method(plot,FM.attribution) +S3method(plot,FundamentalFactorModel) +S3method(plot,StatFactorModel) +S3method(plot,TimeSeriesFactorModel) +S3method(predict,FundamentalFactorModel) +S3method(predict,StatFactorModel) +S3method(predict,TimeSeriesFactorModel) +S3method(print,FM.attribution) +S3method(print,FundamentalFactorModel) +S3method(print,StatFactorModel) +S3method(print,TimeSeriesFactorModel) +S3method(summary,FM.attribution) +S3method(summary,FundamentalFactorModel) +S3method(summary,StatFactorModel) +S3method(summary,TimeSeriesFactorModel) +export(dCornishFisher) +export(factorModelCovariance) +export(factorModelEsDecomposition) +export(factorModelMonteCarlo) +export(factorModelPerformanceAttribution) +export(factorModelSdDecomposition) +export(factorModelVaRDecomposition) +export(fitFundamentalFactorModel) +export(fitStatisticalFactorModel) +export(fitTimeSeriesFactorModel) +export(pCornishFisher) +export(qCornishFisher) +export(rCornishFisher) Modified: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2014-06-19 23:04:29 UTC (rev 3429) +++ pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2014-06-20 00:08:48 UTC (rev 3430) @@ -1,489 +1,490 @@ -#' plot TimeSeriesFactorModel object. -#' -#' Generic function of plot method for fitTimeSeriesFactorModel. Either plot -#' all assets or choose a single asset to plot. -#' -#' -#' @param x fit object created by \code{fitTimeSeriesFactorModel}. -#' @param colorset Defualt colorset the same as \code{barplot}. -#' @param legend.loc Plot legend or not. Defualt is \code{NULL}. -#' @param which.plot Integer indicates which plot to create: "none" will -#' create a menu to choose. Defualt is none.\cr -#' 1 = "Fitted factor returns", \cr -#' 2 = "R square", \cr -#' 3 = "Variance of Residuals",\cr -#' 4 = "FM Correlation",\cr -#' 5 = "Factor Contributions to SD",\cr -#' 6 = "Factor Contributions to ES",\cr -#' 7 = "Factor Contributions to VaR" -#' @param max.show Maximum assets to plot. Default is 6. -#' @param plot.single Plot a single asset of lm class. Defualt is \code{FALSE}. -#' @param asset.name Name of the asset to be plotted. -#' @param which.plot.single Integer indicates which plot to create: "none" -#' will create a menu to choose. Defualt is none.\cr -#' 1 = time series plot of actual and fitted values,\cr -#' 2 = time series plot of residuals with standard error bands, \cr -#' 3 = time series plot of squared residuals, \cr -#' 4 = time series plot of absolute residuals,\cr -#' 5 = SACF and PACF of residuals,\cr -#' 6 = SACF and PACF of squared residuals,\cr -#' 7 = SACF and PACF of absolute residuals,\cr -#' 8 = histogram of residuals with normal curve overlayed,\cr -#' 9 = normal qq-plot of residuals,\cr -#' 10= CUSUM plot of recursive residuals,\cr -#' 11= CUSUM plot of OLS residuals,\cr -#' 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr -#' 13= rolling estimates over 24 month window. -#' @param VaR.method Character, method for computing VaR. Valid choices are -#' either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} -#' in the PerformanceAnalytics package. Default is "historical". -#' @author Eric Zivot and Yi-An Chen. -#' @examples -#' -#' \dontrun{ -#' # load data from the database -#' data(managers.df) -#' fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' # plot of all assets and show only first 4 assets. -#' plot(fit.macro,max.show=4) -#' # single plot of HAM1 asset -#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") -#' } -#' @method plot TimeSeriesFactorModel -#' @export -plot.TimeSeriesFactorModel <- - function(x,colorset=c(1:12),legend.loc=NULL, - which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6, - plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", - "7L","8L","9L","10L","11L","12L","13L"), - VaR.method = "historical") { - require(zoo) - require(PerformanceAnalytics) - require(strucchange) - require(ellipse) - - if (plot.single==TRUE) { - ## inputs: - ## fit.macro lm object summarizing factor model fit. It is assumed that - ## time series date information is included in the names component - ## of the residuals, fitted and model components of the object. - ## asset.name charater. The name of the single asset to be ploted. - ## which.plot.single integer indicating which plot to create: - ## 1 time series plot of actual and fitted values - ## 2 time series plot of residuals with standard error bands - ## 3 time series plot of squared residuals - ## 4 time series plot of absolute residuals - ## 5 SACF and PACF of residuals - ## 6 SACF and PACF of squared residuals - ## 7 SACF and PACF of absolute residuals - ## 8 histogram of residuals with normal curve overlayed - ## 9 normal qq-plot of residuals - ## 10 CUSUM plot of recursive residuals - ## 11 CUSUM plot of OLS residuals - ## 12 CUSUM plot of recursive estimates relative to full sample estimates - ## 13 rolling estimates over 24 month window - which.plot.single<-which.plot.single[1] - if (missing(asset.name) == TRUE) { - stop("Neet to specify an asset to plot if plot.single is TRUE.") - } - - fit.lm = x$asset.fit[[asset.name]] - - if (x$variable.selection == "none") { - - ## extract information from lm object - - factorNames = colnames(fit.lm$model)[-1] - fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" ")) - residuals.z = zoo(residuals(fit.lm), as.Date(names(residuals(fit.lm)))) - fitted.z = zoo(fitted(fit.lm), as.Date(names(fitted(fit.lm)))) - actual.z = zoo(fit.lm$model[,1], as.Date(rownames(fit.lm$model))) - tmp.summary = summary(fit.lm) - - - if (which.plot.single=="none") - which.plot.single<-menu(c("time series plot of actual and fitted values", - "time series plot of residuals with standard error bands", - "time series plot of squared residuals", - "time series plot of absolute residuals", - "SACF and PACF of residuals", - "SACF and PACF of squared residuals", - "SACF and PACF of absolute residuals", - "histogram of residuals with normal curve overlayed", - "normal qq-plot of residuals", - "CUSUM plot of recursive residuals", - "CUSUM plot of OLS residuals", - "CUSUM plot of recursive estimates relative to full sample estimates", - "rolling estimates over 24 month window"), - title="\nMake a plot selection (or 0 to exit):\n") - switch(which.plot.single, - "1L" = { - ## time series plot of actual and fitted values - plot(actual.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black") - lines(fitted.z, lwd=2, col="blue") - abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) - }, - - "2L" = { - ## time series plot of residuals with standard error bands - plot(residuals.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black") - abline(h=0) - abline(h=2*tmp.summary$sigma, lwd=2, lty="dotted", col="red") - abline(h=-2*tmp.summary$sigma, lwd=2, lty="dotted", col="red") - legend(x="bottomleft", legend=c("Residual", "+/ 2*SE"), lwd=2, - lty=c("solid","dotted"), col=c("black","red")) - }, - "3L" = { - ## time series plot of squared residuals - plot(residuals.z^2, main=asset.name, ylab="Squared residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Squared Residuals", lwd=2, col="black") - }, - "4L" = { - ## time series plot of absolute residuals - plot(abs(residuals.z), main=asset.name, ylab="Absolute residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Absolute Residuals", lwd=2, col="black") - }, - "5L" = { - ## SACF and PACF of residuals - chart.ACFplus(residuals.z, main=paste("Residuals: ", asset.name, sep="")) - }, - "6L" = { - ## SACF and PACF of squared residuals - chart.ACFplus(residuals.z^2, main=paste("Residuals^2: ", asset.name, sep="")) - }, - "7L" = { - ## SACF and PACF of absolute residuals - chart.ACFplus(abs(residuals.z), main=paste("|Residuals|: ", asset.name, sep="")) - }, - "8L" = { - ## histogram of residuals with normal curve overlayed - chart.Histogram(residuals.z, methods="add.normal", main=paste("Residuals: ", asset.name, sep="")) - }, - "9L" = { - ## normal qq-plot of residuals - chart.QQPlot(residuals.z, envelope=0.95, main=paste("Residuals: ", asset.name, sep="")) - }, - "10L"= { - ## CUSUM plot of recursive residuals - if (as.character(x$call["fit.method"]) == "OLS") { - cusum.rec = efp(fit.formula, type="Rec-CUSUM", data=fit.lm$model) - plot(cusum.rec, sub=asset.name) - } else - stop("CUMSUM applies only on OLS method") - }, - "11L"= { - ## CUSUM plot of OLS residuals - if (as.character(x$call["fit.method"]) == "OLS") { - cusum.ols = efp(fit.formula, type="OLS-CUSUM", data=fit.lm$model) - plot(cusum.ols, sub=asset.name) - } else - stop("CUMSUM applies only on OLS method") - }, - "12L"= { - ## CUSUM plot of recursive estimates relative to full sample estimates - if (as.character(x$call["fit.method"]) == "OLS") { - cusum.est = efp(fit.formula, type="fluctuation", data=fit.lm$model) - plot(cusum.est, functional=NULL, sub=asset.name) - } else - stop("CUMSUM applies only on OLS method") - }, - "13L"= { - ## rolling regression over 24 month window - if (as.character(x$call["fit.method"]) == "OLS") { - rollReg <- function(data.z, formula) { - coef(lm(formula, data = as.data.frame(data.z))) - } - reg.z = zoo(fit.lm$model, as.Date(rownames(fit.lm$model))) - rollReg.z = rollapply(reg.z, FUN=rollReg, fit.formula, width=24, by.column = FALSE, - align="right") - plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" ")) - } else if (as.character(x$call["fit.method"]) == "DLS") { - decay.factor <- as.numeric(as.character(x$call["decay.factor"])) - t.length <- 24 - w <- rep(decay.factor^(t.length-1),t.length) - for (k in 2:t.length) { - w[k] = w[k-1]/decay.factor - } - w <- w/sum(w) - rollReg.w <- function(data.z, formula,w) { - coef(lm(formula,weights=w, data = as.data.frame(data.z))) - } - reg.z = zoo(fit.lm$model[-length(fit.lm$model)], as.Date(rownames(fit.lm$model))) - factorNames = colnames(fit.lm$model)[c(-1,-length(fit.lm$model))] - fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" ")) - rollReg.z = rollapply(reg.z, FUN=rollReg.w, fit.formula,w, width=24, by.column = FALSE, - align="right") - plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" ")) - } - }, - invisible() - ) - - } else { - # lar or lasso - - factor.names = x$factors.names - plot.data = x$data[,c(asset.name,factor.names)] - alpha = x$alpha[asset.name] - beta = as.matrix(x$beta[asset.name,]) - fitted.z = zoo(alpha+as.matrix(plot.data[,factor.names])%*%beta,as.Date(rownames(plot.data))) - residuals.z = plot.data[,asset.name]-fitted.z - actual.z = zoo(plot.data[,asset.name],as.Date(rownames(plot.data))) - t = length(residuals.z) - k = length(factor.names) - - which.plot.single<-menu(c("time series plot of actual and fitted values", - "time series plot of residuals with standard error bands", - "time series plot of squared residuals", - "time series plot of absolute residuals", - "SACF and PACF of residuals", - "SACF and PACF of squared residuals", - "SACF and PACF of absolute residuals", - "histogram of residuals with normal curve overlayed", - "normal qq-plot of residuals"), - title="\nMake a plot selection (or 0 to exit):\n") - switch(which.plot.single, - "1L" = { - # "time series plot of actual and fitted values", - - plot(actual.z[,asset.name], main=asset.name, ylab="Monthly performance", lwd=2, col="black") - lines(fitted.z, lwd=2, col="blue") - abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) - }, - "2L"={ - # "time series plot of residuals with standard error bands" - plot(residuals.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black") - abline(h=0) - sigma = (sum(residuals.z^2)*(t-k)^-1)^(1/2) - abline(h=2*sigma, lwd=2, lty="dotted", col="red") - abline(h=-2*sigma, lwd=2, lty="dotted", col="red") - legend(x="bottomleft", legend=c("Residual", "+/ 2*SE"), lwd=2, - lty=c("solid","dotted"), col=c("black","red")) - - }, - "3L"={ - # "time series plot of squared residuals" - plot(residuals.z^2, main=asset.name, ylab="Squared residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Squared Residuals", lwd=2, col="black") - }, - "4L" = { - ## time series plot of absolute residuals - plot(abs(residuals.z), main=asset.name, ylab="Absolute residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Absolute Residuals", lwd=2, col="black") - }, - "5L" = { - ## SACF and PACF of residuals - chart.ACFplus(residuals.z, main=paste("Residuals: ", asset.name, sep="")) - }, - "6L" = { - ## SACF and PACF of squared residuals - chart.ACFplus(residuals.z^2, main=paste("Residuals^2: ", asset.name, sep="")) - }, - "7L" = { - ## SACF and PACF of absolute residuals - chart.ACFplus(abs(residuals.z), main=paste("|Residuals|: ", asset.name, sep="")) - }, - "8L" = { - ## histogram of residuals with normal curve overlayed - chart.Histogram(residuals.z, methods="add.normal", main=paste("Residuals: ", asset.name, sep="")) - }, - "9L" = { - ## normal qq-plot of residuals - chart.QQPlot(residuals.z, envelope=0.95, main=paste("Residuals: ", asset.name, sep="")) - }, - invisible() ) - - } - # plot group data - } else { - which.plot<-which.plot[1] - - if(which.plot=='none') - which.plot<-menu(c("Fitted factor returns", - "R square", - "Variance of Residuals", - "FM Correlation", - "Factor Contributions to SD", - "Factor Contributions to ES", - "Factor Contributions to VaR"), - title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n") - - - variable.selection = x$variable.selection - asset.names = x$assets.names - factor.names = x$factors.names - plot.data = x$data[,c(asset.names,factor.names)] - cov.factors = var(plot.data[,factor.names]) - n <- length(asset.names) - - switch(which.plot, - - "1L" = { - if (n > max.show) { - cat(paste("numbers of assets are greater than",max.show,", show only first", - max.show,"assets",sep=" ")) - n <- max.show - } - par(mfrow=c(n/2,2)) - if (variable.selection == "lar" || variable.selection == "lasso") { - for (i in 1:n) { - alpha = x$alpha[i] - beta = as.matrix(x$beta[i,]) - fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta - dataToPlot = cbind(fitted, plot.data[,i]) - colnames(dataToPlot) = c("Fitted","Actual") - main = paste("Factor Model fit for",asset.names[i],seq="") - chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main) - } - } else { - for (i in 1:n) { - dataToPlot = cbind(fitted(x$asset.fit[[i]]), na.omit(plot.data[,i])) - colnames(dataToPlot) = c("Fitted","Actual") - main = paste("Factor Model fit for",asset.names[i],seq="") - chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main) - } - } - par(mfrow=c(1,1)) - }, - "2L" ={ - barplot(x$r2) - }, - "3L" = { - barplot(x$resid.variance) - }, - - "4L" = { - cov.fm<- factorModelCovariance(x$beta,cov.factors,x$resid.variance) - cor.fm = cov2cor(cov.fm) - rownames(cor.fm) = colnames(cor.fm) - ord <- order(cor.fm[1,]) - ordered.cor.fm <- cor.fm[ord, ord] - plotcorr(ordered.cor.fm, col=cm.colors(11)[5*ordered.cor.fm + 6]) - }, - "5L" = { - factor.sd.decomp.list = list() - for (i in asset.names) { - factor.sd.decomp.list[[i]] = - factorModelSdDecomposition(x$beta[i,], - cov.factors, x$resid.variance[i]) - } - # function to extract contribution to sd from list - getCSD = function(x) { - x$cSd.fm - } - # extract contributions to SD from list - cr.sd = sapply(factor.sd.decomp.list, getCSD) - rownames(cr.sd) = c(factor.names, "residual") - # create stacked barchart - barplot(cr.sd, main="Factor Contributions to SD", - legend.text=T, args.legend=list(x="topleft")) - - }, - "6L"={ - factor.es.decomp.list = list() - if (variable.selection == "lar" || variable.selection == "lasso") { - - for (i in asset.names) { - idx = which(!is.na(plot.data[,i])) - alpha = x$alpha[i] - beta = as.matrix(x$beta[i,]) - fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta - residual = plot.data[,i]-fitted - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - (residual[idx,]/sqrt(x$resid.variance[i])) ) - colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") - factor.es.decomp.list[[i]] = - factorModelEsDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05) - - } - } else { - - for (i in asset.names) { - # check for missing values in fund data - idx = which(!is.na(plot.data[,i])) - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - residuals(x$asset.fit[[i]])/sqrt(x$resid.variance[i])) - colnames(tmpData)[c(1,dim(tmpData)[2])] = c(i, "residual") - factor.es.decomp.list[[i]] = - factorModelEsDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05, - VaR.method=VaR.method) - } - } - - # stacked bar charts of percent contributions to SD - getCETL = function(x) { - x$cES.fm - } - # report as positive number - cr.etl = sapply(factor.es.decomp.list, getCETL) - rownames(cr.etl) = c(factor.names, "residual") - barplot(cr.etl, main="Factor Contributions to ES", - legend.text=T, args.legend=list(x="topleft")) - }, - "7L" ={ - - factor.VaR.decomp.list = list() - - if (variable.selection == "lar" || variable.selection == "lasso") { - - for (i in asset.names) { - idx = which(!is.na(plot.data[,i])) - alpha = x$alpha[i] - beta = as.matrix(x$beta[i,]) - fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta - residual = plot.data[,i]-fitted - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - (residual[idx,]/sqrt(x$resid.variance[i])) ) - colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") - factor.VaR.decomp.list[[i]] = - factorModelVaRDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05,VaR.method=VaR.method) - - } - } else { - for (i in asset.names) { - # check for missing values in fund data - idx = which(!is.na(plot.data[,i])) - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - residuals(x$asset.fit[[i]])/sqrt(x$resid.variance[i])) - colnames(tmpData)[c(1,dim(tmpData)[2])] = c(i, "residual") - factor.VaR.decomp.list[[i]] = - factorModelVaRDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05, - VaR.method=VaR.method) - } - } - - # stacked bar charts of percent contributions to SD - getCVaR = function(x) { - x$cVaR.fm - } - # report as positive number - cr.VaR = sapply(factor.VaR.decomp.list, getCVaR) - rownames(cr.VaR) = c(factor.names, "residual") - barplot(cr.VaR, main="Factor Contributions to VaR", - legend.text=T, args.legend=list(x="topleft")) - }, - invisible() - ) - } - - } +#' plot TimeSeriesFactorModel object. +#' +#' Generic function of plot method for fitTimeSeriesFactorModel. Either plot +#' all assets or choose a single asset to plot. +#' +#' +#' @param x fit object created by \code{fitTimeSeriesFactorModel}. +#' @param colorset Defualt colorset the same as \code{barplot}. +#' @param legend.loc Plot legend or not. Defualt is \code{NULL}. +#' @param which.plot Integer indicates which plot to create: "none" will +#' create a menu to choose. Defualt is none.\cr +#' 1 = "Fitted factor returns", \cr +#' 2 = "R square", \cr +#' 3 = "Variance of Residuals",\cr +#' 4 = "FM Correlation",\cr +#' 5 = "Factor Contributions to SD",\cr +#' 6 = "Factor Contributions to ES",\cr +#' 7 = "Factor Contributions to VaR" +#' @param max.show Maximum assets to plot. Default is 6. +#' @param plot.single Plot a single asset of lm class. Defualt is \code{FALSE}. +#' @param asset.name Name of the asset to be plotted. +#' @param which.plot.single Integer indicates which plot to create: "none" +#' @param ... +#' will create a menu to choose. Defualt is none.\cr +#' 1 = time series plot of actual and fitted values,\cr +#' 2 = time series plot of residuals with standard error bands, \cr +#' 3 = time series plot of squared residuals, \cr +#' 4 = time series plot of absolute residuals,\cr +#' 5 = SACF and PACF of residuals,\cr +#' 6 = SACF and PACF of squared residuals,\cr +#' 7 = SACF and PACF of absolute residuals,\cr +#' 8 = histogram of residuals with normal curve overlayed,\cr +#' 9 = normal qq-plot of residuals,\cr +#' 10= CUSUM plot of recursive residuals,\cr +#' 11= CUSUM plot of OLS residuals,\cr +#' 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr +#' 13= rolling estimates over 24 month window. +#' @param VaR.method Character, method for computing VaR. Valid choices are +#' either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} +#' in the PerformanceAnalytics package. Default is "historical". +#' @author Eric Zivot and Yi-An Chen. +#' @examples +#' +#' \dontrun{ +#' # load data from the database +#' data(managers.df) +#' fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), +#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS") +#' # plot of all assets and show only first 4 assets. +#' plot(fit.macro,max.show=4) +#' # single plot of HAM1 asset +#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") +#' } +#' @method plot TimeSeriesFactorModel +#' @export +plot.TimeSeriesFactorModel <- + function(x,colorset=c(1:12),legend.loc=NULL, + which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6, + plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", + "7L","8L","9L","10L","11L","12L","13L"), + VaR.method = "historical", ...) { + require(zoo) + require(PerformanceAnalytics) + require(strucchange) + require(ellipse) + + if (plot.single==TRUE) { + ## inputs: + ## fit.macro lm object summarizing factor model fit. It is assumed that [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3430 From noreply at r-forge.r-project.org Fri Jun 20 05:48:49 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 20 Jun 2014 05:48:49 +0200 (CEST) Subject: [Returnanalytics-commits] r3431 - in pkg/FactorAnalytics: . man Message-ID: <20140620034849.E1AD018751A@r-forge.r-project.org> Author: gyollin Date: 2014-06-20 05:48:49 +0200 (Fri, 20 Jun 2014) New Revision: 3431 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd Log: Fixed non-ASCII character in DESCRIPTION file. Also, some Rd files got updated with the latest build Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2014-06-20 00:08:48 UTC (rev 3430) +++ pkg/FactorAnalytics/DESCRIPTION 2014-06-20 03:48:49 UTC (rev 3431) @@ -1,12 +1,30 @@ -Package: factorAnalytics -Type: Package -Title: Factor Analytics -Version: 1.0 -Date: 2014-06-18 -Author: Eric Zivot and Yi-An Chen -Maintainer: Yi-An Chen -Description: An R package for the estimation and risk analysis of linear factor models for asset returns and portfolios. It contains model fitting methods for the three major types of factor models: time series (or, macroeconomic) factor model, fundamental factor model and statistical factor model. They allow for different types of distributions to be specified for modeling the fat-tailed behavior of financial returns, including Edgeworth expansions. Risk analysis measures such as VaR and ES are also provided for the results of the fitted models. -License: GPL-2 -Depends: R (? 2.15.1), robust, leaps, lars, PerformanceAnalytics, sn, tseries, strucchange, ellipse, doParallel -Suggests: testthat -LazyLoad: yes +Package: factorAnalytics +Type: Package +Title: Factor Analytics +Version: 1.0 +Date: 2014-06-18 +Author: Eric Zivot and Yi-An Chen +Maintainer: Yi-An Chen +Description: An R package for the estimation and risk analysis of linear factor + models for asset returns and portfolios. It contains model fitting methods + for the three major types of factor models: time series (or, macroeconomic) + factor model, fundamental factor model and statistical factor model. They + allow for different types of distributions to be specified for modeling the + fat-tailed behavior of financial returns, including Edgeworth expansions. + Risk analysis measures such as VaR and ES are also provided for the results + of the fitted models. +License: GPL-2 +Depends: + R (>= 2.14.0), + robust, + leaps, + lars, + PerformanceAnalytics, + sn, + tseries, + strucchange, + ellipse, + doParallel +Suggests: + testthat +LazyLoad: yes Modified: pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2014-06-20 00:08:48 UTC (rev 3430) +++ pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2014-06-20 03:48:49 UTC (rev 3431) @@ -1,75 +1,76 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand -\name{plot.TimeSeriesFactorModel} -\alias{plot.TimeSeriesFactorModel} -\title{plot TimeSeriesFactorModel object.} -\usage{ -\method{plot}{TimeSeriesFactorModel}(x, colorset = c(1:12), - legend.loc = NULL, which.plot = c("none", "1L", "2L", "3L", "4L", "5L", - "6L", "7L"), max.show = 6, plot.single = FALSE, asset.name, - which.plot.single = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L", - "8L", "9L", "10L", "11L", "12L", "13L"), VaR.method = "historical") -} -\arguments{ -\item{x}{fit object created by \code{fitTimeSeriesFactorModel}.} - -\item{colorset}{Defualt colorset the same as \code{barplot}.} - -\item{legend.loc}{Plot legend or not. Defualt is \code{NULL}.} - -\item{which.plot}{Integer indicates which plot to create: "none" will -create a menu to choose. Defualt is none.\cr -1 = "Fitted factor returns", \cr -2 = "R square", \cr -3 = "Variance of Residuals",\cr -4 = "FM Correlation",\cr -5 = "Factor Contributions to SD",\cr -6 = "Factor Contributions to ES",\cr -7 = "Factor Contributions to VaR"} - -\item{max.show}{Maximum assets to plot. Default is 6.} - -\item{plot.single}{Plot a single asset of lm class. Defualt is \code{FALSE}.} - -\item{asset.name}{Name of the asset to be plotted.} - -\item{which.plot.single}{Integer indicates which plot to create: "none" -will create a menu to choose. Defualt is none.\cr - 1 = time series plot of actual and fitted values,\cr - 2 = time series plot of residuals with standard error bands, \cr - 3 = time series plot of squared residuals, \cr - 4 = time series plot of absolute residuals,\cr - 5 = SACF and PACF of residuals,\cr - 6 = SACF and PACF of squared residuals,\cr - 7 = SACF and PACF of absolute residuals,\cr - 8 = histogram of residuals with normal curve overlayed,\cr - 9 = normal qq-plot of residuals,\cr - 10= CUSUM plot of recursive residuals,\cr - 11= CUSUM plot of OLS residuals,\cr - 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr - 13= rolling estimates over 24 month window.} - -\item{VaR.method}{Character, method for computing VaR. Valid choices are -either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} -in the PerformanceAnalytics package. Default is "historical".} -} -\description{ -Generic function of plot method for fitTimeSeriesFactorModel. Either plot -all assets or choose a single asset to plot. -} -\examples{ -\dontrun{ -# load data from the database -data(managers.df) -fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), - factors.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") -# plot of all assets and show only first 4 assets. -plot(fit.macro,max.show=4) -# single plot of HAM1 asset -plot(fit.macro, plot.single=TRUE, asset.name="HAM1") -} -} -\author{ -Eric Zivot and Yi-An Chen. -} - +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{plot.TimeSeriesFactorModel} +\alias{plot.TimeSeriesFactorModel} +\title{plot TimeSeriesFactorModel object.} +\usage{ +\method{plot}{TimeSeriesFactorModel}(x, colorset = c(1:12), + legend.loc = NULL, which.plot = c("none", "1L", "2L", "3L", "4L", "5L", + "6L", "7L"), max.show = 6, plot.single = FALSE, asset.name, + which.plot.single = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L", + "8L", "9L", "10L", "11L", "12L", "13L"), VaR.method = "historical", ...) +} +\arguments{ +\item{x}{fit object created by \code{fitTimeSeriesFactorModel}.} + +\item{colorset}{Defualt colorset the same as \code{barplot}.} + +\item{legend.loc}{Plot legend or not. Defualt is \code{NULL}.} + +\item{which.plot}{Integer indicates which plot to create: "none" will +create a menu to choose. Defualt is none.\cr +1 = "Fitted factor returns", \cr +2 = "R square", \cr +3 = "Variance of Residuals",\cr +4 = "FM Correlation",\cr +5 = "Factor Contributions to SD",\cr +6 = "Factor Contributions to ES",\cr +7 = "Factor Contributions to VaR"} + +\item{max.show}{Maximum assets to plot. Default is 6.} + +\item{plot.single}{Plot a single asset of lm class. Defualt is \code{FALSE}.} + +\item{asset.name}{Name of the asset to be plotted.} + +\item{which.plot.single}{Integer indicates which plot to create: "none"} + +\item{...}{will create a menu to choose. Defualt is none.\cr +1 = time series plot of actual and fitted values,\cr +2 = time series plot of residuals with standard error bands, \cr +3 = time series plot of squared residuals, \cr +4 = time series plot of absolute residuals,\cr +5 = SACF and PACF of residuals,\cr +6 = SACF and PACF of squared residuals,\cr +7 = SACF and PACF of absolute residuals,\cr +8 = histogram of residuals with normal curve overlayed,\cr +9 = normal qq-plot of residuals,\cr +10= CUSUM plot of recursive residuals,\cr +11= CUSUM plot of OLS residuals,\cr +12= CUSUM plot of recursive estimates relative to full sample estimates,\cr +13= rolling estimates over 24 month window.} + +\item{VaR.method}{Character, method for computing VaR. Valid choices are +either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} +in the PerformanceAnalytics package. Default is "historical".} +} +\description{ +Generic function of plot method for fitTimeSeriesFactorModel. Either plot +all assets or choose a single asset to plot. +} +\examples{ +\dontrun{ +# load data from the database +data(managers.df) +fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), + factors.names=c("EDHEC.LS.EQ","SP500.TR"), + data=managers.df,fit.method="OLS") +# plot of all assets and show only first 4 assets. +plot(fit.macro,max.show=4) +# single plot of HAM1 asset +plot(fit.macro, plot.single=TRUE, asset.name="HAM1") +} +} +\author{ +Eric Zivot and Yi-An Chen. +} + Modified: pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd 2014-06-20 00:08:48 UTC (rev 3430) +++ pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd 2014-06-20 03:48:49 UTC (rev 3431) @@ -1,45 +1,47 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand -\name{predict.FundamentalFactorModel} -\alias{predict.FundamentalFactorModel} -\title{predict method for FundamentalFactorModel object} -\usage{ -\method{predict}{FundamentalFactorModel}(object, newdata, new.assetvar, - new.datevar) -} -\arguments{ -\item{object}{fit "FundamentalFactorModel" object} - -\item{newdata}{An optional data frame in which to look for variables with which to predict. -If omitted, the fitted values are used.} - -\item{new.assetvar}{Specify new asset variable in newdata if newdata is provided.} - -\item{new.datevar}{Speficy new date variable in newdata if newdata is provided.} -} -\description{ -Generic function of predict method for fitFundamentalFactorModel. -} -\details{ -\code{newdata} must be data.frame and contain date variable, asset variable and exact -exposures names that are used in fit object by \code{fitFundamentalFactorModel} -} -\examples{ -data(Stock.df) -fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP") - , data=stock,returnsvar = "RETURN",datevar = "DATE", - assetvar = "TICKER", - wls = TRUE, regression = "classic", - covariance = "classic", full.resid.cov = FALSE) -# If not specify anything, predict() will give fitted value -pred.fund <- predict(fit.fund) - -# generate random data -testdata <- stock[,c("DATE","TICKER")] -testdata$BOOK2MARKET <- rnorm(n=42465) -testdata$LOG.MARKETCAP <- rnorm(n=42465) -pred.fund2 <- predict(fit.fund,testdata,new.assetvar="TICKER",new.datevar="DATE") -} -\author{ -Yi-An Chen -} - +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{predict.FundamentalFactorModel} +\alias{predict.FundamentalFactorModel} +\title{predict method for FundamentalFactorModel object} +\usage{ +\method{predict}{FundamentalFactorModel}(object, newdata, new.assetvar, + new.datevar, ...) +} +\arguments{ +\item{object}{fit "FundamentalFactorModel" object} + +\item{newdata}{An optional data frame in which to look for variables with which to predict. +If omitted, the fitted values are used.} + +\item{new.assetvar}{Specify new asset variable in newdata if newdata is provided.} + +\item{new.datevar}{Speficy new date variable in newdata if newdata is provided.} + +\item{...}{} +} +\description{ +Generic function of predict method for fitFundamentalFactorModel. +} +\details{ +\code{newdata} must be data.frame and contain date variable, asset variable and exact +exposures names that are used in fit object by \code{fitFundamentalFactorModel} +} +\examples{ +data(Stock.df) +fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP") + , data=stock,returnsvar = "RETURN",datevar = "DATE", + assetvar = "TICKER", + wls = TRUE, regression = "classic", + covariance = "classic", full.resid.cov = FALSE) +# If not specify anything, predict() will give fitted value +pred.fund <- predict(fit.fund) + +# generate random data +testdata <- stock[,c("DATE","TICKER")] +testdata$BOOK2MARKET <- rnorm(n=42465) +testdata$LOG.MARKETCAP <- rnorm(n=42465) +pred.fund2 <- predict(fit.fund,testdata,new.assetvar="TICKER",new.datevar="DATE") +} +\author{ +Yi-An Chen +} + From noreply at r-forge.r-project.org Fri Jun 20 22:56:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 20 Jun 2014 22:56:58 +0200 (CEST) Subject: [Returnanalytics-commits] r3432 - in pkg/PortfolioAnalytics: . R man sandbox Message-ID: <20140620205659.0FE0F18731C@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-20 22:56:58 +0200 (Fri, 20 Jun 2014) New Revision: 3432 Added: pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd pkg/PortfolioAnalytics/sandbox/testing_moments.R Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/man/black.litterman.Rd pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd Log: refactor of set.portfolio.moments to incorporate different methods for estimating moments Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-06-20 03:48:49 UTC (rev 3431) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-20 20:56:58 UTC (rev 3432) @@ -127,7 +127,6 @@ export(optimize.portfolio.rebalancing_v1) export(optimize.portfolio_v1) export(optimize.portfolio_v2) -export(portfolio.moments.boudt) export(portfolio.spec) export(portfolio_risk_objective) export(pos_limit_fail) @@ -150,8 +149,6 @@ export(rp_transform) export(scatterFUN) export(set.portfolio.moments) -export(set.portfolio.moments_v1) -export(set.portfolio.moments_v2) export(statistical.factor.model) export(trailingFUN) export(transaction_cost_constraint) Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-20 03:48:49 UTC (rev 3431) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-20 20:56:58 UTC (rev 3432) @@ -21,43 +21,43 @@ #' @export CCCgarch.MM = function(R, momentargs = NULL , ... ) { - stopifnot("package:fGarch" %in% search() || require("fGarch",quietly=TRUE)) - if (!hasArg(momentargs) | is.null(momentargs)) - momentargs <- list() - cAssets = ncol(R) - T = nrow(R) - if (!hasArg(mu)){ - mu = apply(R, 2, "mean") - }else{ mu = match.call(expand.dots = TRUE)$mu } - R = R - matrix( rep(mu,T) , nrow = T , byrow = TRUE ) - momentargs$mu = mu - S = nextS = c(); - for( i in 1:cAssets ){ - gout = garchFit(formula ~ garch(1,1), data = R[,i],include.mean = F, cond.dist="QMLE", trace = FALSE ) - if( as.vector(gout at fit$coef["alpha1"]) < 0.01 ){ - sigmat = rep( sd( as.vector(R[,i])), length(R[,i]) ); nextSt = sd( as.vector(R[,i])) - }else{ - sigmat = gout at sigma.t; nextSt = predict(gout)[1,3] - } - S = cbind( S , sigmat); nextS = c(nextS,nextSt) + stopifnot("package:fGarch" %in% search() || require("fGarch",quietly=TRUE)) + if (!hasArg(momentargs) | is.null(momentargs)) + momentargs <- list() + cAssets = ncol(R) + T = nrow(R) + if (!hasArg(mu)){ + mu = apply(R, 2, "mean") + }else{ mu = match.call(expand.dots = TRUE)$mu } + R = R - matrix( rep(mu,T) , nrow = T , byrow = TRUE ) + momentargs$mu = mu + S = nextS = c(); + for( i in 1:cAssets ){ + gout = garchFit(formula ~ garch(1,1), data = R[,i],include.mean = F, cond.dist="QMLE", trace = FALSE ) + if( as.vector(gout at fit$coef["alpha1"]) < 0.01 ){ + sigmat = rep( sd( as.vector(R[,i])), length(R[,i]) ); nextSt = sd( as.vector(R[,i])) + }else{ + sigmat = gout at sigma.t; nextSt = predict(gout)[1,3] } - U = R/S; #filtered out time-varying volatility - if (!hasArg(clean)){ - clean = match.call(expand.dots = TRUE)$clean - }else{ clean = NULL } - if(!is.null(clean)){ - cleanU <- try(Return.clean(U, method = clean)) - if (!inherits(cleanU, "try-error")) { U = cleanU } - } - Rcor = cor(U) - D = diag( nextS ,ncol=cAssets ) - momentargs$sigma = D%*%Rcor%*%D - # set volatility of all U to last observation, such that cov(rescaled U)=sigma - uncS = sqrt(diag( cov(U) )) - U = U*matrix( rep(nextS/uncS,T ) , ncol = cAssets , byrow = T ) - momentargs$m3 = PerformanceAnalytics:::M3.MM(U) - momentargs$m4 = PerformanceAnalytics:::M4.MM(U) - return(momentargs) + S = cbind( S , sigmat); nextS = c(nextS,nextSt) + } + U = R/S; #filtered out time-varying volatility + if (!hasArg(clean)){ + clean = match.call(expand.dots = TRUE)$clean + }else{ clean = NULL } + if(!is.null(clean)){ + cleanU <- try(Return.clean(U, method = clean)) + if (!inherits(cleanU, "try-error")) { U = cleanU } + } + Rcor = cor(U) + D = diag( nextS ,ncol=cAssets ) + momentargs$sigma = D%*%Rcor%*%D + # set volatility of all U to last observation, such that cov(rescaled U)=sigma + uncS = sqrt(diag( cov(U) )) + U = U*matrix( rep(nextS/uncS,T ) , ncol = cAssets , byrow = T ) + momentargs$m3 = PerformanceAnalytics:::M3.MM(U) + momentargs$m4 = PerformanceAnalytics:::M4.MM(U) + return(momentargs) } #' set portfolio moments for use by lower level optimization functions @@ -65,103 +65,17 @@ #' @param constraints an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}} #' @param momentargs list containing arguments to be passed down to lower level functions, default NULL #' @param \dots any other passthru parameters -#' @export set.portfolio.moments_v1 <- function(R, constraints, momentargs=NULL,...){ - - if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list() - if(is.null(constraints$objectives)) { - warning("no objectives specified in constraints") - next() - } else { - - lcl <- grep('garch', constraints) - if (!identical(lcl, integer(0))) { - for (objective in constraints[lcl]) { - objective = unlist(objective) - if( is.null( objective$garch ) ) next - if (objective$garch){ - if (is.null(momentargs$mu)|is.null(momentargs$sigma)|is.null(momentargs$m3)|is.null(momentargs$m4)) - { - momentargs = CCCgarch.MM(R,clean=objective$arguments.clean,...) - } - } - } - } - - - lcl<-grep('clean',constraints) - if(!identical(lcl,integer(0))) { - for (objective in constraints[lcl]){ - objective = unlist(objective) - #if(!is.null(objective$arguments$clean)) { - if (!is.null(objective$arguments.clean)){ - if (is.null(momentargs$mu)|is.null(momentargs$sigma)|is.null(momentargs$m3)|is.null(momentargs$m4)) - { - # cleanR<-try(Return.clean(R,method=objective$arguments$clean)) - cleanR <- try(Return.clean(R, method = objective$arguments.clean,...)) - if(!inherits(cleanR,"try-error")) { - momentargs$mu = matrix( as.vector(apply(cleanR,2,'mean')),ncol=1); - momentargs$sigma = cov(cleanR); - momentargs$m3 = PerformanceAnalytics:::M3.MM(cleanR) - momentargs$m4 = PerformanceAnalytics:::M4.MM(cleanR) - #' FIXME NOTE: this isn't perfect as it overwrites the moments for all objectives, not just one with clean='boudt' - } - } - } - } - } - for (objective in constraints$objectives){ - switch(objective$name, - sd =, - StdDev = { - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1); - if(is.null(momentargs$sigma)) momentargs$sigma = cov(R, use='pairwise.complete.obs') - }, - var =, - mVaR =, - VaR = { - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); - if(is.null(momentargs$sigma)) momentargs$sigma = cov(R) - if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) - if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) - }, - es =, - mES =, - CVaR =, - cVaR =, - ES = { - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); - if(is.null(momentargs$sigma)) momentargs$sigma = cov(R) - if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) - if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) - } - ) # end switch on objectives - } - } - return(momentargs) -} - -#' set portfolio moments for use by lower level optimization functions -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns -#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization, see \code{\link{portfolio.spec}} -#' @param momentargs list containing arguments to be passed down to lower level functions, default NULL -#' @param \dots any other passthru parameters -#' @aliases set.portfolio.moments -#' @rdname set.portfolio.moments -#' @export -set.portfolio.moments_v2 <- function(R, portfolio, momentargs=NULL,...){ if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list() - if(is.null(portfolio$objectives)) { - warning("no objectives specified in portfolio") + if(is.null(constraints$objectives)) { + warning("no objectives specified in constraints") next() } else { - # How would this be specified in the new portfolio.spec? As a constraint or in the portfolio part? - # - lcl <- grep('garch', portfolio) + lcl <- grep('garch', constraints) if (!identical(lcl, integer(0))) { - for (objective in portfolio[lcl]) { + for (objective in constraints[lcl]) { objective = unlist(objective) if( is.null( objective$garch ) ) next if (objective$garch){ @@ -174,9 +88,9 @@ } - lcl<-grep('clean',portfolio) + lcl<-grep('clean',constraints) if(!identical(lcl,integer(0))) { - for (objective in portfolio[lcl]){ + for (objective in constraints[lcl]){ objective = unlist(objective) #if(!is.null(objective$arguments$clean)) { if (!is.null(objective$arguments.clean)){ @@ -195,17 +109,14 @@ } } } - for (objective in portfolio$objectives){ + for (objective in constraints$objectives){ switch(objective$name, - mean = { - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1) - }, - var =, sd =, StdDev = { if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1); if(is.null(momentargs$sigma)) momentargs$sigma = cov(R, use='pairwise.complete.obs') }, + var =, mVaR =, VaR = { if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); @@ -217,6 +128,173 @@ mES =, CVaR =, cVaR =, + ES = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = cov(R) + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) + } + ) # end switch on objectives + } + } + return(momentargs) +} + +#' Portfolio Moments +#' +#' Set portfolio moments for use by lower level optimization functions. Currently +#' three methods for setting the moments are available +#' +#' \itemize{ +#' \item{sample: }{sample estimates are used for the moments} +#' \item{boudt: }{estimate the second, third, and fourth moments using a +#' statistical factor model based on the work of Kris Boudt.} +#' See \code{\link{fit.statistical.factor.model}} +#' \item{black_litterman: }{estimate the first and second moments using the +#' Black Litterman Formula. See \code{\link{black.litterman}}}. +#' } +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns +#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization, see \code{\link{portfolio.spec}} +#' @param momentargs list containing arguments to be passed down to lower level functions, default NULL +#' @param method the method used to estimate portfolio moments. Valid choices include "sample", "boudt", and "black_litterman". +#' @param \dots any other passthru parameters +#' @aliases set.portfolio.moments +#' @rdname set.portfolio.moments +set.portfolio.moments_v2 <- function(R, + portfolio, + momentargs=NULL, + method=c("sample", "boudt", "black_litterman"), + ...){ + + if(!hasArg(momentargs) | is.null(momentargs)) momentargs <- list() + if(is.null(portfolio$objectives)) { + warning("no objectives specified in portfolio") + next() + } else { + method <- match.arg(method) + + # If any of the objectives have clean as an argument, we fit the factor + # model and Black Litterman model with cleaned returns. + clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean)) + if(!is.null(clean)){ + if(length(unique(clean)) > 1){ + warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1])) + } + cleanR <- Return.clean(R, method=clean[1]) + cleaned <- TRUE + } else { + cleaned <- FALSE + } + + if(cleaned){ + tmpR <- cleanR + } else { + tmpR <- R + } + + # Fit model based on method + switch(method, + boudt = { + if(hasArg(k)) k=match.call(expand.dots=TRUE)$k else k=1 + fit <- statistical.factor.model(R=tmpR, k=k) + }, + black_litterman = { + if(hasArg(P)) P=match.call(expand.dots=TRUE)$P else P=matrix(rep(1, ncol(R)), nrow=1) + if(hasArg(Mu)) Mu=match.call(expand.dots=TRUE)$Mu else Mu=NULL + if(hasArg(Sigma)) Sigma=match.call(expand.dots=TRUE)$Sigma else Sigma=NULL + B <- black.litterman(R=tmpR, P=P, Mu=Mu, Sigma=Sigma) + } + ) # end switch for fitting models based on method + + lcl <- grep('garch', portfolio) + if (!identical(lcl, integer(0))) { + for (objective in portfolio[lcl]) { + objective = unlist(objective) + if( is.null( objective$garch ) ) next + if (objective$garch){ + if (is.null(momentargs$mu)|is.null(momentargs$sigma)|is.null(momentargs$m3)|is.null(momentargs$m4)) + { + momentargs = CCCgarch.MM(R,clean=objective$arguments.clean,...) + } + } + } + } + + for (objective in portfolio$objectives){ + # The returns should already have been cleaned if any objective has + # arguments=list(clean=*). One drawback is if different cleaning + # methods are being used for different objectives, only the first + # method for cleaning is used. This is mor efficient and avoids "re"-cleaning. + # Not sure that anyone would want to use different cleaning methods anyway. + # Another thing is that we don't recalculate the moments. So if a moment + # is set with un-cleaned returns then the next objective may have + # clean="boudt", but the cleaned returns are not used for that moment. + # I think this is more consisent with how the objectives are specified + # rather than overwriting all moments, but I am open to other ideas or + # suggestions. + if(!is.null(objective$arguments$clean)){ + tmpR <- cleanR + } else { + tmpR <- R + } + switch(objective$name, + mean = { + switch(method, + sample =, + boudt = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean', na.rm=TRUE)), ncol=1) + }, + black_litterman = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + } + ) # end nested switch on method + }, # end switch on mean + var =, + sd =, + StdDev = { + switch(method, + sample = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean', na.rm=TRUE)), ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = cov(tmpR, use='pairwise.complete.obs') + }, + boudt = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean', na.rm=TRUE)), ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) + }, + black_litterman = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + } + ) # end nested switch on method + }, # end switch on var, sd, StdDev + mVaR =, + VaR = { + switch(method, + sample = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = cov(tmpR) + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) + }, + boudt = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) + if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit) + if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit) + }, + black_litterman = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) + } + ) # end nested switch on method + }, # end switch on mVaR, VaR + es =, + mES =, + CVaR =, + cVaR =, ETL=, mETL=, ES = { @@ -224,12 +302,28 @@ # objective and are solving as an LP problem. if(hasArg(ROI)) ROI=match.call(expand.dots=TRUE)$ROI else ROI=FALSE if(!ROI){ - if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1); - if(is.null(momentargs$sigma)) momentargs$sigma = cov(R) - if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) - if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) + switch(method, + sample = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = cov(tmpR) + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) + }, + boudt = { + if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1); + if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit) + if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit) + if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit) + }, + black_litterman = { + if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) + } + ) # end nested switch on method } - } + } # end switch on es, mES, CVaR, cVaR, ETL, mETL, ES ) # end switch on objectives } } @@ -241,14 +335,14 @@ set.portfolio.moments <- set.portfolio.moments_v2 garch.mm <- function(R,mu_ts, covlist,momentargs=list(),...) { - #momentargs<-list() - #momentargs$mu<-mu_ts[last(index(R)),] - momentargs$mu<-mu_ts[last(index(R)),] - - momentargs$sigma<-covlist[as.character(last(index(R)))] - if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) - if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) - return(momentargs) + #momentargs<-list() + #momentargs$mu<-mu_ts[last(index(R)),] + momentargs$mu<-mu_ts[last(index(R)),] + + momentargs$sigma<-covlist[as.character(last(index(R)))] + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R) + return(momentargs) } #' Portfolio Moments @@ -268,7 +362,6 @@ #' functions, default NULL #' @param k number of factors used for fitting statistical factor model #' @param \dots any other passthru parameters -#' @export portfolio.moments.boudt <- function(R, portfolio, momentargs=NULL, k=1, ...){ # Fit the statistical factor model @@ -353,7 +446,6 @@ #' @param Sigma an N x N matrix of the prior covariance matrix. The sample #' covariance is used if \code{Sigma=NULL}. #' @param \dots any other passthru parameters -#' @export portfolio.moments.bl <- function(R, portfolio, momentargs=NULL, P, Mu=NULL, Sigma=NULL, ...){ Modified: pkg/PortfolioAnalytics/man/black.litterman.Rd =================================================================== --- pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-20 03:48:49 UTC (rev 3431) +++ pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-20 20:56:58 UTC (rev 3432) @@ -3,7 +3,7 @@ \alias{black.litterman} \title{Black Litterman Estimates} \usage{ -black.litterman(R, P, Mu, Sigma) +black.litterman(R, P, Mu = NULL, Sigma = NULL) } \arguments{ \item{R}{returns} @@ -11,10 +11,10 @@ \item{P}{a K x N pick matrix} \item{Mu}{vector of length N of the prior expected values. The sample mean -is used if \code{mu} is not provided as an argument.} +is used if \code{Mu=NULL}.} -\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample covariance -is used if \code{Sigma} is not provided as an argument.} +\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample +covariance is used if \code{Sigma=NULL}.} } \value{ \itemize{ Added: pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd =================================================================== --- pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd 2014-06-20 20:56:58 UTC (rev 3432) @@ -0,0 +1,38 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{portfolio.moments.bl} +\alias{portfolio.moments.bl} +\title{Portfolio Moments} +\usage{ +portfolio.moments.bl(R, portfolio, momentargs = NULL, P, Mu = NULL, + Sigma = NULL, ...) +} +\arguments{ +\item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of +asset returns} + +\item{portfolio}{an object of type \code{portfolio} specifying the +constraints and objectives for the optimization, see +\code{\link{portfolio.spec}}} + +\item{momentargs}{list containing arguments to be passed down to lower level +functions, default NULL} + +\item{P}{a K x N pick matrix representing views} + +\item{Mu}{vector of length N of the prior expected values. The sample mean +is used if \code{Mu=NULL}.} + +\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample +covariance is used if \code{Sigma=NULL}.} + +\item{\dots}{any other passthru parameters} +} +\description{ +Set portfolio moments for use by lower level optimization functions using +a basic Black Litterman model. +} +\note{ +If any of the objectives in the \code{portfolio} object have +\code{clean} as an argument, the cleaned returns are used to fit the model. +} + Modified: pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd =================================================================== --- pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-20 03:48:49 UTC (rev 3431) +++ pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-20 20:56:58 UTC (rev 3432) @@ -2,9 +2,10 @@ \name{set.portfolio.moments_v2} \alias{set.portfolio.moments} \alias{set.portfolio.moments_v2} -\title{set portfolio moments for use by lower level optimization functions} +\title{Portfolio Moments} \usage{ -set.portfolio.moments_v2(R, portfolio, momentargs = NULL, ...) +set.portfolio.moments_v2(R, portfolio, momentargs = NULL, + method = c("sample", "boudt", "black_litterman"), ...) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} @@ -13,9 +14,22 @@ \item{momentargs}{list containing arguments to be passed down to lower level functions, default NULL} +\item{method}{the method used to estimate portfolio moments. Valid choices include "sample", "boudt", and "black_litterman".} + \item{\dots}{any other passthru parameters} } \description{ -set portfolio moments for use by lower level optimization functions +Set portfolio moments for use by lower level optimization functions. Currently +three methods for setting the moments are available } +\details{ +\itemize{ + \item{sample: }{sample estimates are used for the moments} + \item{boudt: }{estimate the second, third, and fourth moments using a + statistical factor model based on the work of Kris Boudt.} + See \code{\link{fit.statistical.factor.model}} + \item{black_litterman: }{estimate the first and second moments using the + Black Litterman Formula. See \code{\link{black.litterman}}}. +} +} Added: pkg/PortfolioAnalytics/sandbox/testing_moments.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_moments.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_moments.R 2014-06-20 20:56:58 UTC (rev 3432) @@ -0,0 +1,59 @@ +library(PortfolioAnalytics) + +data(edhec) +R <- edhec[, 1:5] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES", + arguments=list(p=0.9)) + +# uncleaned R +moments.sample <- set.portfolio.moments(R, init.portf) +all.equal(moments.sample$mu, matrix(colMeans(R), ncol=1)) +all.equal(moments.sample$sigma, cov(R)) +all.equal(moments.sample$m3, PerformanceAnalytics:::M3.MM(R)) +all.equal(moments.sample$m4, PerformanceAnalytics:::M4.MM(R)) + +moments.boudt <- set.portfolio.moments(R, init.portf, method="boudt", k=3) +fit <- statistical.factor.model(R, 3) +all.equal(moments.boudt$mu, matrix(colMeans(R), ncol=1)) +all.equal(moments.boudt$sigma, extractCovariance(fit)) +all.equal(moments.boudt$m3, extractCoskewness(fit)) +all.equal(moments.boudt$m4, extractCokurtosis(fit)) + +moments.bl <- set.portfolio.moments(R, init.portf, method="black_litterman") +BL <- black.litterman(R, matrix(rep(1, ncol(R)), 1)) +all.equal(moments.bl$mu, BL$BLMu) +all.equal(moments.bl$sigma, BL$BLSigma) +all.equal(moments.bl$m3, PerformanceAnalytics:::M3.MM(R)) +all.equal(moments.bl$m4, PerformanceAnalytics:::M4.MM(R)) + + +# cleaned R +cleanR <- Return.clean(R, method="boudt") +init.portf$objectives[[1]]$arguments$clean <- "boudt" + +moments.sample <- set.portfolio.moments(R, init.portf) +all.equal(moments.sample$mu, matrix(colMeans(cleanR), ncol=1)) +all.equal(moments.sample$sigma, cov(cleanR)) +all.equal(moments.sample$m3, PerformanceAnalytics:::M3.MM(cleanR)) +all.equal(moments.sample$m4, PerformanceAnalytics:::M4.MM(cleanR)) + +moments.boudt <- set.portfolio.moments(R, init.portf, method="boudt", k=3) +fit <- statistical.factor.model(cleanR, 3) +all.equal(moments.boudt$mu, matrix(colMeans(cleanR), ncol=1)) +all.equal(moments.boudt$sigma, extractCovariance(fit)) +all.equal(moments.boudt$m3, extractCoskewness(fit)) +all.equal(moments.boudt$m4, extractCokurtosis(fit)) + +moments.bl <- set.portfolio.moments(R, init.portf, method="black_litterman") +BL <- black.litterman(cleanR, matrix(rep(1, ncol(cleanR)), 1)) +all.equal(moments.bl$mu, BL$BLMu) +all.equal(moments.bl$sigma, BL$BLSigma) +all.equal(moments.bl$m3, PerformanceAnalytics:::M3.MM(cleanR)) +all.equal(moments.bl$m4, PerformanceAnalytics:::M4.MM(cleanR)) + From noreply at r-forge.r-project.org Sat Jun 21 07:59:41 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 21 Jun 2014 07:59:41 +0200 (CEST) Subject: [Returnanalytics-commits] r3433 - in pkg/FactorAnalytics: . R man vignettes Message-ID: <20140621055941.BD9311874AD@r-forge.r-project.org> Author: pragnya Date: 2014-06-21 07:59:41 +0200 (Sat, 21 Jun 2014) New Revision: 3433 Added: pkg/FactorAnalytics/R/paFM.r pkg/FactorAnalytics/R/plot.pafm.r pkg/FactorAnalytics/R/print.pafm.r pkg/FactorAnalytics/R/summary.pafm.r pkg/FactorAnalytics/man/fitTimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/paFM.Rd pkg/FactorAnalytics/man/plot.pafm.Rd pkg/FactorAnalytics/man/print.pafm.Rd pkg/FactorAnalytics/man/summary.pafm.Rd Removed: pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r pkg/FactorAnalytics/R/plot.FM.attribution.r pkg/FactorAnalytics/R/print.FM.attribution.r pkg/FactorAnalytics/R/summary.FM.attribution.r pkg/FactorAnalytics/man/factorModelPerformanceAttribution.Rd pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd pkg/FactorAnalytics/man/plot.FM.attribution.Rd pkg/FactorAnalytics/man/print.FM.attribution.Rd pkg/FactorAnalytics/man/summary.FM.attribution.Rd Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/factorModelEsDecomposition.R pkg/FactorAnalytics/R/factorModelMonteCarlo.R pkg/FactorAnalytics/R/factorModelVaRDecomposition.R pkg/FactorAnalytics/R/fitFundamentalFactorModel.R pkg/FactorAnalytics/R/fitStatisticalFactorModel.R pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r pkg/FactorAnalytics/R/plot.StatFactorModel.r pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd pkg/FactorAnalytics/vignettes/fundamentalFM.Rnw Log: Removed library(), require() from all functions. Changed the name of the function factorModelPerformanceAttribution to paFM and its returned object class to "pafm". Changed the vignette, plot, print and summary methods for paFM accordingly. Changed the 1st argument in the method functions to match up with the default methods in plot, print and summary. Fixed asset.names in predict.FundamentalFactorModel to correctly reflect output from the fitted object. Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2014-06-20 20:56:58 UTC (rev 3432) +++ pkg/FactorAnalytics/DESCRIPTION 2014-06-21 05:59:41 UTC (rev 3433) @@ -1,30 +1,30 @@ -Package: factorAnalytics -Type: Package -Title: Factor Analytics -Version: 1.0 -Date: 2014-06-18 -Author: Eric Zivot and Yi-An Chen -Maintainer: Yi-An Chen -Description: An R package for the estimation and risk analysis of linear factor - models for asset returns and portfolios. It contains model fitting methods - for the three major types of factor models: time series (or, macroeconomic) - factor model, fundamental factor model and statistical factor model. They - allow for different types of distributions to be specified for modeling the - fat-tailed behavior of financial returns, including Edgeworth expansions. - Risk analysis measures such as VaR and ES are also provided for the results - of the fitted models. -License: GPL-2 -Depends: - R (>= 2.14.0), - robust, - leaps, - lars, - PerformanceAnalytics, - sn, - tseries, - strucchange, - ellipse, - doParallel -Suggests: - testthat -LazyLoad: yes +Package: factorAnalytics +Type: Package +Title: Factor Analytics +Version: 1.0 +Date: 2014-06-18 +Author: Eric Zivot and Yi-An Chen +Maintainer: Yi-An Chen +Description: An R package for the estimation and risk analysis of linear factor + models for asset returns and portfolios. It contains model fitting methods + for the three major types of factor models: time series (or, macroeconomic) + factor model, fundamental factor model and statistical factor model. They + allow for different types of distributions to be specified for modeling the + fat-tailed behavior of financial returns, including Edgeworth expansions. + Risk analysis measures such as VaR and ES are also provided for the results + of the fitted models. +License: GPL-2 +Depends: + R (>= 2.14.0), + robust, + leaps, + lars, + PerformanceAnalytics, + sn, + tseries, + strucchange, + ellipse, + doParallel +Suggests: + testthat, quantmod +LazyLoad: yes Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-20 20:56:58 UTC (rev 3432) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-21 05:59:41 UTC (rev 3433) @@ -1,30 +1,30 @@ # Generated by roxygen2 (4.0.1): do not edit by hand -S3method(plot,FM.attribution) S3method(plot,FundamentalFactorModel) S3method(plot,StatFactorModel) S3method(plot,TimeSeriesFactorModel) +S3method(plot,pafm) S3method(predict,FundamentalFactorModel) S3method(predict,StatFactorModel) S3method(predict,TimeSeriesFactorModel) -S3method(print,FM.attribution) S3method(print,FundamentalFactorModel) S3method(print,StatFactorModel) S3method(print,TimeSeriesFactorModel) -S3method(summary,FM.attribution) +S3method(print,pafm) S3method(summary,FundamentalFactorModel) S3method(summary,StatFactorModel) S3method(summary,TimeSeriesFactorModel) +S3method(summary,pafm) export(dCornishFisher) export(factorModelCovariance) export(factorModelEsDecomposition) export(factorModelMonteCarlo) -export(factorModelPerformanceAttribution) export(factorModelSdDecomposition) export(factorModelVaRDecomposition) export(fitFundamentalFactorModel) export(fitStatisticalFactorModel) export(fitTimeSeriesFactorModel) export(pCornishFisher) +export(paFM) export(qCornishFisher) export(rCornishFisher) Modified: pkg/FactorAnalytics/R/factorModelEsDecomposition.R =================================================================== --- pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2014-06-20 20:56:58 UTC (rev 3432) +++ pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2014-06-21 05:59:41 UTC (rev 3433) @@ -1,132 +1,131 @@ -#' Compute Factor Model ES Decomposition -#' -#' Compute the factor model factor expected shortfall (ES) decomposition for an -#' asset based on Euler's theorem given historic or simulated data and factor -#' model parameters. The partial derivative of ES with respect to factor beta -#' is computed as the expected factor return given fund return is less than or -#' equal to its value-at-risk (VaR). VaR is compute as the sample quantile of -#' the historic or simulated data. -#' -#' The factor model has the form \cr \code{R(t) = beta'F(t) + e(t) = beta.star'F.star(t)}\cr -#' where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' By Euler's -#' theorem:\cr \code{ES.fm = sum(cES.fm) = sum(beta.star*mES.fm)} \cr -#' -#' @param Data \code{B x (k+2)} matrix of historic or simulated data. The first -#' column contains the fund returns, the second through \code{k+1}st columns -#' contain the returns on the \code{k} factors, and the \code{(k+2)}nd column -#' contain residuals scaled to have unit variance. -#' @param beta.vec \code{k x 1} vector of factor betas. -#' @param sig2.e scalar, residual variance from factor model. -#' @param tail.prob scalar, tail probability for VaR quantile. Typically 0.01 -#' or 0.05. -#' @param VaR.method character, method for computing VaR. Valid choices are -#' one of "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} -#' in the PerformanceAnalytics package. -#' -#' -#' @return A list with the following components: -#' \itemize{ -#' \item{VaR} {Scalar, nonparametric VaR value for fund reported as a -#' positive number.} -#' \item{n.exceed} Scalar, number of observations beyond VaR. -#' \item{idx.exceed} n.exceed x 1 vector giving index values of exceedences. -#' \item{ES.fm} Scalar. nonparametric ES value for fund reported as a positive number. -#' \item{mES.fm} (K+1) x 1 vector of factor marginal contributions to ES. -#' \item{cES.fm} (K+1) x 1 vector of factor component contributions to ES. -#' \item{pcES.fm} (K+1) x 1 vector of factor percentage component contributions to ES. -#' } -#' @author Eric Zviot and Yi-An Chen. -#' @references \enumerate{ -#' \item Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A -#' General Analysis", The Journal of Risk 5/2. -#' \item Yamai and Yoshiba (2002)."Comparative Analyses of Expected Shortfall and Value-at-Risk: Their -#' Estimation Error, Decomposition, and Optimization Bank of Japan. -#' \item Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk. -#' \item Epperlein and Smillie (2006) "Cracking VAR with Kernels," Risk. -#' } -#' @examples -#' -#' data(managers.df) -#' fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' # risk factor contribution to ETL -#' # combine fund returns, factor returns and residual returns for HAM1 -#' tmpData = cbind(managers.df[,1],managers.df[,c("EDHEC.LS.EQ","SP500.TR")] , -#' residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.variance[1])) -#' colnames(tmpData)[c(1,4)] = c("HAM1", "residual") -#' factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit.macro$beta[1,], -#' fit.macro$resid.variance[1], tail.prob=0.05, -#' VaR.method="historical" ) -#' -#' # fundamental factor model -#' # try to find factor contribution to ES for STI -#' data(Stock.df) -#' fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP") -#' , data=stock,returnsvar = "RETURN",datevar = "DATE", -#' assetvar = "TICKER", -#' wls = TRUE, regression = "classic", -#' covariance = "classic", full.resid.cov = FALSE) -#' idx <- fit.fund$data[,fit.fund$assetvar] == "STI" -#' asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] -#' tmpData = cbind(asset.ret, fit.fund$factor.returns, -#' fit.fund$residuals[,"STI"]/sqrt(fit.fund$resid.variance["STI"]) ) -#' colnames(tmpData)[c(1,length(tmpData[1,]))] = c("STI", "residual") -#' factorModelEsDecomposition(tmpData, -#' fit.fund$beta["STI",], -#' fit.fund$resid.variance["STI"], tail.prob=0.05,VaR.method="historical") -#' -#' @export -#' -factorModelEsDecomposition <- -function(Data, beta.vec, sig2.e, tail.prob = 0.05, - VaR.method=c("modified", "gaussian", "historical", "kernel")) { - - require(PerformanceAnalytics) - Data = as.matrix(Data) - ncol.Data = ncol(Data) - if(is.matrix(beta.vec)) { - beta.names = c(rownames(beta.vec), "residual") - } else if(is.vector(beta.vec)) { - beta.names = c(names(beta.vec), "residual") - } else { - stop("beta.vec is not an n x 1 matrix or a vector") - } - beta.names = c(names(beta.vec), "residual") - beta.star.vec = c(beta.vec, sqrt(sig2.e)) - names(beta.star.vec) = beta.names - - ## epsilon is calculated in the sense of minimizing mean square error by Silverman 1986 - epi <- 2.575*sd(Data[,1]) * (nrow(Data)^(-1/5)) - VaR.fm = as.numeric(VaR(Data[, 1], p=(1-tail.prob),method=VaR.method)) - idx = which(Data[, 1] <= VaR.fm + epi & Data[,1] >= VaR.fm - epi) - - - - ES.fm = -mean(Data[idx, 1]) - - ## - ## compute marginal contribution to ES - ## - ## compute marginal ES as expected value of factor return given fund - ## return is less than or equal to VaR - mcES.fm = -as.matrix(colMeans(Data[idx, -1])) - -## compute correction factor so that sum of weighted marginal ES adds to portfolio ES -cf = as.numeric( ES.fm / sum(mcES.fm*beta.star.vec) ) -mcES.fm = cf*mcES.fm -cES.fm = mcES.fm*beta.star.vec -pcES.fm = cES.fm/ES.fm -colnames(mcES.fm) = "MCES" -colnames(cES.fm) = "CES" -colnames(pcES.fm) = "PCES" -ans = list(VaR.fm = -VaR.fm, - n.exceed = length(idx), - idx.exceed = idx, - ES.fm = ES.fm, - mES.fm = t(mcES.fm), - cES.fm = t(cES.fm), - pcES.fm = t(pcES.fm)) -return(ans) -} - +#' Compute Factor Model ES Decomposition +#' +#' Compute the factor model factor expected shortfall (ES) decomposition for an +#' asset based on Euler's theorem given historic or simulated data and factor +#' model parameters. The partial derivative of ES with respect to factor beta +#' is computed as the expected factor return given fund return is less than or +#' equal to its value-at-risk (VaR). VaR is compute as the sample quantile of +#' the historic or simulated data. +#' +#' The factor model has the form \cr \code{R(t) = beta'F(t) + e(t) = beta.star'F.star(t)}\cr +#' where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' By Euler's +#' theorem:\cr \code{ES.fm = sum(cES.fm) = sum(beta.star*mES.fm)} \cr +#' +#' @param Data \code{B x (k+2)} matrix of historic or simulated data. The first +#' column contains the fund returns, the second through \code{k+1}st columns +#' contain the returns on the \code{k} factors, and the \code{(k+2)}nd column +#' contain residuals scaled to have unit variance. +#' @param beta.vec \code{k x 1} vector of factor betas. +#' @param sig2.e scalar, residual variance from factor model. +#' @param tail.prob scalar, tail probability for VaR quantile. Typically 0.01 +#' or 0.05. +#' @param VaR.method character, method for computing VaR. Valid choices are +#' one of "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} +#' in the PerformanceAnalytics package. +#' +#' +#' @return A list with the following components: +#' \itemize{ +#' \item{VaR} {Scalar, nonparametric VaR value for fund reported as a +#' positive number.} +#' \item{n.exceed} Scalar, number of observations beyond VaR. +#' \item{idx.exceed} n.exceed x 1 vector giving index values of exceedences. +#' \item{ES.fm} Scalar. nonparametric ES value for fund reported as a positive number. +#' \item{mES.fm} (K+1) x 1 vector of factor marginal contributions to ES. +#' \item{cES.fm} (K+1) x 1 vector of factor component contributions to ES. +#' \item{pcES.fm} (K+1) x 1 vector of factor percentage component contributions to ES. +#' } +#' @author Eric Zviot and Yi-An Chen. +#' @references \enumerate{ +#' \item Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A +#' General Analysis", The Journal of Risk 5/2. +#' \item Yamai and Yoshiba (2002)."Comparative Analyses of Expected Shortfall and Value-at-Risk: Their +#' Estimation Error, Decomposition, and Optimization Bank of Japan. +#' \item Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk. +#' \item Epperlein and Smillie (2006) "Cracking VAR with Kernels," Risk. +#' } +#' @examples +#' +#' data(managers.df) +#' fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), +#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS") +#' # risk factor contribution to ETL +#' # combine fund returns, factor returns and residual returns for HAM1 +#' tmpData = cbind(managers.df[,1],managers.df[,c("EDHEC.LS.EQ","SP500.TR")] , +#' residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.variance[1])) +#' colnames(tmpData)[c(1,4)] = c("HAM1", "residual") +#' factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit.macro$beta[1,], +#' fit.macro$resid.variance[1], tail.prob=0.05, +#' VaR.method="historical" ) +#' +#' # fundamental factor model +#' # try to find factor contribution to ES for STI +#' data(Stock.df) +#' fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP") +#' , data=stock,returnsvar = "RETURN",datevar = "DATE", +#' assetvar = "TICKER", +#' wls = TRUE, regression = "classic", +#' covariance = "classic", full.resid.cov = FALSE) +#' idx <- fit.fund$data[,fit.fund$assetvar] == "STI" +#' asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] +#' tmpData = cbind(asset.ret, fit.fund$factor.returns, +#' fit.fund$residuals[,"STI"]/sqrt(fit.fund$resid.variance["STI"]) ) +#' colnames(tmpData)[c(1,length(tmpData[1,]))] = c("STI", "residual") +#' factorModelEsDecomposition(tmpData, +#' fit.fund$beta["STI",], +#' fit.fund$resid.variance["STI"], tail.prob=0.05,VaR.method="historical") +#' +#' @export +#' +factorModelEsDecomposition <- +function(Data, beta.vec, sig2.e, tail.prob = 0.05, + VaR.method=c("modified", "gaussian", "historical", "kernel")) { + + Data = as.matrix(Data) + ncol.Data = ncol(Data) + if(is.matrix(beta.vec)) { + beta.names = c(rownames(beta.vec), "residual") + } else if(is.vector(beta.vec)) { + beta.names = c(names(beta.vec), "residual") + } else { + stop("beta.vec is not an n x 1 matrix or a vector") + } + beta.names = c(names(beta.vec), "residual") + beta.star.vec = c(beta.vec, sqrt(sig2.e)) + names(beta.star.vec) = beta.names + + ## epsilon is calculated in the sense of minimizing mean square error by Silverman 1986 + epi <- 2.575*sd(Data[,1]) * (nrow(Data)^(-1/5)) + VaR.fm = as.numeric(VaR(Data[, 1], p=(1-tail.prob),method=VaR.method)) + idx = which(Data[, 1] <= VaR.fm + epi & Data[,1] >= VaR.fm - epi) + + + + ES.fm = -mean(Data[idx, 1]) + + ## + ## compute marginal contribution to ES + ## + ## compute marginal ES as expected value of factor return given fund + ## return is less than or equal to VaR + mcES.fm = -as.matrix(colMeans(Data[idx, -1])) + +## compute correction factor so that sum of weighted marginal ES adds to portfolio ES +cf = as.numeric( ES.fm / sum(mcES.fm*beta.star.vec) ) +mcES.fm = cf*mcES.fm +cES.fm = mcES.fm*beta.star.vec +pcES.fm = cES.fm/ES.fm +colnames(mcES.fm) = "MCES" +colnames(cES.fm) = "CES" +colnames(pcES.fm) = "PCES" +ans = list(VaR.fm = -VaR.fm, + n.exceed = length(idx), + idx.exceed = idx, + ES.fm = ES.fm, + mES.fm = t(mcES.fm), + cES.fm = t(cES.fm), + pcES.fm = t(pcES.fm)) +return(ans) +} + Modified: pkg/FactorAnalytics/R/factorModelMonteCarlo.R =================================================================== --- pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-06-20 20:56:58 UTC (rev 3432) +++ pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-06-21 05:59:41 UTC (rev 3433) @@ -1,157 +1,154 @@ -#' Simulate returns using factor model Monte Carlo method. -#' -#' Simulate returns using factor model Monte Carlo method. Parametric method -#' like normal distribution, Cornish-Fisher and skew-t distribution for -#' residuals can be selected. Resampling method such as non-parametric bootstrap -#' or stationary bootstrap can be selected. -#' -#' The factor model Monte Carlo method is described in Jiang (2009). -#' -#' @param n.boot Integer number of bootstrap samples. -#' @param factorData \code{n.months x n.funds} matrix or data.frame of factor -#' returns. -#' @param Beta.mat \code{n.funds x n.factors} matrix of factor betas. -#' @param Alpha.mat \code{n.funds x 1} matrix of factor alphas (intercepts). If -#' \code{NULL} then assume that all alphas are zero. -#' @param residualData \code{n.funds x n.parms} matrix of residual distribution -#' parameters. The columns of \code{residualData} depend on the value of -#' \code{residual.dist}. If \code{residual.dist = "normal"}, then -#' \code{residualData} has one column containing variance values; if -#' \code{residual.dist = "Cornish-Fisher"}, then \code{residualData} has three -#' columns containing variance, skewness and excess kurtosis values; if -#' \code{residual.dist="skew-t"}, then \code{residualData} has four columns -#' containing location, scale, shape, and df values. -#' @param residual.dist character vector specifying the residual distribution. -#' Choices are "normal" for the normal distribution; "Cornish-Fisher" for the -#' Cornish-Fisher distribution based on the Cornish-Fisher expansion of the -#' normal distribution quantile; "skew-t" for the skewed Student's t -#' distribution of Azzalini and Captiano. -#' @param boot.method character vector specifying the resampling method. -#' Choices are "random" for random sampling with replacement (non-parametric -#' bootstrap); "block" for stationary block bootstrapping. -#' @param seed integer random number seed used for resampling the factor -#' returns. -#' @param return.factors logical; if \code{TRUE} then return resampled factors -#' in output list object. -#' @param return.residuals logical; if \code{TRUE} then return simulated -#' residuals in output list object. -#' @return A list with the following components: -#' \itemize{ -#' \item{returns} \code{n.boot x n.funds} matrix of simulated fund -#' returns. -#' \item{factors} \code{n.boot x n.factors} matrix of resampled factor -#' returns. Returned only if \code{return.factors = TRUE}. -#' \item{residuals} \code{n.boot x n.funds} matrix of simulated fund -#' residuals. Returned only if \code{return.residuals = TRUE}. -#' } -#' @author Eric Zivot and Yi-An Chen. -#' @references Jiang, Y. (2009). UW PhD Thesis. -#' @export -#' @examples -#' -#' # load data from the database -#' data(managers.df) -#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' factorData= managers.df[,c("EDHEC.LS.EQ","SP500.TR")] -#' Beta.mat=fit$beta -#' residualData=as.matrix(fit$resid.variance,1,6) -#' n.boot=1000 -#' # bootstrap returns data from factor model with residuals sample from normal distribution -#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="normal", -#' residualData, Alpha.mat=NULL, boot.method="random", -#' seed = 123, return.factors = "TRUE", return.residuals = -#' "TRUE") -#' # Cornish-Fisher distribution -#' # build different residualData matrix -#' residualData <- cbind(c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,2,1,0)) -#' colnames(residualData) <- c("var","skew","ekurt") -#' rownames(residualData) <- colnames(managers.df[,(1:6)]) -#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="Cornish-Fisher", -#' residualData, Alpha.mat=NULL, boot.method="random", -#' seed = 123, return.factors = "TRUE", return.residuals = -#' "TRUE") -#' -#' -#' # skew-t distribution -#' # build residualData matrix -#' residualData <- cbind(rnorm(6),c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,6,10,100)) -#' colnames(residualData) <- c("xi","omega","alpha","nu") -#' rownames(residualData) <- colnames(managers.df[,(1:6)]) -#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="skew-t", -#' residualData, Alpha.mat=NULL, boot.method="random", -#' seed = 123, return.factors = "TRUE", return.residuals = -#' "TRUE") -#' -factorModelMonteCarlo <- - function (n.boot = 1000, factorData, Beta.mat, Alpha.mat = NULL, - residualData, residual.dist = c("normal", "Cornish-Fisher", - "skew-t"), boot.method = c("random", "block"), seed = 123, - return.factors = FALSE, return.residuals = FALSE) - { - require(tseries) - require(sn) - require(PerformanceAnalytics) - boot.method = boot.method[1] - residual.dist = residual.dist[1] - set.seed(seed) - if (nrow(Beta.mat) != nrow(residualData)) { - stop("Beta.mat and residualData have different number of rows") - } - factorData = as.matrix(factorData) - n.funds = nrow(Beta.mat) - fund.names = rownames(Beta.mat) - if (is.null(Alpha.mat)) { - Alpha.mat = matrix(0, nrow(Beta.mat)) - rownames(Alpha.mat) = fund.names - } - if (boot.method == "random") { - bootIdx = sample(nrow(factorData), n.boot, replace = TRUE) - } - else { - n.samples = round(n.boot/nrow(factorData)) - n.adj = n.boot - n.samples * nrow(factorData) - bootIdx = as.vector(tsbootstrap(1:nrow(factorData), nb = n.samples)) - if (n.adj > 0) { - bootIdx = c(bootIdx, bootIdx[1:n.adj]) - } - } - factorDataBoot = factorData[bootIdx, ] - fundReturnsBoot = matrix(0, n.boot, n.funds) - residualsSim = matrix(0, n.boot, n.funds) - colnames(fundReturnsBoot) = colnames(residualsSim) = fund.names - for (i in fund.names) { - set.seed(which(fund.names == i)) - if (residual.dist == "normal") { - residualsSim[, i] = rnorm(n.boot, sd = sqrt(residualData[i, - ])) - } - else if (residual.dist == "Cornish-Fisher") { - residualsSim[, i] = rCornishFisher(n.boot, sigma = sqrt(residualData[i, - "var"]), skew = residualData[i, "skew"], ekurt = residualData[i, - "ekurt"]) - } - else if (residual.dist == "skew-t") { - residualsSim[, i] = rst(n.boot, xi = residualData[i, - "xi"], omega = residualData[i, "omega"], - alpha = residualData[i, "alpha"], nu = residualData[i, - "nu"]) - } - else { - stop("Invalid residual distribution") - } - fundReturnsBoot[, i] = Alpha.mat[i, 1] + factorDataBoot[, - colnames(Beta.mat)] %*% t(Beta.mat[i, , drop = FALSE]) + - residualsSim[, i] - } - ans = list(returns = fundReturnsBoot) - if (return.factors) { - ans$factors = factorDataBoot - } - if (return.residuals) { - ans$residuals = residualsSim - } - return(ans) - } - +#' Simulate returns using factor model Monte Carlo method. +#' +#' Simulate returns using factor model Monte Carlo method. Parametric method +#' like normal distribution, Cornish-Fisher and skew-t distribution for +#' residuals can be selected. Resampling method such as non-parametric bootstrap +#' or stationary bootstrap can be selected. +#' +#' The factor model Monte Carlo method is described in Jiang (2009). +#' +#' @param n.boot Integer number of bootstrap samples. +#' @param factorData \code{n.months x n.funds} matrix or data.frame of factor +#' returns. +#' @param Beta.mat \code{n.funds x n.factors} matrix of factor betas. +#' @param Alpha.mat \code{n.funds x 1} matrix of factor alphas (intercepts). If +#' \code{NULL} then assume that all alphas are zero. +#' @param residualData \code{n.funds x n.parms} matrix of residual distribution +#' parameters. The columns of \code{residualData} depend on the value of +#' \code{residual.dist}. If \code{residual.dist = "normal"}, then +#' \code{residualData} has one column containing variance values; if +#' \code{residual.dist = "Cornish-Fisher"}, then \code{residualData} has three +#' columns containing variance, skewness and excess kurtosis values; if +#' \code{residual.dist="skew-t"}, then \code{residualData} has four columns +#' containing location, scale, shape, and df values. +#' @param residual.dist character vector specifying the residual distribution. +#' Choices are "normal" for the normal distribution; "Cornish-Fisher" for the +#' Cornish-Fisher distribution based on the Cornish-Fisher expansion of the +#' normal distribution quantile; "skew-t" for the skewed Student's t +#' distribution of Azzalini and Captiano. +#' @param boot.method character vector specifying the resampling method. +#' Choices are "random" for random sampling with replacement (non-parametric +#' bootstrap); "block" for stationary block bootstrapping. +#' @param seed integer random number seed used for resampling the factor +#' returns. +#' @param return.factors logical; if \code{TRUE} then return resampled factors +#' in output list object. +#' @param return.residuals logical; if \code{TRUE} then return simulated +#' residuals in output list object. +#' @return A list with the following components: +#' \itemize{ +#' \item{returns} \code{n.boot x n.funds} matrix of simulated fund +#' returns. +#' \item{factors} \code{n.boot x n.factors} matrix of resampled factor +#' returns. Returned only if \code{return.factors = TRUE}. +#' \item{residuals} \code{n.boot x n.funds} matrix of simulated fund +#' residuals. Returned only if \code{return.residuals = TRUE}. +#' } +#' @author Eric Zivot and Yi-An Chen. +#' @references Jiang, Y. (2009). UW PhD Thesis. +#' @export +#' @examples +#' +#' # load data from the database +#' data(managers.df) +#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), +#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS") +#' factorData= managers.df[,c("EDHEC.LS.EQ","SP500.TR")] +#' Beta.mat=fit$beta +#' residualData=as.matrix(fit$resid.variance,1,6) +#' n.boot=1000 +#' # bootstrap returns data from factor model with residuals sample from normal distribution +#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="normal", +#' residualData, Alpha.mat=NULL, boot.method="random", +#' seed = 123, return.factors = "TRUE", return.residuals = +#' "TRUE") +#' # Cornish-Fisher distribution +#' # build different residualData matrix +#' residualData <- cbind(c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,2,1,0)) +#' colnames(residualData) <- c("var","skew","ekurt") +#' rownames(residualData) <- colnames(managers.df[,(1:6)]) +#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="Cornish-Fisher", +#' residualData, Alpha.mat=NULL, boot.method="random", +#' seed = 123, return.factors = "TRUE", return.residuals = +#' "TRUE") +#' +#' +#' # skew-t distribution +#' # build residualData matrix +#' residualData <- cbind(rnorm(6),c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,6,10,100)) +#' colnames(residualData) <- c("xi","omega","alpha","nu") +#' rownames(residualData) <- colnames(managers.df[,(1:6)]) +#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="skew-t", +#' residualData, Alpha.mat=NULL, boot.method="random", +#' seed = 123, return.factors = "TRUE", return.residuals = +#' "TRUE") +#' +factorModelMonteCarlo <- + function (n.boot = 1000, factorData, Beta.mat, Alpha.mat = NULL, + residualData, residual.dist = c("normal", "Cornish-Fisher", + "skew-t"), boot.method = c("random", "block"), seed = 123, + return.factors = FALSE, return.residuals = FALSE) + { + boot.method = boot.method[1] + residual.dist = residual.dist[1] + set.seed(seed) + if (nrow(Beta.mat) != nrow(residualData)) { + stop("Beta.mat and residualData have different number of rows") + } + factorData = as.matrix(factorData) + n.funds = nrow(Beta.mat) + fund.names = rownames(Beta.mat) + if (is.null(Alpha.mat)) { + Alpha.mat = matrix(0, nrow(Beta.mat)) + rownames(Alpha.mat) = fund.names + } + if (boot.method == "random") { + bootIdx = sample(nrow(factorData), n.boot, replace = TRUE) + } + else { + n.samples = round(n.boot/nrow(factorData)) + n.adj = n.boot - n.samples * nrow(factorData) + bootIdx = as.vector(tsbootstrap(1:nrow(factorData), nb = n.samples)) + if (n.adj > 0) { + bootIdx = c(bootIdx, bootIdx[1:n.adj]) + } + } + factorDataBoot = factorData[bootIdx, ] + fundReturnsBoot = matrix(0, n.boot, n.funds) + residualsSim = matrix(0, n.boot, n.funds) + colnames(fundReturnsBoot) = colnames(residualsSim) = fund.names + for (i in fund.names) { + set.seed(which(fund.names == i)) + if (residual.dist == "normal") { + residualsSim[, i] = rnorm(n.boot, sd = sqrt(residualData[i, + ])) + } + else if (residual.dist == "Cornish-Fisher") { + residualsSim[, i] = rCornishFisher(n.boot, sigma = sqrt(residualData[i, + "var"]), skew = residualData[i, "skew"], ekurt = residualData[i, + "ekurt"]) + } + else if (residual.dist == "skew-t") { + residualsSim[, i] = rst(n.boot, xi = residualData[i, + "xi"], omega = residualData[i, "omega"], + alpha = residualData[i, "alpha"], nu = residualData[i, + "nu"]) + } + else { + stop("Invalid residual distribution") + } + fundReturnsBoot[, i] = Alpha.mat[i, 1] + factorDataBoot[, + colnames(Beta.mat)] %*% t(Beta.mat[i, , drop = FALSE]) + + residualsSim[, i] + } + ans = list(returns = fundReturnsBoot) + if (return.factors) { + ans$factors = factorDataBoot + } + if (return.residuals) { + ans$residuals = residualsSim + } + return(ans) + } + Deleted: pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r =================================================================== --- pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r 2014-06-20 20:56:58 UTC (rev 3432) +++ pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r 2014-06-21 05:59:41 UTC (rev 3433) @@ -1,239 +0,0 @@ -#' Compute performance attribution -#' -#' Decompose total returns into returns attributed to factors and specific returns. -#' Class of FM.attribution is generated and generic function \code{plot()} and \code{summary()},\code{print()} can be applied. -#' -#' Total returns can be decomposed into returns attributed to factors and -#' specific returns. \cr \eqn{R_t = \sum b_j * f_jt + u_t,t=1...T} \cr -#' \code{b_j} is exposure to factor j and \code{f_jt} is factor j. -#' The returns attributed to factor j is \code{b_j * f_jt} and specific -#' returns is \code{u_t}. -#' -#' @param fit Class of "TimeSeriesFactorModel", "FundamentalFactorModel" or -#' "statFactorModel". [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3433 From noreply at r-forge.r-project.org Sun Jun 22 22:46:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 22 Jun 2014 22:46:33 +0200 (CEST) Subject: [Returnanalytics-commits] r3434 - pkg/PerformanceAnalytics/vignettes Message-ID: <20140622204634.11CB8186AAE@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-22 22:46:33 +0200 (Sun, 22 Jun 2014) New Revision: 3434 Added: pkg/PerformanceAnalytics/vignettes/portfolio_returns.Rnw Log: Adding first draft of portfolio returns vignette Added: pkg/PerformanceAnalytics/vignettes/portfolio_returns.Rnw =================================================================== --- pkg/PerformanceAnalytics/vignettes/portfolio_returns.Rnw (rev 0) +++ pkg/PerformanceAnalytics/vignettes/portfolio_returns.Rnw 2014-06-22 20:46:33 UTC (rev 3434) @@ -0,0 +1,269 @@ +\documentclass{article} +\usepackage{amsmath} +\usepackage{verbatim} + +\begin{document} + +\section{Basic definitions} + +Suppose we have a portfolio of $N$ assets. + +The value of asset $i$ in the portfolio is defined as + +\begin{eqnarray*} +V_i = \lambda_i * P_i +\end{eqnarray*} + +where: +\begin{eqnarray*} +\lambda_i \text{ is the number of shares of asset $i$}\\ +P_i \text{ is the price of asset $i$}\\ +\end{eqnarray*} + +The total portfolio value is defined as +\begin{eqnarray*} +V_P = \sum_{i=1}^N V_i +\end{eqnarray*} + +The weight of asset $i$ in the portfolio is defined as + +\begin{eqnarray*} +w_i = V_i / V_P +\end{eqnarray*} + +where: +\begin{eqnarray*} +V_i \text{ is the value of asset $i$}\\ +V_P \text{ is the total value of the portfolio}\\ +\end{eqnarray*} + +The portfolio return at time $t$ is defined as + +\begin{eqnarray*} +R_t = \frac{V_t - V_{t-1}}{V_{t-1}} +\end{eqnarray*} + +\section{Simple Example: Prices and Shares Framework} +Suppose we have a portfolio of $N = 2$ assets, asset A and asset B. The prices for assets A and B are given as: + +<<>>= +prices = cbind(c(5, 7, 6, 7), + c(10, 11, 12, 8)) +dimnames(prices) = list(paste0("t",0:3), c("A", "B")) +prices +@ + + +We wish to form an equal weight portfolio, that is, form a portfolio where +\begin{equation*} +w_i = \frac{1}{N} \text{ for } i \in 1, \hdots, N. +\end{equation*} + +Let $V_{P0} = 1000$ be the portfolio value at $t_0$. + +Step 1: Compute the number of shares of each asset to purchase. +\begin{eqnarray*} +w_i &=& \frac{V_i}{V_P}\\ +&=& \frac{\lambda_i * P_i}{V_P}\\ +\end{eqnarray*} + +Solve for $\lambda_i$. +\begin{eqnarray*} +\lambda_i &=& \frac{w_i * V_P}{P_i} +\end{eqnarray*} + +\begin{eqnarray*} +\lambda_A &=& \frac{w_A * V_P0}{P_A} = \frac{0.5 * \$1000}{\$5} = 100\\ +\lambda_B &=& \frac{w_B * V_P0}{P_B} = \frac{0.5 * \$1000}{\$10} = 50\\ +\end{eqnarray*} + +<<>>= +V_P0 = 1000 +N = ncol(prices) +w = rep(1 / N, N) +lambda = w * V_P0 / prices["t0",] +lambda +@ + + +Step 2: Compute the asset value and portfolio value for $t \in 0, \hdots, 3$. +<<>>= +# Compute the value of the assets +V_assets <- matrix(0, nrow(prices), ncol(prices), dimnames=dimnames(prices)) +for(i in 1:nrow(prices)){ + V_assets[i,] = prices[i,] * lambda +} +V_assets +@ + +<<>>= +# Compute the value of the portfolio +V_P = rowSums(V_assets) +V_P +@ + + +Step 3: Compute the portfolio returns for $t \in 1, \hdots, 3$. +<<>>= +# Compute the portfolio returns +R_t = diff(V_P) / V_P[1:3] +R_t +@ + + +Step 4: Compute the weights of each asset in the portfolio for $t \in 0, \hdots, 3$ +<<>>= +weights = V_assets / V_P +weights +@ + +We have shown that calculating portfolio weights, values, and returns is simple in a prices and shares framework. However, calculating these metrics becomes more of a challenge in a weights and returns framework. + +\section{Example: Weights and Returns Framework} + +For this example, we will use the monthly returns during 1997 of the first 5 assets in the edhec dataset. + +<<>>= +library(PerformanceAnalytics) +data(edhec) +R = edhec["1997", 1:5] +colnames(R) = c("CA", "CTAG", "DS", "EM", "EMN") +R +@ + +Suppose that on 1996-12-31 we wish to form an equal weight portfolio such that the weight for asset $i$ is given as: + +\begin{equation*} +w_i = frac{1 / N} \quad \text{for } i \in 1, \hdots, N +\end{equation*} + +where $N$ is equal to the number of assets. + +<<>>= +N = ncol(R) +weights = xts(matrix(rep(1 / N, N), 1), as.Date("1996-12-31")) +colnames(weights) = colnames(R) +weights +@ + +There are two cases we need to consider when calculating the beginning of period (bop) value. + +Case 1: The beginning of period $t$ is a rebalancing event. For example, the rebalance weights at the end of \verb"1996-12-31" take effect at the beginning of \verb"1997-01-31". This means that the beginning of \verb"1997-01-31" is considered a rebalance event. + +The beginning of period value for asset $i$ at time $t$ is given as: + +\begin{equation*} +V_{{bop}_{t,i}} = w_i * V_{t-1} +\end{equation*} + +where $w_i$ is the weight of asset $i$ and $V_{t-1}$ is the end of period (eop) portfolio value of the prior period. + +Case 2: The beginning of period $t$ is not a rebalancing event. +\begin{equation*} +V_{{bop}_{t,i}} = V_{{eop}_{t-1,i}} +\end{equation*} + +where $V_{{eop}_{t,i}}$ is the end of period value for asset $i$ from the prior period. + +The end of period value for asset $i$ at time $t$ is given as: +\begin{equation*} +V_{{eop}_{t,i}} = (1 + R_{t,i}) * V_{{bop}_{t,i}} +\end{equation*} + +Here we demonstrate this and compute values for the periods 1 and 2. + +For the first period, $t=1$, we need an initial value for the portfolio value. Let $V_0 = 1$ denote the initial portfolio value. Note that the initial portfolio value can be any arbitrary number. Here we use $V_0 = 1$ for simplicity. + +<<>>= +V_0 = 1 +bop_value = eop_value = matrix(0, 2, ncol(R)) +@ + +Compute the values for $t=1$. +<<>>= +t = 1 +bop_value[t,] = coredata(weights) * V_0 +eop_value[t,] = coredata(1 + R[t,]) * bop_value[t,] +@ + +Now compute the values for $t=2$. +<<>>= +t = 2 +bop_value[t,] = eop_value[t-1,] +eop_value[t,] = coredata(1 + R[t,]) * bop_value[t,] +@ + +It is easily seen that the values for the rest of the time periods can be computed by iterating over $ t \in 1, \hdots, T$ where $T=12$ in this example. + +The weight of asset $i$ at time $t$ is calculated as: +\begin{equation*} +w_{t,i} = \frac{V_{t,i}}{\sum_{i=0}^N V_{t,i}} +\end{equation*} + +Here we compute the beginning and end of period weights. +<<>>= +bop_weights = eop_weights = matrix(0, 2, ncol(R)) +for(t in 1:2){ + bop_weights[t,] = bop_value[t,] / sum(bop_value[t,]) + eop_weights[t,] = eop_value[t,] / sum(eop_value[t,]) +} +bop_weights +eop_weights +@ + +The portfolio returns for time $t$ are calculated as: + +\begin{equation*} +R_{P_t} = \frac{V_t - V_{t-1}}{V_{t-1}} +\end{equation*} + +<<>>= +V = c(V_0, rowSums(eop_value)) +R_P = diff(V) / V[1:2] +R_P +@ + + +The contribution of asset $i$ at time $t$ is calculated as: + +\begin{equation*} +contribution_{t,i} = \frac{V_{{eop}_{t,i}} - V_{{bop}_{t,i}}}{\sum_{i=1}^N V_{{bop}_{t,i}}} +\end{equation*} + +<<>>= +contribution = matrix(0, 2, ncol(R)) +for(t in 1:2){ + contribution[t,] = (eop_value[t,] - bop_value[t,]) / sum(bop_value[t,]) +} +contribution +@ + +Note that contribution can also be calculated as: +\begin{equation*} +contribution_{t,i} = R_{t,i} * w_{t,i} +\end{equation*} + +\section{Return.portfolio Examples} + +<<>>= +args(Return.portfolio) +@ + + +If no \verb"weights" are specified, then an equal weight portfolio is computed. Also, if \verb"rebalance_on=NA" then a buy and hold portfolio is assumed. See \verb"?Return.portfolio" for a detailed explanation of the function and arguments. + +<>= +# Equally weighted, buy and hold portfolio returns +Return.portfolio(R) + +# Equally weighted, rebalanced quarterly portfolio returns +Return.portfolio(R, rebalance_on="quarters") + +# Equally weighted, rebalanced quarterly portfolio returns. +# Use verbose=TRUE to return additional information +# including asset values and weights +Return.portfolio(R, rebalance_on="quarters", verbose=TRUE) +@ + + +\end{document} From noreply at r-forge.r-project.org Sun Jun 22 22:48:19 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 22 Jun 2014 22:48:19 +0200 (CEST) Subject: [Returnanalytics-commits] r3435 - pkg/PerformanceAnalytics/sandbox Message-ID: <20140622204819.74992186AB1@r-forge.r-project.org> Author: kecoli Date: 2014-06-22 22:48:19 +0200 (Sun, 22 Jun 2014) New Revision: 3435 Removed: pkg/PerformanceAnalytics/sandbox/PAenhance/ Log: merging Kirk's github work to R-forge From noreply at r-forge.r-project.org Sun Jun 22 22:49:22 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 22 Jun 2014 22:49:22 +0200 (CEST) Subject: [Returnanalytics-commits] r3436 - in pkg/PerformanceAnalytics/sandbox: . PAshiny PAshiny/www PAshiny/www/stylesheets Message-ID: <20140622204922.45651186AB1@r-forge.r-project.org> Author: kecoli Date: 2014-06-22 22:49:22 +0200 (Sun, 22 Jun 2014) New Revision: 3436 Added: pkg/PerformanceAnalytics/sandbox/PAshiny/ pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.Rdata pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.Rdata pkg/PerformanceAnalytics/sandbox/PAshiny/run.R pkg/PerformanceAnalytics/sandbox/PAshiny/server.R pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R pkg/PerformanceAnalytics/sandbox/PAshiny/table.Performance.R pkg/PerformanceAnalytics/sandbox/PAshiny/textArea.js pkg/PerformanceAnalytics/sandbox/PAshiny/ui.R pkg/PerformanceAnalytics/sandbox/PAshiny/www/ pkg/PerformanceAnalytics/sandbox/PAshiny/www/chooser-binding.js pkg/PerformanceAnalytics/sandbox/PAshiny/www/index_1.html pkg/PerformanceAnalytics/sandbox/PAshiny/www/stylesheets/ pkg/PerformanceAnalytics/sandbox/PAshiny/www/stylesheets/jquery-ui.css pkg/PerformanceAnalytics/sandbox/PAshiny/www/stylesheets/style.css pkg/PerformanceAnalytics/sandbox/PAshiny/www/textarea.js Log: merging Kirk's github work to R-forge Shiny interface for table.Performance.R in PAenhance Added: pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js 2014-06-22 20:49:22 UTC (rev 3436) @@ -0,0 +1,84 @@ +(function() { + +function updateChooser(chooser) { + chooser = $(chooser); + var left = chooser.find("select.left"); + var right = chooser.find("select.right"); + var leftArrow = chooser.find(".left-arrow"); + var rightArrow = chooser.find(".right-arrow"); + + var canMoveTo = (left.val() || []).length > 0; + var canMoveFrom = (right.val() || []).length > 0; + + leftArrow.toggleClass("muted", !canMoveFrom); + rightArrow.toggleClass("muted", !canMoveTo); +} + +function move(chooser, source, dest) { + chooser = $(chooser); + var selected = chooser.find(source).children("option:selected"); + var dest = chooser.find(dest); + dest.children("option:selected").each(function(i, e) {e.selected = false;}); + dest.append(selected); + updateChooser(chooser); + chooser.trigger("change"); +} + +$(document).on("change", ".chooser select", function() { + updateChooser($(this).parents(".chooser")); +}); + +$(document).on("click", ".chooser .right-arrow", function() { + move($(this).parents(".chooser"), ".left", ".right"); +}); + +$(document).on("click", ".chooser .left-arrow", function() { + move($(this).parents(".chooser"), ".right", ".left"); +}); + +$(document).on("dblclick", ".chooser select.left", function() { + move($(this).parents(".chooser"), ".left", ".right"); +}); + +$(document).on("dblclick", ".chooser select.right", function() { + move($(this).parents(".chooser"), ".right", ".left"); +}); + +var binding = new Shiny.InputBinding(); + +binding.find = function(scope) { + return $(scope).find(".chooser"); +}; + +binding.initialize = function(el) { + updateChooser(el); +}; + +binding.getValue = function(el) { + return { + left: $.makeArray($(el).find("select.left option").map(function(i, e) { return e.value; })), + right: $.makeArray($(el).find("select.right option").map(function(i, e) { return e.value; })) + } +}; + +binding.setValue = function(el, value) { + // TODO: implement +}; + +binding.subscribe = function(el, callback) { + $(el).on("change.chooserBinding", function(e) { + callback(); + }); +}; + +binding.unsubscribe = function(el) { + $(el).off(".chooserBinding"); +}; + +binding.getType = function() { + return "shinyjsexamples.chooser"; +}; + +Shiny.inputBindings.register(binding, "shinyjsexamples.chooser"); + +})(); \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R 2014-06-22 20:49:22 UTC (rev 3436) @@ -0,0 +1,59 @@ +# TODO: Add comment +# +# Author: KirkLi +############################################################################### + + +chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices, + size = 5, multiple = FALSE) { + + leftChoices <- lapply(leftChoices, tags$option) + rightChoices <- lapply(rightChoices, tags$option) + + if (multiple) + multiple <- "multiple" + else + multiple <- NULL + + tagList( + singleton(tags$head( + tags$script(src="chooser-binding.js"), + tags$style(type="text/css", + HTML(".chooser-container { display: inline-block; }") + ) + )), + div(id=inputId, class="chooser", + div(class="chooser-container chooser-left-container", + tags$select(class="left", size=size, multiple=multiple, leftChoices) + ), + div(class="chooser-container chooser-center-container", + icon("arrow-circle-o-right", "right-arrow fa-3x"), + tags$br(), + icon("arrow-circle-o-left", "left-arrow fa-3x") + ), + div(class="chooser-container chooser-right-container", + tags$select(class="right", size=size, multiple=multiple, rightChoices) + ) + ) + ) +} +# +#inputTextarea <- function(inputId, label="",value="", nrows=5, ncols=5) { +# tagList( +# singleton(tags$head(tags$script(src = "textArea.js"))), +# tags$label(label, `for` = inputId), +# tags$textarea(id = inputId, +# class = "inputtextarea", +# rows = nrows, +# cols = ncols, +# as.character(value)) +# ) +#} + + +registerInputHandler("shinyjsexamples.chooser", function(data, ...) { + if (is.null(data)) + NULL + else + list(left=as.character(data$left), right=as.character(data$right)) + }, force = TRUE) Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.Rdata =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.Rdata ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv 2014-06-22 20:49:22 UTC (rev 3436) @@ -0,0 +1,61 @@ +"","MODI","MGF","MAT","EMN","AMAT","AMGN" +"1997-01-31",0.06542056,-0.02091743,0.01351351,-0.01131222,0.373913,0.03678161 +"1997-02-28",-0.02912281,0.006792453,-0.12,0.009153318,0.02531646,0.08425721 +"1997-03-31",-0.1090909,-0.01222641,-0.02787879,-0.01696145,-0.08395062,-0.08588957 +"1997-04-30",0.09183674,0.02584615,0.1614583,-0.05116279,0.1832884,0.05369128 +"1997-05-30",0.1005607,-0.002943396,0.07174888,0.1666667,0.1890661,0.1358811 +"1997-06-30",0.01709402,0.01592381,0.1362343,0.07462185,0.08524904,-0.1308411 +"1997-07-31",0.05042017,0.03464151,0.02583026,-0.04724409,0.2974404,0.01182796 +"1997-08-29",-0.01392,-0.01218349,-0.03776978,-0.01136364,0.02721088,-0.1572795 +"1997-09-30",0.1387755,0.01562617,-0.007252336,0.04392894,0.009271523,-0.03278688 +"1997-10-31",-0.02329749,-0.003185185,0.1735849,-0.03830645,-0.2992126,0.0273794 +"1997-11-28",0.001908257,0.006130841,0.03054662,0.01257862,-0.01123596,0.03807107 +"1997-12-31",0.005524862,0.005981308,-0.06845554,-0.006169772,-0.08712121,0.05867971 +"1998-01-30",0.02197802,0.02482243,0.08724833,0,0.08921162,-0.07621247 +"1998-02-27",0.009032258,-0.003229358,0.04475309,0.09968521,0.1219048,0.0625 +"1998-03-31",-0.007142857,-0.003481481,-0.06333826,0.03629771,-0.04074703,0.1458824 +"1998-04-30",0.07014389,-0.0315514,-0.03159558,0.01946246,0.02300885,-0.02053388 +"1998-05-29",-0.08006722,0.01576699,-0.01141925,-0.02545455,-0.1141869,0.01467505 +"1998-06-30",0.01838235,0.02523077,0.1192739,-0.06432836,-0.078125,0.08057851 +"1998-07-31",-0.03610108,0.006490566,-0.0915805,-0.08835341,0.1355932,0.123327 +"1998-08-31",-0.1603745,0.0154717,-0.1577236,-0.09140969,-0.266791,-0.1710638 +"1998-09-30",0.04269663,0.01502804,-0.1326641,-0.01328485,0.02798982,0.2412731 +"1998-10-30",0.1293103,0.005481482,0.2857143,0.1648079,0.3737624,0.03970223 +"1998-11-30",0.120916,-0.0222963,-0.03819444,-0.01382979,0.1171171,-0.04216388 +"1998-12-31",-0.006849315,0.005638095,-0.3189892,-0.2200216,0.1016129,0.3895349 +"1999-01-29",-0.2068966,-0.01340952,-0.03457447,-0.09217877,0.4802343,0.2223551 +"1999-02-26",-0.01878261,-0.003961165,0.1625344,0.1615385,-0.1196835,-0.02298288 +"1999-03-31",0.002232143,-0.004,-0.0514692,-0.09928477,0.1089888,0.1991992 +"1999-04-30",0.1135857,0.00570297,0.03759398,0.3239227,-0.1306991,-0.1794658 +"1999-05-28",0.03536,-0.004039604,0.02173913,-0.09090909,0.02564103,0.02950153 +"1999-06-30",0.01361868,0.00592,-0.008416075,0.03091358,0.3431818,-0.03754941 +"1999-07-30",-0.01631478,-0.0036,-0.09569378,-0.001207729,-0.02622673,0.2628337 +"1999-08-31",-0.06403902,-0.01389899,-0.0952381,-0.1015719,-0.01216334,0.08211382 +"1999-09-30",-0.2163866,0.01674227,-0.1069006,-0.1318439,0.09322779,-0.0202855 +"1999-10-29",0.06702413,-0.0242449,-0.2960526,-0.03291536,0.156074,-0.02147239 +"1999-11-30",0.1449246,-0.01431579,0.07009346,0.008103727,0.0848991,0.1426332 +"1999-12-31",-0.1150443,-0.01462366,-0.07668122,0.2380064,0.3001924,0.3182442 +"2000-01-31",-0.01,0.04,-0.2047619,-0.163827,0.08337445,0.0603538 +"2000-02-29",-0.0689899,0.01761702,-0.07784431,-0.09874608,0.332878,0.07065751 +"2000-03-31",0.1013699,0.01743158,0.1002597,0.2783304,0.03040656,-0.09990834 +"2000-04-28",-0.1218905,0.01725,0.172619,0.1497253,0.08023873,-0.08757637 +"2000-05-31",-0.07648725,-0.01352577,0.1015228,-0.1290323,-0.1798649,0.1361607 +"2000-06-30",0.3416149,0.03882105,-0.02101382,0.05766804,0.08532934,0.1041257 +"2000-07-31",0,0.006693878,-0.1611374,-0.01832461,-0.1627586,-0.07562277 +"2000-08-31",0.05092593,0.01689796,-0.1073446,-0.08,0.1375618,0.1674687 +"2000-09-29",0.001666667,-0.003636364,0.1420253,-0.1332754,-0.3128168,-0.07893652 +"2000-10-31",-0.06378259,0.01657143,0.1564246,0.1607445,-0.1043203,-0.1702842 +"2000-11-30",0.0450237,0.006303031,-0.02415459,0.00728863,-0.2388235,0.09816613 +"2000-12-29",-0.2402746,0.05680808,0.1437624,0.138987,-0.05564142,0.004911591 +"2001-01-31",0.2379518,0.01061542,0.02908588,-0.04184617,0.3175123,0.09970675 +"2001-02-28",0.04379562,0.009035219,0.1413189,0.1014772,-0.1602484,0.02488889 +"2001-03-30",-0.03058824,0.007328206,0.04599061,-0.03479105,0.0295858,-0.1647875 +"2001-04-30",0.08271842,-0.01874998,-0.08962797,0.08167412,0.2551724,0.01582553 +"2001-05-31",-0.0781922,0.01499999,0.1021672,-0.05071376,-0.08553111,0.08570491 +"2001-06-29",0.08369348,0.006811108,0.0629214,-0.04887218,-0.01662331,-0.08586919 +"2001-07-31",0.06381436,0.0191654,-0.05391123,-0.07873189,-0.06598774,0.03345416 +"2001-08-31",-0.01431493,0.03262192,0.005027941,-0.1159982,-0.06040123,0.02535487 +"2001-09-28",-0.1426578,-0.01290799,-0.1295164,-0.05284872,-0.3399861,-0.08600315 +"2001-10-31",-0.1558177,0.02311177,0.2088123,-0.05482088,0.1993671,-0.03318021 +"2001-11-30",0.04867471,-0.01750736,-0.02482834,0.1183328,0.1650543,0.1691306 +"2001-12-31",0.0846118,-0.01016698,-0.0657251,0.02840765,0.009058801,-0.1503839 Added: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.Rdata =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.Rdata ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/PAshiny/run.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAshiny/run.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAshiny/run.R 2014-06-22 20:49:22 UTC (rev 3436) @@ -0,0 +1,60 @@ +# TODO: Add comment +# +# Author: kirkli +############################################################################### + + +rm(list=ls()) +# install.packages('devtools') +# install.packages("shiny") +# devtools::install_github('shiny-incubator', 'rstudio') +# install.packages("Rglpk") +# setwd("C:/Dropbox/doug/MVO") +if(!"devtools" %in% rownames(installed.packages())) {install.packages('devtools')} +# In linux, if error occurs, check R-Curl. +if(!"shiny" %in% rownames(installed.packages())) {install.packages('shiny')} +if(!"shinyIncubator" %in% rownames(installed.packages())) {devtools::install_github("shiny-incubator", "rstudio")} +if(!"Rglpk" %in% rownames(installed.packages())) {install.packages('Rglpk')} +if(!"xts" %in% rownames(installed.packages())) {install.packages('xts')} +if(!"corpcor" %in% rownames(installed.packages())) {install.packages('corpcor')} +if(!"quadprog" %in% rownames(installed.packages())) {install.packages('quadprog')} + +library(shinyIncubator) +library(shiny) +library(quadprog) +library(Rglpk) +library(xts) + +# ## +# load("crsp.short.Rdata") +# +# allcap.ts <- merge(merge(smallcap.ts,midcap.ts),largecap.ts) +# stock.names.list <- c(names(smallcap.ts)[1:2],names(midcap.ts)[1:2],names(largecap.ts)[1:2]) +# files <- list(data=allcap.ts[,stock.names.list],group=rep(c(1,2,3),each=2)) +# save(files,file="crsp.short.6.Rdata") +# +# load("crsp.short.6.Rdata") +# files$data +# write.csv(as.data.frame(files$data),file="crsp.short.6.csv",row.names=TRUE) +# write.csv(files$group,file="crsp.short.6.group.csv",row.names=FALSE) +#test <- read.csv("crsp.short.6.csv") +#test2 <- read.csv("crsp.short.6.group.csv") +# +# head(test) +# head(test2) + +result.folder <<- getwd() +code.folder <<- getwd() +setwd(code.folder) +runApp() + + + + + + + + + + + Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/run.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAshiny/server.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAshiny/server.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAshiny/server.R 2014-06-22 20:49:22 UTC (rev 3436) @@ -0,0 +1,210 @@ +# TODO: Add comment +# +# Author: KirkLi +############################################################################### + + +library(shiny) + +source("table.Performance.R") +source("chooser.R") +count <- 0 +# Define server logic for random distribution application +shinyServer(function(input, output) { + + + inputTextarea <- function(inputId, label="",value="", nrows=10, ncols=10) { + tagList( + singleton(tags$head(tags$script(src = "textarea.js"))), + tags$label(label, `for` = inputId), + tags$textarea(id = inputId, + class = "inputtextarea", + rows = nrows, + cols = ncols, + as.character(value)) + ) + } + + output$text <- renderPrint({ +# if(input$goButton1==0) { + if(is.null(input$file1) & input$dataset) + cat("Please load data.\n") +# if (input$dataset==F) +# cat("Example csv file: \n") + else{ + if(!is.null(input$file1))cat("first 10 rows of the return data: \n")} +# } +# else{ + +# } + } + ) + +# output$contents <- renderDataTable({ +## if(input$goButton1==0) { +## test <- read.csv("crsp.short.6.csv") +## head(test) +## } +## else{ +# if(input$dataset==F){ +# mydata <- mydata.raw <- read.csv("crsp.short.6.csv") +# rownames(mydata) <- mydata[,1] +# colnames(mydata.raw)[1] <- "date" +# mydata <- mydata[,-1] +# mydata <<- mydata +# date <- mydata.raw[,1] +# cbind(date,round(mydata,2)) +# }else{ +# if(!is.null(input$file1)){ +# inFile1 <- input$file1 +# mydata <- mydata.raw <- read.csv( +# inFile1$datapath, +# header=input$header1, +# sep=input$sep1, +# quote=input$quote1) +# rownames(mydata) <- mydata[,1] +# colnames(mydata.raw)[1] <- "date" +# mydata <- mydata[,-1] +# mydata <<- mydata +# date <- mydata.raw[,1] +# cbind(date,round(mydata,2)) +# } +# +# } +## } +# }) + + output$summary <- renderDataTable({ +# if(input$goButton1==0) { +# test <- read.csv("crsp.short.6.csv") +# head(test) +# } +# else{ + if(input$dataset==F){ + mydata <- mydata.raw <- read.csv("crsp.short.6.csv") + rownames(mydata) <- mydata[,1] + colnames(mydata.raw)[1] <- "date" + mydata <- mydata[,-1] + mydata <<- mydata + date <- mydata.raw[,1] + cbind(date,round(mydata,2)) + }else{ + if(!is.null(input$file1)){ + inFile1 <- input$file1 + mydata <- mydata.raw <- read.csv( + inFile1$datapath, + header=input$header1, + sep=input$sep1, + quote=input$quote1) + rownames(mydata) <- mydata[,1] + colnames(mydata.raw)[1] <- "date" + mydata <- mydata[,-1] + mydata <<- mydata + date <- mydata.raw[,1] + cbind(date,round(mydata,2))} + + } +# } + }) + + metric.list <- reactive({ + if(length(input$mychooser$right)>=1) + table.Performance.input.shiny(metrics=input$mychooser$right) + else return() + }) +# + nmetric<- reactive({ + length(metric.list()) + }) +# + +# metric.list <-function()table.Performance.input.shiny(metrics="BernardoLedoitRatio") +# +# metric.list() +# + + output$selection <- renderPrint( +# nrows <<- length(input$mychooser$right) + input$mychooser$right + ) + +# + ## metric.list <- function() table.Performance.input.shiny(metrics="ES") + ## metric.list() + + + ct=1:50 + eval(parse(text=paste0("output$para.",ct," <- renderUI({ + if(length(input$mychooser$right)>= ",ct," ){ + count <- ",ct," + inputId = eval(parse(text=paste0('\"para.',count,'\"'))) + label= eval(parse(text=paste0('paste0(names(metric.list())[',count,'],\":\")'))) + value= eval(parse(text=paste0('paste0(names(metric.list()[[',count,']]),\"=\",metric.list()[[',count,']],collapse=\"\n\")'))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=5,ncol=10) + else return() + + } + else return() + })"))) + + + eval(parse(text=paste0("metric.list.m.",ct,"<- reactive({if(length(input$mychooser$right)>=",ct,"){if(length(input$para.",ct,")>0){ + l1 <- unlist(strsplit(input$para.",ct,",'\n')) + l1 <- strsplit(l1,'=') + temp <- metric.list()[[",ct,"]] + temp[unlist(lapply(l1,'[[',1))] <- unlist(lapply(l1,'[[',2))} else return() + temp + } + else{return()} + })"))) + + ## + + output$result <-renderDataTable({ + metrics <- input$mychooser$right + if(length(input$mychooser$right)>0){ + metricsOptArgVal <-list() + string.use <- + paste0("list(",paste0("metric.list.m.",1:50,"()",collapse=","),")") + metricsOptArgVal <- eval(parse(text=string.use + )) + + names(metricsOptArgVal) <- metrics + res <<- table.Performance.output.shiny(R=mydata,metricsOptArgVal= metricsOptArgVal,metrics=metrics,metricsNames=NULL) + cbind(metrics,res) } else return() + }) + + +# output$diag2 <- renderPrint({ +# metrics <- input$mychooser$right +# string.use <- paste0("list(",paste0("metric.list.m.",1:50,"()",collapse=","),")") +# metricsOptArgVal <- eval(parse(text=string.use +# )) +# +# names(metricsOptArgVal) <- metrics +# metricsOptArgVal +# } +# ) + + + output$downloadData <- downloadHandler( + # This function returns a string which tells the client + # browser what name to use when saving the file. + filename = function() { + paste0("PerformanceMetricTable_",Sys.Date(),".",input$filetype) + }, + + # This function should write data to a file given to it by + # the argument 'file'. + content = function(file) { + sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t") + # Write to a file specified by the 'file' argument + write.table(res, file, sep = sep, + row.names = TRUE,col.names=NA) + }) + + + }) + + Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/server.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R 2014-06-22 20:49:22 UTC (rev 3436) @@ -0,0 +1,906 @@ +library(shiny) + +source("table.Performance.R") +source("chooser.R") +count <- 0 +# Define server logic for random distribution application +shinyServer(function(input, output) { + + + inputTextarea <- function(inputId, label="",value="", nrows=10, ncols=10) { + tagList( + singleton(tags$head(tags$script(src = "textarea.js"))), + tags$label(label, `for` = inputId), + tags$textarea(id = inputId, + class = "inputtextarea", + rows = nrows, + cols = ncols, + as.character(value)) + ) + } + + output$text <- renderPrint({ +# if(input$goButton1==0) { + if(is.null(input$file1)) + cat("Please load data.\n") + if (input$dataset==F) + cat("Example csv file: \n") + else{ + if(!is.null(input$file1))cat("first 10 rows of the return data: \n")} +# } +# else{ + +# } + } + ) + + output$contents <- renderTable({ +# if(input$goButton1==0) { +# test <- read.csv("crsp.short.6.csv") +# head(test) +# } +# else{ + if(input$dataset==F){ + mydata1 <<- read.csv("crsp.short.6.csv") + rownames(mydata1) <- mydata1[,1] + mydata <<- mydata1[,-1] + head(mydata) + }else{ + if(!is.null(input$file1)){ + inFile1 <- input$file1 + mydata <- read.csv( + inFile1$datapath, + header=input$header1, + sep=input$sep1, + quote=input$quote1) + rownames(mydata) <- mydata[,1] + mydata <<- mydata[,-1] + head(mydata)} + + } +# } + }) + + output$summary <- renderTable({mydata}) + metric.list <- reactive({ + if(length(input$mychooser$right)>=1) + table.Performance.input.shiny(metrics=input$mychooser$right) + else return() + }) +# + nmetric<- reactive({ + length(metric.list()) + }) +# + +# metric.list <-function()table.Performance.input.shiny(metrics="BernardoLedoitRatio") +# +# metric.list() +# + + output$selection <- renderPrint( +# nrows <<- length(input$mychooser$right) + input$mychooser$right + ) + + + output$para.1 <- renderUI({ + if(length(input$mychooser$right)>=1){ + count <- 1 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + + output$para.2 <- renderUI({ + if(length(input$mychooser$right)>=2){ + count <- 2 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + + output$para.3 <- renderUI({ + if(length(input$mychooser$right)>=3){ + count <- 3 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.4 <- renderUI({ + if(length(input$mychooser$right)>=4){ + count <- 4 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.5 <- renderUI({ + if(length(input$mychooser$right)>= 5 ){ + count <- 5 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + + output$para.6 <- renderUI({ + if(length(input$mychooser$right)>= 6 ){ + count <- 6 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.7 <- renderUI({ + if(length(input$mychooser$right)>= 7 ){ + count <- 7 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.8 <- renderUI({ + if(length(input$mychooser$right)>= 8 ){ + count <- 8 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.9 <- renderUI({ + if(length(input$mychooser$right)>= 9 ){ + count <- 9 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.10 <- renderUI({ + if(length(input$mychooser$right)>= 10 ){ + count <- 10 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.11 <- renderUI({ + if(length(input$mychooser$right)>= 11 ){ + count <- 11 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.12 <- renderUI({ + if(length(input$mychooser$right)>= 12 ){ + count <- 12 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.13 <- renderUI({ + if(length(input$mychooser$right)>= 13 ){ + count <- 13 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.14 <- renderUI({ + if(length(input$mychooser$right)>= 14 ){ + count <- 14 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.15 <- renderUI({ + if(length(input$mychooser$right)>= 15 ){ + count <- 15 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + + output$para.16 <- renderUI({ + if(length(input$mychooser$right)>= 16 ){ + count <- 16 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + output$para.17 <- renderUI({ + if(length(input$mychooser$right)>= 17 ){ + count <- 17 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + output$para.18 <- renderUI({ + if(length(input$mychooser$right)>= 18){ + count <- 18 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + output$para.19 <- renderUI({ + if(length(input$mychooser$right)>= 19 ){ + count <- 19 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) + value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')"))) + if(nchar(value)>=2 & length(value)>0) # colum sign + inputTextarea(inputId,label,value,nrow=10,ncol=10) + else return() + + } + else return() + }) + output$para.20 <- renderUI({ + if(length(input$mychooser$right)>= 20 ){ + count <- 20 + inputId = eval(parse(text=paste0("'para.",count,"'"))) + label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')"))) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3436 From noreply at r-forge.r-project.org Sun Jun 22 22:52:01 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 22 Jun 2014 22:52:01 +0200 (CEST) Subject: [Returnanalytics-commits] r3437 - in pkg/PerformanceAnalytics/sandbox: . PAenhance PAenhance/R PAenhance/man PAenhance/vignettes Message-ID: <20140622205201.7FA80186AC6@r-forge.r-project.org> Author: kecoli Date: 2014-06-22 22:52:01 +0200 (Sun, 22 Jun 2014) New Revision: 3437 Added: pkg/PerformanceAnalytics/sandbox/PAenhance/ pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release pkg/PerformanceAnalytics/sandbox/PAenhance/R/ pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/inslib.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/table.Performance.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/table.Performance.pool.R pkg/PerformanceAnalytics/sandbox/PAenhance/R/table.Performance.pool.cran.R pkg/PerformanceAnalytics/sandbox/PAenhance/README.md pkg/PerformanceAnalytics/sandbox/PAenhance/man/ pkg/PerformanceAnalytics/sandbox/PAenhance/man/SharpeRatio.Rd pkg/PerformanceAnalytics/sandbox/PAenhance/man/chart.Boxplot.Rd pkg/PerformanceAnalytics/sandbox/PAenhance/man/chart.QQPlot.Rd pkg/PerformanceAnalytics/sandbox/PAenhance/man/table.Performance.Rd pkg/PerformanceAnalytics/sandbox/PAenhance/man/table.Performance.pool.Rd pkg/PerformanceAnalytics/sandbox/PAenhance/man/table.Performance.pool.cran.Rd pkg/PerformanceAnalytics/sandbox/PAenhance/vignettes/ pkg/PerformanceAnalytics/sandbox/PAenhance/vignettes/PA-KirkLi.Rnw pkg/PerformanceAnalytics/sandbox/PAenhance/vignettes/PA-KirkLi.pdf Log: merging Kirk's github work to R-forge including Chart.Boxplot, Chart.QQplot, table.performance.R Added: pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,13 @@ +Package: PAenhance +Type: Package +Title: Enhancement of PerformanceAnalytics developed by Kirk Li and Douglass + Martin +Version: 1.0 +Date: 2014-05-10 +Author: Kirk Li, Douglass Martin +Maintainer: Kirk Li +Description: Develop various enhancement to PerformanceAnalytics Package +License: GPL +Copyright: (c) 2014-2014 +Contributors: +Roxygen: list(wrap = TRUE) Added: pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2014 kecoli + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,8 @@ +# Generated by roxygen2 (4.0.1.99): do not edit by hand + +export(SharpeRatio) +export(chart.Boxplot) +export(chart.QQPlot) +export(table.Performance) +export(table.Performance.pool) +export(table.Performance.pool.cran) Added: pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,7 @@ +6/22 + +adding export to excel + +5/10 + +Per Doug's comments, adding interactive=NULL and latex=TRUE functionailites Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,24 @@ +.ls.objects <- +function (pos = 1, pattern, order.by, + decreasing=FALSE, head=FALSE, n=5) { + napply <- function(names, fn) sapply(names, function(x) + fn(get(x, pos = pos))) + names <- ls(pos = pos, pattern = pattern) + obj.class <- napply(names, function(x) as.character(class(x))[1]) + obj.mode <- napply(names, mode) + obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class) + obj.prettysize <- napply(names, function(x) { + capture.output(print(object.size(x), units = "auto")) }) + obj.size <- napply(names, object.size) + obj.dim <- t(napply(names, function(x) + as.numeric(dim(x))[1:2])) + vec <- is.na(obj.dim)[, 1] & (obj.type != "function") + obj.dim[vec, 1] <- napply(names, length)[vec] + out <- data.frame(obj.type, obj.size, obj.prettysize, obj.dim) + names(out) <- c("Type", "Size", "PrettySize", "Rows", "Columns") + if (!missing(order.by)) + out <- out[order(out[[order.by]], decreasing=decreasing), ] + if (head) + out <- head(out, n) + out +} Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,154 @@ +#' A modified version of SharpeRatio that compatible with table.Peroformance +#' +#' The Sharpe ratio is simply the return per unit of risk (represented by +#' variability). In the classic case, the unit of risk is the standard +#' deviation of the returns. +#' +#' \deqn{\frac{\overline{(R_{a}-R_{f})}}{\sqrt{\sigma_{(R_{a}-R_{f})}}}} +#' +#' William Sharpe now recommends \code{\link{InformationRatio}} preferentially +#' to the original Sharpe Ratio. +#' +#' The higher the Sharpe ratio, the better the combined performance of "risk" +#' and return. +#' +#' As noted, the traditional Sharpe Ratio is a risk-adjusted measure of return +#' that uses standard deviation to represent risk. +#' +#' A number of papers now recommend using a "modified Sharpe" ratio using a +#' Modified Cornish-Fisher VaR or CVaR/Expected Shortfall as the measure of +#' Risk. +#' +#' We have recently extended this concept to create multivariate modified +#' Sharpe-like Ratios for standard deviation, Gaussian VaR, modified VaR, +#' Gaussian Expected Shortfall, and modified Expected Shortfall. See +#' \code{\link{VaR}} and \code{\link{ES}}. You can pass additional arguments +#' to \code{\link{VaR}} and \code{\link{ES}} via \dots{} The most important is +#' probably the 'method' argument/ +#' +#' This function returns a traditional or modified Sharpe ratio for the same +#' periodicity of the data being input (e.g., monthly data -> monthly SR) +#' +#' +#' @aliases SharpeRatio.modified SharpeRatio +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param Rf risk free rate, in same period as your returns +#' @param p confidence level for calculation, default p=.95 +#' @param FUN one of "StdDev" or "VaR" or "ES" to use as the denominator +#' @param weights portfolio weighting vector, default NULL, see Details in +#' \code{\link{VaR}} +#' @param annualize if TRUE, annualize the measure, default FALSE +#' @param \dots any other passthru parameters to the VaR or ES functions +#' @author Brian G. Peterson, Kirk Li +#' @seealso \code{\link{SharpeRatio.annualized}} \cr +#' \code{\link{InformationRatio}} \cr \code{\link{TrackingError}} \cr +#' \code{\link{ActivePremium}} \cr \code{\link{SortinoRatio}} \cr +#' \code{\link{VaR}} \cr \code{\link{ES}} \cr +#' @references Sharpe, W.F. The Sharpe Ratio,\emph{Journal of Portfolio +#' Management},Fall 1994, 49-58. +#' +#' Laurent Favre and Jose-Antonio Galeano. Mean-Modified Value-at-Risk +#' Optimization with Hedge Funds. Journal of Alternative Investment, Fall 2002, +#' v 5. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' SharpeRatio(managers[,1,drop=FALSE], Rf=.035/12, FUN="StdDev") +#' SharpeRatio(managers[,1,drop=FALSE], Rf = managers[,10,drop=FALSE], FUN="StdDev") +#' SharpeRatio(managers[,1:6], Rf=.035/12, FUN="StdDev") +#' SharpeRatio(managers[,1:6], Rf = managers[,10,drop=FALSE], FUN="StdDev") +#' +#' +#' +#' data(edhec) +#' SharpeRatio(edhec[, 6, drop = FALSE], FUN="VaR") +#' SharpeRatio(edhec[, 6, drop = FALSE], Rf = .04/12, FUN="VaR") +#' SharpeRatio(edhec[, 6, drop = FALSE], Rf = .04/12, FUN="VaR" , method="gaussian") +#' SharpeRatio(edhec[, 6, drop = FALSE], FUN="ES") +#' +#' # and all the methods +#' SharpeRatio(managers[,1:9], Rf = managers[,10,drop=FALSE]) +#' SharpeRatio(edhec,Rf = .04/12) +#' +#' @export +#' @rdname SharpeRatio +SharpeRatio <- +function (R, Rf = 0, p = 0.95, method = c("StdDev", "VaR", "ES"), + weights = NULL, annualize = FALSE, ...) +{ + R = checkData(R) + + method <- match.arg(method) + + if (!is.null(dim(Rf))) + Rf = checkData(Rf) + if (annualize) { + freq = periodicity(R) + switch(freq$scale, minute = { + stop("Data periodicity too high") + }, hourly = { + stop("Data periodicity too high") + }, daily = { + scale = 252 + }, weekly = { + scale = 52 + }, monthly = { + scale = 12 + }, quarterly = { + scale = 4 + }, yearly = { + scale = 1 + }) + } + else { + scale = 1 + } + srm <- function(R, ..., Rf, p, FUNC) { + FUNCT <- match.fun(FUNC) + xR = Return.excess(R, Rf) + SRM = mean(xR, na.rm = TRUE)/FUNCT(R = R, p = p, ... = ..., + invert = FALSE) + SRM + } + sra <- function(R, ..., Rf, p, FUNC) { + if (FUNC == "StdDev") + FUNC = "StdDev.annualized" + FUNCT <- match.fun(FUNC) + xR = Return.excess(R, Rf) + SRA = Return.annualized(xR)/FUNCT(R = R, p = p, ... = ..., + invert = FALSE) + SRA + } + i = 1 + if (is.null(weights)) { + result = matrix(nrow = length(method), ncol = ncol(R)) + colnames(result) = colnames(R) + } + else { + result = matrix(nrow = length(method)) + } + tmprownames = vector() + + for (FUNCT in method) { + if (is.null(weights)) { + if (annualize) + result[i, ] = sapply(R, FUN = sra, Rf = Rf, p = p, + FUNC = FUNCT, ...) + else result[i, ] = sapply(R, FUN = srm, Rf = Rf, + p = p, FUNC = FUNCT, ...) + } + else { + result[i, ] = mean(R %*% weights, na.rm = TRUE)/match.fun(FUNCT)(R, + Rf = Rf, p = p, weights = weights, portfolio_method = "single", + ... = ...) + } + tmprownames = c(tmprownames, paste(if (annualize) "Annualized ", + FUNCT, " Sharpe", " (Rf=", round(scale * mean(Rf) * + 100, 1), "%, p=", round(p * 100, 1), "%):", sep = "")) + i = i + 1 + } + rownames(result) = tmprownames + return(result) +} Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,89 @@ +cbind.na <- +function (..., deparse.level = 1) +{ + na <- nargs() - (!missing(deparse.level)) + deparse.level <- as.integer(deparse.level) + stopifnot(0 <= deparse.level, deparse.level <= 2) + argl <- list(...) + while (na > 0 && is.null(argl[[na]])) { + argl <- argl[-na] + na <- na - 1 + } + if (na == 0) + return(NULL) + if (na == 1) { + if (isS4(..1)) + return(cbind2(..1)) + else return(matrix(...)) + } + if (deparse.level) { + symarg <- as.list(sys.call()[-1L])[1L:na] + Nms <- function(i) { + if (is.null(r <- names(symarg[i])) || r == "") { + if (is.symbol(r <- symarg[[i]]) || deparse.level == + 2) + deparse(r) + } + else r + } + } + if (na == 0) { + r <- argl[[2]] + fix.na <- FALSE + } + else { + nrs <- unname(lapply(argl, nrow)) + iV <- sapply(nrs, is.null) + fix.na <- identical(nrs[(na - 1):na], list(NULL, NULL)) + if (deparse.level) { + if (fix.na) + fix.na <- !is.null(Nna <- Nms(na)) + if (!is.null(nmi <- names(argl))) + iV <- iV & (nmi == "") + ii <- if (fix.na) + 2:(na - 1) + else 2:na + if (any(iV[ii])) { + for (i in ii[iV[ii]]) if (!is.null(nmi <- Nms(i))) + names(argl)[i] <- nmi + } + } + nRow <- as.numeric(sapply(argl, function(x) NROW(x))) + maxRow <- max(nRow, na.rm = TRUE) + argl <- lapply(argl, function(x) if (is.null(nrow(x))) + c(x, rep(NA, maxRow - length(x))) + else rbind.na(x, matrix(, maxRow - nrow(x), ncol(x)))) + r <- do.call(cbind, c(argl[-1L], list(deparse.level = deparse.level))) + } + d2 <- dim(r) + r <- cbind2(argl[[1]], r) + if (deparse.level == 0) + return(r) + ism1 <- !is.null(d1 <- dim(..1)) && length(d1) == 2L + ism2 <- !is.null(d2) && length(d2) == 2L && !fix.na + if (ism1 && ism2) + return(r) + Ncol <- function(x) { + d <- dim(x) + if (length(d) == 2L) + d[2L] + else as.integer(length(x) > 0L) + } + nn1 <- !is.null(N1 <- if ((l1 <- Ncol(..1)) && !ism1) Nms(1)) + nn2 <- !is.null(N2 <- if (na == 2 && Ncol(..2) && !ism2) Nms(2)) + if (nn1 || nn2 || fix.na) { + if (is.null(colnames(r))) + colnames(r) <- rep.int("", ncol(r)) + setN <- function(i, nams) colnames(r)[i] <<- if (is.null(nams)) + "" + else nams + if (nn1) + setN(1, N1) + if (nn2) + setN(1 + l1, N2) + if (fix.na) + setN(ncol(r), Nna) + } + r +} + Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,423 @@ +#' box whiskers plot wrapper +#' +#' A wrapper to create box and whiskers plot with some defaults useful for +#' comparing distributions. +#' +#' We have also provided controls for all the symbols and lines in the chart. +#' One default, set by \code{as.Tufte=TRUE}, will strip chartjunk and draw a +#' Boxplot per recommendations by Edward Tufte. Another default, set by \code{as.Notch=TRUE}, will draw a notch in each side of the boxes. It can also be useful when comparing several series to sort them in the order of ascending or descending return or risk measurement by use of \code{sort.by} and \code{sort.ascending=TRUE}. In addition, one can compare this with another user specified order, called base order, e.g., to see the relative change of the orders of the series between two measurements of interest. +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param horizontal TRUE/FALSE plot horizontal (TRUE) or vertical (FALSE) +#' @param names logical. if TRUE, show the names of each series +#' @param as.Tufte logical. default FALSE. if TRUE use method derived for Tufte +#' for limiting chartjunk +#' @param as.Notch logical. default FALSE. if TRUE a notch is drawn in each side of the boxes. +#' See \code{\link[graphics]{boxplot}} +#' @param sort.by one of the return or risk measure c("NULL", "mean", "median", "variance", "sharp ratio", "mean absolute deviation", "std dev", "sterling ratio", "calmar ratio", "burke ratio", "pain index", "ulcer index","martin ratio", "downside risk", "omega ratio", "sortino ratio", "upside risk","upside potential ratio", "omega sharpe ratio"). default is "NULL". +#' @param sort.base one of the return or risk measure as listed in \code{sort.by}, +#' add the base order number next to the labels sorted by \code{sort.by} +#' @param sort.ascending logical. If TRUE sort the distributions by ascending +#' \code{sort.by} and \code{sort.base} +#' @param colorset color palette to use, set by default to rational choices +#' @param symbol.color draws the symbols described in +#' \code{mean.symbol},\code{median.symbol},\code{outlier.symbol} in the color +#' specified +#' @param mean.symbol symbol to use for the mean of the distribution +#' @param median.symbol symbol to use for the median of the distribution +#' @param outlier.symbol symbol to use for the outliers of the distribution +#' @param show.data numerical vector of column numbers to display on top of +#' boxplot, default NULL +#' @param add.mean logical. if TRUE, show a line for the mean of all +#' distributions plotted +#' @param xlab set the x-axis label, same as in \code{\link{plot}} +#' @param main set the chart title, same as in \code{\link{plot}} +#' @param element.color specify the color of chart elements. Default is +#' "darkgray" +#' @param \dots any other passthru parameters +#' @return box plot of returns +#' @author Peter Carl +#' @author Ke Li \email{kirkli@@stat.washington.edu} +#' @seealso \code{\link[graphics]{boxplot}} +#' @references Tufte, Edward R. \emph{The Visual Display of Quantitative +#' Information}. Graphics Press. 1983. p. 124-129 +#' @keywords ts multivariate distribution models hplot +#' @examples +#' +#' data(edhec) +#' chart.Boxplot(edhec) +#' chart.Boxplot(edhec,as.Tufte=TRUE) +#' chart.Boxplot(R=edhec,sort.by="upside risk", +#' horizontal=TRUE, sort.base="std dev", +#' sort.ascending=TRUE) +#' @export +chart.Boxplot <- + function (R, horizontal = TRUE, names = TRUE, as.Tufte = FALSE, as.Notch=FALSE, sort.by = NULL, sort.base=NULL, sort.ascending = FALSE, colorset = "black", symbol.color = "red", mean.symbol = 1, median.symbol = "|", outlier.symbol = 1, show.data = NULL, add.mean = TRUE, xlab="Return", main = "Return Distribution Comparison", element.color = "darkgray", ...) +{ # @ author Peter Carl, updated by Kirk Li. + # DESCRIPTION: + # A wrapper to create box and whiskers plot, but with some sensible defaults + # useful for comparing distributions. + + # mar: a numerical vector of the form c(bottom, left, top, right) which + # gives the number of lines of margin to be specified on the four sides + # of the plot. The default is c(5, 4, 4, 2) + 0.1 + + sort.by <- tolower(sort.by) + + sort.by = sort.by[1] + + pool <- c("NA","mean", "median", "variance", "sharp ratio", "mean absolute deviation", "std dev", "sterling ratio", "calmar ratio", "burke ratio", "pain index", "ulcer index","martin ratio", "downside risk", "omega ratio", "sortino ratio", "upside risk","upside potential ratio", "omega sharpe ratio") + + sort.by <- match.arg(sort.by, pool, several.ok = FALSE) + + R = checkData(R, method="data.frame") + R.xts = checkData(R,method="xts") + columns = ncol(R) + rows = nrow(R) + columnnames = colnames(R) + + column.order = NULL + + sort.by <- tolower(sort.by) + + sort.by = sort.by[1] + + op <- par(no.readonly=TRUE) + + if(names){ + par(mar=c(5,12,4,2) + 0.2) + } + + if(length(colorset) < columns) + colorset = rep(colorset, length.out = columns) + + if(length(symbol.color) < columns) + symbol.color = rep(symbol.color, length.out = columns) + + if(length(mean.symbol) < columns) + mean.symbol = rep(mean.symbol, length.out = columns) + + means = sapply(R, mean, na.rm = TRUE) + + + asc.desc <- ifelse(sort.ascending,"ascending","descending") + + switch(sort.by, + mean = { + column.order = order(means, decreasing=!sort.ascending) + sort.by = paste("Mean", sep="") + }, + median = { + medians = sapply(R, median, na.rm = TRUE) + column.order = order(medians, decreasing=!sort.ascending) + sort.by = paste("Median", sep="") + }, + variance = { + variances = sapply(R, var, na.rm = TRUE) + column.order = order(variances, decreasing=!sort.ascending) + sort.by = paste("Variance", sep="") + }, + "sharp ratio" = { + sharpratio = sapply(R,function(x)mean(x,na.rm = TRUE)/sd(x,na.rm = TRUE)) + column.order = order(sharpratio, decreasing=!sort.ascending) + sort.by = paste("Sharp Ratio",sep="") + }, + "mean absolute deviation" = { + MeanAbsoluteDeviation = sapply(R,MeanAbsoluteDeviation) + column.order = order(MeanAbsoluteDeviation, decreasing=!sort.ascending) + sort.by = paste("Mean Absolute Dev",sep="") + }, + "std dev" = { + StdDev.annualized = sapply(R.xts,function(x)StdDev.annualized(x)) + column.order = order(StdDev.annualized, decreasing=!sort.ascending) + sort.by = paste("Std Dev",sep="") + }, + "sterling ratio" = { + SterlingRatio = sapply(R.xts,SterlingRatio) + column.order = order(SterlingRatio, decreasing=!sort.ascending) + sort.by = paste("Sterling Ratio",sep="") + }, + "calmar ratio" = { + CalmarRatio = sapply(R.xts,CalmarRatio) + column.order = order(CalmarRatio, decreasing=!sort.ascending) + sort.by = paste("Calmar Ratio",sep="") + }, + "burke ratio" = { + BurkeRatio = sapply(R.xts,BurkeRatio) + column.order = order(BurkeRatio, decreasing=!sort.ascending) + sort.by = paste("Burke Ratio",sep="") + }, + "pain index" = { + PainIndex = sapply(R,PainIndex) + column.order = order(PainIndex, decreasing=!sort.ascending) + sort.by = paste("Pain Index",sep="") + }, + "ulcer index" = { + UlcerIndex = sapply(R,UlcerIndex) + column.order = order(UlcerIndex, decreasing=!sort.ascending) + sort.by = paste("Ulcer Index",sep="") + }, + "martin ratio" = { + MartinRatio = sapply(R.xts,MartinRatio) + column.order = order(MartinRatio, decreasing=!sort.ascending) + sort.by = paste("Martin Ratio",sep="") + }, + "downside risk" = { + DownsideDeviation = sapply(R,DownsideDeviation) + column.order = order(DownsideDeviation, decreasing=!sort.ascending) + sort.by = paste("Downside Risk",sep="") + }, + "omega ratio" = { + Omega = sapply(R,Omega) + column.order = order(Omega, decreasing=!sort.ascending) + sort.by = paste("Omega Ratio",sep="") + }, + "sortino ratio" = { + SortinoRatio = sapply(R,SortinoRatio) + column.order = order(SortinoRatio, decreasing=!sort.ascending) + sort.by = paste("Sortino Ratio",sep="") + }, + "upside risk" = { + UpsideRisk = sapply(R,UpsideRisk) + column.order = order(UpsideRisk, decreasing=!sort.ascending) + sort.by = paste("Upside Risk",sep="") + }, + "upside potential ratio" = { + UpsidePotentialRatio = sapply(R,UpsidePotentialRatio) + column.order = order(UpsidePotentialRatio, decreasing=!sort.ascending) + sort.by = paste("Upside Potential Ratio",sep="") + }, + "omega sharpe ratio" = { + OmegaSharpeRatio = sapply(R,OmegaSharpeRatio) + column.order = order(OmegaSharpeRatio, decreasing=!sort.ascending) + sort.by = paste("Omega Sharpe Ratio",sep="") + }, + { + column.order = 1:columns + sort.by = paste("Unsorted", sep="") + } + ) # end switch + + ylab=paste("Sorted by:",asc.desc,sort.by) + + + # base order + if(!is.null(sort.base)){ + colum.order.base = NULL + + sort.base <- tolower(sort.base) + + sort.base <- match.arg(sort.base, pool, several.ok = FALSE) + + switch(sort.base, + mean = { + means = sapply(R, mean, na.rm = TRUE) + column.order.base = order(means, decreasing=!sort.ascending) + sort.base = paste("Mean", sep="") + }, + median = { + medians = sapply(R, median, na.rm = TRUE) + column.order.base = order(medians, decreasing=!sort.ascending) + sort.base = paste("Median", sep="") + }, + variance = { + variances = sapply(R, var, na.rm = TRUE) + column.order.base = order(variances, decreasing=!sort.ascending) + sort.base = paste("Variance", sep="") + }, + "sharp ratio" = { + sharpratio = sapply(R,function(x)mean(x,na.rm = TRUE)/sd(x,na.rm = TRUE)) + column.order.base = order(sharpratio, decreasing=!sort.ascending) + sort.base = paste("Sharp Ratio",sep="") + }, + "mean absolute deviation" = { + MeanAbsoluteDeviation = sapply(R,MeanAbsoluteDeviation) + column.order.base = order(MeanAbsoluteDeviation, decreasing=!sort.ascending) + sort.base = paste("Mean Absolute Dev",sep="") + }, + "std dev" = { + StdDev.annualized = sapply(R.xts,StdDev.annualized) + column.order.base = order(StdDev.annualized, decreasing=!sort.ascending) + sort.base = paste("Std Dev",sep="") + }, + "sterling ratio" = { + SterlingRatio = sapply(R.xts,SterlingRatio) + column.order.base = order(SterlingRatio, decreasing=!sort.ascending) + sort.base = paste("Sterling Ratio",sep="") + }, + "calmar ratio" = { + CalmarRatio = sapply(R.xts,function(x)mean(x,na.rm = TRUE)/sd(x,na.rm = TRUE)) + column.order.base = order(CalmarRatio, decreasing=!sort.ascending) + sort.base = paste("Calmar Ratio",sep="") + }, + "burke ratio" = { + BurkeRatio = sapply(R.xts,BurkeRatio) + column.order.base = order(BurkeRatio, decreasing=!sort.ascending) + sort.base = paste("Burke Ratio",sep="") + }, + "ulcer index" = { + UlcerIndex = sapply(R,UlcerIndex) + column.order.base = order(UlcerIndex, decreasing=!sort.ascending) + sort.base = paste("Ulcer Index",sep="") + }, + "pain index" = { + PainRatio = sapply(R.xts,PainRatio) + column.order.base = order(PainRatio, decreasing=!sort.ascending) + sort.base = paste("Pain Index",sep="") + }, + "martin ratio" = { + MartinRatio = sapply(R.xts,MartinRatio) + column.order.base = order(MartinRatio, decreasing=!sort.ascending) + sort.base = paste("Martin Ratio",sep="") + }, + "downside risk" = { + DownsideDeviation = sapply(R,DownsideDeviation) + column.order.base = order(DownsideDeviation, decreasing=!sort.ascending) + sort.base = paste("Downside Risk",sep="") + }, + "omega ratio" = { + Omega = sapply(R,Omega) + column.order.base = order(Omega, decreasing=!sort.ascending) + sort.base = paste("Omega Ratio",sep="") + }, + "sortino ratio" = { + SortinoRatio = sapply(R,SortinoRatio) + column.order.base = order(SortinoRatio, decreasing=!sort.ascending) + sort.base = paste("Sortino Ratio",sep="") + }, + "upside risk" = { + UpsideRisk = sapply(R,UpsideRisk) + column.order.base = order(UpsideRisk, decreasing=!sort.ascending) + sort.base = paste("Upside Risk",sep="") + }, + "upside potential ratio" = { + UpsidePotentialRatio = sapply(R,UpsidePotentialRatio) + column.order.base = order(UpsidePotentialRatio, decreasing=!sort.ascending) + sort.base = paste("Upside Potential Ratio",sep="") + }, + "omega sharpe ratio" = { + OmegaSharpeRatio = sapply(R,OmegaSharpeRatio) + column.order.base = order(OmegaSharpeRatio, decreasing=!sort.ascending) + sort.base = paste("Omega Sharpe Ratio",sep="") + }, + { + column.order.base = 1:columns + sort.base = paste("Unsorted", sep="") + } + ) # end switch + + ylab.base=paste(asc.desc,sort.base) + } + + if(horizontal) { + par(mar=c(5,8,4,2)+1) + column.order.box <- rev(column.order) + if(!is.null(sort.base)) + column.order.base.box <- rev(column.order.base) + } else { + par(mar=c(8,4,4,2)+1) + column.order.box <- column.order + if(!is.null(sort.base)) + column.order.base.box <- column.order.base + + } + + + if(as.Tufte){ + boxplot(R[,column.order.box], horizontal = horizontal, names = names, main = main, xlab = ifelse(horizontal,xlab,""), ylab = ifelse(horizontal,"",xlab), pars = list(boxcol = "white", medlty = "blank", medpch = median.symbol, medlwd = 2, medcex = .8, medcol = colorset[column.order.box], whisklty = c(1,1), whiskcol = colorset[column.order.box], staplelty = "blank", outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order.box] ), axes = FALSE, cex.lab=0.7,...) + mtext(side=3,text=ylab,cex=0.7) + if(!is.null(sort.base)) + mtext(side=3, + text=paste("Base order: ",ylab.base,sep=" "),line=1,cex=0.7) + } else if(as.Notch){ + + boxplot(R[,column.order.box], horizontal = horizontal, names = names, main = main, xlab = ifelse(horizontal,xlab,""), ylab = ifelse(horizontal,"",xlab), pars = list(boxcol = colorset[column.order.box], medlwd = 1, medcol = colorset[column.order.box], whisklty = c(1,1), whiskcol = colorset[column.order.box], staplelty = 1, staplecol = colorset[column.order.box], staplecex = .5, outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order.box] ), axes = FALSE, boxwex=.6, cex.lab=0.7, notch=TRUE,...) + mtext(side=3,text=ylab,cex=0.7) + + if(!is.null(sort.base)) + mtext(side=3, + text=paste("Base order: ",ylab.base,sep=" "),line=1,cex=0.7) + } else{ + + boxplot(R[,column.order.box], horizontal = horizontal, names = names, main = main, xlab = ifelse(horizontal,xlab,""), ylab = ifelse(horizontal,"",xlab), pars = list(boxcol = colorset[column.order.box], medlwd = 1, medcol = colorset[column.order.box], whisklty = c(1,1), whiskcol = colorset[column.order.box], staplelty = 1, staplecol = colorset[column.order.box], staplecex = .5, outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order.box] ), axes = FALSE, boxwex=.6, cex.lab=0.7,...) + mtext(side=3,text=ylab,cex=0.7) + if(!is.null(sort.base)) + mtext(side=3, + text=paste("Base order: ", ylab.base,sep=" "),line=1,cex=0.7) + } # end else + + if(!is.null(show.data)) { + highlight.color=1:24 + for (item in show.data) { + points(as.vector(R[item,column.order]), 1:columns, col=highlight.color[item]) #, pch = mean.symbol[column.order], col=symbol.color[column.order]) + } + } + + if(add.mean){ + if(horizontal) + points(means[column.order], columns:1, pch = mean.symbol[column.order], col=symbol.color[column.order],cex=0.5) else + points(1:columns, means[column.order], pch = mean.symbol[column.order], col=symbol.color[column.order],cex=0.5) + } + + if(names){ + if(!is.null(sort.base)){ + if(horizontal){ + labels = paste(columnnames[column.order]," ",sep="") + labels.sec =paste("(",(match(column.order,column.order.base)),")",sep="") + labels=rev(labels) + } else{ + labels = paste(columnnames[column.order]," ",sep="") + labels.sec = paste("(",match(column.order,column.order.base),")",sep="") + } + } else labels = columnnames[column.order] + + if(!horizontal){ +# axis(1,labels=FALSE) + text(1:length(labels), par("usr")[1] - 0.2, srt = 45, adj = 1, + labels = labels, xpd = TRUE, cex=0.7) + if(!is.null(sort.base)) + text(1:length(labels), par("usr")[1] - 0.2, srt = 0, adj = 1, + labels = labels.sec, xpd = TRUE, cex=0.5) + ## Plot x axis label at line 6 (of 7) + }else{ +# axis(2, cex.axis = 0.9, col = element.color, labels = labels, at = 1:columns, las = 2) + text(par("usr")[3] - 0.24, 1:length(labels), srt = 0, adj = 1, + labels = labels, xpd = TRUE, cex=0.7) + if(!is.null(sort.base)) + text(par("usr")[3] - 0.24, 1:length(labels), srt = 0, adj = 0, + labels = labels.sec, xpd = TRUE, cex=0.5) + } + } else{ + labels = "" + axis(2, cex.axis = 0.8, col = element.color, labels = labels, at = 1:columns, las = 1, tick = FALSE) + } + +# if(names) +# title(sub=ylab) +# else +# title(sub=ylab) + box(col=element.color) + + if(horizontal) { + abline(v=0, lty="solid",col=element.color) + } else { + abline(h=0, lty="solid",col=element.color) + } + + + par(op) +} + +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: chart.Boxplot.R 2621 2013-07-22 19:36:44Z peter_carl $ +# +############################################################################### Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R ___________________________________________________________________ Added: svn:mime-type + text/plain Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R 2014-06-22 20:52:01 UTC (rev 3437) @@ -0,0 +1,311 @@ +#' Plot a QQ chart +#' +#' Plot the return data against any theoretical distribution. +#' +#' A Quantile-Quantile (QQ) plot is a scatter plot designed to compare the data +#' to the theoretical distributions to visually determine if the observations +#' are likely to have come from a known population. The empirical quantiles are +#' plotted to the y-axis, and the x-axis contains the values of the theorical +#' model. A 45-degree reference line is also plotted. If the empirical data +#' come from the population with the choosen distribution, the points should +#' fall approximately along this reference line. The larger the departure from +#' the reference line, the greater the evidence that the data set have come +#' from a population with a different distribution. +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param distribution root name of comparison distribution - e.g., 'norm' for +#' the normal distribution; 't' for the t-distribution. See examples for other +#' ideas. +#' @param xlab set the x-axis label, as in \code{\link{plot}} +#' @param ylab set the y-axis label, as in \code{\link{plot}} +#' @param xaxis if true, draws the x axis [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3437 From noreply at r-forge.r-project.org Sun Jun 22 23:27:22 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 22 Jun 2014 23:27:22 +0200 (CEST) Subject: [Returnanalytics-commits] r3438 - in pkg/PerformanceAnalytics/sandbox/PAenhance: . R man Message-ID: <20140622212722.ACFF9186EDE@r-forge.r-project.org> Author: kecoli Date: 2014-06-22 23:27:22 +0200 (Sun, 22 Jun 2014) New Revision: 3438 Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/Uncertainty.R pkg/PerformanceAnalytics/sandbox/PAenhance/man/UncertaintyMeasure.Rd Modified: pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R pkg/PerformanceAnalytics/sandbox/PAenhance/man/SharpeRatio.Rd Log: change of man page, add uncertainty measure of Variance estimator, add bootstrap sd for SharpRatio, modify Sharpratio to adapt to table.Performance Modified: pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE 2014-06-22 20:52:01 UTC (rev 3437) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE 2014-06-22 21:27:22 UTC (rev 3438) @@ -6,3 +6,4 @@ export(table.Performance) export(table.Performance.pool) export(table.Performance.pool.cran) +export(var.se) Modified: pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R 2014-06-22 20:52:01 UTC (rev 3437) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R 2014-06-22 21:27:22 UTC (rev 3438) @@ -1,3 +1,6 @@ +#' calculate a traditional or modified Sharpe Ratio of Return over StdDev or +#' VaR or ES, accompanied with bootstrap of standard error. +#' #' A modified version of SharpeRatio that compatible with table.Peroformance #' #' The Sharpe ratio is simply the return per unit of risk (represented by @@ -72,11 +75,15 @@ #' SharpeRatio(managers[,1:9], Rf = managers[,10,drop=FALSE]) #' SharpeRatio(edhec,Rf = .04/12) #' +#' # bootstrap sd +#' R =managers[,1:2,drop=FALSE] +#' SharpeRatio(edhec[, 6, drop = FALSE], Rf = .04/12, FUN="VaR", bootsd=TRUE) +#' #' @export #' @rdname SharpeRatio SharpeRatio <- function (R, Rf = 0, p = 0.95, method = c("StdDev", "VaR", "ES"), - weights = NULL, annualize = FALSE, ...) + weights = NULL, annualize = FALSE, bootsd = FALSE, ...) { R = checkData(R) @@ -121,23 +128,47 @@ invert = FALSE) SRA } + + boot.sd.fn <- function(X,idx,...,Rf, p, FUNC, FUN_ma) # FUN_ma: selecting srm.boot or sra + { + match.fun(FUN_ma)(X[idx],Rf=Rf,FUNC=FUNC,p=p) + } + + boot.sd <- function(X, ..., Rf, p, FUNC, FUN_ma) + { + boot.res = boot(X, statistic=boot.sd.fn, FUN_ma=FUN_ma, Rf=Rf, p=p, R=10*length(X), FUNC=FUNC) + sd(as.vector(boot.res$t)) + } + + i = 1 if (is.null(weights)) { result = matrix(nrow = length(method), ncol = ncol(R)) colnames(result) = colnames(R) + if(bootsd){ + result.boot.sd = matrix(nrow=length(FUN), ncol=ncol(R)) + } } else { result = matrix(nrow = length(method)) } tmprownames = vector() + if(bootsd) require(boot) + for (FUNCT in method) { if (is.null(weights)) { - if (annualize) + if (annualize) { result[i, ] = sapply(R, FUN = sra, Rf = Rf, p = p, FUNC = FUNCT, ...) - else result[i, ] = sapply(R, FUN = srm, Rf = Rf, + if(bootsd) + result.boot.sd[i,] = sapply(R,FUN=boot.sd, Rf=Rf, p=p, FUNC=FUNCT,FUN_ma="sra",...) + } + else {result[i, ] = sapply(R, FUN = srm, Rf = Rf, p = p, FUNC = FUNCT, ...) + if(bootsd) + result.boot.sd[i,] = sapply(R,FUN=boot.sd,Rf=Rf, p=p, FUNC=FUNCT,FUN_ma="srm",...) + } } else { result[i, ] = mean(R %*% weights, na.rm = TRUE)/match.fun(FUNCT)(R, @@ -150,5 +181,9 @@ i = i + 1 } rownames(result) = tmprownames + if(bootsd) + rownames(result.boot.sd)=tmprownames + if(bootsd) + return(list(estimate = result, boot.sd = result.boot.sd)) return(result) } Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/Uncertainty.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/R/Uncertainty.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/Uncertainty.R 2014-06-22 21:27:22 UTC (rev 3438) @@ -0,0 +1,46 @@ +#' Uncertainty measure of Variance Estimator +#' This function returns the standard error of the three estimator of Variance. +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param methods the estimation methods for Variance estimator, default is normal +#' @author Douglass Martin, Kirk Li +#' @references TBA +#' @keywords variance estimation, bootstrap +#' @examples +#' data(edhec) +#' var.se(edhec[,1],methods="normal") +#' @export +#' @rdname UncertaintyMeasure +var.se <- function(R,methods=c("normal","non-normal","bootstrap")){ + R <- checkData(R, method="xts") + columns=colnames(R) + + methods <- match.arg(methods,c("normal","non-normal","bootstrap")) + + switch(methods, + "normal" = { var.std.error = sapply(R, function(x) sqrt(2/(length(x)-1)* var(x,na.rm=TRUE)^2)) + }, + "non-normal" = {var.std.error = sapply(R, function(x) sqrt((length(x)/(length(x)-1))^2 * + ( + (mean((x-mean(x,na.rm=TRUE))^4,na.rm=TRUE)-var(x,na.rm=TRUE)^2)/length(x) + + -2*(mean((x-mean(x,na.rm=TRUE))^4)-2*var(x,na.rm=TRUE)^2)/length(x)^2 + + +(mean((x-mean(x,na.rm=TRUE))^4,na.rm=TRUE)-3*var(x,na.rm=TRUE)^2)/length(x)^3 + ) + ))}, + "bootstrap" = { require("boot") + + boot.sd.var <- function(X,idx) var(X[idx],na.rm=TRUE) + boot.sd <- function(X) + { + boot.res = boot(X, statistic=boot.sd.var, R=10*length(X)) + sd(as.vector(boot.res$t)) + } + + var.std.error = sapply(R,boot.sd)} + ) + var.std.error +} + + Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/Uncertainty.R ___________________________________________________________________ Added: svn:mime-type + text/plain Modified: pkg/PerformanceAnalytics/sandbox/PAenhance/man/SharpeRatio.Rd =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/man/SharpeRatio.Rd 2014-06-22 20:52:01 UTC (rev 3437) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/man/SharpeRatio.Rd 2014-06-22 21:27:22 UTC (rev 3438) @@ -2,10 +2,11 @@ \name{SharpeRatio} \alias{SharpeRatio} \alias{SharpeRatio.modified} -\title{A modified version of SharpeRatio that compatible with table.Peroformance} +\title{calculate a traditional or modified Sharpe Ratio of Return over StdDev or +VaR or ES, accompanied with bootstrap of standard error.} \usage{ SharpeRatio(R, Rf = 0, p = 0.95, method = c("StdDev", "VaR", "ES"), - weights = NULL, annualize = FALSE, ...) + weights = NULL, annualize = FALSE, bootsd = FALSE, ...) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries @@ -28,11 +29,14 @@ ES functions} } \description{ +A modified version of SharpeRatio that compatible with +table.Peroformance +} +\details{ The Sharpe ratio is simply the return per unit of risk (represented by variability). In the classic case, the unit of risk is the standard deviation of the returns. -} -\details{ + \deqn{\frac{\overline{(R_{a}-R_{f})}}{\sqrt{\sigma_{(R_{a}-R_{f})}}}} William Sharpe now recommends @@ -81,6 +85,10 @@ # and all the methods SharpeRatio(managers[,1:9], Rf = managers[,10,drop=FALSE]) SharpeRatio(edhec,Rf = .04/12) + +# bootstrap sd +R =managers[,1:2,drop=FALSE] +SharpeRatio(edhec[, 6, drop = FALSE], Rf = .04/12, FUN="VaR", bootsd=TRUE) } \author{ Brian G. Peterson, Kirk Li Added: pkg/PerformanceAnalytics/sandbox/PAenhance/man/UncertaintyMeasure.Rd =================================================================== --- pkg/PerformanceAnalytics/sandbox/PAenhance/man/UncertaintyMeasure.Rd (rev 0) +++ pkg/PerformanceAnalytics/sandbox/PAenhance/man/UncertaintyMeasure.Rd 2014-06-22 21:27:22 UTC (rev 3438) @@ -0,0 +1,34 @@ +% Generated by roxygen2 (4.0.1.99): do not edit by hand +\name{var.se} +\alias{var.se} +\title{Uncertainty measure of Variance Estimator +This function returns the standard error of the three estimator of Variance.} +\usage{ +var.se(R, methods = c("normal", "non-normal", "bootstrap")) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{methods}{the estimation methods for Variance + estimator, default is normal} +} +\description{ +Uncertainty measure of Variance Estimator This function +returns the standard error of the three estimator of +Variance. +} +\examples{ +data(edhec) +var.se(edhec[,1],methods="normal") +} +\author{ +Douglass Martin, Kirk Li +} +\references{ +TBA +} +\keyword{bootstrap} +\keyword{estimation,} +\keyword{variance} + Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/man/UncertaintyMeasure.Rd ___________________________________________________________________ Added: svn:mime-type + text/plain From noreply at r-forge.r-project.org Wed Jun 25 00:26:12 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 25 Jun 2014 00:26:12 +0200 (CEST) Subject: [Returnanalytics-commits] r3439 - pkg/PortfolioAnalytics/sandbox Message-ID: <20140624222612.C4B4A187288@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-25 00:26:12 +0200 (Wed, 25 Jun 2014) New Revision: 3439 Added: pkg/PortfolioAnalytics/sandbox/scriptFFV.R Log: Adding basic fully flexible views script Added: pkg/PortfolioAnalytics/sandbox/scriptFFV.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/scriptFFV.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/scriptFFV.R 2014-06-24 22:26:12 UTC (rev 3439) @@ -0,0 +1,51 @@ +library(PortfolioAnalytics) +data(edhec) +R <- edhec[,1:5] + +# compute the probabilities +probs <- rep(1 / nrow(R), nrow(R)) +# probabilities should always sum to 1 +sum(probs) + +# suppose that I express a bearish view on R[,1] - R[,2] +# lambda is the ad-hoc multiplier +# Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish) +lambda <- -2 +V <- coredata(R[,1] - R[,2]) +m <- mean(V) +s <- sd(V) +b <- matrix(m + lambda * s, 1) + +# set up matrix for equality constraints +# constrain such that probabilities sum to 1 +Aeq <- matrix(1, nrow=1, ncol=nrow(R)) +beq <- matrix(1, 1, 1) + +# set up matrix for inequality constraints +A <- t(V) + +# Compute posterior probabilities +# The EntryProg optimization handles inequality constraints as A < b +# If I hav +posterior_probs <- Meucci::EntropyProg(probs, A, b, Aeq, beq)$p_ +dim(posterior_probs) +sum(posterior_probs) + +# why do the probs equal the posterior probs? +all.equal(as.numeric(posterior_probs), probs) + +# Now I have my posterior probabilities +# What is a general approach I can use for any arbitrary optimization +all.equal(as.numeric(t(coredata(R)) %*% posterior_probs),as.numeric(matrix(colMeans(R), ncol=1))) + +# This is pretty close to sample cov +Exps <- t(R) %*% posterior_probs +Scnd_Mom = t(R) %*% (R * (posterior_probs %*% matrix( 1,1,ncol(R)) ) ) +Scnd_Mom = ( Scnd_Mom + t(Scnd_Mom) ) / 2 +Covs = Scnd_Mom - Exps %*% t(Exps) +Covs +cov(R) + + +all.equal(coredata(R[,1] - R[,2]), A, check.attributes=FALSE) + From noreply at r-forge.r-project.org Wed Jun 25 18:05:02 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 25 Jun 2014 18:05:02 +0200 (CEST) Subject: [Returnanalytics-commits] r3440 - in pkg/FactorAnalytics: . R Message-ID: <20140625160502.CA5631874CB@r-forge.r-project.org> Author: pragnya Date: 2014-06-25 18:05:02 +0200 (Wed, 25 Jun 2014) New Revision: 3440 Added: pkg/FactorAnalytics/R/fitTSFM.R Removed: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R Modified: pkg/FactorAnalytics/DESCRIPTION Log: FitTSFM: Reformatted the function into smaller testable components, renamed functions and variables to conform to the Google R style Guide (Camel case), added a detailed and consistent description, added step() control options, included more warnings and input checks. Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2014-06-24 22:26:12 UTC (rev 3439) +++ pkg/FactorAnalytics/DESCRIPTION 2014-06-25 16:05:02 UTC (rev 3440) @@ -11,14 +11,15 @@ factor model, fundamental factor model and statistical factor model. They allow for different types of distributions to be specified for modeling the fat-tailed behavior of financial returns, including Edgeworth expansions. - Risk analysis measures such as VaR and ES are also provided for the results - of the fitted models. + Risk analysis measures such as VaR and ES and performance attribution (to + factor-contributed and idiosyncratic returns) are also included. License: GPL-2 Depends: R (>= 2.14.0), robust, leaps, lars, + lmtest, PerformanceAnalytics, sn, tseries, Added: pkg/FactorAnalytics/R/fitTSFM.R =================================================================== --- pkg/FactorAnalytics/R/fitTSFM.R (rev 0) +++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-25 16:05:02 UTC (rev 3440) @@ -0,0 +1,446 @@ +#' @title Fits a time series factor model (TSFM) using time series regression +#' +#' @description Fits a time series (or, macroeconomic) factor model for single +#' or multiple asset returns or excess returns using time series regression. +#' Users can choose between ordinary least squares-OLS, discounted least +#' squares-DLS (or) robust regression. Several variable selection options +#' including Stepwise, Subsets, Lars are available as well. An object of class +#' \code{tsfm} is returned. +#' +#' @details +#' Estimation method "OLS" corresponds to ordinary least squares, "DLS" is +#' discounted least squares, which is weighted least squares estimation with +#' exponentially declining weights that sum to unity, and, "Robust" is robust +#' regression (uses \code{\link[robust]{lmRob}}). +#' +#' If \code{variable.selection}="none", all chosen factors are used in the +#' factor model. Whereas, "stepwise" performs traditional forward/backward +#' stepwise OLS regression (using \code{\link[stats]{step}}), that starts from +#' the initial set of factors and adds factors only if the regression fit, as +#' measured by the Bayesian Information Criterion (BIC) or Akaike Information +#' Criterion (AIC), improves. And, "all subsets" enables subsets selection +#' using \code{\link[leaps]{regsubsets}} that chooses the n-best performing +#' subsets of any given size (specified as \code{num.factor.subsets} here). +#' "lars" and "lasso" correspond to variants of least angle regression using +#' \code{\link[lars]{lars}}. If "lars" or "lasso" are chosen, \code{fit.method} +#' will be ignored. +#' +#' Note: If \code{variable.selection}="lars" or "lasso", \code{fit.method} +#' will be ignored. And, "Robust" \code{fit.method} is not truly available with +#' \code{variable.selection}="all subsets"; instead, results are produced for +#' \code{variable.selection}="none" with "Robust" to include all factors. +#' +#' If \code{add.up.market = TRUE}, max(0, Rm-Rf) is added as a factor in the +#' regression, following Henriksson & Merton (1981), to account for market +#' timing (price movement of the general stock market relative to fixed income +#' securities). The coefficient can be interpreted as the number of free put +#' options. +#' +#' Finally, for both the "lars" and "lasso" methods, the "Cp" statistic +#' (defined in page 17 of Efron et al. (2002)) is calculated using +#' \code{\link[lars]{summary.lars}} . While, "cv" computes the K-fold +#' cross-validated mean squared prediction error using +#' \code{\link[lars]{cv.lars}}. +#' +#' @param asset.names a character vector containing the names of the assets, +#' whose returns or excess returns are the dependent variable. +#' @param factor.names a character vector containing the names of the +#' macroeconomic factors. +#' @param market.name name of an optional column for market excess returns +#' (Rm-Rf). Necessary if \code{add.up.market} or \code{add.up.market.squared} +#' are \code{TRUE}. +#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object +#' containing column(s) named \code{asset.names} and \code{factor.names}. +#' \code{market.name} is also necessary if \code{add.up.market} or +#' \code{add.market.sqd} are \code{TRUE}. +#' @param fit.method the estimation method, one of "OLS", "DLS" or "Robust". +#' See details. If \code{variable.selection}="lars" or "lasso", +#' \code{fit.method} will be ignored. And, "Robust" \code{fit.method} is not +#' available with \code{variable.selection}="all subsets". +#' @param variable.selection the variable selection method, one of "none", +#' "stepwise","all subsets","lars" or "lasso". See details. +#' @param subsets.method a required option for the "all subsets" method; one of +#' "exhaustive", "forward", "backward" or "seqrep" (sequential replacement) +#' to specify the type of subset search/selection. +#' @param nvmax an option for the "all subsets" method; a scalar, specifies +#' the maximum size of subsets to examine. Default is 8. +#' @param force.in an option for the "all subsets" method; a vector containing +#' the names of factors that should always be included in the model. Default +#' is NULL. +#' @param num.factors.subset an option for the "all subsets" method; a scalar +#' number of factors required in the factor model. Default is 1. +#' Note: nvmax >= num.factors.subset >= length(force.in). +#' @param add.up.market a logical value that when set to \code{TRUE}, adds +#' max(0, Rm-Rf) as a regressor. If \code{TRUE}, \code{market.name} is +#' required. Default is \code{FALSE}. See Details. +#' @param add.market.sqd a logical value that when set to \code{TRUE}, adds +#' (Rm-Rf)^2 as a regressor. If \code{TRUE}, \code{market.name} is +#' required. Default is \code{FALSE}. +#' @param decay a scalar, specifies the decay factor for +#' \code{fit.method="DLS"}. Default is 0.95. +#' @param lars.criterion an option to assess model selection for the "lars" or +#' "lasso" variable.selection methods; one of "Cp" or "cv". See details. +#' Default is "Cp". +#' @param ... optional arguments passed to the \code{step} function for +#' variable.selection method "stepwise", such as direction, steps and +#' the penalty factor k. Note that argument k is available only for "OLS" +#' and "DLS" fits. Scope argument is not available presently. Also plan to +#' include other controls passed to \code{lmRob} soon. +#' +#' @return The returned value is an S3 object of class \code{tsfm} +#' containing the following components: +#' \item{asset.fit} {list of the fitted objects for each asset. Each fitted +#' object is of class \code{lm} if \code{fit.method} is "OLS" or "DLS"; +#' of class \code{lmRob} if the \code{fit.method} is "Robust"; of class +#' \code{lars} if \code{variable.selection}="lars" or "lasso". +#' \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-squared values.} +#' \item{resid.sd} {N x 1 vector of residual standard deviations.} +#' \item{call} {the matched function call.} +#' \item{data} {data as input.} +#' \item{asset.names} {asset.names as input.} +#' \item{factor.names{ {factor.names as input.} +#' \item{fit.method} {fit.method as input.} +#' \item{variable.selection} {variable.selection as input.} +#' Where N is the number of assets and K is the number of factors. +#' +#' @family Factor Models +#' +#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan. +#' @references +#' \enumerate{ +#' \item Christopherson, Carino and Ferson (2009). Portfolio Performance +#' Measurement and Benchmarking, McGraw Hill. +#' \item Efron, Hastie, Johnstone and Tibshirani (2002) "Least Angle +#' Regression" (with discussion) Annals of Statistics. Also refer to +#' \url{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 Henriksson and Merton (1981). On market timing and investment +#' performance. II. Statistical procedures for evaluating forecasting skills, +#' Journal of Business, Vol 54, No 4. +#' } +#' +#' @examples +#' \dontrun{ +#' # load data from the database +#' data(managers.df) +#' fit <- fitTimeSeriesFactorModel(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS") +#' # summary of HAM1 +#' summary(fit$asset.fit$HAM1) +#' # plot actual vs. fitted over time for HAM1 +#' # use chart.TimeSeries() function from PerformanceAnalytics package +#' dataToPlot <- cbind(fitted(fit$asset.fit$HAM1), na.omit(managers.df$HAM1)) +#' colnames(dataToPlot) <- c("Fitted","Actual") +#' chart.TimeSeries(dataToPlot, main="FM fit for HAM1", +#' colorset=c("black","blue"), legend.loc="bottomleft") +#' } +#' +#' @export + +fitTSFM <- function(asset.names, factor.names, market.name, data=data, + fit.method = c("OLS","DLS","Robust"), + variable.selection = c("none","stepwise","all subsets", + "lars","lasso"), + subsets.method = c("exhaustive", "backward", "forward", + "seqrep"), + nvmax=8, force.in=NULL, num.factors.subset=1, + add.up.market=FALSE, add.market.sqd=FALSE, + decay=0.95, lars.criterion="Cp", ...) { + + # get all the arguments specified by their full names + call <- match.call() + if (!exists("direction")) {direction <- "backward"} + if (!exists("steps")) {steps <- 1000} + if (!exists("k")) {k <- 2} + if (!exists("market.name") && (add.up.market==TRUE | add.market.sqd==TRUE)) { + stop("Missing input: 'market.name' to include factors 'up.market' or + 'market.sqd'") + } + + # convert data into an xts object and hereafter work with xts objects + data.xts <- checkData(data) + + # extract columns to be used in the time series regression + dat.xts <- merge(data.xts[,asset.names], data.xts[,factor.names]) + if (add.up.market == TRUE | add.market.sqd == TRUE ) { + dat.xts <- merge(dat.xts, data.xts[,market.name]) + } + + # Selects regression procedure based on specified variable.selection method. + # Each method returns a list of fitted factor models for each asset. + if (variable.selection == "none") { + reg.list <- NoVariableSelection(dat.xts, asset.names, factor.names, + market.name, fit.method, add.up.market, + add.market.sqd, decay) + } else if (variable.selection == "stepwise"){ + reg.list <- SelectStepwise(dat.xts, asset.names, factor.names, + market.name, fit.method, + add.up.market, add.market.sqd, decay, + direction, steps, k) + } else if (variable.selection == "all subsets"){ + reg.list <- SelectAllSubsets(dat.xts, asset.names, factor.names, + market.name, fit.method, subsets.method, + nvmax, force.in, num.factors.subset, + add.up.market, add.market.sqd, decay) + } else if (variable.selection == "lars" | variable.selection == "lasso"){ + result.lars <- SelectLars(dat.xts, asset.names, factor.names, market.name, + variable.selection, add.up.market, add.market.sqd, + decay, lars.criterion) + result.lars <- c(result.lars, call, data, asset.names, factor.names, + fit.method, variable.selection) + return(result.lars) + } + else { + stop("Invalid argument: variable.selection must be either 'none', + 'stepwise','all subsets','lars' or 'lasso'") + } + + # extract the fitted factor models, coefficients, r2 values and residual vol + # from returned factor model fits above + alpha <- sapply(reg.list, function(x) coef(x)[1], USE.NAMES = FALSE) + beta <- sapply(reg.list, function(x) coef(x)[-1], USE.NAMES = FALSE) + r2 <- sapply(reg.list, function(x) summary(x)$r.squared) + resid.sd <- sapply(reg.list, function(x) summary(x)$sigma) + # create list of return values. + result <- list(asset.fit=reg.list, alpha=alpha, beta=beta, r2=r2, + resid.sd=resid.sd, call=call, data=data, + asset.names=asset.names, factor.names=factor.names, + fit.method=fit.method, variable.selection=variable.selection) + class(result) <- "tsfm" + return(result) +} + + +### method variable.selection = "none" +# +NoVariableSelection <- function (dat.xts, asset.names, factor.names, + market.name, fit.method, add.up.market, + add.market.sqd, decay){ + # initialize list object to hold the fitted objects + reg.list <- list() + + # loop through and estimate model for each asset to allow unequal histories + for (i in asset.names){ + # completely remove NA cases + reg.xts <- na.omit(dat.xts[, c(i, factor.names)]) + # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2 + reg.xts <- MarketFactors(dat.xts, reg.xts, market.name, + add.up.market, add.market.sqd) + # formula to pass to lm or lmRob + fm.formula <- as.formula(paste(i," ~ .")) + + # fit based on time series regression method chosen + if (fit.method == "OLS") { + reg.list[[i]] <- lm(fm.formula, data=reg.xts) + } else if (fit.method == "DLS") { + w <- WeightsDLS(nrow(reg.xts), decay) + reg.list[[i]] <- lm(fm.formula, data=reg.xts, weights=w) + } else if (fit.method == "Robust") { + reg.list[[i]] <- lmRob(fm.formula, data=reg.xts) + } else { + stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'") + } + } + reg.list +} + + +### method variable.selection = "stepwise" +# +SelectStepwise <- function(dat.xts, asset.names, factor.names, + market.name, fit.method, add.up.market, + add.market.sqd, decay, direction, steps, k){ + # initialize list object to hold the fitted objects + reg.list <- list() + + # loop through and estimate model for each asset to allow unequal histories + for (i in asset.names){ + # completely remove NA cases + reg.xts <- na.omit(dat.xts[, c(i, factor.names)]) + # formula to pass to lm or lmRob + fm.formula <- as.formula(paste(i," ~ .")) + + # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2 + if(fit.method=="Robust" && (add.up.market==TRUE | add.market.sqd==TRUE)) { + stop("This function does not support add.up.market/add.market.sqd when + variable.selection = 'stepwise' && fit.method = 'Robust'. Please + choose a different combination of options.") + } else { + reg.xts <- MarketFactors(dat.xts, reg.xts, market.name, + add.up.market, add.market.sqd) + } + + # fit based on time series regression method chosen + if (fit.method == "OLS") { + reg.list[[i]] <- step(lm(fm.formula, data=reg.xts), direction=direction, + steps=steps, k=k, trace=0) + } else if (fit.method == "DLS") { + w <- WeightsDLS(nrow(reg.xts), decay) + reg.list[[i]] <- step(lm(fm.formula, data=reg.xts, weights=w), + direction=direction, steps=steps, k=k, trace=0) + } else if (fit.method == "Robust") { + reg.list[[i]] <- step.lmRob(lmRob(fm.formula, data=reg.df), trace=FALSE, + direction=direction, steps=steps, k=k) + } else { + stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'") + } + } + reg.list +} + + +### method variable.selection = "all subsets" +# +SelectAllSubsets <- function(dat.xts, asset.names, factor.names, + market.name, fit.method, subsets.method, + nvmax, force.in, num.factors.subset, + add.up.market, add.market.sqd, decay){ + # Check argument validity + if (nvmax < num.factors.subset) { + stop("Invaid Argument: nvmax should be >= num.factors.subset") + } + # initialize list object to hold the fitted objects + reg.list <- list() + + # loop through and estimate model for each asset to allow unequal histories + for (i in asset.names){ + # formula to pass to lm or lmRob + fm.formula <- as.formula(paste(i," ~ .")) + + # branch out based on time series regression method chosen + if (fit.method == "Robust") { + warning("'Robust' fit.method is not available with 'all subsets' + variable.selection. Instead, results are shown for + variable.selection='none' with fit.method='Robust' to include + all factors.") + reg.xts <- na.omit(dat.xts[, c(i, factor.names)]) + reg.xts <- MarketFactors(dat.xts, reg.xts, market.name, + add.up.market, add.market.sqd) + asset.fit <- lmRob(fm.formula, data=reg.xts) + } + else if (fit.method == "OLS" | fit.method == "DLS") { + # use regsubsets to find the best model with a subset of factors of size + # num.factors.subset + + if (num.factors.subset == length(force.in)) { + reg.xts <- na.omit(dat.xts[, c(i, force.in)]) + } else if (num.factors.subset > length(force.in)) { + reg.xts <- na.omit(dat.xts[, c(i, factor.names)]) + if (fit.method != "DLS") {decay <- 1} + # do weighted least squares if "DLS" + w <- WeightsDLS(nrow(reg.xts), decay) + fm.subsets <- regsubsets(fm.formula, data=reg.xts, nvmax=nvmax, + force.in=force.in, method=subsets.method, + weights=w) + sum.sub <- summary(fm.subsets) + reg.xts <- na.omit(dat.xts[,c(i,names(which(sum.sub$which[ + as.character(num.factors.subset),-1]==TRUE)))]) + } else { + stop("Invalid Argument: num.factors.subset should be >= + length(force.in)") + } + + # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2 + reg.xts <- MarketFactors(dat.xts, reg.xts, market.name, + add.up.market, add.market.sqd) + # fit linear regression model for the factors chosen + reg.list[[i]] <- lm(fm.formula, data=reg.xts, weights=w) + } + else { + stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'") + } + } + reg.list +} + + +### method variable.selection = "lars" or "lasso" +# +SelectLars <- function(dat.xts, asset.names, factor.names, market.name, + variable.selection, add.up.market, add.market.sqd, + decay, lars.criterion) { + # initialize list object to hold the fitted objects and, vectors and matrices + # for the other results + asset.fit <- list() + alpha <- rep(NA, length(asset.names)) + beta <- matrix(NA, length(asset.names), length(factor.names)) + r2 <- rep(NA, length(asset.names)) + resid.sd <- rep(NA, length(asset.names)) + + + # loop through and estimate model for each asset to allow unequal histories + for (i in asset.names){ + # completely remove NA cases + reg.xts <- na.omit(dat.xts[, c(i, factor.names)]) + # optionally add factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2 + reg.xts <- MarketFactors(dat.xts, reg.xts, market.name, + add.up.market, add.market.sqd) + # convert to matrix + reg.mat <- as.matrix(na.omit(reg.xts)) + # fit lar or lasso regression model + lars.fit <- lars(reg.mat[,factor.names], reg.mat[,i], + type=variable.selection, trace = FALSE) + lars.sum <- summary(lars.fit) + + # get the step that minimizes the "Cp" statistic or the "cv" mean-sqd + # prediction error + if (lars.criterion == "Cp") { + s <- which.min(lars.sum$Cp) + } else if (lars.criterion == "cv") { + lars.cv <- cv.lars(reg.mat[,factor.names], reg.mat[,i], trace=FALSE, + type=variable.selection, mode="step", plot.it=FALSE) + s <- which.min(lars.cv$cv) + } else { + stop("Invalid argument: lars.criterion must be Cp' or 'cv'") + } + + # get factor model coefficients & fitted values at the step obtained above + coef.lars <- predict(lars.fit, s=s, type="coef", mode="step") + fitted.lars <- predict(lars.fit, reg.xts[,factor.names], s=s, type="fit", + mode="step") + # extract and assign the results + asset.fit[[i]] = lars.fit + alpha[i] <- (fitted.lars$fit - + reg.xts[,factor.names]%*%coef.lars$coefficients)[1] + beta.names <- names(coef.lars$coefficients) + beta[i,beta.names] <- coef.lars$coefficients + r2[i] <- lars.fit$R2[s] + resid.sd[i] <- lars.sum$Rss[s]/(nrow(reg.xts)-s) + + } + results.lars <- list(asset.fit, alpha, beta, r2, resid.sd) +} + + +### Format and add optional factors "up.market" and "market.sqd" +# +MarketFactors <- function(dat.xts, reg.xts, market.name, + add.up.market, add.market.sqd) { + if(add.up.market == TRUE) { + # up.market = max(0,Rm-Rf) + up.market <- apply(dat.xts[,market.name],1,max,0) + reg.xts <- merge(reg.xts,up.market) + colnames(reg.xts)[dim(reg.xts)[2]] <- "up.market" + } + if(add.market.sqd == TRUE) { + # market.sqd = (Rm-Rf)^2 + market.sqd <- dat.xts[,market.name]^2 + reg.xts <- merge(reg.xts,market.sqd) + colnames(reg.xts)[dim(reg.xts)[2]] <- "market.sqd" + } + reg.xts +} + + +### calculate weights for "DLS" +# +WeightsDLS <- function(t,d){ + # more weight given to more recent observations + w <- d^seq((t-1),0,-1) + # ensure that the weights sum to unity + w/sum(w) +} \ No newline at end of file Deleted: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2014-06-24 22:26:12 UTC (rev 3439) +++ pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2014-06-25 16:05:02 UTC (rev 3440) @@ -1,530 +0,0 @@ -#' Fit time series factor model by time series regression techniques. -#' -#' @description Fit time series factor model by time series regression techniques for single -#' or multiple assets. Classic OLS, Robust regression can be chosen and several model selection methods -#' can be applied. Class "TimeSeriesFactorModel" will be created too. -#' -#' @details -#' \code{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. -#' -#' @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 \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 -#' that sum to unity. "Robust" -#' @param variable.selection "none" will not activate variables sellection. Default is "none". -#' "stepwise" is traditional forward/backward #' stepwise OLS regression, starting from the initial set of factors, that adds -#' factors only if the regression fit as measured by the Bayesian Information -#' Criteria (BIC) or Akaike Information Criteria (AIC) can be done using the R -#' function step() from the stats package. If "Robust" is chosen, the -#' function step.lmRob in Robust package will be used. "all subsets" is -#' Traditional all subsets regression can be done using the R function -#' regsubsets() from the package leaps. "lar" , "lasso" is based on package -#' "lars", linear angle regression. If "lar" or "lasso" is chose. fit.method will be ignored. -#' @param decay.factor for DLS. Default is 0.95. -#' @param nvmax control option for all subsets. maximum size of subsets to -#' examine -#' @param force.in control option for all subsets. The factors that should be -#' 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 -#' 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 -#' 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{data} original data as input -#' \item{factors.names} factors.names as input -#' \item{variable.selection} variable.selection as input -#' \item{assets.names} asset.names as input -#' } -#' -#' -#' -#' -#' @author Eric Zivot and Yi-An Chen. -#' @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. -#' \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 -#' data(managers.df) -#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' # summary of HAM1 -#' summary(fit$asset.fit$HAM1) -#' # plot actual vs. fitted over time for HAM1 -#' # use chart.TimeSeries() function from PerformanceAnalytics package -#' dataToPlot = cbind(fitted(fit$asset.fit$HAM1), na.omit(managers.df$HAM1)) -#' colnames(dataToPlot) = c("Fitted","Actual") -#' chart.TimeSeries(dataToPlot, main="FM fit for HAM1", -#' colorset=c("black","blue"), legend.loc="bottomleft") -#' } -#' @export -fitTimeSeriesFactorModel <- -function(assets.names, factors.names, data=data, num.factor.subset = 1, - fit.method=c("OLS","DLS","Robust"), - variable.selection="none", - decay.factor = 0.95,nvmax=8,force.in=NULL, - subsets.method = c("exhaustive", "backward", "forward", "seqrep"), - lars.criteria = "Cp",add.up.market.returns = FALSE,add.quadratic.term = FALSE, - excess.market.returns.name ) { - - this.call <- match.call() - - # 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() - - -# initialize matrices and vectors to hold estimated betas, -# residual variances, and R-square values from -# fitted factor models - -Alphas = ResidVars = R2values = rep(NA, length(assets.names)) -names(Alphas) = names(ResidVars) = names(R2values) = assets.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)]) - if(add.up.market.returns == TRUE) { - reg.df$up.beta = reg.df[,excess.market.returns.name] - reg.df$up.beta[reg.df$up.beta <0] <- rep(0,sum(reg.df$up.beta<0)) - } - 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) - reg.list[[i]] = fm.fit - Alphas[i] = coef(fm.fit)[1] - Betas.names = names(coef(fm.fit)[-1]) - Betas[i,Betas.names] = coef(fm.fit)[-1] - ResidVars[i] = fm.summary$sigma^2 - R2values[i] = fm.summary$r.squared - } - } 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) { - w[k] = w[k-1]/decay.factor - } - # sum weigth to unitary - w <- w/sum(w) - fm.formula = as.formula(paste(i,"~", ".", sep="")) - fm.fit = lm(fm.formula, data=reg.df,weights=w) - fm.summary = summary(fm.fit) - reg.list[[i]] = fm.fit - Alphas[i] = coef(fm.fit)[1] - Betas.names = names(coef(fm.fit)[-1]) - Betas[i,Betas.names] = coef(fm.fit)[-1] - ResidVars[i] = fm.summary$sigma^2 - R2values[i] = fm.summary$r.squared - } - } 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) - 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") - } - -# -### 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) - reg.list[[i]] = fm.fit - Alphas[i] = coef(fm.fit)[1] - Betas.names = names(coef(fm.fit)[-1]) - Betas[i,Betas.names] = coef(fm.fit)[-1] - ResidVars[i] = fm.summary$sigma^2 - R2values[i] = fm.summary$r.squared - } [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3440 From noreply at r-forge.r-project.org Thu Jun 26 05:57:07 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 26 Jun 2014 05:57:07 +0200 (CEST) Subject: [Returnanalytics-commits] r3441 - in pkg/FactorAnalytics: . R man Message-ID: <20140626035708.0FBAB187534@r-forge.r-project.org> Author: pragnya Date: 2014-06-26 05:57:07 +0200 (Thu, 26 Jun 2014) New Revision: 3441 Added: pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/R/predict.tsfm.r pkg/FactorAnalytics/R/print.tsfm.r pkg/FactorAnalytics/R/summary.tsfm.r pkg/FactorAnalytics/R/tsfm.r pkg/FactorAnalytics/man/fitTSFM.Rd Removed: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r pkg/FactorAnalytics/man/fitTimeSeriesFactorModel.Rd Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitTSFM.R Log: Added help entry on class tsfm and corresponding edits to the generic methods. Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-25 16:05:02 UTC (rev 3440) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-26 03:57:07 UTC (rev 3441) @@ -23,7 +23,7 @@ export(factorModelVaRDecomposition) export(fitFundamentalFactorModel) export(fitStatisticalFactorModel) -export(fitTimeSeriesFactorModel) +export(fitTSFM) export(pCornishFisher) export(paFM) export(qCornishFisher) Modified: pkg/FactorAnalytics/R/fitTSFM.R =================================================================== --- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-25 16:05:02 UTC (rev 3440) +++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 03:57:07 UTC (rev 3441) @@ -5,7 +5,7 @@ #' Users can choose between ordinary least squares-OLS, discounted least #' squares-DLS (or) robust regression. Several variable selection options #' including Stepwise, Subsets, Lars are available as well. An object of class -#' \code{tsfm} is returned. +#' \code{\link{tsfm}} is returned. #' #' @details #' Estimation method "OLS" corresponds to ordinary least squares, "DLS" is @@ -87,22 +87,25 @@ #' and "DLS" fits. Scope argument is not available presently. Also plan to #' include other controls passed to \code{lmRob} soon. #' -#' @return The returned value is an S3 object of class \code{tsfm} +#' @return fitTSFM returns an object of class +#' \code{tsfm}.The returned object is a list #' containing the following components: -#' \item{asset.fit} {list of the fitted objects for each asset. Each fitted +#' \describe{ +#' \item{asset.fit}{list of the fitted objects for each asset. Each fitted #' object is of class \code{lm} if \code{fit.method} is "OLS" or "DLS"; #' of class \code{lmRob} if the \code{fit.method} is "Robust"; of class -#' \code{lars} if \code{variable.selection}="lars" or "lasso". -#' \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-squared values.} -#' \item{resid.sd} {N x 1 vector of residual standard deviations.} -#' \item{call} {the matched function call.} -#' \item{data} {data as input.} -#' \item{asset.names} {asset.names as input.} -#' \item{factor.names{ {factor.names as input.} -#' \item{fit.method} {fit.method as input.} -#' \item{variable.selection} {variable.selection as input.} +#' \code{lars} if \code{variable.selection}="lars" or "lasso".} +#' \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-squared values.} +#' \item{resid.sd}{N x 1 vector of residual standard deviations.} +#' \item{call}{the matched function call.} +#' \item{data}{data as input.} +#' \item{asset.names}{asset.names as input.} +#' \item{factor.names}{factor.names as input.} +#' \item{fit.method}{fit.method as input.} +#' \item{variable.selection}{variable.selection as input.} +#' } #' Where N is the number of assets and K is the number of factors. #' #' @family Factor Models Deleted: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2014-06-25 16:05:02 UTC (rev 3440) +++ pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2014-06-26 03:57:07 UTC (rev 3441) @@ -1,486 +0,0 @@ -#' plot TimeSeriesFactorModel object. -#' -#' Generic function of plot method for fitTimeSeriesFactorModel. Either plot -#' all assets or choose a single asset to plot. -#' -#' -#' @param x fit object created by \code{fitTimeSeriesFactorModel}. -#' @param colorset Defualt colorset the same as \code{barplot}. -#' @param legend.loc Plot legend or not. Defualt is \code{NULL}. -#' @param which.plot Integer indicates which plot to create: "none" will -#' create a menu to choose. Defualt is none.\cr -#' 1 = "Fitted factor returns", \cr -#' 2 = "R square", \cr -#' 3 = "Variance of Residuals",\cr -#' 4 = "FM Correlation",\cr -#' 5 = "Factor Contributions to SD",\cr -#' 6 = "Factor Contributions to ES",\cr -#' 7 = "Factor Contributions to VaR" -#' @param max.show Maximum assets to plot. Default is 6. -#' @param plot.single Plot a single asset of lm class. Defualt is \code{FALSE}. -#' @param asset.name Name of the asset to be plotted. -#' @param which.plot.single Integer indicates which plot to create: "none" -#' will create a menu to choose. Defualt is none.\cr -#' 1 = time series plot of actual and fitted values,\cr -#' 2 = time series plot of residuals with standard error bands, \cr -#' 3 = time series plot of squared residuals, \cr -#' 4 = time series plot of absolute residuals,\cr -#' 5 = SACF and PACF of residuals,\cr -#' 6 = SACF and PACF of squared residuals,\cr -#' 7 = SACF and PACF of absolute residuals,\cr -#' 8 = histogram of residuals with normal curve overlayed,\cr -#' 9 = normal qq-plot of residuals,\cr -#' 10= CUSUM plot of recursive residuals,\cr -#' 11= CUSUM plot of OLS residuals,\cr -#' 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr -#' 13= rolling estimates over 24 month window. -#' @param VaR.method Character, method for computing VaR. Valid choices are -#' either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} -#' in the PerformanceAnalytics package. Default is "historical". -#' @param ... further arguments passed to or from other methods. -#' @author Eric Zivot and Yi-An Chen. -#' @examples -#' -#' \dontrun{ -#' # load data from the database -#' data(managers.df) -#' fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' # plot of all assets and show only first 4 assets. -#' plot(fit.macro,max.show=4) -#' # single plot of HAM1 asset -#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") -#' } -#' @method plot TimeSeriesFactorModel -#' @export -plot.TimeSeriesFactorModel <- - function(x,colorset=c(1:12),legend.loc=NULL, - which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6, - plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", - "7L","8L","9L","10L","11L","12L","13L"), - VaR.method = "historical", ...) { - - if (plot.single==TRUE) { - ## inputs: - ## fit.macro lm object summarizing factor model fit. It is assumed that - ## time series date information is included in the names component - ## of the residuals, fitted and model components of the object. - ## asset.name charater. The name of the single asset to be ploted. - ## which.plot.single integer indicating which plot to create: - ## 1 time series plot of actual and fitted values - ## 2 time series plot of residuals with standard error bands - ## 3 time series plot of squared residuals - ## 4 time series plot of absolute residuals - ## 5 SACF and PACF of residuals - ## 6 SACF and PACF of squared residuals - ## 7 SACF and PACF of absolute residuals - ## 8 histogram of residuals with normal curve overlayed - ## 9 normal qq-plot of residuals - ## 10 CUSUM plot of recursive residuals - ## 11 CUSUM plot of OLS residuals - ## 12 CUSUM plot of recursive estimates relative to full sample estimates - ## 13 rolling estimates over 24 month window - which.plot.single<-which.plot.single[1] - if (missing(asset.name) == TRUE) { - stop("Neet to specify an asset to plot if plot.single is TRUE.") - } - - fit.lm = x$asset.fit[[asset.name]] - - if (x$variable.selection == "none") { - - ## extract information from lm object - - factorNames = colnames(fit.lm$model)[-1] - fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" ")) - residuals.z = zoo(residuals(fit.lm), as.Date(names(residuals(fit.lm)))) - fitted.z = zoo(fitted(fit.lm), as.Date(names(fitted(fit.lm)))) - actual.z = zoo(fit.lm$model[,1], as.Date(rownames(fit.lm$model))) - tmp.summary = summary(fit.lm) - - - if (which.plot.single=="none") - which.plot.single<-menu(c("time series plot of actual and fitted values", - "time series plot of residuals with standard error bands", - "time series plot of squared residuals", - "time series plot of absolute residuals", - "SACF and PACF of residuals", - "SACF and PACF of squared residuals", - "SACF and PACF of absolute residuals", - "histogram of residuals with normal curve overlayed", - "normal qq-plot of residuals", - "CUSUM plot of recursive residuals", - "CUSUM plot of OLS residuals", - "CUSUM plot of recursive estimates relative to full sample estimates", - "rolling estimates over 24 month window"), - title="\nMake a plot selection (or 0 to exit):\n") - switch(which.plot.single, - "1L" = { - ## time series plot of actual and fitted values - plot(actual.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black") - lines(fitted.z, lwd=2, col="blue") - abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) - }, - - "2L" = { - ## time series plot of residuals with standard error bands - plot(residuals.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black") - abline(h=0) - abline(h=2*tmp.summary$sigma, lwd=2, lty="dotted", col="red") - abline(h=-2*tmp.summary$sigma, lwd=2, lty="dotted", col="red") - legend(x="bottomleft", legend=c("Residual", "+/ 2*SE"), lwd=2, - lty=c("solid","dotted"), col=c("black","red")) - }, - "3L" = { - ## time series plot of squared residuals - plot(residuals.z^2, main=asset.name, ylab="Squared residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Squared Residuals", lwd=2, col="black") - }, - "4L" = { - ## time series plot of absolute residuals - plot(abs(residuals.z), main=asset.name, ylab="Absolute residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Absolute Residuals", lwd=2, col="black") - }, - "5L" = { - ## SACF and PACF of residuals - chart.ACFplus(residuals.z, main=paste("Residuals: ", asset.name, sep="")) - }, - "6L" = { - ## SACF and PACF of squared residuals - chart.ACFplus(residuals.z^2, main=paste("Residuals^2: ", asset.name, sep="")) - }, - "7L" = { - ## SACF and PACF of absolute residuals - chart.ACFplus(abs(residuals.z), main=paste("|Residuals|: ", asset.name, sep="")) - }, - "8L" = { - ## histogram of residuals with normal curve overlayed - chart.Histogram(residuals.z, methods="add.normal", main=paste("Residuals: ", asset.name, sep="")) - }, - "9L" = { - ## normal qq-plot of residuals - chart.QQPlot(residuals.z, envelope=0.95, main=paste("Residuals: ", asset.name, sep="")) - }, - "10L"= { - ## CUSUM plot of recursive residuals - if (as.character(x$call["fit.method"]) == "OLS") { - cusum.rec = efp(fit.formula, type="Rec-CUSUM", data=fit.lm$model) - plot(cusum.rec, sub=asset.name) - } else - stop("CUMSUM applies only on OLS method") - }, - "11L"= { - ## CUSUM plot of OLS residuals - if (as.character(x$call["fit.method"]) == "OLS") { - cusum.ols = efp(fit.formula, type="OLS-CUSUM", data=fit.lm$model) - plot(cusum.ols, sub=asset.name) - } else - stop("CUMSUM applies only on OLS method") - }, - "12L"= { - ## CUSUM plot of recursive estimates relative to full sample estimates - if (as.character(x$call["fit.method"]) == "OLS") { - cusum.est = efp(fit.formula, type="fluctuation", data=fit.lm$model) - plot(cusum.est, functional=NULL, sub=asset.name) - } else - stop("CUMSUM applies only on OLS method") - }, - "13L"= { - ## rolling regression over 24 month window - if (as.character(x$call["fit.method"]) == "OLS") { - rollReg <- function(data.z, formula) { - coef(lm(formula, data = as.data.frame(data.z))) - } - reg.z = zoo(fit.lm$model, as.Date(rownames(fit.lm$model))) - rollReg.z = rollapply(reg.z, FUN=rollReg, fit.formula, width=24, by.column = FALSE, - align="right") - plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" ")) - } else if (as.character(x$call["fit.method"]) == "DLS") { - decay.factor <- as.numeric(as.character(x$call["decay.factor"])) - t.length <- 24 - w <- rep(decay.factor^(t.length-1),t.length) - for (k in 2:t.length) { - w[k] = w[k-1]/decay.factor - } - w <- w/sum(w) - rollReg.w <- function(data.z, formula,w) { - coef(lm(formula,weights=w, data = as.data.frame(data.z))) - } - reg.z = zoo(fit.lm$model[-length(fit.lm$model)], as.Date(rownames(fit.lm$model))) - factorNames = colnames(fit.lm$model)[c(-1,-length(fit.lm$model))] - fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" ")) - rollReg.z = rollapply(reg.z, FUN=rollReg.w, fit.formula,w, width=24, by.column = FALSE, - align="right") - plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" ")) - } - }, - invisible() - ) - - } else { - # lar or lasso - - factor.names = x$factors.names - plot.data = x$data[,c(asset.name,factor.names)] - alpha = x$alpha[asset.name] - beta = as.matrix(x$beta[asset.name,]) - fitted.z = zoo(alpha+as.matrix(plot.data[,factor.names])%*%beta,as.Date(rownames(plot.data))) - residuals.z = plot.data[,asset.name]-fitted.z - actual.z = zoo(plot.data[,asset.name],as.Date(rownames(plot.data))) - t = length(residuals.z) - k = length(factor.names) - - which.plot.single<-menu(c("time series plot of actual and fitted values", - "time series plot of residuals with standard error bands", - "time series plot of squared residuals", - "time series plot of absolute residuals", - "SACF and PACF of residuals", - "SACF and PACF of squared residuals", - "SACF and PACF of absolute residuals", - "histogram of residuals with normal curve overlayed", - "normal qq-plot of residuals"), - title="\nMake a plot selection (or 0 to exit):\n") - switch(which.plot.single, - "1L" = { - # "time series plot of actual and fitted values", - - plot(actual.z[,asset.name], main=asset.name, ylab="Monthly performance", lwd=2, col="black") - lines(fitted.z, lwd=2, col="blue") - abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) - }, - "2L"={ - # "time series plot of residuals with standard error bands" - plot(residuals.z, main=asset.name, ylab="Monthly performance", lwd=2, col="black") - abline(h=0) - sigma = (sum(residuals.z^2)*(t-k)^-1)^(1/2) - abline(h=2*sigma, lwd=2, lty="dotted", col="red") - abline(h=-2*sigma, lwd=2, lty="dotted", col="red") - legend(x="bottomleft", legend=c("Residual", "+/ 2*SE"), lwd=2, - lty=c("solid","dotted"), col=c("black","red")) - - }, - "3L"={ - # "time series plot of squared residuals" - plot(residuals.z^2, main=asset.name, ylab="Squared residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Squared Residuals", lwd=2, col="black") - }, - "4L" = { - ## time series plot of absolute residuals - plot(abs(residuals.z), main=asset.name, ylab="Absolute residual", lwd=2, col="black") - abline(h=0) - legend(x="topleft", legend="Absolute Residuals", lwd=2, col="black") - }, - "5L" = { - ## SACF and PACF of residuals - chart.ACFplus(residuals.z, main=paste("Residuals: ", asset.name, sep="")) - }, - "6L" = { - ## SACF and PACF of squared residuals - chart.ACFplus(residuals.z^2, main=paste("Residuals^2: ", asset.name, sep="")) - }, - "7L" = { - ## SACF and PACF of absolute residuals - chart.ACFplus(abs(residuals.z), main=paste("|Residuals|: ", asset.name, sep="")) - }, - "8L" = { - ## histogram of residuals with normal curve overlayed - chart.Histogram(residuals.z, methods="add.normal", main=paste("Residuals: ", asset.name, sep="")) - }, - "9L" = { - ## normal qq-plot of residuals - chart.QQPlot(residuals.z, envelope=0.95, main=paste("Residuals: ", asset.name, sep="")) - }, - invisible() ) - - } - # plot group data - } else { - which.plot<-which.plot[1] - - if(which.plot=='none') - which.plot<-menu(c("Fitted factor returns", - "R square", - "Variance of Residuals", - "FM Correlation", - "Factor Contributions to SD", - "Factor Contributions to ES", - "Factor Contributions to VaR"), - title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n") - - - variable.selection = x$variable.selection - asset.names = x$assets.names - factor.names = x$factors.names - plot.data = x$data[,c(asset.names,factor.names)] - cov.factors = var(plot.data[,factor.names]) - n <- length(asset.names) - - switch(which.plot, - - "1L" = { - if (n > max.show) { - cat(paste("numbers of assets are greater than",max.show,", show only first", - max.show,"assets",sep=" ")) - n <- max.show - } - par(mfrow=c(n/2,2)) - if (variable.selection == "lar" || variable.selection == "lasso") { - for (i in 1:n) { - alpha = x$alpha[i] - beta = as.matrix(x$beta[i,]) - fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta - dataToPlot = cbind(fitted, plot.data[,i]) - colnames(dataToPlot) = c("Fitted","Actual") - main = paste("Factor Model fit for",asset.names[i],seq="") - chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main) - } - } else { - for (i in 1:n) { - dataToPlot = cbind(fitted(x$asset.fit[[i]]), na.omit(plot.data[,i])) - colnames(dataToPlot) = c("Fitted","Actual") - main = paste("Factor Model fit for",asset.names[i],seq="") - chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main) - } - } - par(mfrow=c(1,1)) - }, - "2L" ={ - barplot(x$r2) - }, - "3L" = { - barplot(x$resid.variance) - }, - - "4L" = { - cov.fm<- factorModelCovariance(x$beta,cov.factors,x$resid.variance) - cor.fm = cov2cor(cov.fm) - rownames(cor.fm) = colnames(cor.fm) - ord <- order(cor.fm[1,]) - ordered.cor.fm <- cor.fm[ord, ord] - plotcorr(ordered.cor.fm, col=cm.colors(11)[5*ordered.cor.fm + 6]) - }, - "5L" = { - factor.sd.decomp.list = list() - for (i in asset.names) { - factor.sd.decomp.list[[i]] = - factorModelSdDecomposition(x$beta[i,], - cov.factors, x$resid.variance[i]) - } - # function to extract contribution to sd from list - getCSD = function(x) { - x$cSd.fm - } - # extract contributions to SD from list - cr.sd = sapply(factor.sd.decomp.list, getCSD) - rownames(cr.sd) = c(factor.names, "residual") - # create stacked barchart - barplot(cr.sd, main="Factor Contributions to SD", - legend.text=T, args.legend=list(x="topleft")) - - }, - "6L"={ - factor.es.decomp.list = list() - if (variable.selection == "lar" || variable.selection == "lasso") { - - for (i in asset.names) { - idx = which(!is.na(plot.data[,i])) - alpha = x$alpha[i] - beta = as.matrix(x$beta[i,]) - fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta - residual = plot.data[,i]-fitted - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - (residual[idx,]/sqrt(x$resid.variance[i])) ) - colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") - factor.es.decomp.list[[i]] = - factorModelEsDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05) - - } - } else { - - for (i in asset.names) { - # check for missing values in fund data - idx = which(!is.na(plot.data[,i])) - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - residuals(x$asset.fit[[i]])/sqrt(x$resid.variance[i])) - colnames(tmpData)[c(1,dim(tmpData)[2])] = c(i, "residual") - factor.es.decomp.list[[i]] = - factorModelEsDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05, - VaR.method=VaR.method) - } - } - - # stacked bar charts of percent contributions to SD - getCETL = function(x) { - x$cES.fm - } - # report as positive number - cr.etl = sapply(factor.es.decomp.list, getCETL) - rownames(cr.etl) = c(factor.names, "residual") - barplot(cr.etl, main="Factor Contributions to ES", - legend.text=T, args.legend=list(x="topleft")) - }, - "7L" ={ - - factor.VaR.decomp.list = list() - - if (variable.selection == "lar" || variable.selection == "lasso") { - - for (i in asset.names) { - idx = which(!is.na(plot.data[,i])) - alpha = x$alpha[i] - beta = as.matrix(x$beta[i,]) - fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta - residual = plot.data[,i]-fitted - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - (residual[idx,]/sqrt(x$resid.variance[i])) ) - colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") - factor.VaR.decomp.list[[i]] = - factorModelVaRDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05,VaR.method=VaR.method) - - } - } else { - for (i in asset.names) { - # check for missing values in fund data - idx = which(!is.na(plot.data[,i])) - tmpData = cbind(coredata(plot.data[idx,i]), - coredata(plot.data[idx,factor.names]), - residuals(x$asset.fit[[i]])/sqrt(x$resid.variance[i])) - colnames(tmpData)[c(1,dim(tmpData)[2])] = c(i, "residual") - factor.VaR.decomp.list[[i]] = - factorModelVaRDecomposition(tmpData, - x$beta[i,], - x$resid.variance[i], tail.prob=0.05, - VaR.method=VaR.method) - } - } - - # stacked bar charts of percent contributions to SD - getCVaR = function(x) { - x$cVaR.fm - } - # report as positive number - cr.VaR = sapply(factor.VaR.decomp.list, getCVaR) - rownames(cr.VaR) = c(factor.names, "residual") - barplot(cr.VaR, main="Factor Contributions to VaR", - legend.text=T, args.legend=list(x="topleft")) - }, - invisible() - ) - } - - } Added: pkg/FactorAnalytics/R/plot.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.tsfm.r (rev 0) +++ pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441) @@ -0,0 +1,486 @@ +#' plot TimeSeriesFactorModel object. +#' +#' Generic function of plot method for fitTimeSeriesFactorModel. Either plot +#' all assets or choose a single asset to plot. +#' +#' +#' @param x fit object created by \code{fitTimeSeriesFactorModel}. +#' @param colorset Defualt colorset the same as \code{barplot}. +#' @param legend.loc Plot legend or not. Defualt is \code{NULL}. +#' @param which.plot Integer indicates which plot to create: "none" will +#' create a menu to choose. Defualt is none.\cr +#' 1 = "Fitted factor returns", \cr +#' 2 = "R square", \cr +#' 3 = "Variance of Residuals",\cr +#' 4 = "FM Correlation",\cr +#' 5 = "Factor Contributions to SD",\cr +#' 6 = "Factor Contributions to ES",\cr +#' 7 = "Factor Contributions to VaR" +#' @param max.show Maximum assets to plot. Default is 6. +#' @param plot.single Plot a single asset of lm class. Defualt is \code{FALSE}. +#' @param asset.name Name of the asset to be plotted. +#' @param which.plot.single Integer indicates which plot to create: "none" +#' will create a menu to choose. Defualt is none.\cr +#' 1 = time series plot of actual and fitted values,\cr +#' 2 = time series plot of residuals with standard error bands, \cr +#' 3 = time series plot of squared residuals, \cr +#' 4 = time series plot of absolute residuals,\cr +#' 5 = SACF and PACF of residuals,\cr +#' 6 = SACF and PACF of squared residuals,\cr +#' 7 = SACF and PACF of absolute residuals,\cr +#' 8 = histogram of residuals with normal curve overlayed,\cr +#' 9 = normal qq-plot of residuals,\cr +#' 10= CUSUM plot of recursive residuals,\cr +#' 11= CUSUM plot of OLS residuals,\cr +#' 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr +#' 13= rolling estimates over 24 month window. +#' @param VaR.method Character, method for computing VaR. Valid choices are +#' either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} +#' in the PerformanceAnalytics package. Default is "historical". +#' @param ... further arguments passed to or from other methods. +#' @author Eric Zivot and Yi-An Chen. +#' @examples +#' +#' \dontrun{ +#' # load data from the database +#' data(managers.df) +#' fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), +#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS") +#' # plot of all assets and show only first 4 assets. +#' plot(fit.macro,max.show=4) +#' # single plot of HAM1 asset +#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") +#' } +#' @method plot TimeSeriesFactorModel +#' @export +plot.TimeSeriesFactorModel <- + function(x,colorset=c(1:12),legend.loc=NULL, + which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6, + plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", + "7L","8L","9L","10L","11L","12L","13L"), + VaR.method = "historical", ...) { + + if (plot.single==TRUE) { + ## inputs: + ## fit.macro lm object summarizing factor model fit. It is assumed that + ## time series date information is included in the names component + ## of the residuals, fitted and model components of the object. + ## asset.name charater. The name of the single asset to be ploted. + ## which.plot.single integer indicating which plot to create: + ## 1 time series plot of actual and fitted values + ## 2 time series plot of residuals with standard error bands + ## 3 time series plot of squared residuals + ## 4 time series plot of absolute residuals + ## 5 SACF and PACF of residuals + ## 6 SACF and PACF of squared residuals + ## 7 SACF and PACF of absolute residuals + ## 8 histogram of residuals with normal curve overlayed + ## 9 normal qq-plot of residuals + ## 10 CUSUM plot of recursive residuals + ## 11 CUSUM plot of OLS residuals + ## 12 CUSUM plot of recursive estimates relative to full sample estimates [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3441 From noreply at r-forge.r-project.org Thu Jun 26 09:54:15 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 26 Jun 2014 09:54:15 +0200 (CEST) Subject: [Returnanalytics-commits] r3442 - in pkg/FactorAnalytics: . R man Message-ID: <20140626075415.8F9881855E9@r-forge.r-project.org> Author: pragnya Date: 2014-06-26 09:54:15 +0200 (Thu, 26 Jun 2014) New Revision: 3442 Added: pkg/FactorAnalytics/man/.Rapp.history pkg/FactorAnalytics/man/plot.TSFM.Rd pkg/FactorAnalytics/man/predict.tsfm.Rd pkg/FactorAnalytics/man/print.tsfm.Rd pkg/FactorAnalytics/man/summary.tsfm.Rd Removed: pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitTSFM.R pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/R/predict.tsfm.r pkg/FactorAnalytics/R/print.tsfm.r pkg/FactorAnalytics/R/summary.tsfm.r pkg/FactorAnalytics/R/tsfm.r pkg/FactorAnalytics/man/fitTSFM.Rd Log: Edits to the S3 methods for class tsfm and their documentation. Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-26 07:54:15 UTC (rev 3442) @@ -2,18 +2,14 @@ S3method(plot,FundamentalFactorModel) S3method(plot,StatFactorModel) -S3method(plot,TimeSeriesFactorModel) S3method(plot,pafm) S3method(predict,FundamentalFactorModel) S3method(predict,StatFactorModel) -S3method(predict,TimeSeriesFactorModel) S3method(print,FundamentalFactorModel) S3method(print,StatFactorModel) -S3method(print,TimeSeriesFactorModel) S3method(print,pafm) S3method(summary,FundamentalFactorModel) S3method(summary,StatFactorModel) -S3method(summary,TimeSeriesFactorModel) S3method(summary,pafm) export(dCornishFisher) export(factorModelCovariance) @@ -26,5 +22,9 @@ export(fitTSFM) export(pCornishFisher) export(paFM) +export(plot.TSFM) +export(predict.tsfm) +export(print.tsfm) export(qCornishFisher) export(rCornishFisher) +export(summary.tsfm) Modified: pkg/FactorAnalytics/R/fitTSFM.R =================================================================== --- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 07:54:15 UTC (rev 3442) @@ -111,6 +111,7 @@ #' @family Factor Models #' #' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan. +#' #' @references #' \enumerate{ #' \item Christopherson, Carino and Ferson (2009). Portfolio Performance @@ -125,6 +126,10 @@ #' Journal of Business, Vol 54, No 4. #' } #' +#' @seealso \code{\link{summary.tsfm}}, \code{\link{plot.tsfm}}, +#' \code{\link{predict.tsfm}}, \code{\link{coef.tsfm}}, +#' \code{\link{fitted.tsfm}}, \code{\link{residuals.tsfm}} +#' #' @examples #' \dontrun{ #' # load data from the database @@ -152,7 +157,7 @@ "seqrep"), nvmax=8, force.in=NULL, num.factors.subset=1, add.up.market=FALSE, add.market.sqd=FALSE, - decay=0.95, lars.criterion="Cp", ...) { + decay=0.95, lars.criterion="Cp", ...){ # get all the arguments specified by their full names call <- match.call() @@ -280,14 +285,14 @@ # fit based on time series regression method chosen if (fit.method == "OLS") { reg.list[[i]] <- step(lm(fm.formula, data=reg.xts), direction=direction, - steps=steps, k=k, trace=0) + steps=steps, k=k, trace=0) } else if (fit.method == "DLS") { w <- WeightsDLS(nrow(reg.xts), decay) reg.list[[i]] <- step(lm(fm.formula, data=reg.xts, weights=w), - direction=direction, steps=steps, k=k, trace=0) + direction=direction, steps=steps, k=k, trace=0) } else if (fit.method == "Robust") { reg.list[[i]] <- step.lmRob(lmRob(fm.formula, data=reg.df), trace=FALSE, - direction=direction, steps=steps, k=k) + direction=direction, steps=steps, k=k) } else { stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'") } @@ -422,7 +427,7 @@ ### Format and add optional factors "up.market" and "market.sqd" # MarketFactors <- function(dat.xts, reg.xts, market.name, - add.up.market, add.market.sqd) { + add.up.market, add.market.sqd){ if(add.up.market == TRUE) { # up.market = max(0,Rm-Rf) up.market <- apply(dat.xts[,market.name],1,max,0) Modified: pkg/FactorAnalytics/R/plot.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442) @@ -1,27 +1,35 @@ -#' plot TimeSeriesFactorModel object. +#' @title Plots from a fitted time series factor model #' -#' Generic function of plot method for fitTimeSeriesFactorModel. Either plot -#' all assets or choose a single asset to plot. +#' @description S3 \code{plot} method for object of class \code{tsfm}. Plots +#' selected characteristics for one or more assets. #' -#' -#' @param x fit object created by \code{fitTimeSeriesFactorModel}. -#' @param colorset Defualt colorset the same as \code{barplot}. -#' @param legend.loc Plot legend or not. Defualt is \code{NULL}. -#' @param which.plot Integer indicates which plot to create: "none" will -#' create a menu to choose. Defualt is none.\cr -#' 1 = "Fitted factor returns", \cr -#' 2 = "R square", \cr -#' 3 = "Variance of Residuals",\cr +#' @param x an object of class \code{tsfm} produced by \code{fitTSFM}. +#' @param colorset a vector of colors for the bars or bar components. Argument +#' is used by \code{\link[graphics]{barplot}}. Default is c(1:12). +#' @param legend.loc places a legend into one of nine locations on the chart: +#' bottomright, bottom, bottomleft, left, topleft, top, topright, right, or +#' center. Argument is used by +#' \code{\link[PerformanceAnalytics]{chart.TimeSeries}}. Default is \code{NULL}. +#' @param which.plot a number or "none" to indicate which type of group plot to +#' create for multiple assets. Default is "none"; which brings up the following +#' menu to select a type. \cr +#' 1 = "Fitted asset returns", \cr +#' 2 = "R-squared", \cr +#' 3 = "Residual Volatility",\cr #' 4 = "FM Correlation",\cr -#' 5 = "Factor Contributions to SD",\cr -#' 6 = "Factor Contributions to ES",\cr -#' 7 = "Factor Contributions to VaR" -#' @param max.show Maximum assets to plot. Default is 6. -#' @param plot.single Plot a single asset of lm class. Defualt is \code{FALSE}. -#' @param asset.name Name of the asset to be plotted. -#' @param which.plot.single Integer indicates which plot to create: "none" -#' will create a menu to choose. Defualt is none.\cr -#' 1 = time series plot of actual and fitted values,\cr +#' 5 = "Factors' Contribution to SD",\cr +#' 6 = "Factors' Contribution to ES",\cr +#' 7 = "Factors' Contribution to VaR" +#' @param max.show maximum number of assets in a plot. Default is 6. +#' @param plot.single a logical value. If \code{TRUE}, plots an individual +#' asset's linear factor model trait selected by \code{which.plot.single}. +#' Default is \code{FALSE}. +#' @param asset.name name of the individual asset to be plotted. Is necessary +#' if \code{plot.single=TRUE} +#' @param which.plot.single a number or "none" to indicate which type of group +#' plot to create for multiple assets. Default is "none"; which brings up the +#' following menu to select a type.\cr +#' 1 = time series plot of actual and fitted factor returns,\cr #' 2 = time series plot of residuals with standard error bands, \cr #' 3 = time series plot of squared residuals, \cr #' 4 = time series plot of absolute residuals,\cr @@ -33,33 +41,39 @@ #' 10= CUSUM plot of recursive residuals,\cr #' 11= CUSUM plot of OLS residuals,\cr #' 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr -#' 13= rolling estimates over 24 month window. -#' @param VaR.method Character, method for computing VaR. Valid choices are -#' either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} -#' in the PerformanceAnalytics package. Default is "historical". +#' 13= rolling estimates over an observation window of length 24. +#' @param VaR.method a method for computing VaR; one of "modified", "gaussian", +#' "historical" or "kernel". VaR is computed using +#' \code{\link[PerformanceAnalytics]{VaR}}. Default is "historical". #' @param ... further arguments passed to or from other methods. -#' @author Eric Zivot and Yi-An Chen. +#' +#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' #' @examples #' #' \dontrun{ #' # load data from the database #' data(managers.df) -#' fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' # plot of all assets and show only first 4 assets. +#' fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS") +#' # plot all assets and show only the first 4 assets. #' plot(fit.macro,max.show=4) -#' # single plot of HAM1 asset +#' # plot of an individual asset, "HAM1" #' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") #' } -#' @method plot TimeSeriesFactorModel +#' #' @export -plot.TimeSeriesFactorModel <- - function(x,colorset=c(1:12),legend.loc=NULL, - which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6, - plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", - "7L","8L","9L","10L","11L","12L","13L"), - VaR.method = "historical", ...) { + +plot.TSFM <- + function(x, colorset=c(1:12), legend.loc=NULL, + which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"), max.show=6, + plot.single=FALSE, asset.name, + which.plot.single=c("none","1L","2L","3L","4L","5L","6L","7L","8L", + "9L","10L","11L","12L","13L"), + VaR.method = "historical", ...){ if (plot.single==TRUE) { ## inputs: @@ -80,7 +94,7 @@ ## 10 CUSUM plot of recursive residuals ## 11 CUSUM plot of OLS residuals ## 12 CUSUM plot of recursive estimates relative to full sample estimates - ## 13 rolling estimates over 24 month window + ## 13 rolling estimates over an observation window of length 24 which.plot.single<-which.plot.single[1] if (missing(asset.name) == TRUE) { stop("Neet to specify an asset to plot if plot.single is TRUE.") @@ -113,7 +127,7 @@ "CUSUM plot of recursive residuals", "CUSUM plot of OLS residuals", "CUSUM plot of recursive estimates relative to full sample estimates", - "rolling estimates over 24 month window"), + "rolling estimates over an observation window of length 24"), title="\nMake a plot selection (or 0 to exit):\n") switch(which.plot.single, "1L" = { @@ -304,13 +318,13 @@ which.plot<-which.plot[1] if(which.plot=='none') - which.plot<-menu(c("Fitted factor returns", - "R square", - "Variance of Residuals", + which.plot<-menu(c("Fitted asset returns", + "R-squared", + "Residual Volatility", "FM Correlation", - "Factor Contributions to SD", - "Factor Contributions to ES", - "Factor Contributions to VaR"), + "Factors' Contribution to SD", + "Factors' Contribution to ES", + "Factors' Contribution to VaR"), title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n") @@ -354,7 +368,7 @@ barplot(x$r2) }, "3L" = { - barplot(x$resid.variance) + barplot(x$resid.sd) }, "4L" = { @@ -380,7 +394,7 @@ cr.sd = sapply(factor.sd.decomp.list, getCSD) rownames(cr.sd) = c(factor.names, "residual") # create stacked barchart - barplot(cr.sd, main="Factor Contributions to SD", + barplot(cr.sd, main="Factors' Contribution to SD", legend.text=T, args.legend=list(x="topleft")) }, @@ -428,7 +442,7 @@ # report as positive number cr.etl = sapply(factor.es.decomp.list, getCETL) rownames(cr.etl) = c(factor.names, "residual") - barplot(cr.etl, main="Factor Contributions to ES", + barplot(cr.etl, main="Factors' Contribution to ES", legend.text=T, args.legend=list(x="topleft")) }, "7L" ={ @@ -476,7 +490,7 @@ # report as positive number cr.VaR = sapply(factor.VaR.decomp.list, getCVaR) rownames(cr.VaR) = c(factor.names, "residual") - barplot(cr.VaR, main="Factor Contributions to VaR", + barplot(cr.VaR, main="Factors' Contribution to VaR", legend.text=T, args.legend=list(x="topleft")) }, invisible() Modified: pkg/FactorAnalytics/R/predict.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/predict.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/R/predict.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442) @@ -1,43 +1,50 @@ -#' predict method for TimeSeriesModel object. +#' @title Predicts asset returns based on a fitted time series factor model #' -#' Generic function of predict method for fitTimeSeriesFactorModel. It utilizes -#' function \code{predict.lm}. +#' @description S3 \code{predict} method for object of class \code{tsfm}. It +#' calls the \code{predict} method for fitted objects of class \code{lm}, +#' \code{lmRob} or \code{lars} as appropriate. #' -#' @param object A fit object created by fitTimeSeiresFactorModel. -#' @param newdata A vector, matrix, data.frame, xts, timeSeries or zoo object to be coerced. -#' @param ... Any other arguments used in \code{predict.lm}, such as \code{newdata} and -#' \code{fit.se}. -#' @author Yi-An Chen. +#' @param object an object of class \code{\link[stats]{tsfm}} produced by +#' \code{fitTSFM}. +#' @param newdata a vector, matrix, data.frame, xts, timeSeries or zoo object +#' containing the variables with which to predict. +#' @param ... optional arguments passed to \code{predict.lm} or +#' \code{\link[robust]{predict.lmRob}}, such as \code{se.fit}, or, to +#' \code{\link[lars]{predict.lars}} such as \code{mode}. #' +#' @author Yi-An Chen and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' #' @examples -#' #' # load data from the database #' data(managers.df) #' ret.assets = managers.df[,(1:6)] #' # fit the factor model with OLS -#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df, fit.method="OLS") #' #' pred.fit <- predict(fit) #' newdata <- data.frame(EDHEC.LS.EQ = rnorm(n=120), SP500.TR = rnorm(n=120) ) #' rownames(newdata) <- rownames(fit$data) -#' pred.fit2 <- predict(fit,newdata,interval="confidence") +#' pred.fit2 <- predict(fit, newdata, interval="confidence") #' -#' @method predict TimeSeriesFactorModel +#' @return \code{predict.tsfm} produces a vector or a matrix of predictions. +#' #' @export #' -predict.TimeSeriesFactorModel <- function(object,newdata = NULL,...){ - - if (missing(newdata) || is.null(newdata) ) { - lapply(object$asset.fit, predict,...) - } else { - newdata <- checkData(newdata,method = "data.frame") - lapply(object$asset.fit, predict ,newdata,... ) - } +predict.tsfm <- function(object, newdata = NULL, ...){ + + if (missing(newdata) || is.null(newdata)) { + lapply(object$asset.fit, predict, ...) + } else { + newdata <- checkData(newdata, method = "data.frame") + lapply(object$asset.fit, predict, newdata, ...) + } +} -} # # if ( !(missing(newdata) && !is.null(newdata) )) { # numAssets <- length(names(fit.macro$asset.fit)) @@ -63,5 +70,5 @@ # # # } - - + + Modified: pkg/FactorAnalytics/R/print.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/print.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/R/print.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442) @@ -1,39 +1,45 @@ -#' print TimeSeriesfactorModel object -#' -#' Generic function of print method for \code{fitTimeSeriesFactorModel}. -#' -#' -#' @param x Fit object created by \code{fitTimeSeriesFactorModel}. -#' @param digits Integer indicating the number of decimal places. Default is 3. -#' @param ... Other arguments for \code{print} methods. -#' @author Yi-An Chen. -#' @method print TimeSeriesFactorModel -#' @export -#' @examples -#' -#' # load data from the database -#' data(managers.df) -#' fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' print(fit.macro) -#' -print.TimeSeriesFactorModel <- function(x,digits=max(3, .Options$digits - 3),...){ - if(!is.null(cl <- x$call)) { - cat("\nCall:\n") - dput(cl) - } - cat("\nFactor Model:\n") - tmp <- c(dim(t(x$beta)), nrow(x$data)) - names(tmp) <- c("Factors", "Variables", "Periods") - print(tmp) - cat("\nRegression alphas:\n") - print(x$alpha , digits = digits, ...) - cat("\nFactor Betas:\n") - print(t(x$beta), digits = digits, ...) - cat("\nRegression R-squared:\n") - print(x$r2, digits = digits, ...) - cat("\nResidual Variance:\n") - print(x$resid.variance, digits = digits, ...) - -} +#' @title Prints out a fitted time series factor model object +#' +#' @description S3 \code{print} method for object of class \code{tsfm}. Prints +#' the call, factor model dimension, regression coefficients, r-squared and +#' residual volatilities from the fitted object. +#' +#' @param x an object of class \code{tsfm} produced by \code{fitTSFM}. +#' @param digits an integer value, to indicate the required number of +#' significant digits. Default is 3. +#' @param ... optional arguments passed to the \code{print} method. +#' +#' @author Yi-An Chen and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' +#' @examples +#' data(managers.df) +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=colnames(managers.df[,7:9]), +#' market.name="SP500.TR", +#' data=data, fit.method="OLS", variable.selection="none", +#' add.up.market=TRUE, add.market.sqd=TRUE) +#' print(fit) +#' +#' @export +#' + +print.tsfm <- function(x, digits=max(3, .Options$digits - 3), ...){ + if(!is.null(cl <- x$call)){ + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Model dimensions:\n") + tmp <- c(dim(t(x$beta)), nrow(x$data)) + names(tmp) <- c("#Factors", "#Assets", "#Periods") + print(tmp) + cat("\nRegression Alphas:\n") + print(x$alpha , digits = digits, ...) + cat("\nFactor Betas:\n") + print(t(x$beta), digits = digits, ...) + cat("\nRegression R-squared values:\n") + print(x$r2, digits = digits, ...) + cat("\nResidual Volatilities:\n") + print(x$resid.sd, digits = digits, ...) +} Modified: pkg/FactorAnalytics/R/summary.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-26 07:54:15 UTC (rev 3442) @@ -1,40 +1,47 @@ -#' summary method for TimeSeriesModel object. -#' -#' Generic function of summary method for \code{fitTimeSeriesFactorModel}. -#' -#' -#' @param object An object created by \code{fitTimeSeiresFactorModel}. -#' @param digits Integer indicates the number of decimal places. Default is 3. -#' @param ... Other option used in \code{print} method. -#' @author Yi-An Chen. -#' @examples -#' -#' # load data from the database -#' data(managers.df) -#' # fit the factor model with OLS -#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' summary(fit) -#' @method summary TimeSeriesFactorModel -#' @export -#' -summary.TimeSeriesFactorModel <- function(object,digits=3,...){ - if(!is.null(cl <- object$call)) { - cat("\nCall:\n") - dput(cl) - } - cat("\nFactor Betas\n") - n <- length(object$assets.names) - for (i in 1:n) { - options(digits = digits) - cat("\n", object$assets.names[i], "\n") - table.macro <- t(summary(object$asset.fit[[i]])$coefficients) - colnames(table.macro)[1] <- "alpha" - print(table.macro,digits = digits,...) - cat("\nR-square =", object$r2[i] ,",residual variance =" - , object$resid.variance[i],"\n") - } - -} - +#' @title Summarizing fitted time series factor model +#' +#' @description S3 \code{summary} method for object of class \code{tsfm}. +#' Resulting object is of class {summary.tsfm}. +#' +#' @param object an object of class \code{tsfm} produced by \code{fitTSFM}. +#' @param digits an integer value, to indicate the required number of +#' significant digits. Default is 3. +#' @param ... optional arguments passed to the \code{print} method. +#' +#' @return Returns an object of class {summary.tsfm}. +#' +#' @author Yi-An Chen & Sangeetha Srinivasan. +#' +#' @seealso \code{\link{fitTSFM}} +#' +#' @examples +#' data(managers.df) +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=colnames(managers.df[,7:9]), +#' market.name="SP500.TR", +#' data=data, fit.method="OLS", variable.selection="none", +#' add.up.market=TRUE, add.market.sqd=TRUE) +#' summary(fit) +#' +#' @export +#' + +summary.tsfm <- function(object, digits=3, ...){ + if(!is.null(cl <- object$call)) { + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Betas\n") + n <- length(object$assets.names) + for (i in 1:n) { + options(digits = digits) + cat("\n", object$assets.names[i], "\n") + table.macro <- t(summary(object$asset.fit[[i]])$coefficients) + colnames(table.macro)[1] <- "Intercept" + print(table.macro,digits = digits,...) + cat("\nR-squared =", object$r2[i] ,",residual volatility =" + , object$resid.sd[i],"\n") + } + +} + Modified: pkg/FactorAnalytics/R/tsfm.r =================================================================== --- pkg/FactorAnalytics/R/tsfm.r 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/R/tsfm.r 2014-06-26 07:54:15 UTC (rev 3442) @@ -26,15 +26,14 @@ #' #' @author Sangeetha Srinivasan #' -#' @seealso \code\link{fitTSFM} +#' @seealso \code{\link{fitTSFM}} #' #' @examples -#' \dontrun{ -#' data <- managers.df +#' data(managers.df) #' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), -#' factor.names=colnames(data[,7:9]), market.name="SP500.TR", +#' factor.names=colnames(managers.df[,7:9]), +#' market.name="SP500.TR", #' data=data, fit.method="OLS", variable.selection="none", #' add.up.market=TRUE, add.market.sqd=TRUE) #' print(fit) -#' } #' \ No newline at end of file Added: pkg/FactorAnalytics/man/.Rapp.history =================================================================== Modified: pkg/FactorAnalytics/man/fitTSFM.Rd =================================================================== --- pkg/FactorAnalytics/man/fitTSFM.Rd 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/man/fitTSFM.Rd 2014-06-26 07:54:15 UTC (rev 3442) @@ -170,4 +170,9 @@ Journal of Business, Vol 54, No 4. } } +\seealso{ +\code{\link{summary.tsfm}}, \code{\link{plot.tsfm}}, +\code{\link{predict.tsfm}}, \code{\link{coef.tsfm}}, +\code{\link{fitted.tsfm}}, \code{\link{residuals.tsfm}} +} Added: pkg/FactorAnalytics/man/plot.TSFM.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.TSFM.Rd (rev 0) +++ pkg/FactorAnalytics/man/plot.TSFM.Rd 2014-06-26 07:54:15 UTC (rev 3442) @@ -0,0 +1,89 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{plot.TSFM} +\alias{plot.TSFM} +\title{Plots from a fitted time series factor model} +\usage{ +plot.TSFM(x, colorset = c(1:12), legend.loc = NULL, which.plot = c("none", + "1L", "2L", "3L", "4L", "5L", "6L", "7L"), max.show = 6, + plot.single = FALSE, asset.name, which.plot.single = c("none", "1L", "2L", + "3L", "4L", "5L", "6L", "7L", "8L", "9L", "10L", "11L", "12L", "13L"), + VaR.method = "historical", ...) +} +\arguments{ +\item{x}{an object of class \code{tsfm} produced by \code{fitTSFM}.} + +\item{colorset}{a vector of colors for the bars or bar components. Argument +is used by \code{\link[graphics]{barplot}}. Default is c(1:12).} + +\item{legend.loc}{places a legend into one of nine locations on the chart: +bottomright, bottom, bottomleft, left, topleft, top, topright, right, or +center. Argument is used by +\code{\link[PerformanceAnalytics]{chart.TimeSeries}}. Default is \code{NULL}.} + +\item{which.plot}{a number or "none" to indicate which type of group plot to +create for multiple assets. Default is "none"; which brings up the following +menu to select a type. \cr +1 = "Fitted asset returns", \cr +2 = "R-squared", \cr +3 = "Residual Volatility",\cr +4 = "FM Correlation",\cr +5 = "Factors' Contribution to SD",\cr +6 = "Factors' Contribution to ES",\cr +7 = "Factors' Contribution to VaR"} + +\item{max.show}{maximum number of assets in a plot. Default is 6.} + +\item{plot.single}{a logical value. If \code{TRUE}, plots an individual +asset's linear factor model trait selected by \code{which.plot.single}. +Default is \code{FALSE}.} + +\item{asset.name}{name of the individual asset to be plotted. Is necessary +if \code{plot.single=TRUE}} + +\item{which.plot.single}{a number or "none" to indicate which type of group +plot to create for multiple assets. Default is "none"; which brings up the +following menu to select a type.\cr + 1 = time series plot of actual and fitted factor returns,\cr + 2 = time series plot of residuals with standard error bands, \cr + 3 = time series plot of squared residuals, \cr + 4 = time series plot of absolute residuals,\cr + 5 = SACF and PACF of residuals,\cr + 6 = SACF and PACF of squared residuals,\cr + 7 = SACF and PACF of absolute residuals,\cr + 8 = histogram of residuals with normal curve overlayed,\cr + 9 = normal qq-plot of residuals,\cr + 10= CUSUM plot of recursive residuals,\cr + 11= CUSUM plot of OLS residuals,\cr + 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr + 13= rolling estimates over an observation window of length 24.} + +\item{VaR.method}{a method for computing VaR; one of "modified", "gaussian", +"historical" or "kernel". VaR is computed using +\code{\link[PerformanceAnalytics]{VaR}}. Default is "historical".} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +S3 \code{plot} method for object of class \code{tsfm}. Plots +selected characteristics for one or more assets. +} +\examples{ +\dontrun{ +# load data from the database +data(managers.df) +fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=c("EDHEC.LS.EQ","SP500.TR"), + data=managers.df,fit.method="OLS") +# plot all assets and show only the first 4 assets. +plot(fit.macro,max.show=4) +# plot of an individual asset, "HAM1" +plot(fit.macro, plot.single=TRUE, asset.name="HAM1") +} +} +\author{ +Eric Zivot, Yi-An Chen and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitTSFM}} +} + Deleted: pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2014-06-26 07:54:15 UTC (rev 3442) @@ -1,77 +0,0 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand -\name{plot.TimeSeriesFactorModel} -\alias{plot.TimeSeriesFactorModel} -\title{plot TimeSeriesFactorModel object.} -\usage{ -\method{plot}{TimeSeriesFactorModel}(x, colorset = c(1:12), - legend.loc = NULL, which.plot = c("none", "1L", "2L", "3L", "4L", "5L", - "6L", "7L"), max.show = 6, plot.single = FALSE, asset.name, - which.plot.single = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L", - "8L", "9L", "10L", "11L", "12L", "13L"), VaR.method = "historical", ...) -} -\arguments{ -\item{x}{fit object created by \code{fitTimeSeriesFactorModel}.} - -\item{colorset}{Defualt colorset the same as \code{barplot}.} - -\item{legend.loc}{Plot legend or not. Defualt is \code{NULL}.} - -\item{which.plot}{Integer indicates which plot to create: "none" will -create a menu to choose. Defualt is none.\cr -1 = "Fitted factor returns", \cr -2 = "R square", \cr -3 = "Variance of Residuals",\cr -4 = "FM Correlation",\cr -5 = "Factor Contributions to SD",\cr -6 = "Factor Contributions to ES",\cr -7 = "Factor Contributions to VaR"} - -\item{max.show}{Maximum assets to plot. Default is 6.} - -\item{plot.single}{Plot a single asset of lm class. Defualt is \code{FALSE}.} - -\item{asset.name}{Name of the asset to be plotted.} - -\item{which.plot.single}{Integer indicates which plot to create: "none" -will create a menu to choose. Defualt is none.\cr - 1 = time series plot of actual and fitted values,\cr - 2 = time series plot of residuals with standard error bands, \cr - 3 = time series plot of squared residuals, \cr - 4 = time series plot of absolute residuals,\cr - 5 = SACF and PACF of residuals,\cr - 6 = SACF and PACF of squared residuals,\cr - 7 = SACF and PACF of absolute residuals,\cr - 8 = histogram of residuals with normal curve overlayed,\cr - 9 = normal qq-plot of residuals,\cr - 10= CUSUM plot of recursive residuals,\cr - 11= CUSUM plot of OLS residuals,\cr - 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr - 13= rolling estimates over 24 month window.} - -\item{VaR.method}{Character, method for computing VaR. Valid choices are -either "modified","gaussian","historical", "kernel". computation is done with the \code{VaR} -in the PerformanceAnalytics package. Default is "historical".} - -\item{...}{further arguments passed to or from other methods.} -} -\description{ -Generic function of plot method for fitTimeSeriesFactorModel. Either plot -all assets or choose a single asset to plot. -} -\examples{ -\dontrun{ -# load data from the database -data(managers.df) -fit.macro <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), - factors.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") -# plot of all assets and show only first 4 assets. -plot(fit.macro,max.show=4) -# single plot of HAM1 asset -plot(fit.macro, plot.single=TRUE, asset.name="HAM1") -} -} -\author{ -Eric Zivot and Yi-An Chen. -} - Deleted: pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2014-06-26 03:57:07 UTC (rev 3441) +++ pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2014-06-26 07:54:15 UTC (rev 3442) @@ -1,37 +0,0 @@ -% Generated by roxygen2 (4.0.1): do not edit by hand -\name{predict.TimeSeriesFactorModel} -\alias{predict.TimeSeriesFactorModel} -\title{predict method for TimeSeriesModel object.} -\usage{ -\method{predict}{TimeSeriesFactorModel}(object, newdata = NULL, ...) -} -\arguments{ -\item{object}{A fit object created by fitTimeSeiresFactorModel.} - -\item{newdata}{A vector, matrix, data.frame, xts, timeSeries or zoo object to be coerced.} - -\item{...}{Any other arguments used in \code{predict.lm}, such as \code{newdata} and -\code{fit.se}.} -} -\description{ -Generic function of predict method for fitTimeSeriesFactorModel. It utilizes -function \code{predict.lm}. -} -\examples{ -# load data from the database -data(managers.df) -ret.assets = managers.df[,(1:6)] -# fit the factor model with OLS -fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), - factors.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") - -pred.fit <- predict(fit) -newdata <- data.frame(EDHEC.LS.EQ = rnorm(n=120), SP500.TR = rnorm(n=120) ) -rownames(newdata) <- rownames(fit$data) -pred.fit2 <- predict(fit,newdata,interval="confidence") -} -\author{ -Yi-An Chen. -} - Added: pkg/FactorAnalytics/man/predict.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.tsfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/predict.tsfm.Rd 2014-06-26 07:54:15 UTC (rev 3442) @@ -0,0 +1,47 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{predict.tsfm} +\alias{predict.tsfm} [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3442 From noreply at r-forge.r-project.org Fri Jun 27 05:57:26 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 27 Jun 2014 05:57:26 +0200 (CEST) Subject: [Returnanalytics-commits] r3443 - in pkg/FactorAnalytics: . R man Message-ID: <20140627035726.CAA90186DC6@r-forge.r-project.org> Author: pragnya Date: 2014-06-27 05:57:26 +0200 (Fri, 27 Jun 2014) New Revision: 3443 Removed: pkg/FactorAnalytics/man/plot.TSFM.Rd Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/factorModelCovariance.r pkg/FactorAnalytics/R/fitTSFM.R pkg/FactorAnalytics/R/paFM.r pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/R/predict.tsfm.r pkg/FactorAnalytics/R/print.tsfm.r pkg/FactorAnalytics/R/summary.tsfm.r pkg/FactorAnalytics/R/tsfm.r pkg/FactorAnalytics/man/factorModelCovariance.Rd pkg/FactorAnalytics/man/fitTSFM.Rd pkg/FactorAnalytics/man/paFM.Rd pkg/FactorAnalytics/man/predict.tsfm.Rd pkg/FactorAnalytics/man/print.tsfm.Rd pkg/FactorAnalytics/man/summary.tsfm.Rd Log: Edits to fitTSFM and related method functions for consistency in description and names. Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-26 07:54:15 UTC (rev 3442) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-27 03:57:26 UTC (rev 3443) @@ -22,7 +22,7 @@ export(fitTSFM) export(pCornishFisher) export(paFM) -export(plot.TSFM) +export(plot.tsfm) export(predict.tsfm) export(print.tsfm) export(qCornishFisher) Modified: pkg/FactorAnalytics/R/factorModelCovariance.r =================================================================== --- pkg/FactorAnalytics/R/factorModelCovariance.r 2014-06-26 07:54:15 UTC (rev 3442) +++ pkg/FactorAnalytics/R/factorModelCovariance.r 2014-06-27 03:57:26 UTC (rev 3443) @@ -1,88 +1,102 @@ -#' Compute Factor Model Covariance Matrix. -#' -#' Compute asset return covariance matrix from factor model. -#' -#' The return on asset \code{i} is assumed to follow the -#' factor model -#' \cr \code{R(i,t) = alpha + t(beta)*F(t) + e(i,t), e(i,t) ~ iid(0, sig(i)^2)} \cr -#' where \code{beta} is a \code{K x 1} vector of factor -#' exposures. The return variance is then \cr \code{var(R(i,t) = -#' t(beta)*var(F(t))*beta + sig(i)^2}, \cr and the \code{N x N} covariance -#' matrix of the return vector \code{R} is \cr \code{var(R) = B*var(F(t))*t(B) -#' + D} \cr where B is the \code{N x K} matrix of asset betas and \code{D} is a -#' diagonal matrix with \code{sig(i)^2} values along the diagonal. -#' -#' @param beta \code{N x K} matrix of factor betas, where \code{N} is the -#' number of assets and \code{K} is the number of factors. -#' @param factor.cov \code{K x K} factor return covariance matrix. -#' @param resid.variance \code{N x 1} vector of asset specific residual -#' variances from the factor model. -#' @return \code{N x N} return covariance matrix based on factor model -#' parameters. -#' @author Eric Zivot and Yi-An Chen. -#' @references Zivot, E. and J. Wang (2006), \emph{Modeling Financial Time -#' Series with S-PLUS, Second Edition}, Springer-Verlag. -#' @export -#' @examples -#' \dontrun{ -#' # Time Series model -#' -#' data(managers.df) -#' factors = managers.df[,(7:9)] -#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' factors = managers.df[,(7:8)] -#' factorModelCovariance(fit$beta,var(factors),fit$resid.variance) -#' -#' # Statistical Model -#' data(stat.fm.data) -#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=2) -#' #' factorModelCovariance(t(sfm.pca.fit$loadings),var(sfm.pca.fit$factors),sfm.pca.fit$resid.variance) -#' -#' sfm.apca.fit <- fitStatisticalFactorModel(sfm.apca.dat,k=2) -#' -#' factorModelCovariance(t(sfm.apca.fit$loadings), -#' var(sfm.apca.fit$factors),sfm.apca.fit$resid.variance) -#' -#' # fundamental factor model example -#' #' -#' data(stock) -#' # there are 447 assets -#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -#' beta.mat <- subset(stock,DATE == "2003-12-31")[,exposure.names] -#' beta.mat1 <- cbind(rep(1,447),beta.mat1) -# FM return covariance -#' fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP") -#' , data=stock,returnsvar = "RETURN",datevar = "DATE", -#' assetvar = "TICKER", -#' wls = TRUE, regression = "classic", -#' covariance = "classic", full.resid.cov = FALSE) -#' ret.cov.fundm <- factorModelCovariance(beta.mat1,fit.fund$factor.cov$cov,fit.fund$resid.variance) -#' fit.fund$returns.cov$cov == ret.cov.fundm -#' } -#' @export -#' - -factorModelCovariance <- -function(beta, factor.cov, resid.variance) { - - beta = as.matrix(beta) - factor.cov = as.matrix(factor.cov) - sig.e = as.vector(resid.variance) - if (length(sig.e) > 1) { - D.e = diag(as.vector(sig.e)) - } else { - D.e = as.matrix(sig.e) - } - if (ncol(beta) != ncol(factor.cov)) - stop("beta and factor.cov must have same number of columns") - - if (nrow(D.e) != nrow(beta)) - stop("beta and D.e must have same number of rows") - cov.fm = beta %*% factor.cov %*% t(beta) + D.e - if (any(diag(chol(cov.fm)) == 0)) - warning("Covariance matrix is not positive definite") - return(cov.fm) -} - +#' @title Factor model Covariance Matrix for assets' returns. +#' +#' @description Computes the covariance matrix for assets' returns based on a +#' fitted factor model. +#' +#' @details The return on asset \code{i} is assumed to follow a factor model +#' of the form, \cr \cr \code{R(i,t) = alpha + beta*F(t) + e(i,t)}, \cr \cr +#' where, \code{e(i,t) ~ iid(0,sig(i)^2)}, \code{beta} is a \code{1 x K} vector +#' of factor exposures and the error terms are serially uncorrelated and +#' contenporaneously uncorrelated across assets. Thus, the variance of asset +#' \code{i}'s return is given by \cr \cr +#' \code{var(R(i,t)) = beta*var(F(t))*tr(beta) + sig(i)^2}. \cr \cr +#' And, the \code{N x N} covariance matrix of N asset returns is \cr \cr +#' \code{var(R) = B*var(F(t))*tr(B) + D}, \cr \cr +#' where, B is the \code{N x K} matrix of asset betas and \code{D} is a diagonal +#' matrix with \code{sig(i)^2} along the diagonal. +#' +#' @param beta an \code{N x K} matrix of factor betas, where \code{N} is the +#' number of assets and \code{K} is the number of factors. +#' @param factor.cov a \code{K x K} factor covariance matrix. +#' @param resid.sd an \code{N x 1} vector of asset specific residual +#' volatilities from the factor model. +#' +#' @return The computed \code{N x N} covariance matrix for asset returns based +#' on the given factor model parameters. +#' +#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan. +#' +#' @references Zivot, E. and J. Wang (2006), \emph{Modeling Financial Time +#' Series with S-PLUS, Second Edition}, Springer-Verlag. +#' +#' @seealso \code{\link{fitTSFM}}, \code{\link{fitSFM}}, \code{\link{fitFFM}} +#' +#' @examples +#' \dontrun{ +#' # Time Series Factor model +#' data(managers.df) +#' factors = managers.df[, (7:9)] +#' fit <- fitTSFM(assets.names=colnames(managers.df[, (1:6)]), +#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), data=managers.df, +#' fit.method="OLS") +#' factors = managers.df[, (7:8)] +#' factorModelCovariance(fit$beta, var(factors), fit$resid.sd) +#' +#' # Statistical Factor Model +#' data(stat.fm.data) +#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat, k=2) +#' #' factorModelCovariance(t(sfm.pca.fit$loadings), var(sfm.pca.fit$factors), +#' sfm.pca.fit$resid.sd) +#' +#' sfm.apca.fit <- fitSFM(sfm.apca.dat, k=2) +#' +#' factorModelCovariance(t(sfm.apca.fit$loadings), var(sfm.apca.fit$factors), +#' sfm.apca.fit$resid.sd) +#' +#' # Fundamental Factor Model +#' data(stock) +#' # there are 447 assets +#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' beta.mat <- subset(stock, DATE=="2003-12-31")[, exposure.names] +#' beta.mat1 <- cbind(rep(1, 447), beta.mat1) +#' # FM return covariance +#' fit.fund <- fitFFM(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP"), +#' data=stock, returnsvar="RETURN", datevar="DATE", +#' assetvar="TICKER", wls=TRUE, regression="classic", +#' covariance="classic", full.resid.cov=FALSE) +#' ret.cov.fundm <- factorModelCovariance(beta.mat1, fit.fund$factor.cov$cov, +#' fit.fund$resid.sd) +#' fit.fund$returns.cov$cov == ret.cov.fundm +#' } +#' @export +#' + +factorModelCovariance <- function(beta, factor.cov, resid.sd) { + + beta = as.matrix(beta) + factor.cov = as.matrix(factor.cov) + sig2.e = as.vector(resid.sd)^2 + + if (length(sig.e) > 1) { + D.e = diag(as.vector(sig2.e)) + } else { + D.e = as.matrix(sig2.e) + } + + if (ncol(beta) != ncol(factor.cov)) { + stop("'beta' and 'factor.cov' must have same number of columns.") + } + + if (nrow(D.e) != nrow(beta)) { + stop("'beta' and 'D.e' must have same number of rows.") + } + + cov.fm = beta %*% factor.cov %*% t(beta) + D.e + + if (any(diag(chol(cov.fm)) == 0)) { + warning("Covariance matrix is not positive definite!") + } + + return(cov.fm) +} + Modified: pkg/FactorAnalytics/R/fitTSFM.R =================================================================== --- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-26 07:54:15 UTC (rev 3442) +++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-27 03:57:26 UTC (rev 3443) @@ -1,11 +1,11 @@ -#' @title Fits a time series factor model (TSFM) using time series regression +#' @title Fit a time series factor model using time series regression #' #' @description Fits a time series (or, macroeconomic) factor model for single #' or multiple asset returns or excess returns using time series regression. #' Users can choose between ordinary least squares-OLS, discounted least #' squares-DLS (or) robust regression. Several variable selection options #' including Stepwise, Subsets, Lars are available as well. An object of class -#' \code{\link{tsfm}} is returned. +#' \code{tsfm} is returned. #' #' @details #' Estimation method "OLS" corresponds to ordinary least squares, "DLS" is @@ -13,7 +13,7 @@ #' exponentially declining weights that sum to unity, and, "Robust" is robust #' regression (uses \code{\link[robust]{lmRob}}). #' -#' If \code{variable.selection}="none", all chosen factors are used in the +#' If \code{variable.selection="none"}, all chosen factors are used in the #' factor model. Whereas, "stepwise" performs traditional forward/backward #' stepwise OLS regression (using \code{\link[stats]{step}}), that starts from #' the initial set of factors and adds factors only if the regression fit, as @@ -27,8 +27,8 @@ #' #' Note: If \code{variable.selection}="lars" or "lasso", \code{fit.method} #' will be ignored. And, "Robust" \code{fit.method} is not truly available with -#' \code{variable.selection}="all subsets"; instead, results are produced for -#' \code{variable.selection}="none" with "Robust" to include all factors. +#' \code{variable.selection="all subsets"}; instead, results are produced for +#' \code{variable.selection="none"} with "Robust" to include all factors. #' #' If \code{add.up.market = TRUE}, max(0, Rm-Rf) is added as a factor in the #' regression, following Henriksson & Merton (1981), to account for market @@ -42,41 +42,36 @@ #' cross-validated mean squared prediction error using #' \code{\link[lars]{cv.lars}}. #' -#' @param asset.names a character vector containing the names of the assets, -#' whose returns or excess returns are the dependent variable. -#' @param factor.names a character vector containing the names of the -#' macroeconomic factors. -#' @param market.name name of an optional column for market excess returns -#' (Rm-Rf). Necessary if \code{add.up.market} or \code{add.up.market.squared} +#' @param asset.names vector containing names of assets, whose returns or +#' excess returns are the dependent variable. +#' @param factor.names vector containing names of the macroeconomic factors. +#' @param market.name name of the column for market excess returns (Rm-Rf). +#' Is required only if \code{add.up.market} or \code{add.up.market.squared} #' are \code{TRUE}. -#' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object -#' containing column(s) named \code{asset.names} and \code{factor.names}. -#' \code{market.name} is also necessary if \code{add.up.market} or -#' \code{add.market.sqd} are \code{TRUE}. +#' @param data vector, matrix, data.frame, xts, timeSeries or zoo object +#' containing column(s) named \code{asset.names}, \code{factor.names} and +#' optionally, \code{market.name}. #' @param fit.method the estimation method, one of "OLS", "DLS" or "Robust". -#' See details. If \code{variable.selection}="lars" or "lasso", -#' \code{fit.method} will be ignored. And, "Robust" \code{fit.method} is not -#' available with \code{variable.selection}="all subsets". +#' See details. #' @param variable.selection the variable selection method, one of "none", #' "stepwise","all subsets","lars" or "lasso". See details. -#' @param subsets.method a required option for the "all subsets" method; one of -#' "exhaustive", "forward", "backward" or "seqrep" (sequential replacement) -#' to specify the type of subset search/selection. -#' @param nvmax an option for the "all subsets" method; a scalar, specifies -#' the maximum size of subsets to examine. Default is 8. -#' @param force.in an option for the "all subsets" method; a vector containing -#' the names of factors that should always be included in the model. Default -#' is NULL. -#' @param num.factors.subset an option for the "all subsets" method; a scalar -#' number of factors required in the factor model. Default is 1. +#' @param subsets.method one of "exhaustive", "forward", "backward" or "seqrep" +#' (sequential replacement) to specify the type of subset search/selection. +#' Required if "all subsets" variable selection is chosen. +#' @param nvmax the maximum size of subsets to examine; an option for +#' "all subsets" variable selection. Default is 8. +#' @param force.in vector containing the names of factors that should always +#' be included in the model; an option for "all subsets" variable selection. +#' Default is NULL. +#' @param num.factors.subset number of factors required in the factor model; +#' an option for "all subsets" variable selection. Default is 1. #' Note: nvmax >= num.factors.subset >= length(force.in). -#' @param add.up.market a logical value that when set to \code{TRUE}, adds -#' max(0, Rm-Rf) as a regressor. If \code{TRUE}, \code{market.name} is -#' required. Default is \code{FALSE}. See Details. -#' @param add.market.sqd a logical value that when set to \code{TRUE}, adds -#' (Rm-Rf)^2 as a regressor. If \code{TRUE}, \code{market.name} is -#' required. Default is \code{FALSE}. -#' @param decay a scalar, specifies the decay factor for +#' @param add.up.market logical; If \code{TRUE}, adds max(0, Rm-Rf) as a +#' regressor and \code{market.name} is also required. Default is \code{FALSE}. +#' See Details. +#' @param add.market.sqd logical; If \code{TRUE}, adds (Rm-Rf)^2 as a +#' regressor and \code{market.name} is also required. Default is \code{FALSE}. +#' @param decay a scalar in (0, 1] to specify the decay factor for #' \code{fit.method="DLS"}. Default is 0.95. #' @param lars.criterion an option to assess model selection for the "lars" or #' "lasso" variable.selection methods; one of "Cp" or "cv". See details. @@ -88,13 +83,12 @@ #' include other controls passed to \code{lmRob} soon. #' #' @return fitTSFM returns an object of class -#' \code{tsfm}.The returned object is a list +#' \code{tsfm}. The returned object is a list #' containing the following components: -#' \describe{ -#' \item{asset.fit}{list of the fitted objects for each asset. Each fitted -#' object is of class \code{lm} if \code{fit.method} is "OLS" or "DLS"; -#' of class \code{lmRob} if the \code{fit.method} is "Robust"; of class -#' \code{lars} if \code{variable.selection}="lars" or "lasso".} +#' \item{asset.fit}{list of fitted objects for each asset. Each object is of +#' class \code{lm} if \code{fit.method="OLS" or "DLS"}, class \code{lmRob} if +#' the \code{fit.method="Robust"}, or class \code{lars} if +#' \code{variable.selection="lars" or "lasso"}.} #' \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-squared values.} @@ -105,7 +99,6 @@ #' \item{factor.names}{factor.names as input.} #' \item{fit.method}{fit.method as input.} #' \item{variable.selection}{variable.selection as input.} -#' } #' Where N is the number of assets and K is the number of factors. #' #' @family Factor Models @@ -126,10 +119,16 @@ #' Journal of Business, Vol 54, No 4. #' } #' -#' @seealso \code{\link{summary.tsfm}}, \code{\link{plot.tsfm}}, -#' \code{\link{predict.tsfm}}, \code{\link{coef.tsfm}}, -#' \code{\link{fitted.tsfm}}, \code{\link{residuals.tsfm}} +#' @seealso The following generic method functions: \code{\link{plot.tsfm}}, +#' \code{\link{predict.tsfm}}, \code{\link{print.tsfm}} and +#' \code{\link{summary.tsfm}}. #' +#' And, the following extractor functions: \code{\link{coef.tsfm}}, +#' \code{\link{cov.tsfm}}, \code{\link{fitted.tsfm}} and +#' \code{\link{residuals.tsfm}}. +#' +#' \code{\link{paFM}} for Performance Attribution. +#' #' @examples #' \dontrun{ #' # load data from the database Modified: pkg/FactorAnalytics/R/paFM.r =================================================================== --- pkg/FactorAnalytics/R/paFM.r 2014-06-26 07:54:15 UTC (rev 3442) +++ pkg/FactorAnalytics/R/paFM.r 2014-06-27 03:57:26 UTC (rev 3443) @@ -1,234 +1,233 @@ -#' Compute performance attribution +#' @title Compute performance attribution in factor models #' -#' Decompose total returns into returns attributed to factors and specific returns. -#' Class of \code{"pafm"} is generated and generic function \code{plot()} and \code{summary()},\code{print()} can be applied. +#' @description Decompose total returns into returns attributed to factors and +#' specific returns. An object of class \code{"pafm"} is generated and generic +#' functions such as \code{plot}, \code{summary} and \code{print} can be used. #' -#' Total returns can be decomposed into returns attributed to factors and -#' specific returns. \cr \eqn{R_t = \sum b_j * f_jt + u_t,t=1...T} \cr +#' @details Total returns can be decomposed into returns attributed to factors +#' and specific returns. \cr \eqn{R_t = \sum b_j * f_jt + u_t,t=1...T} \cr #' \code{b_j} is exposure to factor j and \code{f_jt} is factor j. #' The returns attributed to factor j is \code{b_j * f_jt} and specific #' returns is \code{u_t}. #' -#' @param fit Class of "TimeSeriesFactorModel", "FundamentalFactorModel" or -#' "statFactorModel". -#' @param ... Other controled variables for fit methods. -#' @return an object of class \code{"pafm"} containing -#' \itemize{ -#' \item{cum.ret.attr.f} N X J matrix of cumulative return attributed to -#' factors. -#' \item{cum.spec.ret} 1 x N vector of cumulative specific returns. -#' \item{attr.list} list of time series of attributed returns for every -#' portfolio. +#' @param fit an object of class \code{tsfm}, \code{sfm} or \code{ffm}. +#' @param ... other arguments/controls passed to the fit methods. +#' +#' @return The returned object is of class \code{"pafm"} containing +#' \describe{ +#' \item{cum.ret.attr.f}{N X J matrix of cumulative return attributed to +#' factors.} +#' \item{cum.spec.ret}{1 x N vector of cumulative specific returns.} +#' \item{attr.list}{list of time series of attributed returns for every +#' portfolio.} #' } -#' @author Yi-An Chen. -#' @references Grinold,R and Kahn R, \emph{Active Portfolio Management}, +#' +#' @author Yi-An Chen and Sangeetha Srinivasan +#' +#' @references Grinold, R. and Kahn, R. \emph{Active Portfolio Management}, #' McGraw-Hill. -#' @export -#' @examples #' +#' @seealso \code{\link{fitTSFM}}, \code{\link{fitSFM}}, \code{\link{fitFFM}} +#' +#' @examples #' \dontrun{ #' data(managers.df) -#' fit.ts <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") -#' # withoud benchmark +#' fit.ts <- fitTSFM(assets.names=colnames(managers.df[, (1:6)]), +#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df, fit.method="OLS") +#' # without benchmark #' fm.attr <- paFM(fit.ts) #' } #' +#' @export #' -paFM <- - function(fit,...) { + +paFM <- function(fit, ...) { + + if (class(fit)!="tsfm" & class(fit)!="ffm" & class(fit)!="sfm") { + stop("Class has to be one of 'tsfm', 'ffm' or 'sfm'.") + } + + # TSFM chunk + + if (class(fit)=="tsfm") { + # return attributed to factors + cum.attr.ret <- fit$beta + cum.spec.ret <- fit$alpha + factorName = colnames(fit$beta) + fundName = rownames(fit$beta) - if (class(fit) !="TimeSeriesFactorModel" & class(fit) !="FundamentalFactorModel" - & class(fit) != "StatFactorModel") - { - stop("Class has to be either 'TimeSeriesFactorModel', 'FundamentalFactorModel' or - 'StatFactorModel'.") + attr.list <- list() + + for (k in fundName) { + fit.lm = fit$asset.fit[[k]] + + ## extract information from lm object + data <- checkData(fit$data) + date <- index(na.omit(data[, k])) + actual.xts = xts(fit.lm$model[1], as.Date(date)) + # attributed returns + # active portfolio management p.512 17A.9 + # top-down method + + cum.ret <- Return.cumulative(actual.xts) + # setup initial value + attr.ret.xts.all <- xts(, as.Date(date)) + + for ( i in factorName ) { + + if (is.na(fit$beta[k, i])) { + cum.attr.ret[k, i] <- NA + attr.ret.xts.all <- merge(attr.ret.xts.all, + xts(rep(NA, length(date)), as.Date(date))) + } else { + attr.ret.xts <- actual.xts - + xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), + as.Date(date)) + cum.attr.ret[k, i] <- cum.ret - + Return.cumulative(actual.xts - attr.ret.xts) + attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts) + } + } + + # specific returns + spec.ret.xts <- actual.xts - + xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]), + as.Date(date)) + cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts - spec.ret.xts) + attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts) + colnames(attr.list[[k]]) <- c(factorName, "specific.returns") } + } + + if (class(fit)=="ffm" ) { + # if benchmark is provided + # + # if (!is.null(benchmark)) { + # stop("use fitFundamentalFactorModel instead") + # } + # return attributed to factors + factor.returns <- fit$factor.returns[, -1] + factor.names <- colnames(fit$beta) + date <- index(factor.returns) + ticker <- fit$asset.names - # TimeSeriesFactorModel chunk + #cumulative return attributed to factors + if (factor.names[1] == "(Intercept)") { + # discard intercept + cum.attr.ret <- matrix(, nrow=length(ticker), ncol=length(factor.names), + dimnames=list(ticker, factor.names))[, -1] + } else { + cum.attr.ret <- matrix(, nrow=length(ticker), ncol=length(factor.names), + dimnames=list(ticker, factor.names)) + } + cum.spec.ret <- rep(0, length(ticker)) + names(cum.spec.ret) <- ticker - if (class(fit) == "TimeSeriesFactorModel") { - - # return attributed to factors - cum.attr.ret <- fit$beta - cum.spec.ret <- fit$alpha - factorName = colnames(fit$beta) - fundName = rownames(fit$beta) + # make list of every asstes and every list contains return attributed to + # factors and specific returns + attr.list <- list() + + for (k in ticker) { + idx <- which(fit$data[, fit$assetvar]== k) + returns <- fit$data[idx, fit$returnsvar] + num.f.names <- intersect(fit$exposure.names, factor.names) - attr.list <- list() + # check if there is industry factors + if (length(setdiff(fit$exposure.names, factor.names)) > 0) { + ind.f <- matrix(rep(fit$beta[k, ][-(1:length(num.f.names))], + length(idx)), nrow=length(idx), byrow=TRUE) + colnames(ind.f) <- colnames(fit$beta)[-(1:length(num.f.names))] + exposure <- cbind(fit$data[idx, num.f.names], ind.f) + } else { + exposure <- fit$data[idx, num.f.names] + } + attr.factor <- exposure * coredata(factor.returns) + specific.returns <- returns - apply(attr.factor, 1, sum) + attr <- cbind(attr.factor, specific.returns) + attr.list[[k]] <- xts(attr, as.Date(date)) + cum.attr.ret[k, ] <- apply(attr.factor, 2, Return.cumulative) + cum.spec.ret[k] <- Return.cumulative(specific.returns) + } + } + + if (class(fit)=="sfm") { + + # return attributed to factors + cum.attr.ret <- t(fit$loadings) + cum.spec.ret <- fit$r2 + factorName = rownames(fit$loadings) + fundName = colnames(fit$loadings) + data <- checkData(fit$data) + # create list for attribution + attr.list <- list() + # pca method + + if ( dim(fit$asset.ret)[1] > dim(fit$asset.ret)[2] ) { + for (k in fundName) { fit.lm = fit$asset.fit[[k]] - ## extract information from lm object - data <- checkData(fit$data) - date <- index(na.omit(data[,k])) + date <- index(data[, k]) + # probably needs more general Date setting actual.xts = xts(fit.lm$model[1], as.Date(date)) # attributed returns # active portfolio management p.512 17A.9 - # top-down method - cum.ret <- Return.cumulative(actual.xts) # setup initial value attr.ret.xts.all <- xts(, as.Date(date)) for ( i in factorName ) { - - if (is.na(fit$beta[k,i])) { - cum.attr.ret[k,i] <- NA - attr.ret.xts.all <- merge(attr.ret.xts.all,xts(rep(NA,length(date)),as.Date(date))) - } else { - attr.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), - as.Date(date)) - cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts-attr.ret.xts) - attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts) - } + attr.ret.xts <- actual.xts - + xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), + as.Date(date)) + cum.attr.ret[k, i] <- cum.ret - + Return.cumulative(actual.xts - attr.ret.xts) + attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts) } - # specific returns - spec.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[,-1])%*%as.matrix(fit.lm$coef[-1]), - as.Date(date)) + spec.ret.xts <- actual.xts - + xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]), + as.Date(date)) cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts) - attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts) - colnames(attr.list[[k]]) <- c(factorName,"specific.returns") + attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts) + colnames(attr.list[[k]]) <- c(factorName, "specific.returns") } + } else { + # apca method: + # fit$loadings # f X K + # fit$factors # T X f + date <- index(fit$factors) - - } - - if (class(fit) =="FundamentalFactorModel" ) { - # if benchmark is provided -# -# if (!is.null(benchmark)) { -# stop("use fitFundamentalFactorModel instead") -# } - # return attributed to factors - factor.returns <- fit$factor.returns[,-1] - factor.names <- colnames(fit$beta) - date <- index(factor.returns) - ticker <- fit$asset.names - - - - #cumulative return attributed to factors - if (factor.names[1] == "(Intercept)") { - cum.attr.ret <- matrix(,nrow=length(ticker),ncol=length(factor.names), - dimnames=list(ticker,factor.names))[,-1] # discard intercept - } else { - cum.attr.ret <- matrix(,nrow=length(ticker),ncol=length(factor.names), - dimnames=list(ticker,factor.names)) - } - cum.spec.ret <- rep(0,length(ticker)) - names(cum.spec.ret) <- ticker - - # make list of every asstes and every list contains return attributed to factors - # and specific returns - - attr.list <- list() - for (k in ticker) { - idx <- which(fit$data[,fit$assetvar]== k) - returns <- fit$data[idx,fit$returnsvar] - num.f.names <- intersect(fit$exposure.names,factor.names) - # check if there is industry factors - if (length(setdiff(fit$exposure.names,factor.names))>0 ){ - ind.f <- matrix(rep(fit$beta[k,][-(1:length(num.f.names))],length(idx)),nrow=length(idx),byrow=TRUE) - colnames(ind.f) <- colnames(fit$beta)[-(1:length(num.f.names))] - exposure <- cbind(fit$data[idx,num.f.names],ind.f) - } else {exposure <- fit$data[idx,num.f.names] } + for ( k in fundName) { + attr.ret.xts.all <- xts(, as.Date(date)) + actual.xts <- xts(fit$asset.ret[, k], as.Date(date)) + cum.ret <- Return.cumulative(actual.xts) - attr.factor <- exposure * coredata(factor.returns) - specific.returns <- returns - apply(attr.factor,1,sum) - attr <- cbind(attr.factor,specific.returns) - attr.list[[k]] <- xts(attr,as.Date(date)) - cum.attr.ret[k,] <- apply(attr.factor,2,Return.cumulative) - cum.spec.ret[k] <- Return.cumulative(specific.returns) - } - - - - } - - if (class(fit) == "StatFactorModel") { - - # return attributed to factors - cum.attr.ret <- t(fit$loadings) - cum.spec.ret <- fit$r2 - factorName = rownames(fit$loadings) - fundName = colnames(fit$loadings) - data <- checkData(fit$data) - # create list for attribution - attr.list <- list() - # pca method - - if ( dim(fit$asset.ret)[1] > dim(fit$asset.ret)[2] ) { - - - for (k in fundName) { - fit.lm = fit$asset.fit[[k]] - - ## extract information from lm object - date <- index(data[,k]) - # probably needs more general Date setting - actual.xts = xts(fit.lm$model[1], as.Date(date)) - # attributed returns - # active portfolio management p.512 17A.9 - - cum.ret <- Return.cumulative(actual.xts) - # setup initial value - attr.ret.xts.all <- xts(, as.Date(date)) - for ( i in factorName ) { - attr.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]), - as.Date(date)) - cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts-attr.ret.xts) - attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts) - - - } - - # specific returns - spec.ret.xts <- actual.xts - xts(as.matrix(fit.lm$model[,-1])%*%as.matrix(fit.lm$coef[-1]), - as.Date(date)) - cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts) - attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts) - colnames(attr.list[[k]]) <- c(factorName,"specific.returns") + for (i in factorName) { + attr.ret.xts <- xts(fit$factors[, i] * fit$loadings[i, k], + as.Date(date)) + attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts) + cum.attr.ret[k, i] <- cum.ret - Return.cumulative(actual.xts - + attr.ret.xts) } - } else { - # apca method - # fit$loadings # f X K - # fit$factors # T X f - - date <- index(fit$factors) - for ( k in fundName) { - attr.ret.xts.all <- xts(, as.Date(date)) - actual.xts <- xts(fit$asset.ret[,k],as.Date(date)) - cum.ret <- Return.cumulative(actual.xts) - for (i in factorName) { - attr.ret.xts <- xts(fit$factors[,i] * fit$loadings[i,k], as.Date(date) ) - attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts) - cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts-attr.ret.xts) - } - spec.ret.xts <- actual.xts - xts(fit$factors%*%fit$loadings[,k],as.Date(date)) - cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts) - attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts) - colnames(attr.list[[k]]) <- c(factorName,"specific.returns") - } - - - } - - } - - - - ans = list(cum.ret.attr.f=cum.attr.ret, - cum.spec.ret=cum.spec.ret, - attr.list=attr.list) - class(ans) = "pafm" - return(ans) + spec.ret.xts <- actual.xts - xts(fit$factors%*%fit$loadings[, k], + as.Date(date)) + cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3443 From noreply at r-forge.r-project.org Fri Jun 27 21:15:04 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 27 Jun 2014 21:15:04 +0200 (CEST) Subject: [Returnanalytics-commits] r3444 - in pkg/FactorAnalytics: . R man Message-ID: <20140627191504.80F61185357@r-forge.r-project.org> Author: pragnya Date: 2014-06-27 21:15:04 +0200 (Fri, 27 Jun 2014) New Revision: 3444 Added: pkg/FactorAnalytics/R/coef.sfm.r pkg/FactorAnalytics/R/coef.tsfm.R pkg/FactorAnalytics/R/fitted.sfm.r pkg/FactorAnalytics/R/fitted.tsfm.r pkg/FactorAnalytics/R/residuals.sfm.r pkg/FactorAnalytics/R/residuals.tsfm.r pkg/FactorAnalytics/man/coef.sfm.Rd pkg/FactorAnalytics/man/coef.tsfm.Rd pkg/FactorAnalytics/man/fitted.sfm.Rd pkg/FactorAnalytics/man/fitted.tsfm.Rd pkg/FactorAnalytics/man/plot.tsfm.Rd pkg/FactorAnalytics/man/residuals.sfm.Rd pkg/FactorAnalytics/man/residuals.tsfm.Rd Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitTSFM.R pkg/FactorAnalytics/R/plot.tsfm.r pkg/FactorAnalytics/R/predict.tsfm.r pkg/FactorAnalytics/R/print.tsfm.r pkg/FactorAnalytics/R/summary.tsfm.r pkg/FactorAnalytics/man/predict.tsfm.Rd pkg/FactorAnalytics/man/print.tsfm.Rd pkg/FactorAnalytics/man/summary.tsfm.Rd Log: Added coef(), fitted() and residuals() methods for tsfm. Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-27 19:15:04 UTC (rev 3444) @@ -1,16 +1,25 @@ # Generated by roxygen2 (4.0.1): do not edit by hand +S3method(coef,sfm) +S3method(coef,tsfm) +S3method(fitted,tsfm) S3method(plot,FundamentalFactorModel) S3method(plot,StatFactorModel) S3method(plot,pafm) +S3method(plot,tsfm) S3method(predict,FundamentalFactorModel) S3method(predict,StatFactorModel) +S3method(predict,tsfm) S3method(print,FundamentalFactorModel) S3method(print,StatFactorModel) S3method(print,pafm) +S3method(print,tsfm) +S3method(residuals,sfm) +S3method(residuals,tsfm) S3method(summary,FundamentalFactorModel) S3method(summary,StatFactorModel) S3method(summary,pafm) +S3method(summary,tsfm) export(dCornishFisher) export(factorModelCovariance) export(factorModelEsDecomposition) @@ -22,9 +31,5 @@ export(fitTSFM) export(pCornishFisher) export(paFM) -export(plot.tsfm) -export(predict.tsfm) -export(print.tsfm) export(qCornishFisher) export(rCornishFisher) -export(summary.tsfm) Added: pkg/FactorAnalytics/R/coef.sfm.r =================================================================== --- pkg/FactorAnalytics/R/coef.sfm.r (rev 0) +++ pkg/FactorAnalytics/R/coef.sfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,22 @@ +#' @title Extract coefficients from a fitted stochastic factor model +#' +#' @description Method or helper function for fit object of class \code{sfm}. +#' +#' @param x an object of class \code{sfm} which is returned by +#' \code{\link{fitSFM}} +#' +#' @return +#' \item{coef.mat}{an N x (K+1) matrix of all coefficients} +#' where, N is the number of assets and K is the number of factors. +#' +#' @author Eric Zivot and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' +#' @method coef sfm +#' @export + +coef.sfm <- function(x){ + coef.mat <- t(sapply(x$asset.fit, coef)) + return(coef.mat) +} \ No newline at end of file Added: pkg/FactorAnalytics/R/coef.tsfm.R =================================================================== --- pkg/FactorAnalytics/R/coef.tsfm.R (rev 0) +++ pkg/FactorAnalytics/R/coef.tsfm.R 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,33 @@ +#' @title Extract coefficients from a fitted time series factor model +#' +#' @description Method or helper function for fit object of class \code{tsfm}. +#' +#' @param x an object of class \code{tsfm} which is returned by +#' \code{\link{fitTSFM}} +#' +#' @return +#' \item{coef.mat}{an N x (K+1) matrix of all coefficients} +#' where, N is the number of assets and K is the number of factors. +#' +#' @author Eric Zivot and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' +#' @examples +#' \dontrun{ +#' data(managers.df) +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=colnames(managers.df[,7:9]), +#' market.name="SP500.TR", +#' data=data, fit.method="OLS", variable.selection="none", +#' add.up.market=TRUE, add.market.sqd=TRUE) +#' coef(fit) +#' } +#' +#' @method coef tsfm +#' @export + +coef.tsfm <- function(x){ + coef.mat <- t(sapply(x$asset.fit, coef)) + return(coef.mat) +} Modified: pkg/FactorAnalytics/R/fitTSFM.R =================================================================== --- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-27 19:15:04 UTC (rev 3444) @@ -208,8 +208,9 @@ # extract the fitted factor models, coefficients, r2 values and residual vol # from returned factor model fits above - alpha <- sapply(reg.list, function(x) coef(x)[1], USE.NAMES = FALSE) - beta <- sapply(reg.list, function(x) coef(x)[-1], USE.NAMES = FALSE) + coef.mat <- t(sapply(reg.list, coef)) + alpha <- coef.mat[, 1] + beta <- coef.mat[, -1] r2 <- sapply(reg.list, function(x) summary(x)$r.squared) resid.sd <- sapply(reg.list, function(x) summary(x)$sigma) # create list of return values. Added: pkg/FactorAnalytics/R/fitted.sfm.r =================================================================== --- pkg/FactorAnalytics/R/fitted.sfm.r (rev 0) +++ pkg/FactorAnalytics/R/fitted.sfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,27 @@ +#' @title Get fitted values from a stochastic factor model +#' +#' @description Method or helper function for fit object of class \code{sfm}. +#' +#' @param x an object of class \code{sfm} which is returned by +#' \code{\link{fitSFM}} +#' +#' @return +#' \item{fitted.xts}{an N x T data object of fitted values} +#' where, N is the number of assets and T is the number of time periods. +#' +#' @author Eric Zivot and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitSFM}} +#' +#' @method fitted tsfm +#' @export + +fitted.sfm <- function(x){ + # get fitted values from each linear factor model fit + # and convert them into xts/zoo objects + fitted.list = sapply(x$asset.fit, function(x) checkData(fitted(x))) + # this is a list of xts objects, indexed by the asset name + # merge the objects in the list into one xts object + fitted.xts <- do.call(merge, fitted.list) + return(fitted.xts) +} Added: pkg/FactorAnalytics/R/fitted.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/fitted.tsfm.r (rev 0) +++ pkg/FactorAnalytics/R/fitted.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,38 @@ +#' @title Get fitted values from a time series factor model +#' +#' @description Method or helper function for fit object of class \code{tsfm}. +#' +#' @param x an object of class \code{tsfm} which is returned by +#' \code{\link{fitTSFM}} +#' +#' @return +#' \item{fitted.xts}{an N x T data object of fitted values} +#' where, N is the number of assets and T is the number of time periods. +#' +#' @author Eric Zivot and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' +#' @examples +#' \dontrun{ +#' data(managers.df) +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=colnames(managers.df[,7:9]), +#' market.name="SP500.TR", +#' data=data, fit.method="OLS", variable.selection="none", +#' add.up.market=TRUE, add.market.sqd=TRUE) +#' fitted(fit) +#' } +#' +#' @method fitted tsfm +#' @export + +fitted.tsfm <- function(x){ + # get fitted values from each linear factor model fit + # and convert them into xts/zoo objects + fitted.list = sapply(x$asset.fit, function(x) checkData(fitted(x))) + # this is a list of xts objects, indexed by the asset name + # merge the objects in the list into one xts object + fitted.xts <- do.call(merge, fitted.list) + return(fitted.xts) +} Modified: pkg/FactorAnalytics/R/plot.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/R/plot.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -66,6 +66,7 @@ #' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") #' } #' +#' @method plot tsfm #' @export plot.tsfm <- Modified: pkg/FactorAnalytics/R/predict.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/predict.tsfm.r 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/R/predict.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -12,6 +12,9 @@ #' \code{\link[robust]{predict.lmRob}}, such as \code{se.fit}, or, to #' \code{\link[lars]{predict.lars}} such as \code{mode}. #' +#' @return +#' \code{predict.tsfm} produces a vector or a matrix of predictions. +#' #' @author Yi-An Chen and Sangeetha Srinivasan #' #' @seealso \code{\link{fitTSFM}}, \code{\link{summary.tsfm}}, @@ -31,9 +34,7 @@ #' rownames(newdata) <- rownames(fit$data) #' pred.fit2 <- predict(fit, newdata, interval="confidence") #' -#' @return -#' \code{predict.tsfm} produces a vector or a matrix of predictions. -#' +#' @method predict tsfm #' @export #' Modified: pkg/FactorAnalytics/R/print.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/print.tsfm.r 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/R/print.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -11,8 +11,7 @@ #' #' @author Yi-An Chen and Sangeetha Srinivasan #' -#' @seealso \code{\link{fitTSFM}}, \code{\link{summary.tsfm}}, -#' \code{\link{tsfm}} +#' @seealso \code{\link{fitTSFM}}, \code{\link{summary.tsfm}} #' #' @examples #' data(managers.df) @@ -23,6 +22,7 @@ #' add.up.market=TRUE, add.market.sqd=TRUE) #' print(fit) #' +#' @method print tsfm #' @export #' @@ -31,12 +31,12 @@ cat("\nCall:\n") dput(cl) } - cat("\nFactor Model dimensions:\n") + cat("\nModel dimensions:\n") tmp <- c(dim(t(x$beta)), nrow(x$data)) - names(tmp) <- c("#Factors", "#Assets", "#Periods") + names(tmp) <- c("Factors", "Assets", "Periods") print(tmp) cat("\nRegression Alphas:\n") - print(x$alpha , digits = digits, ...) + print(x$alpha, digits = digits, ...) cat("\nFactor Betas:\n") print(t(x$beta), digits = digits, ...) cat("\nRegression R-squared values:\n") Added: pkg/FactorAnalytics/R/residuals.sfm.r =================================================================== --- pkg/FactorAnalytics/R/residuals.sfm.r (rev 0) +++ pkg/FactorAnalytics/R/residuals.sfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,27 @@ +#' @title Get residuals from a fitted stochastic factor model +#' +#' @description Method or helper function for fit object of class \code{sfm}. +#' +#' @param x an object of class \code{sfm} which is returned by +#' \code{\link{fitSFM}} +#' +#' @return +#' \item{residuals.xts}{an N x T data object of residuals} +#' where, N is the number of assets and T is the number of time periods. +#' +#' @author Eric Zivot and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitSFM}} +#' +#' @method residuals sfm +#' @export + +residuals.sfm <- function(x) { + # get residuals from each linear factor model fit + # and convert them into xts/zoo objects + residuals.list = sapply(x$asset.fit, function(x) checkData(residuals(x))) + # this is a list of xts objects, indexed by the asset name + # merge the objects in the list into one xts object + residuals.xts <- do.call(merge, residuals.list) + return(residuals.xts) +} Added: pkg/FactorAnalytics/R/residuals.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/residuals.tsfm.r (rev 0) +++ pkg/FactorAnalytics/R/residuals.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,38 @@ +#' @title Get residuals from a fitted time series factor model +#' +#' @description Method or helper function for fit object of class \code{tsfm}. +#' +#' @param x an object of class \code{tsfm} which is returned by +#' \code{\link{fitTSFM}} +#' +#' @return +#' \item{residuals.xts}{an N x T data object of residuals} +#' where, N is the number of assets and T is the number of time periods. +#' +#' @author Eric Zivot and Sangeetha Srinivasan +#' +#' @seealso \code{\link{fitTSFM}} +#' +#' @examples +#' \dontrun{ +#' data(managers.df) +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=colnames(managers.df[,7:9]), +#' market.name="SP500.TR", +#' data=data, fit.method="OLS", variable.selection="none", +#' add.up.market=TRUE, add.market.sqd=TRUE) +#' residuals(fit) +#' } +#' +#' @method residuals tsfm +#' @export + +residuals.tsfm <- function(x) { + # get residuals from each linear factor model fit + # and convert them into xts/zoo objects + residuals.list = sapply(x$asset.fit, function(x) checkData(residuals(x))) + # this is a list of xts objects, indexed by the asset name + # merge the objects in the list into one xts object + residuals.xts <- do.call(merge, residuals.list) + return(residuals.xts) +} Modified: pkg/FactorAnalytics/R/summary.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) @@ -12,7 +12,7 @@ #' #' @author Yi-An Chen & Sangeetha Srinivasan. #' -#' @seealso \code{\link{fitTSFM}}, \code{\link{tsfm}} +#' @seealso \code{\link{fitTSFM}} #' #' @examples #' data(managers.df) @@ -23,8 +23,8 @@ #' add.up.market=TRUE, add.market.sqd=TRUE) #' summary(fit) #' +#' @method summary tsfm #' @export -#' summary.tsfm <- function(object, digits=3, ...){ if(!is.null(cl <- object$call)) { Added: pkg/FactorAnalytics/man/coef.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/coef.sfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/coef.sfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,25 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{coef.sfm} +\alias{coef.sfm} +\title{Extract coefficients from a fitted stochastic factor model} +\usage{ +\method{coef}{sfm}(x) +} +\arguments{ +\item{x}{an object of class \code{sfm} which is returned by +\code{\link{fitSFM}}} +} +\value{ +\item{coef.mat}{an N x (K+1) matrix of all coefficients} +where, N is the number of assets and K is the number of factors. +} +\description{ +Method or helper function for fit object of class \code{sfm}. +} +\author{ +Eric Zivot and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitTSFM}} +} + Added: pkg/FactorAnalytics/man/coef.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/coef.tsfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/coef.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{coef.tsfm} +\alias{coef.tsfm} +\title{Extract coefficients from a fitted time series factor model} +\usage{ +\method{coef}{tsfm}(x) +} +\arguments{ +\item{x}{an object of class \code{tsfm} which is returned by +\code{\link{fitTSFM}}} +} +\value{ +\item{coef.mat}{an N x (K+1) matrix of all coefficients} +where, N is the number of assets and K is the number of factors. +} +\description{ +Method or helper function for fit object of class \code{tsfm}. +} +\examples{ +\dontrun{ +data(managers.df) +fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=colnames(managers.df[,7:9]), + market.name="SP500.TR", + data=data, fit.method="OLS", variable.selection="none", + add.up.market=TRUE, add.market.sqd=TRUE) +coef(fit) +} +} +\author{ +Eric Zivot and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitTSFM}} +} + Added: pkg/FactorAnalytics/man/fitted.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitted.sfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/fitted.sfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,25 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{fitted.sfm} +\alias{fitted.sfm} +\title{Get fitted values from a stochastic factor model} +\usage{ +\method{fitted}{tsfm}(x) +} +\arguments{ +\item{x}{an object of class \code{sfm} which is returned by +\code{\link{fitSFM}}} +} +\value{ +\item{fitted.xts}{an N x T data object of fitted values} +where, N is the number of assets and T is the number of time periods. +} +\description{ +Method or helper function for fit object of class \code{sfm}. +} +\author{ +Eric Zivot and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitSFM}} +} + Added: pkg/FactorAnalytics/man/fitted.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitted.tsfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/fitted.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{fitted.tsfm} +\alias{fitted.tsfm} +\title{Get fitted values from a time series factor model} +\usage{ +\method{fitted}{tsfm}(x) +} +\arguments{ +\item{x}{an object of class \code{tsfm} which is returned by +\code{\link{fitTSFM}}} +} +\value{ +\item{fitted.xts}{an N x T data object of fitted values} +where, N is the number of assets and T is the number of time periods. +} +\description{ +Method or helper function for fit object of class \code{tsfm}. +} +\examples{ +\dontrun{ +data(managers.df) +fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=colnames(managers.df[,7:9]), + market.name="SP500.TR", + data=data, fit.method="OLS", variable.selection="none", + add.up.market=TRUE, add.market.sqd=TRUE) +fitted(fit) +} +} +\author{ +Eric Zivot and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitTSFM}} +} + Added: pkg/FactorAnalytics/man/plot.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.tsfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/plot.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,90 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{plot.tsfm} +\alias{plot.tsfm} +\title{Plots from a fitted time series factor model} +\usage{ +\method{plot}{tsfm}(x, colorset = c(1:12), legend.loc = NULL, + which.plot = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L"), + max.show = 6, plot.single = FALSE, asset.name, + which.plot.single = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L", + "8L", "9L", "10L", "11L", "12L", "13L"), VaR.method = "historical", ...) +} +\arguments{ +\item{x}{an object of class \code{tsfm} produced by \code{fitTSFM}.} + +\item{colorset}{a vector of colors for the bars or bar components. Argument +is used by \code{\link[graphics]{barplot}}. Default is c(1:12).} + +\item{legend.loc}{places a legend into one of nine locations on the chart: +bottomright, bottom, bottomleft, left, topleft, top, topright, right, or +center. Argument is used by +\code{\link[PerformanceAnalytics]{chart.TimeSeries}}. Default is \code{NULL}.} + +\item{which.plot}{a number or "none" to indicate which type of group plot to +create for multiple assets. Default is "none"; which brings up the following +menu to select a type. \cr +1 = "Fitted asset returns", \cr +2 = "R-squared", \cr +3 = "Residual Volatility",\cr +4 = "FM Correlation",\cr +5 = "Factors' Contribution to SD",\cr +6 = "Factors' Contribution to ES",\cr +7 = "Factors' Contribution to VaR"} + +\item{max.show}{maximum number of assets in a plot. Default is 6.} + +\item{plot.single}{a logical value. If \code{TRUE}, plots an individual +asset's linear factor model trait selected by \code{which.plot.single}. +Default is \code{FALSE}.} + +\item{asset.name}{name of the individual asset to be plotted. Is necessary +if \code{plot.single=TRUE}} + +\item{which.plot.single}{a number or "none" to indicate which type of group +plot to create for multiple assets. Default is "none"; which brings up the +following menu to select a type.\cr + 1 = time series plot of actual and fitted factor returns,\cr + 2 = time series plot of residuals with standard error bands, \cr + 3 = time series plot of squared residuals, \cr + 4 = time series plot of absolute residuals,\cr + 5 = SACF and PACF of residuals,\cr + 6 = SACF and PACF of squared residuals,\cr + 7 = SACF and PACF of absolute residuals,\cr + 8 = histogram of residuals with normal curve overlayed,\cr + 9 = normal qq-plot of residuals,\cr + 10= CUSUM plot of recursive residuals,\cr + 11= CUSUM plot of OLS residuals,\cr + 12= CUSUM plot of recursive estimates relative to full sample estimates,\cr + 13= rolling estimates over an observation window of length 24.} + +\item{VaR.method}{a method for computing VaR; one of "modified", "gaussian", +"historical" or "kernel". VaR is computed using +\code{\link[PerformanceAnalytics]{VaR}}. Default is "historical".} + +\item{...}{further arguments passed to or from other methods.} +} +\description{ +S3 \code{plot} method for object of class \code{tsfm}. Plots +selected characteristics for one or more assets. +} +\examples{ +\dontrun{ +# load data from the database +data(managers.df) +fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=c("EDHEC.LS.EQ","SP500.TR"), + data=managers.df,fit.method="OLS") +# plot all assets and show only the first 4 assets. +plot(fit.macro,max.show=4) +# plot of an individual asset, "HAM1" +plot(fit.macro, plot.single=TRUE, asset.name="HAM1") +} +} +\author{ +Eric Zivot, Yi-An Chen and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitTSFM}}, \code{\link{summary.tsfm}}, +\code{\link{tsfm}} +} + Modified: pkg/FactorAnalytics/man/predict.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.tsfm.Rd 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/man/predict.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -3,7 +3,7 @@ \alias{predict.tsfm} \title{Predicts asset returns based on a fitted time series factor model} \usage{ -predict.tsfm(object, newdata = NULL, ...) +\method{predict}{tsfm}(object, newdata = NULL, ...) } \arguments{ \item{object}{an object of class \code{\link[stats]{tsfm}} produced by Modified: pkg/FactorAnalytics/man/print.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/print.tsfm.Rd 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/man/print.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -3,7 +3,7 @@ \alias{print.tsfm} \title{Prints out a fitted time series factor model object} \usage{ -print.tsfm(x, digits = max(3, .Options$digits - 3), ...) +\method{print}{tsfm}(x, digits = max(3, .Options$digits - 3), ...) } \arguments{ \item{x}{an object of class \code{tsfm} produced by \code{fitTSFM}.} @@ -31,7 +31,6 @@ Yi-An Chen and Sangeetha Srinivasan } \seealso{ -\code{\link{fitTSFM}}, \code{\link{summary.tsfm}}, -\code{\link{tsfm}} +\code{\link{fitTSFM}}, \code{\link{summary.tsfm}} } Added: pkg/FactorAnalytics/man/residuals.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/residuals.sfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/residuals.sfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,25 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{residuals.sfm} +\alias{residuals.sfm} +\title{Get residuals from a fitted stochastic factor model} +\usage{ +\method{residuals}{sfm}(x) +} +\arguments{ +\item{x}{an object of class \code{sfm} which is returned by +\code{\link{fitSFM}}} +} +\value{ +\item{residuals.xts}{an N x T data object of residuals} +where, N is the number of assets and T is the number of time periods. +} +\description{ +Method or helper function for fit object of class \code{sfm}. +} +\author{ +Eric Zivot and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitSFM}} +} + Added: pkg/FactorAnalytics/man/residuals.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/residuals.tsfm.Rd (rev 0) +++ pkg/FactorAnalytics/man/residuals.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -0,0 +1,36 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{residuals.tsfm} +\alias{residuals.tsfm} +\title{Get residuals from a fitted time series factor model} +\usage{ +\method{residuals}{tsfm}(x) +} +\arguments{ +\item{x}{an object of class \code{tsfm} which is returned by +\code{\link{fitTSFM}}} +} +\value{ +\item{residuals.xts}{an N x T data object of residuals} +where, N is the number of assets and T is the number of time periods. +} +\description{ +Method or helper function for fit object of class \code{tsfm}. +} +\examples{ +\dontrun{ +data(managers.df) +fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=colnames(managers.df[,7:9]), + market.name="SP500.TR", + data=data, fit.method="OLS", variable.selection="none", + add.up.market=TRUE, add.market.sqd=TRUE) +residuals(fit) +} +} +\author{ +Eric Zivot and Sangeetha Srinivasan +} +\seealso{ +\code{\link{fitTSFM}} +} + Modified: pkg/FactorAnalytics/man/summary.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/summary.tsfm.Rd 2014-06-27 03:57:26 UTC (rev 3443) +++ pkg/FactorAnalytics/man/summary.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) @@ -3,7 +3,7 @@ \alias{summary.tsfm} \title{Summarizing a fitted time series factor model} \usage{ -summary.tsfm(object, digits = 3, ...) +\method{summary}{tsfm}(object, digits = 3, ...) } \arguments{ \item{object}{an object of class \code{tsfm} produced by \code{fitTSFM}.} @@ -33,6 +33,6 @@ Yi-An Chen & Sangeetha Srinivasan. } \seealso{ -\code{\link{fitTSFM}}, \code{\link{tsfm}} +\code{\link{fitTSFM}} } From noreply at r-forge.r-project.org Sun Jun 29 05:59:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 29 Jun 2014 05:59:31 +0200 (CEST) Subject: [Returnanalytics-commits] r3445 - in pkg/FactorAnalytics: . R inst/tests man sandbox vignettes Message-ID: <20140629035932.297B8186EC4@r-forge.r-project.org> Author: pragnya Date: 2014-06-29 05:59:29 +0200 (Sun, 29 Jun 2014) New Revision: 3445 Added: pkg/FactorAnalytics/man/print.summary.tsfm.Rd Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/coef.sfm.r pkg/FactorAnalytics/R/coef.tsfm.R pkg/FactorAnalytics/R/factorModelCovariance.r pkg/FactorAnalytics/R/factorModelEsDecomposition.R pkg/FactorAnalytics/R/factorModelMonteCarlo.R pkg/FactorAnalytics/R/factorModelVaRDecomposition.R pkg/FactorAnalytics/R/fitTSFM.R pkg/FactorAnalytics/R/fitted.sfm.r pkg/FactorAnalytics/R/fitted.tsfm.r pkg/FactorAnalytics/R/print.tsfm.r pkg/FactorAnalytics/R/residuals.sfm.r pkg/FactorAnalytics/R/residuals.tsfm.r pkg/FactorAnalytics/R/summary.pafm.r pkg/FactorAnalytics/R/summary.tsfm.r pkg/FactorAnalytics/inst/tests/test-fitTSFM.r pkg/FactorAnalytics/man/coef.sfm.Rd pkg/FactorAnalytics/man/coef.tsfm.Rd pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd pkg/FactorAnalytics/man/factorModelVaRDecomposition.Rd pkg/FactorAnalytics/man/fitTSFM.Rd pkg/FactorAnalytics/man/fitted.sfm.Rd pkg/FactorAnalytics/man/fitted.tsfm.Rd pkg/FactorAnalytics/man/print.tsfm.Rd pkg/FactorAnalytics/man/residuals.sfm.Rd pkg/FactorAnalytics/man/residuals.tsfm.Rd pkg/FactorAnalytics/man/summary.pafm.Rd pkg/FactorAnalytics/man/summary.tsfm.Rd pkg/FactorAnalytics/sandbox/test.vignette.r pkg/FactorAnalytics/sandbox/testfile.r pkg/FactorAnalytics/vignettes/fundamentalFM.Rnw Log: Add class summary.tsfm. Edit method functions, vignette, examples. Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/DESCRIPTION 2014-06-29 03:59:29 UTC (rev 3445) @@ -29,3 +29,4 @@ Suggests: testthat, quantmod LazyLoad: yes +LazyDataCompression: xz Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/NAMESPACE 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,6 +2,7 @@ S3method(coef,sfm) S3method(coef,tsfm) +S3method(fitted,sfm) S3method(fitted,tsfm) S3method(plot,FundamentalFactorModel) S3method(plot,StatFactorModel) @@ -13,6 +14,7 @@ S3method(print,FundamentalFactorModel) S3method(print,StatFactorModel) S3method(print,pafm) +S3method(print,summary.tsfm) S3method(print,tsfm) S3method(residuals,sfm) S3method(residuals,tsfm) Modified: pkg/FactorAnalytics/R/coef.sfm.r =================================================================== --- pkg/FactorAnalytics/R/coef.sfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/coef.sfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,8 +2,9 @@ #' #' @description Method or helper function for fit object of class \code{sfm}. #' -#' @param x an object of class \code{sfm} which is returned by +#' @param object a fit object of class \code{sfm} which is returned by #' \code{\link{fitSFM}} +#' @param ... other arguments passed #' #' @return #' \item{coef.mat}{an N x (K+1) matrix of all coefficients} @@ -16,7 +17,7 @@ #' @method coef sfm #' @export -coef.sfm <- function(x){ - coef.mat <- t(sapply(x$asset.fit, coef)) +coef.sfm <- function(object,...){ + coef.mat <- t(sapply(object$asset.fit, coef)) return(coef.mat) } \ No newline at end of file Modified: pkg/FactorAnalytics/R/coef.tsfm.R =================================================================== --- pkg/FactorAnalytics/R/coef.tsfm.R 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/coef.tsfm.R 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,8 +2,9 @@ #' #' @description Method or helper function for fit object of class \code{tsfm}. #' -#' @param x an object of class \code{tsfm} which is returned by +#' @param object a fit object of class \code{tsfm} which is returned by #' \code{\link{fitTSFM}} +#' @param ... other arguments passed #' #' @return #' \item{coef.mat}{an N x (K+1) matrix of all coefficients} @@ -27,7 +28,7 @@ #' @method coef tsfm #' @export -coef.tsfm <- function(x){ - coef.mat <- t(sapply(x$asset.fit, coef)) +coef.tsfm <- function(object,...){ + coef.mat <- t(sapply(object$asset.fit, coef)) return(coef.mat) } Modified: pkg/FactorAnalytics/R/factorModelCovariance.r =================================================================== --- pkg/FactorAnalytics/R/factorModelCovariance.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/factorModelCovariance.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -77,7 +77,7 @@ factor.cov = as.matrix(factor.cov) sig2.e = as.vector(resid.sd)^2 - if (length(sig.e) > 1) { + if (length(sig2.e) > 1) { D.e = diag(as.vector(sig2.e)) } else { D.e = as.matrix(sig2.e) Modified: pkg/FactorAnalytics/R/factorModelEsDecomposition.R =================================================================== --- pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2014-06-29 03:59:29 UTC (rev 3445) @@ -16,7 +16,7 @@ #' contain the returns on the \code{k} factors, and the \code{(k+2)}nd column #' contain residuals scaled to have unit variance. #' @param beta.vec \code{k x 1} vector of factor betas. -#' @param sig2.e scalar, residual variance from factor model. +#' @param sig.e scalar, residual variance from factor model. #' @param tail.prob scalar, tail probability for VaR quantile. Typically 0.01 #' or 0.05. #' @param VaR.method character, method for computing VaR. Valid choices are @@ -47,16 +47,17 @@ #' @examples #' #' data(managers.df) -#' fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") +#' fit.macro <- fitTSFM (asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df, fit.method="OLS", +#' variable.selection="none") #' # risk factor contribution to ETL #' # combine fund returns, factor returns and residual returns for HAM1 #' tmpData = cbind(managers.df[,1],managers.df[,c("EDHEC.LS.EQ","SP500.TR")] , -#' residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.variance[1])) +#' residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.sd[1])) #' colnames(tmpData)[c(1,4)] = c("HAM1", "residual") #' factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit.macro$beta[1,], -#' fit.macro$resid.variance[1], tail.prob=0.05, +#' fit.macro$resid.sd[1], tail.prob=0.05, #' VaR.method="historical" ) #' #' # fundamental factor model @@ -79,7 +80,7 @@ #' @export #' factorModelEsDecomposition <- -function(Data, beta.vec, sig2.e, tail.prob = 0.05, +function(Data, beta.vec, sig.e, tail.prob = 0.05, VaR.method=c("modified", "gaussian", "historical", "kernel")) { Data = as.matrix(Data) @@ -92,7 +93,7 @@ stop("beta.vec is not an n x 1 matrix or a vector") } beta.names = c(names(beta.vec), "residual") - beta.star.vec = c(beta.vec, sqrt(sig2.e)) + beta.star.vec = c(beta.vec, sig.e) names(beta.star.vec) = beta.names ## epsilon is calculated in the sense of minimizing mean square error by Silverman 1986 Modified: pkg/FactorAnalytics/R/factorModelMonteCarlo.R =================================================================== --- pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-06-29 03:59:29 UTC (rev 3445) @@ -51,12 +51,13 @@ #' #' # load data from the database #' data(managers.df) -#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS", +#' variable.selection="none") #' factorData= managers.df[,c("EDHEC.LS.EQ","SP500.TR")] #' Beta.mat=fit$beta -#' residualData=as.matrix(fit$resid.variance,1,6) +#' residualData=as.matrix((fit$resid.sd)^2,1,6) #' n.boot=1000 #' # bootstrap returns data from factor model with residuals sample from normal distribution #' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="normal", Modified: pkg/FactorAnalytics/R/factorModelVaRDecomposition.R =================================================================== --- pkg/FactorAnalytics/R/factorModelVaRDecomposition.R 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/factorModelVaRDecomposition.R 2014-06-29 03:59:29 UTC (rev 3445) @@ -43,16 +43,17 @@ #' @examples #' #' data(managers.df) -#' fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") +#' fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df,fit.method="OLS", +#' variable.selection="none") #' # risk factor contribution to VaR #' # combine fund returns, factor returns and residual returns for HAM1 #' tmpData = cbind(managers.df[,1],managers.df[,c("EDHEC.LS.EQ","SP500.TR")] , -#' residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.variance[1])) +#' residuals(fit.macro$asset.fit$HAM1)/fit.macro$resid.sd[1]) #' colnames(tmpData)[c(1,4)] = c("HAM1", "residual") #' factor.VaR.decomp.HAM1 = factorModelVaRDecomposition(tmpData, fit.macro$beta[1,], -#' fit.macro$resid.variance[1], tail.prob=0.05, +#' fit.macro$resid.sd[1], tail.prob=0.05, #' VaR.method="historical") #' #' @export Modified: pkg/FactorAnalytics/R/fitTSFM.R =================================================================== --- pkg/FactorAnalytics/R/fitTSFM.R 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/fitTSFM.R 2014-06-29 03:59:29 UTC (rev 3445) @@ -130,21 +130,20 @@ #' \code{\link{paFM}} for Performance Attribution. #' #' @examples -#' \dontrun{ #' # load data from the database #' data(managers.df) -#' fit <- fitTimeSeriesFactorModel(asset.names=colnames(managers.df[,(1:6)]), -#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") +#' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), data=managers.df, +#' fit.method="OLS", variable.selection="none") #' # summary of HAM1 #' summary(fit$asset.fit$HAM1) #' # plot actual vs. fitted over time for HAM1 -#' # use chart.TimeSeries() function from PerformanceAnalytics package +#' # using chart.TimeSeries() function from PerformanceAnalytics package #' dataToPlot <- cbind(fitted(fit$asset.fit$HAM1), na.omit(managers.df$HAM1)) #' colnames(dataToPlot) <- c("Fitted","Actual") #' chart.TimeSeries(dataToPlot, main="FM fit for HAM1", #' colorset=c("black","blue"), legend.loc="bottomleft") -#' } +#' #' #' @export @@ -291,8 +290,8 @@ reg.list[[i]] <- step(lm(fm.formula, data=reg.xts, weights=w), direction=direction, steps=steps, k=k, trace=0) } else if (fit.method == "Robust") { - reg.list[[i]] <- step.lmRob(lmRob(fm.formula, data=reg.df), trace=FALSE, - direction=direction, steps=steps, k=k) + reg.list[[i]] <- step.lmRob(lmRob(fm.formula, data=reg.xts), trace=FALSE, + direction=direction, steps=steps) } else { stop("Invalid argument: fit.method must be 'OLS', 'DLS' or 'Robust'") } Modified: pkg/FactorAnalytics/R/fitted.sfm.r =================================================================== --- pkg/FactorAnalytics/R/fitted.sfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/fitted.sfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,8 +2,9 @@ #' #' @description Method or helper function for fit object of class \code{sfm}. #' -#' @param x an object of class \code{sfm} which is returned by -#' \code{\link{fitSFM}} +#' @param object a fit object of class \code{sfm} which is returned by +#' \code{\link{fitSFM}} +#' @param ... other arguments passed #' #' @return #' \item{fitted.xts}{an N x T data object of fitted values} @@ -13,13 +14,13 @@ #' #' @seealso \code{\link{fitSFM}} #' -#' @method fitted tsfm +#' @method fitted sfm #' @export -fitted.sfm <- function(x){ +fitted.sfm <- function(object,...){ # get fitted values from each linear factor model fit # and convert them into xts/zoo objects - fitted.list = sapply(x$asset.fit, function(x) checkData(fitted(x))) + fitted.list = sapply(object$asset.fit, function(x) checkData(fitted(x))) # this is a list of xts objects, indexed by the asset name # merge the objects in the list into one xts object fitted.xts <- do.call(merge, fitted.list) Modified: pkg/FactorAnalytics/R/fitted.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/fitted.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/fitted.tsfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,8 +2,9 @@ #' #' @description Method or helper function for fit object of class \code{tsfm}. #' -#' @param x an object of class \code{tsfm} which is returned by +#' @param object a fit object of class \code{tsfm} which is returned by #' \code{\link{fitTSFM}} +#' @param ... other arguments passed #' #' @return #' \item{fitted.xts}{an N x T data object of fitted values} @@ -27,10 +28,10 @@ #' @method fitted tsfm #' @export -fitted.tsfm <- function(x){ +fitted.tsfm <- function(object,...){ # get fitted values from each linear factor model fit # and convert them into xts/zoo objects - fitted.list = sapply(x$asset.fit, function(x) checkData(fitted(x))) + fitted.list = sapply(object$asset.fit, function(x) checkData(fitted(x))) # this is a list of xts objects, indexed by the asset name # merge the objects in the list into one xts object fitted.xts <- do.call(merge, fitted.list) Modified: pkg/FactorAnalytics/R/print.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/print.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/print.tsfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -18,7 +18,7 @@ #' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), #' factor.names=colnames(managers.df[,7:9]), #' market.name="SP500.TR", -#' data=data, fit.method="OLS", variable.selection="none", +#' data=managers.df, fit.method="OLS", variable.selection="none", #' add.up.market=TRUE, add.market.sqd=TRUE) #' print(fit) #' @@ -39,7 +39,7 @@ print(x$alpha, digits = digits, ...) cat("\nFactor Betas:\n") print(t(x$beta), digits = digits, ...) - cat("\nRegression R-squared values:\n") + cat("\nR-squared values:\n") print(x$r2, digits = digits, ...) cat("\nResidual Volatilities:\n") print(x$resid.sd, digits = digits, ...) Modified: pkg/FactorAnalytics/R/residuals.sfm.r =================================================================== --- pkg/FactorAnalytics/R/residuals.sfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/residuals.sfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,8 +2,9 @@ #' #' @description Method or helper function for fit object of class \code{sfm}. #' -#' @param x an object of class \code{sfm} which is returned by +#' @param object a fit object of class \code{sfm} which is returned by #' \code{\link{fitSFM}} +#' @param ... other arguments passed #' #' @return #' \item{residuals.xts}{an N x T data object of residuals} @@ -16,10 +17,10 @@ #' @method residuals sfm #' @export -residuals.sfm <- function(x) { +residuals.sfm <- function(object,...) { # get residuals from each linear factor model fit # and convert them into xts/zoo objects - residuals.list = sapply(x$asset.fit, function(x) checkData(residuals(x))) + residuals.list = sapply(object$asset.fit, function(x) checkData(residuals(x))) # this is a list of xts objects, indexed by the asset name # merge the objects in the list into one xts object residuals.xts <- do.call(merge, residuals.list) Modified: pkg/FactorAnalytics/R/residuals.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/residuals.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/residuals.tsfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -2,8 +2,9 @@ #' #' @description Method or helper function for fit object of class \code{tsfm}. #' -#' @param x an object of class \code{tsfm} which is returned by +#' @param object a fit object of class \code{tsfm} which is returned by #' \code{\link{fitTSFM}} +#' @param ... other arguments passed #' #' @return #' \item{residuals.xts}{an N x T data object of residuals} @@ -27,10 +28,10 @@ #' @method residuals tsfm #' @export -residuals.tsfm <- function(x) { +residuals.tsfm <- function(object ,...) { # get residuals from each linear factor model fit # and convert them into xts/zoo objects - residuals.list = sapply(x$asset.fit, function(x) checkData(residuals(x))) + residuals.list = sapply(object$asset.fit, function(x) checkData(residuals(x))) # this is a list of xts objects, indexed by the asset name # merge the objects in the list into one xts object residuals.xts <- do.call(merge, residuals.list) Modified: pkg/FactorAnalytics/R/summary.pafm.r =================================================================== --- pkg/FactorAnalytics/R/summary.pafm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/summary.pafm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -12,9 +12,10 @@ #' # load data from the database #' data(managers.df) #' # fit the factor model with OLS -#' fit.ts <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), -#' factors.names=c("EDHEC.LS.EQ","SP500.TR"), -#' data=managers.df,fit.method="OLS") +#' fit.ts <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), +#' factor.names=c("EDHEC.LS.EQ","SP500.TR"), +#' data=managers.df, fit.method="OLS", +#' variable.selection="none") #' #' fm.attr <- paFM(fit.ts) #' summary(fm.attr) Modified: pkg/FactorAnalytics/R/summary.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/R/summary.tsfm.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -1,15 +1,23 @@ #' @title Summarizing a fitted time series factor model #' #' @description S3 \code{summary} method for object of class \code{tsfm}. -#' Resulting object is of class {summary.tsfm}. +#' Resulting object is of class {summary.tsfm}. There is a generic +#' \code{print} method for this object. #' #' @param object an object of class \code{tsfm} produced by \code{fitTSFM}. -#' @param digits an integer value, to indicate the required number of -#' significant digits. Default is 3. -#' @param ... optional arguments passed to the \code{print} method. +#' @param ... futher arguments passed to or from other methods. #' -#' @return Returns an object of class {summary.tsfm}. +#' @return Returns an object of class \code{summary.tsfm}, which is a list +#' containing the function call to \code{fitTSFM} and the +#' \code{summary.lm} objects fitted for each asset in the factor model. +#' The print method for class \code{summary.tsfm} outputs the call, coefficients, +#' r-squared and residual volatilty for all assets. #' +#' @note For a more detailed printed summary for each asset, refer to +#' \code{print.summary.lm}, which tries to be smart about formatting the +#' coefficients, standard errors, etc. and additionally gives ?significance +#' stars? if \code{signif.stars} is TRUE. +#' #' @author Yi-An Chen & Sangeetha Srinivasan. #' #' @seealso \code{\link{fitTSFM}} @@ -18,30 +26,48 @@ #' data(managers.df) #' fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), #' factor.names=colnames(managers.df[,7:9]), -#' market.name="SP500.TR", -#' data=data, fit.method="OLS", variable.selection="none", +#' market.name="SP500.TR", data=managers.df, +#' fit.method="OLS", variable.selection="none", #' add.up.market=TRUE, add.market.sqd=TRUE) #' summary(fit) #' #' @method summary tsfm +#' @method print summary.tsfm #' @export -summary.tsfm <- function(object, digits=3, ...){ - if(!is.null(cl <- object$call)) { - cat("\nCall:\n") - dput(cl) +summary.tsfm <- function(object, ...){ + # check input object validity + if (!inherits(object, "tsfm")) { + stop("Invalid 'tsfm' object") } - cat("\nFactor Betas\n") - n <- length(object$assets.names) - for (i in 1:n) { - options(digits = digits) - cat("\n", object$assets.names[i], "\n") - table.macro <- t(summary(object$asset.fit[[i]])$coefficients) - colnames(table.macro)[1] <- "Intercept" - print(table.macro,digits = digits,...) - cat("\nR-squared =", object$r2[i] ,",Residual Volatility =" - , object$resid.sd[i],"\n") - } - + # extract summary.lm objects for each asset + sum <- lapply(object$asset.fit, summary) + # include the call to fitTSFM + sum <- c(call=object$call, sum) + class(sum) <- "summary.tsfm" + return(sum) } +# summary.tsfm <- function(object, ...){ +# # check input object validity +# if (!inherits(object, "tsfm")) { +# stop("Invalid 'tsfm' object") +# } +# n <- length(object$asset.names) +# asset.summary <- list() +# +# for (i in 1:n) { +# coeff <- t(summary(object$asset.fit[[i]])$coefficients) +# R2 <- object$r2[i] +# SD <- object$resid.sd[i] +# asset.summary[[i]] <- list(coeff, R2, SD) +# names(asset.summary) <- ("Coefficients", "R.squared", "Residual.Volatility") +# } +# +# out <- c(Call=object$call, +# Coefficients=coeff, +# R.squared=R2, +# Residual.Volatility=SD) +# class(out) <- "summary.tsfm" +# return(out) +# } Modified: pkg/FactorAnalytics/inst/tests/test-fitTSFM.r =================================================================== --- pkg/FactorAnalytics/inst/tests/test-fitTSFM.r 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/inst/tests/test-fitTSFM.r 2014-06-29 03:59:29 UTC (rev 3445) @@ -1,30 +1,31 @@ -context("Test fitTimeSeriesFactorModel") - -test_that("fitTimeSeriesFactorModel is as expected", { - - # fit Carhart 4-factor model using lm - fpath <- system.file("extdata", "timeSeriesReturns.csv", package="factorAnalytics") - returns.z <- read.zoo(file=fpath,header=TRUE,sep=",",as.is=TRUE,FUN=as.yearmon) - returns.z <- window(returns.z,start="2008-01-01",end="2012-12-31") - assets <- names(returns.z)[1:30] - ex.rets <- returns.z[,assets]-returns.z$rf - carhart <- returns.z[,c("mktrf","smb","hml","umd")] - ff4 <- lm(ex.rets ~ carhart) - sum4 = summary(ff4) - rsq4 <- as.numeric(sapply(X = sum4, FUN = "[", "r.squared")) - Sigma.F <- var(carhart) - beta.hat <- coef(ff4)[-1,] - Sigma.eps <- diag(as.numeric(sapply(X = sum4, FUN = "[", "sigma"))) - Sigma.R <- t(beta.hat) %*% Sigma.F %*% beta.hat + Sigma.eps^2 - - # fit Carhart 4-factor mode via fitTimeSeriesFactorModel - ff.mod <- fitTimeSeriesFactorModel( - assets.names = assets, - factors.names = c("mktrf","smb", "hml","umd"), - data = cbind(ex.rets,carhart), - fit.method = "OLS") - - expect_that(ff.mod$beta,is_equivalent_to(t(coef(ff4)[-1,]))) - expect_that(as.numeric(ff.mod$r2),equals(as.numeric(sapply(X = sum4, FUN = "[", "r.squared")))) - -}) +context("Test fitTSFM") + +test_that("fitTSFM is as expected", { + + # fit Carhart 4-factor model using lm + fpath <- system.file("extdata", "timeSeriesReturns.csv", package="factorAnalytics") + returns.z <- read.zoo(file=fpath,header=TRUE,sep=",",as.is=TRUE,FUN=as.yearmon) + returns.z <- window(returns.z,start="2008-01-01",end="2012-12-31") + assets <- names(returns.z)[1:30] + ex.rets <- returns.z[,assets]-returns.z$rf + carhart <- returns.z[,c("mktrf","smb","hml","umd")] + ff4 <- lm(ex.rets ~ carhart) + sum4 = summary(ff4) + rsq4 <- as.numeric(sapply(X = sum4, FUN = "[", "r.squared")) + Sigma.F <- var(carhart) + beta.hat <- coef(ff4)[-1,] + Sigma.eps <- diag(as.numeric(sapply(X = sum4, FUN = "[", "sigma"))) + Sigma.R <- t(beta.hat) %*% Sigma.F %*% beta.hat + Sigma.eps^2 + + # fit Carhart 4-factor mode via fitTSFM + ff.mod <- fitTSFM( + asset.names = assets, + factor.names = c("mktrf","smb", "hml","umd"), + data = cbind(ex.rets,carhart), + fit.method = "OLS", + variable.selection="none") + + expect_that(ff.mod$beta,is_equivalent_to(t(coef(ff4)[-1,]))) + expect_that(as.numeric(ff.mod$r2),equals(as.numeric(sapply(X = sum4, FUN = "[", "r.squared")))) + +}) Modified: pkg/FactorAnalytics/man/coef.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/coef.sfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/coef.sfm.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -3,11 +3,13 @@ \alias{coef.sfm} \title{Extract coefficients from a fitted stochastic factor model} \usage{ -\method{coef}{sfm}(x) +\method{coef}{sfm}(object, ...) } \arguments{ -\item{x}{an object of class \code{sfm} which is returned by +\item{object}{a fit object of class \code{sfm} which is returned by \code{\link{fitSFM}}} + +\item{...}{other arguments passed} } \value{ \item{coef.mat}{an N x (K+1) matrix of all coefficients} Modified: pkg/FactorAnalytics/man/coef.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/coef.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/coef.tsfm.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -3,11 +3,13 @@ \alias{coef.tsfm} \title{Extract coefficients from a fitted time series factor model} \usage{ -\method{coef}{tsfm}(x) +\method{coef}{tsfm}(object, ...) } \arguments{ -\item{x}{an object of class \code{tsfm} which is returned by +\item{object}{a fit object of class \code{tsfm} which is returned by \code{\link{fitTSFM}}} + +\item{...}{other arguments passed} } \value{ \item{coef.mat}{an N x (K+1) matrix of all coefficients} Modified: pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd =================================================================== --- pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -3,7 +3,7 @@ \alias{factorModelEsDecomposition} \title{Compute Factor Model ES Decomposition} \usage{ -factorModelEsDecomposition(Data, beta.vec, sig2.e, tail.prob = 0.05, +factorModelEsDecomposition(Data, beta.vec, sig.e, tail.prob = 0.05, VaR.method = c("modified", "gaussian", "historical", "kernel")) } \arguments{ @@ -14,7 +14,7 @@ \item{beta.vec}{\code{k x 1} vector of factor betas.} -\item{sig2.e}{scalar, residual variance from factor model.} +\item{sig.e}{scalar, residual variance from factor model.} \item{tail.prob}{scalar, tail probability for VaR quantile. Typically 0.01 or 0.05.} @@ -51,16 +51,17 @@ } \examples{ data(managers.df) -fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), - factors.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") +fit.macro <- fitTSFM (asset.names=colnames(managers.df[,(1:6)]), + factor.names=c("EDHEC.LS.EQ","SP500.TR"), + data=managers.df, fit.method="OLS", + variable.selection="none") # risk factor contribution to ETL # combine fund returns, factor returns and residual returns for HAM1 tmpData = cbind(managers.df[,1],managers.df[,c("EDHEC.LS.EQ","SP500.TR")] , -residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.variance[1])) +residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.sd[1])) colnames(tmpData)[c(1,4)] = c("HAM1", "residual") factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit.macro$beta[1,], - fit.macro$resid.variance[1], tail.prob=0.05, + fit.macro$resid.sd[1], tail.prob=0.05, VaR.method="historical" ) # fundamental factor model Modified: pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd =================================================================== --- pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -70,12 +70,13 @@ \examples{ # load data from the database data(managers.df) -fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), - factors.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") +fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=c("EDHEC.LS.EQ","SP500.TR"), + data=managers.df,fit.method="OLS", + variable.selection="none") factorData= managers.df[,c("EDHEC.LS.EQ","SP500.TR")] Beta.mat=fit$beta -residualData=as.matrix(fit$resid.variance,1,6) +residualData=as.matrix((fit$resid.sd)^2,1,6) n.boot=1000 # bootstrap returns data from factor model with residuals sample from normal distribution bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="normal", Modified: pkg/FactorAnalytics/man/factorModelVaRDecomposition.Rd =================================================================== --- pkg/FactorAnalytics/man/factorModelVaRDecomposition.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/factorModelVaRDecomposition.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -49,16 +49,17 @@ } \examples{ data(managers.df) -fit.macro <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), - factors.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") +fit.macro <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=c("EDHEC.LS.EQ","SP500.TR"), + data=managers.df,fit.method="OLS", + variable.selection="none") # risk factor contribution to VaR # combine fund returns, factor returns and residual returns for HAM1 tmpData = cbind(managers.df[,1],managers.df[,c("EDHEC.LS.EQ","SP500.TR")] , -residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.variance[1])) +residuals(fit.macro$asset.fit$HAM1)/fit.macro$resid.sd[1]) colnames(tmpData)[c(1,4)] = c("HAM1", "residual") factor.VaR.decomp.HAM1 = factorModelVaRDecomposition(tmpData, fit.macro$beta[1,], - fit.macro$resid.variance[1], tail.prob=0.05, + fit.macro$resid.sd[1], tail.prob=0.05, VaR.method="historical") } \author{ Modified: pkg/FactorAnalytics/man/fitTSFM.Rd =================================================================== --- pkg/FactorAnalytics/man/fitTSFM.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/fitTSFM.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -130,21 +130,19 @@ \code{\link[lars]{cv.lars}}. } \examples{ -\dontrun{ # load data from the database data(managers.df) -fit <- fitTimeSeriesFactorModel(asset.names=colnames(managers.df[,(1:6)]), - factor.names=c("EDHEC.LS.EQ","SP500.TR"), - data=managers.df,fit.method="OLS") +fit <- fitTSFM(asset.names=colnames(managers.df[,(1:6)]), + factor.names=c("EDHEC.LS.EQ","SP500.TR"), data=managers.df, + fit.method="OLS", variable.selection="none") # summary of HAM1 summary(fit$asset.fit$HAM1) # plot actual vs. fitted over time for HAM1 -# use chart.TimeSeries() function from PerformanceAnalytics package +# using chart.TimeSeries() function from PerformanceAnalytics package dataToPlot <- cbind(fitted(fit$asset.fit$HAM1), na.omit(managers.df$HAM1)) colnames(dataToPlot) <- c("Fitted","Actual") chart.TimeSeries(dataToPlot, main="FM fit for HAM1", colorset=c("black","blue"), legend.loc="bottomleft") - } } \author{ Eric Zivot, Yi-An Chen and Sangeetha Srinivasan. Modified: pkg/FactorAnalytics/man/fitted.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitted.sfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/fitted.sfm.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -3,11 +3,13 @@ \alias{fitted.sfm} \title{Get fitted values from a stochastic factor model} \usage{ -\method{fitted}{tsfm}(x) +\method{fitted}{sfm}(object, ...) } \arguments{ -\item{x}{an object of class \code{sfm} which is returned by +\item{object}{a fit object of class \code{sfm} which is returned by \code{\link{fitSFM}}} + +\item{...}{other arguments passed} } \value{ \item{fitted.xts}{an N x T data object of fitted values} Modified: pkg/FactorAnalytics/man/fitted.tsfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitted.tsfm.Rd 2014-06-27 19:15:04 UTC (rev 3444) +++ pkg/FactorAnalytics/man/fitted.tsfm.Rd 2014-06-29 03:59:29 UTC (rev 3445) @@ -3,11 +3,13 @@ \alias{fitted.tsfm} \title{Get fitted values from a time series factor model} \usage{ -\method{fitted}{tsfm}(x) +\method{fitted}{tsfm}(object, ...) } \arguments{ -\item{x}{an object of class \code{tsfm} which is returned by +\item{object}{a fit object of class \code{tsfm} which is returned by \code{\link{fitTSFM}}} + +\item{...}{other arguments passed} } \value{ \item{fitted.xts}{an N x T data object of fitted values} [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3445 From noreply at r-forge.r-project.org Sun Jun 29 14:50:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 29 Jun 2014 14:50:14 +0200 (CEST) Subject: [Returnanalytics-commits] r3446 - pkg/PortfolioAnalytics/R Message-ID: <20140629125014.B240C185764@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-29 14:50:14 +0200 (Sun, 29 Jun 2014) New Revision: 3446 Added: pkg/PortfolioAnalytics/R/EntropyProg.R Log: Adding EntropyProg from Meucci Added: pkg/PortfolioAnalytics/R/EntropyProg.R =================================================================== --- pkg/PortfolioAnalytics/R/EntropyProg.R (rev 0) +++ pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 12:50:14 UTC (rev 3446) @@ -0,0 +1,227 @@ +#' Entropy pooling program for blending views on scenarios with a prior scenario-probability distribution +#' +#' Entropy program will change the initial predictive distribution 'p' to a new set 'p_' that satisfies +#' specified moment conditions but changes other propoerties of the new distribution the least by +#' minimizing the relative entropy between the two distributions. Theoretical note: Relative Entropy (Kullback-Leibler information criterion KLIC) is an +#' asymmetric measure. +#' +#' We retrieve a new set of probabilities for the joint-scenarios using the Entropy pooling method +#' Of the many choices of 'p' that satisfy the views, we choose 'p' that minimize the entropy or distance of the new probability +#' distribution to the prior joint-scenario probabilities +#' We use Kullback-Leibler divergence or relative entropy dist(p,q): Sum across all scenarios [ p-t * ln( p-t / q-t ) ] +#' Therefore we define solution as p* = argmin (choice of p ) [ sum across all scenarios: p-t * ln( p-t / q-t) ], +#' such that 'p' satisfies views. The views modify the prior in a cohrent manner (minimizing distortion) +#' We forumulate the stress tests of the baseline scenarios as linear constraints on yet-to-be defined probabilities +#' Note that the numerical optimization acts on a very limited number of variables equal +#' to the number of views. It does not act directly on the very large number of variables +#' of interest, namely the probabilities of the Monte Carlo scenarios. This feature guarantees +#' the numerical feasability of entropy optimization +#' Note that new probabilities are generated in much the same way that the state-price density modifies +#' objective probabilities of pay-offs to risk-neutral probabilities in contingent-claims asset pricing +#' +#' Compute posterior (=change of measure) with Entropy Pooling, as described in +#' +#' @param p a vector of initial probabilities based on prior (reference model, empirical distribution, etc.). Sum of 'p' must be 1 +#' @param Aeq matrix consisting of equality constraints (paired with argument 'beq'). Denoted as 'H' in the Meucci paper. (denoted as 'H' in the "Meucci - Flexible Views Theory & Practice" paper formlua 86 on page 22) +#' @param beq vector corresponding to the matrix of equality constraints (paired with argument 'Aeq'). Denoted as 'h' in the Meucci paper +#' @param A matrix consisting of inequality constraints (paired with argument 'b'). Denoted as 'F' in the Meucci paper +#' @param b vector consisting of inequality constraints (paired with matrix A). Denoted as 'f' in the Meucci paper +#' +#' ' \deqn{ \tilde{p} \equiv argmin_{Fx \leq f, Hx \equiv h} \big\{ \sum_1^J x_{j} \big(ln \big( x_{j} \big) - ln \big( p_{j} \big) \big) \big\} +#' \\ \ell \big(x, \lambda, \nu \big) \equiv x' \big(ln \big(x\big) - ln \big(p\big) \big) + \lambda' \big(Fx - f\big) + \nu' \big(Hx - h\big)} +#' @return a list with +#' p_ revised probabilities based on entropy pooling +#' optimizationPerformance a list with status of optimization, value, number of iterations and sum of probabilities. +#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com} +#' @references +#' A. Meucci - "Fully Flexible Views: Theory and Practice". See page 22 for illustration of numerical implementation +#' Symmys site containing original MATLAB source code \url{http://www.symmys.com} +#' NLOPT open-source optimization site containing background on algorithms \url{http://ab-initio.mit.edu/wiki/index.php/NLopt} +#' We use the information-theoretic estimator of Kitamur and Stutzer (1997). +#' Reversing 'p' and 'p_' leads to the empirical likelihood" estimator of Qin and Lawless (1994). +#' See Robertson et al, "Forecasting Using Relative Entropy" (2002) for more theory +#' @export +EntropyProg = function( p , A = NULL , b = NULL , Aeq , beq ) +{ + library( nloptr ) + + if( !length(b) ) A = matrix( ,nrow = 0, ncol = 0) + if( !length(b) ) b = matrix( ,nrow = 0, ncol = 0) + # count the number of constraints + K_ = nrow( A ) # K_ is the number of inequality constraints in the matrix-vector pair A-b + K = nrow( Aeq ) # K is the number of equality views in the matrix-vector pair Aeq-beq + + # parameter checks + if ( K_ + K == 0 ) { stop( "at least one equality or inequality constraint must be specified")} + if ( ( ( .999999 < sum(p)) & (sum(p) < 1.00001) ) == FALSE ) { stop( "sum of probabilities from prior distribution must equal 1")} + if ( nrow(Aeq)!=nrow(beq) ) { stop( "number of inequality constraints in matrix Aeq must match number of elements in vector beq") } + if ( nrow(A)!=nrow(b) ) { stop( "number of equality constraints in matrix A must match number of elements in vector b") } + + # calculate derivatives of constraint matrices + A_ = t( A ) + b_ = t( b ) + Aeq_ = t( Aeq ) + beq_ = t( beq ) + + # starting guess for optimization search with length = to number of views + x0 = matrix( 0 , nrow = K_ + K , ncol = 1 ) + + if ( !K_ ) # equality constraints only + { + # define maximum likelihood, gradient, and hessian functions for unconstrained and constrained optimization + eval_f_list = function( v ) # cost function for unconstrained optimization (no inequality constraints) + { + x = exp( log(p) - 1 - Aeq_ %*% v ) + x = apply( cbind( x , 10^-32 ) , 1 , max ) # robustification + # L is the Lagrangian dual function (without inequality constraints). See formula 88 on p. 22 in "Meucci - Fully Flexible Views - Theory and Practice (2010)" + # t(x) is the derivative x' + # Aeq_ is the derivative of the Aeq matrix of equality constraints (denoted as 'H in the paper) + # beq_ is the transpose of the vector associated with Aeq equality constraints + # L= x' * ( log(x) - log(p) + Aeq_ * v ) - beq_ * v + # 1xJ * ( Jx1 - Jx1 + JxN+1 * N+1x1 ) - 1xN+1 * N+1x1 + L = t(x) %*% ( log(x) - log(p) + Aeq_ %*% v ) - beq_ %*% v + mL = -L # take negative values since we want to maximize + + # evaluate gradient + gradient = beq - Aeq %*% x + + # evaluate Hessian + # We comment this out for now -- to be used when we find an optimizer that can utilize the Hessian in addition to the gradient + # H = ( Aeq %*% (( x %*% ones(1,K) ) * Aeq_) ) # Hessian computed by Chen Qing, Lin Daimin, Meng Yanyan, Wang Weijun + + return( list( objective = mL , gradient = gradient ) ) + } + + # setup unconstrained optimization + start = Sys.time() + opts = list( algorithm = "NLOPT_LD_LBFGS" , xtol_rel = 1.0e-6 , + check_derivatives = TRUE , check_derivatives_print = "all" , print_level = 2 , maxeval = 1000 ) + optimResult = nloptr(x0 = x0, eval_f = eval_f_list , opts = opts ) + end = Sys.time() + print( c("Optimization completed in " , end - start )) ; rm( start ) ; rm( end ) + + if ( optimResult$status < 0 ) { print( c("Exit code " , optimResult$status ) ) ; stop( "Error: The optimizer did not converge" ) } + + # return results of optimization + v = optimResult$solution + p_ = exp( log(p) - 1 - Aeq_ %*% v ) + optimizationPerformance = list( converged = (optimResult$status > 0) , ml = optimResult$objective , iterations = optimResult$iterations , sumOfProbabilities = sum( p_ ) ) + }else # case inequality constraints are specified + { + # setup variables for constrained optimization + InqMat = -diag( 1 , K_ + K ) # -1 * Identity Matrix with dimension equal to number of constraints + InqMat = InqMat[ -c( K_+1:nrow( InqMat ) ) , ] # drop rows corresponding to equality constraints + InqVec = matrix( 0 , K_ , 1 ) + + # define maximum likelihood, gradient, and hessian functions for constrained optimization + InqConstraint = function( x ) { return( InqMat %*% x ) } # function used to evalute A %*% x <= 0 or A %*% x <= c(0,0) if there is more than one inequality constraint + + jacobian_constraint = function( x ) { return( InqMat ) } + # Jacobian of the constraints matrix. One row per constraint, one column per control parameter (x1,x2) + # Turns out the Jacobian of the constraints matrix is always equal to InqMat + + nestedfunC = function( lv ) + { + lv = as.matrix( lv ) + l = lv[ 1:K_ , , drop = FALSE ] # inequality Lagrange multiplier + v = lv[ (K_+1):length(lv) , , drop = FALSE ] # equality lagrange multiplier + x = exp( log(p) - 1 - A_ %*% l - Aeq_ %*% v ) + x = apply( cbind( x , 10^-32 ) , 1 , max ) + + # L is the cost function used for constrained optimization + # L is the Lagrangian dual function with inequality constraints and equality constraints + L = t(x) %*% ( log(x) - log(p) ) + t(l) %*% (A %*% x-b) + t(v) %*% (Aeq %*% x-beq) + objective = -L # take negative values since we want to maximize + + # calculate the gradient + gradient = rbind( b - A%*%x , beq - Aeq %*% x ) + + # compute the Hessian (commented out since no R optimizer supports use of Hessian) + # Hessian computed by Chen Qing, Lin Daimin, Meng Yanyan, Wang Weijun + #onesToK_ = array( rep( 1 , K_ ) ) ;onesToK = array( rep( 1 , K ) ) + #x = as.matrix( x ) + #H11 = A %*% ((x %*% onesToK_) * A_) ; H12 = A %*% ((x %*% onesToK) * Aeq_) + #H21 = Aeq %*% ((x %*% onesToK_) * A_) ; H22 = Aeq %*% ((x %*% onesToK) * Aeq_) + #H1 = cbind( H11 , H12 ) ; H2 = cbind( H21 , H22 ) ; H = rbind( H1 , H2 ) # Hessian for constrained optimization + return( list( objective = objective , gradient = gradient ) ) + } + + # find minimum of constrained multivariate function + start = Sys.time() + # Note: other candidates for constrained optimization in library nloptr: NLOPT_LD_SLSQP, NLOPT_LD_MMA, NLOPT_LN_AUGLAG, NLOPT_LD_AUGLAG_EQ + # See NLOPT open-source site for more details: http://ab-initio.mit.edu/wiki/index.php/NLopt + local_opts <- list( algorithm = "NLOPT_LD_SLSQP", xtol_rel = 1.0e-6 , + check_derivatives = TRUE , check_derivatives_print = "all" , + eval_f = nestedfunC , eval_g_ineq = InqConstraint , eval_jac_g_ineq = jacobian_constraint ) + optimResult = nloptr( x0 = x0 , eval_f = nestedfunC , eval_g_ineq = InqConstraint , eval_jac_g_ineq = jacobian_constraint , + opts = list( algorithm = "NLOPT_LD_AUGLAG" , local_opts = local_opts , + print_level = 2 , maxeval = 1000 , + check_derivatives = TRUE , check_derivatives_print = "all" , xtol_rel = 1.0e-6 ) ) + end = Sys.time() + print( c("Optimization completed in " , end - start )) ; rm( start ) ; rm( end ) + + if ( optimResult$status < 0 ) { print( c("Exit code " , optimResult$status ) ) ; stop( "Error: The optimizer did not converge" ) } + + # return results of optimization + lv = matrix( optimResult$solution , ncol = 1 ) + l = lv[ 1:K_ , , drop = FALSE ] # inequality Lagrange multipliers + v = lv[ (K_+1):nrow( lv ) , , drop = FALSE ] # equality Lagrange multipliers + p_ = exp( log(p) -1 - A_ %*% l - Aeq_ %*% v ) + optimizationPerformance = list( converged = (optimResult$status > 0) , ml = optimResult$objective , iterations = optimResult$iterations , sumOfProbabilities = sum( p_ ) ) + } + + print( optimizationPerformance ) + + if ( sum( p_ ) < .999 ) { stop( "Sum or revised probabilities is less than 1!" ) } + if ( sum( p_ ) > 1.001 ) { stop( "Sum or revised probabilities is greater than 1!" ) } + + return ( list ( p_ = p_ , optimizationPerformance = optimizationPerformance ) ) +} + + + +#' Generates histogram +#' +#' @param X a vector containing the data points +#' @param p a vector containing the probabilities for each of the data points in X +#' @param nBins expected number of Bins the data set is to be broken down into +#' @param freq a boolean variable to indicate whether the graphic is a representation of frequencies +#' +#' @return a list with +#' f the frequency for each midpoint +#' x the midpoints of the nBins intervals +#' +#' @references +#' \url{http://www.symmys.com} +#' See Meucci script pHist.m used for plotting +#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com} and Xavier Valls \email{flamejat@@gmail.com} + +pHist = function( X , p , nBins, freq = FALSE ) +{ + if ( length( match.call() ) < 3 ) + { + J = dim( X )[ 1 ] + nBins = round( 10 * log(J) ) + } + + dist = hist( x = X , breaks = nBins , plot = FALSE ); + n = dist$counts + x = dist$breaks + D = x[2] - x[1] + + N = length(x) + np = zeros(N , 1) + + for (s in 1:N) + { + # The boolean Index is true is X is within the interval centered at x(s) and within a half-break distance + Index = ( X >= x[s] - D/2 ) & ( X <= x[s] + D/2 ) + # np = new probabilities? + np[ s ] = sum( p[ Index ] ) + f = np/D + } + + plot( x , f , type = "h", main = "Portfolio return distribution") + + return( list( f = f , x = x ) ) +} From noreply at r-forge.r-project.org Sun Jun 29 18:18:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 29 Jun 2014 18:18:42 +0200 (CEST) Subject: [Returnanalytics-commits] r3447 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20140629161842.5DC9E186F81@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-29 18:18:42 +0200 (Sun, 29 Jun 2014) New Revision: 3447 Added: pkg/PortfolioAnalytics/R/meucci_moments.R pkg/PortfolioAnalytics/R/meucci_ranking.R Modified: pkg/PortfolioAnalytics/R/EntropyProg.R pkg/PortfolioAnalytics/sandbox/scriptFFV.R Log: Adding Meucci ranking Modified: pkg/PortfolioAnalytics/R/EntropyProg.R =================================================================== --- pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 12:50:14 UTC (rev 3446) +++ pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 16:18:42 UTC (rev 3447) @@ -1,227 +1,274 @@ -#' Entropy pooling program for blending views on scenarios with a prior scenario-probability distribution -#' -#' Entropy program will change the initial predictive distribution 'p' to a new set 'p_' that satisfies -#' specified moment conditions but changes other propoerties of the new distribution the least by -#' minimizing the relative entropy between the two distributions. Theoretical note: Relative Entropy (Kullback-Leibler information criterion KLIC) is an -#' asymmetric measure. -#' -#' We retrieve a new set of probabilities for the joint-scenarios using the Entropy pooling method -#' Of the many choices of 'p' that satisfy the views, we choose 'p' that minimize the entropy or distance of the new probability -#' distribution to the prior joint-scenario probabilities -#' We use Kullback-Leibler divergence or relative entropy dist(p,q): Sum across all scenarios [ p-t * ln( p-t / q-t ) ] -#' Therefore we define solution as p* = argmin (choice of p ) [ sum across all scenarios: p-t * ln( p-t / q-t) ], -#' such that 'p' satisfies views. The views modify the prior in a cohrent manner (minimizing distortion) -#' We forumulate the stress tests of the baseline scenarios as linear constraints on yet-to-be defined probabilities -#' Note that the numerical optimization acts on a very limited number of variables equal -#' to the number of views. It does not act directly on the very large number of variables -#' of interest, namely the probabilities of the Monte Carlo scenarios. This feature guarantees -#' the numerical feasability of entropy optimization -#' Note that new probabilities are generated in much the same way that the state-price density modifies -#' objective probabilities of pay-offs to risk-neutral probabilities in contingent-claims asset pricing -#' -#' Compute posterior (=change of measure) with Entropy Pooling, as described in -#' -#' @param p a vector of initial probabilities based on prior (reference model, empirical distribution, etc.). Sum of 'p' must be 1 -#' @param Aeq matrix consisting of equality constraints (paired with argument 'beq'). Denoted as 'H' in the Meucci paper. (denoted as 'H' in the "Meucci - Flexible Views Theory & Practice" paper formlua 86 on page 22) -#' @param beq vector corresponding to the matrix of equality constraints (paired with argument 'Aeq'). Denoted as 'h' in the Meucci paper -#' @param A matrix consisting of inequality constraints (paired with argument 'b'). Denoted as 'F' in the Meucci paper -#' @param b vector consisting of inequality constraints (paired with matrix A). Denoted as 'f' in the Meucci paper -#' -#' ' \deqn{ \tilde{p} \equiv argmin_{Fx \leq f, Hx \equiv h} \big\{ \sum_1^J x_{j} \big(ln \big( x_{j} \big) - ln \big( p_{j} \big) \big) \big\} -#' \\ \ell \big(x, \lambda, \nu \big) \equiv x' \big(ln \big(x\big) - ln \big(p\big) \big) + \lambda' \big(Fx - f\big) + \nu' \big(Hx - h\big)} -#' @return a list with -#' p_ revised probabilities based on entropy pooling -#' optimizationPerformance a list with status of optimization, value, number of iterations and sum of probabilities. -#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com} -#' @references -#' A. Meucci - "Fully Flexible Views: Theory and Practice". See page 22 for illustration of numerical implementation -#' Symmys site containing original MATLAB source code \url{http://www.symmys.com} -#' NLOPT open-source optimization site containing background on algorithms \url{http://ab-initio.mit.edu/wiki/index.php/NLopt} -#' We use the information-theoretic estimator of Kitamur and Stutzer (1997). -#' Reversing 'p' and 'p_' leads to the empirical likelihood" estimator of Qin and Lawless (1994). -#' See Robertson et al, "Forecasting Using Relative Entropy" (2002) for more theory -#' @export -EntropyProg = function( p , A = NULL , b = NULL , Aeq , beq ) -{ - library( nloptr ) - - if( !length(b) ) A = matrix( ,nrow = 0, ncol = 0) - if( !length(b) ) b = matrix( ,nrow = 0, ncol = 0) - # count the number of constraints - K_ = nrow( A ) # K_ is the number of inequality constraints in the matrix-vector pair A-b - K = nrow( Aeq ) # K is the number of equality views in the matrix-vector pair Aeq-beq - - # parameter checks - if ( K_ + K == 0 ) { stop( "at least one equality or inequality constraint must be specified")} - if ( ( ( .999999 < sum(p)) & (sum(p) < 1.00001) ) == FALSE ) { stop( "sum of probabilities from prior distribution must equal 1")} - if ( nrow(Aeq)!=nrow(beq) ) { stop( "number of inequality constraints in matrix Aeq must match number of elements in vector beq") } - if ( nrow(A)!=nrow(b) ) { stop( "number of equality constraints in matrix A must match number of elements in vector b") } - - # calculate derivatives of constraint matrices - A_ = t( A ) - b_ = t( b ) - Aeq_ = t( Aeq ) - beq_ = t( beq ) - - # starting guess for optimization search with length = to number of views - x0 = matrix( 0 , nrow = K_ + K , ncol = 1 ) - - if ( !K_ ) # equality constraints only - { - # define maximum likelihood, gradient, and hessian functions for unconstrained and constrained optimization - eval_f_list = function( v ) # cost function for unconstrained optimization (no inequality constraints) - { - x = exp( log(p) - 1 - Aeq_ %*% v ) - x = apply( cbind( x , 10^-32 ) , 1 , max ) # robustification - # L is the Lagrangian dual function (without inequality constraints). See formula 88 on p. 22 in "Meucci - Fully Flexible Views - Theory and Practice (2010)" - # t(x) is the derivative x' - # Aeq_ is the derivative of the Aeq matrix of equality constraints (denoted as 'H in the paper) - # beq_ is the transpose of the vector associated with Aeq equality constraints - # L= x' * ( log(x) - log(p) + Aeq_ * v ) - beq_ * v - # 1xJ * ( Jx1 - Jx1 + JxN+1 * N+1x1 ) - 1xN+1 * N+1x1 - L = t(x) %*% ( log(x) - log(p) + Aeq_ %*% v ) - beq_ %*% v - mL = -L # take negative values since we want to maximize - - # evaluate gradient - gradient = beq - Aeq %*% x - - # evaluate Hessian - # We comment this out for now -- to be used when we find an optimizer that can utilize the Hessian in addition to the gradient - # H = ( Aeq %*% (( x %*% ones(1,K) ) * Aeq_) ) # Hessian computed by Chen Qing, Lin Daimin, Meng Yanyan, Wang Weijun - - return( list( objective = mL , gradient = gradient ) ) - } - - # setup unconstrained optimization - start = Sys.time() - opts = list( algorithm = "NLOPT_LD_LBFGS" , xtol_rel = 1.0e-6 , - check_derivatives = TRUE , check_derivatives_print = "all" , print_level = 2 , maxeval = 1000 ) - optimResult = nloptr(x0 = x0, eval_f = eval_f_list , opts = opts ) - end = Sys.time() - print( c("Optimization completed in " , end - start )) ; rm( start ) ; rm( end ) - - if ( optimResult$status < 0 ) { print( c("Exit code " , optimResult$status ) ) ; stop( "Error: The optimizer did not converge" ) } - - # return results of optimization - v = optimResult$solution - p_ = exp( log(p) - 1 - Aeq_ %*% v ) - optimizationPerformance = list( converged = (optimResult$status > 0) , ml = optimResult$objective , iterations = optimResult$iterations , sumOfProbabilities = sum( p_ ) ) - }else # case inequality constraints are specified - { - # setup variables for constrained optimization - InqMat = -diag( 1 , K_ + K ) # -1 * Identity Matrix with dimension equal to number of constraints - InqMat = InqMat[ -c( K_+1:nrow( InqMat ) ) , ] # drop rows corresponding to equality constraints - InqVec = matrix( 0 , K_ , 1 ) - - # define maximum likelihood, gradient, and hessian functions for constrained optimization - InqConstraint = function( x ) { return( InqMat %*% x ) } # function used to evalute A %*% x <= 0 or A %*% x <= c(0,0) if there is more than one inequality constraint - - jacobian_constraint = function( x ) { return( InqMat ) } - # Jacobian of the constraints matrix. One row per constraint, one column per control parameter (x1,x2) - # Turns out the Jacobian of the constraints matrix is always equal to InqMat - - nestedfunC = function( lv ) - { - lv = as.matrix( lv ) - l = lv[ 1:K_ , , drop = FALSE ] # inequality Lagrange multiplier - v = lv[ (K_+1):length(lv) , , drop = FALSE ] # equality lagrange multiplier - x = exp( log(p) - 1 - A_ %*% l - Aeq_ %*% v ) - x = apply( cbind( x , 10^-32 ) , 1 , max ) - - # L is the cost function used for constrained optimization - # L is the Lagrangian dual function with inequality constraints and equality constraints - L = t(x) %*% ( log(x) - log(p) ) + t(l) %*% (A %*% x-b) + t(v) %*% (Aeq %*% x-beq) - objective = -L # take negative values since we want to maximize - - # calculate the gradient - gradient = rbind( b - A%*%x , beq - Aeq %*% x ) - - # compute the Hessian (commented out since no R optimizer supports use of Hessian) - # Hessian computed by Chen Qing, Lin Daimin, Meng Yanyan, Wang Weijun - #onesToK_ = array( rep( 1 , K_ ) ) ;onesToK = array( rep( 1 , K ) ) - #x = as.matrix( x ) - #H11 = A %*% ((x %*% onesToK_) * A_) ; H12 = A %*% ((x %*% onesToK) * Aeq_) - #H21 = Aeq %*% ((x %*% onesToK_) * A_) ; H22 = Aeq %*% ((x %*% onesToK) * Aeq_) - #H1 = cbind( H11 , H12 ) ; H2 = cbind( H21 , H22 ) ; H = rbind( H1 , H2 ) # Hessian for constrained optimization - return( list( objective = objective , gradient = gradient ) ) - } - - # find minimum of constrained multivariate function - start = Sys.time() - # Note: other candidates for constrained optimization in library nloptr: NLOPT_LD_SLSQP, NLOPT_LD_MMA, NLOPT_LN_AUGLAG, NLOPT_LD_AUGLAG_EQ - # See NLOPT open-source site for more details: http://ab-initio.mit.edu/wiki/index.php/NLopt - local_opts <- list( algorithm = "NLOPT_LD_SLSQP", xtol_rel = 1.0e-6 , - check_derivatives = TRUE , check_derivatives_print = "all" , - eval_f = nestedfunC , eval_g_ineq = InqConstraint , eval_jac_g_ineq = jacobian_constraint ) - optimResult = nloptr( x0 = x0 , eval_f = nestedfunC , eval_g_ineq = InqConstraint , eval_jac_g_ineq = jacobian_constraint , - opts = list( algorithm = "NLOPT_LD_AUGLAG" , local_opts = local_opts , - print_level = 2 , maxeval = 1000 , - check_derivatives = TRUE , check_derivatives_print = "all" , xtol_rel = 1.0e-6 ) ) - end = Sys.time() - print( c("Optimization completed in " , end - start )) ; rm( start ) ; rm( end ) - - if ( optimResult$status < 0 ) { print( c("Exit code " , optimResult$status ) ) ; stop( "Error: The optimizer did not converge" ) } - - # return results of optimization - lv = matrix( optimResult$solution , ncol = 1 ) - l = lv[ 1:K_ , , drop = FALSE ] # inequality Lagrange multipliers - v = lv[ (K_+1):nrow( lv ) , , drop = FALSE ] # equality Lagrange multipliers - p_ = exp( log(p) -1 - A_ %*% l - Aeq_ %*% v ) - optimizationPerformance = list( converged = (optimResult$status > 0) , ml = optimResult$objective , iterations = optimResult$iterations , sumOfProbabilities = sum( p_ ) ) - } - - print( optimizationPerformance ) - - if ( sum( p_ ) < .999 ) { stop( "Sum or revised probabilities is less than 1!" ) } - if ( sum( p_ ) > 1.001 ) { stop( "Sum or revised probabilities is greater than 1!" ) } - - return ( list ( p_ = p_ , optimizationPerformance = optimizationPerformance ) ) -} - - - -#' Generates histogram -#' -#' @param X a vector containing the data points -#' @param p a vector containing the probabilities for each of the data points in X -#' @param nBins expected number of Bins the data set is to be broken down into -#' @param freq a boolean variable to indicate whether the graphic is a representation of frequencies -#' -#' @return a list with -#' f the frequency for each midpoint -#' x the midpoints of the nBins intervals -#' -#' @references -#' \url{http://www.symmys.com} -#' See Meucci script pHist.m used for plotting -#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com} and Xavier Valls \email{flamejat@@gmail.com} - -pHist = function( X , p , nBins, freq = FALSE ) -{ - if ( length( match.call() ) < 3 ) - { - J = dim( X )[ 1 ] - nBins = round( 10 * log(J) ) - } - - dist = hist( x = X , breaks = nBins , plot = FALSE ); - n = dist$counts - x = dist$breaks - D = x[2] - x[1] - - N = length(x) - np = zeros(N , 1) - - for (s in 1:N) - { - # The boolean Index is true is X is within the interval centered at x(s) and within a half-break distance - Index = ( X >= x[s] - D/2 ) & ( X <= x[s] + D/2 ) - # np = new probabilities? - np[ s ] = sum( p[ Index ] ) - f = np/D - } - - plot( x , f , type = "h", main = "Portfolio return distribution") - - return( list( f = f , x = x ) ) -} +#' Entropy pooling program for blending views on scenarios with a prior scenario-probability distribution +#' +#' Entropy program will change the initial predictive distribution 'p' to a new set 'p_' that satisfies +#' specified moment conditions but changes other propoerties of the new distribution the least by +#' minimizing the relative entropy between the two distributions. Theoretical note: Relative Entropy (Kullback-Leibler information criterion KLIC) is an +#' asymmetric measure. +#' +#' We retrieve a new set of probabilities for the joint-scenarios using the Entropy pooling method +#' Of the many choices of 'p' that satisfy the views, we choose 'p' that minimize the entropy or distance of the new probability +#' distribution to the prior joint-scenario probabilities. +#' +#' We use Kullback-Leibler divergence or relative entropy dist(p,q): Sum across all scenarios [ p-t * ln( p-t / q-t ) ] +#' Therefore we define solution as p* = argmin (choice of p ) [ sum across all scenarios: p-t * ln( p-t / q-t) ], +#' such that 'p' satisfies views. The views modify the prior in a cohrent manner (minimizing distortion) +#' We forumulate the stress tests of the baseline scenarios as linear constraints on yet-to-be defined probabilities +#' Note that the numerical optimization acts on a very limited number of variables equal +#' to the number of views. It does not act directly on the very large number of variables +#' of interest, namely the probabilities of the Monte Carlo scenarios. This feature guarantees +#' the numerical feasability of entropy optimization. +#' +#' Note that new probabilities are generated in much the same way that the state-price density modifies +#' objective probabilities of pay-offs to risk-neutral probabilities in contingent-claims asset pricing +#' +#' Compute posterior (=change of measure) with Entropy Pooling, as described in +#' +#' @param p a vector of initial probabilities based on prior (reference model, empirical distribution, etc.). Sum of 'p' must be 1 +#' @param Aeq matrix consisting of equality constraints (paired with argument 'beq'). Denoted as 'H' in the Meucci paper. (denoted as 'H' in the "Meucci - Flexible Views Theory & Practice" paper formlua 86 on page 22) +#' @param beq vector corresponding to the matrix of equality constraints (paired with argument 'Aeq'). Denoted as 'h' in the Meucci paper +#' @param A matrix consisting of inequality constraints (paired with argument 'b'). Denoted as 'F' in the Meucci paper +#' @param b vector consisting of inequality constraints (paired with matrix A). Denoted as 'f' in the Meucci paper +#' @param verbose If TRUE, prints out additional information. Default FALSE. +#' +#' ' \deqn{ \tilde{p} \equiv argmin_{Fx \leq f, Hx \equiv h} \big\{ \sum_1^J x_{j} \big(ln \big( x_{j} \big) - ln \big( p_{j} \big) \big) \big\} +#' \\ \ell \big(x, \lambda, \nu \big) \equiv x' \big(ln \big(x\big) - ln \big(p\big) \big) + \lambda' \big(Fx - f\big) + \nu' \big(Hx - h\big)} +#' @return a list with +#' \itemize{ +#' \item{\code{p_}:}{ revised probabilities based on entropy pooling} +#' \item{\code{optimizationPerformance}:}{ a list with status of optimization, +#' value, number of iterations, and sum of probabilities} +#' } +#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com} +#' @references +#' A. Meucci - "Fully Flexible Views: Theory and Practice". See page 22 for illustration of numerical implementation +#' Symmys site containing original MATLAB source code \url{http://www.symmys.com} +#' NLOPT open-source optimization site containing background on algorithms \url{http://ab-initio.mit.edu/wiki/index.php/NLopt} +#' We use the information-theoretic estimator of Kitamur and Stutzer (1997). +#' Reversing 'p' and 'p_' leads to the empirical likelihood" estimator of Qin and Lawless (1994). +#' See Robertson et al, "Forecasting Using Relative Entropy" (2002) for more theory +#' @export +EntropyProg = function( p , A = NULL , b = NULL , Aeq , beq, verbose=FALSE ) +{ + stopifnot("package:nloptr" %in% search() || require("nloptr",quietly = TRUE) ) + + if( !length(b) ) A = matrix( ,nrow = 0, ncol = 0) + if( !length(b) ) b = matrix( ,nrow = 0, ncol = 0) + + # count the number of constraints + K_ = nrow( A ) # K_ is the number of inequality constraints in the matrix-vector pair A-b + K = nrow( Aeq ) # K is the number of equality views in the matrix-vector pair Aeq-beq + + # parameter checks + if ( K_ + K == 0 ) { stop( "at least one equality or inequality constraint must be specified")} + if ( ( ( .999999 < sum(p)) & (sum(p) < 1.00001) ) == FALSE ) { stop( "sum of probabilities from prior distribution must equal 1")} + if ( nrow(Aeq) != nrow(beq) ) { stop( "number of inequality constraints in matrix Aeq must match number of elements in vector beq") } + if ( nrow(A) != nrow(b) ) { stop( "number of equality constraints in matrix A must match number of elements in vector b") } + + # calculate derivatives of constraint matrices + A_ = t( A ) + b_ = t( b ) + Aeq_ = t( Aeq ) + beq_ = t( beq ) + + # starting guess for optimization search with length = to number of views + x0 = matrix( 0 , nrow = K_ + K , ncol = 1 ) + + # set up print arguments for verbose + if(verbose){ + check_derivatives_print = "none" + print_level = 0 + } else { + check_derivatives_print = "all" + print_level = 2 + } + + if ( !K_ ) # equality constraints only + { + # define maximum likelihood, gradient, and hessian functions for unconstrained and constrained optimization + eval_f_list = function( v ) # cost function for unconstrained optimization (no inequality constraints) + { + x = exp( log(p) - 1 - Aeq_ %*% v ) + x = apply( cbind( x , 10^-32 ) , 1 , max ) # robustification + # L is the Lagrangian dual function (without inequality constraints). See formula 88 on p. 22 in "Meucci - Fully Flexible Views - Theory and Practice (2010)" + # t(x) is the derivative x' + # Aeq_ is the derivative of the Aeq matrix of equality constraints (denoted as 'H in the paper) + # beq_ is the transpose of the vector associated with Aeq equality constraints + # L= x' * ( log(x) - log(p) + Aeq_ * v ) - beq_ * v + # 1xJ * ( Jx1 - Jx1 + JxN+1 * N+1x1 ) - 1xN+1 * N+1x1 + L = t(x) %*% ( log(x) - log(p) + Aeq_ %*% v ) - beq_ %*% v + mL = -L # take negative values since we want to maximize + + # evaluate gradient + gradient = beq - Aeq %*% x + + # evaluate Hessian + # We comment this out for now -- to be used when we find an optimizer that can utilize the Hessian in addition to the gradient + # H = ( Aeq %*% (( x %*% ones(1,K) ) * Aeq_) ) # Hessian computed by Chen Qing, Lin Daimin, Meng Yanyan, Wang Weijun + + return( list( objective = mL , gradient = gradient ) ) + } + + # setup unconstrained optimization + start = Sys.time() + opts = list( algorithm = "NLOPT_LD_LBFGS" , + xtol_rel = 1.0e-6 , + check_derivatives = TRUE , + check_derivatives_print = check_derivatives_print , + print_level = print_level , + maxeval = 1000 ) + optimResult = nloptr(x0 = x0, eval_f = eval_f_list , opts = opts ) + end = Sys.time() + + if(verbose){ + print( c("Optimization completed in ", end - start )) + } + + if ( optimResult$status < 0 ) { + print( c("Exit code " , optimResult$status ) ) + stop( "Error: The optimizer did not converge" ) + } + + # return results of optimization + v = optimResult$solution + p_ = exp( log(p) - 1 - Aeq_ %*% v ) + optimizationPerformance = list( converged = (optimResult$status > 0) , + ml = optimResult$objective , + iterations = optimResult$iterations , + sumOfProbabilities = sum( p_ ) ) + }else # case inequality constraints are specified + { + # setup variables for constrained optimization + InqMat = -diag( 1 , K_ + K ) # -1 * Identity Matrix with dimension equal to number of constraints + InqMat = InqMat[ -c( K_+1:nrow( InqMat ) ) , ] # drop rows corresponding to equality constraints + InqVec = matrix( 0 , K_ , 1 ) + + # define maximum likelihood, gradient, and hessian functions for constrained optimization + InqConstraint = function( x ) { return( InqMat %*% x ) } # function used to evalute A %*% x <= 0 or A %*% x <= c(0,0) if there is more than one inequality constraint + + jacobian_constraint = function( x ) { return( InqMat ) } + # Jacobian of the constraints matrix. One row per constraint, one column per control parameter (x1,x2) + # Turns out the Jacobian of the constraints matrix is always equal to InqMat + + nestedfunC = function( lv ) + { + lv = as.matrix( lv ) + l = lv[ 1:K_ , , drop = FALSE ] # inequality Lagrange multiplier + v = lv[ (K_+1):length(lv) , , drop = FALSE ] # equality lagrange multiplier + x = exp( log(p) - 1 - A_ %*% l - Aeq_ %*% v ) + x = apply( cbind( x , 10^-32 ) , 1 , max ) + + # L is the cost function used for constrained optimization + # L is the Lagrangian dual function with inequality constraints and equality constraints + L = t(x) %*% ( log(x) - log(p) ) + t(l) %*% (A %*% x-b) + t(v) %*% (Aeq %*% x-beq) + objective = -L # take negative values since we want to maximize + + # calculate the gradient + gradient = rbind( b - A%*%x , beq - Aeq %*% x ) + + # compute the Hessian (commented out since no R optimizer supports use of Hessian) + # Hessian computed by Chen Qing, Lin Daimin, Meng Yanyan, Wang Weijun + #onesToK_ = array( rep( 1 , K_ ) ) ;onesToK = array( rep( 1 , K ) ) + #x = as.matrix( x ) + #H11 = A %*% ((x %*% onesToK_) * A_) ; H12 = A %*% ((x %*% onesToK) * Aeq_) + #H21 = Aeq %*% ((x %*% onesToK_) * A_) ; H22 = Aeq %*% ((x %*% onesToK) * Aeq_) + #H1 = cbind( H11 , H12 ) ; H2 = cbind( H21 , H22 ) ; H = rbind( H1 , H2 ) # Hessian for constrained optimization + return( list( objective = objective , gradient = gradient ) ) + } + + # find minimum of constrained multivariate function + start = Sys.time() + # Note: other candidates for constrained optimization in library nloptr: NLOPT_LD_SLSQP, NLOPT_LD_MMA, NLOPT_LN_AUGLAG, NLOPT_LD_AUGLAG_EQ + # See NLOPT open-source site for more details: http://ab-initio.mit.edu/wiki/index.php/NLopt + local_opts <- list( algorithm = "NLOPT_LD_SLSQP", + xtol_rel = 1.0e-6 , + check_derivatives = TRUE , + check_derivatives_print = check_derivatives_print , + eval_f = nestedfunC , + eval_g_ineq = InqConstraint , + eval_jac_g_ineq = jacobian_constraint ) + optimResult = nloptr( x0 = x0 , + eval_f = nestedfunC , + eval_g_ineq = InqConstraint , + eval_jac_g_ineq = jacobian_constraint , + opts = list( algorithm = "NLOPT_LD_AUGLAG" , + local_opts = local_opts , + print_level = print_level , + maxeval = 1000 , + check_derivatives = TRUE , + check_derivatives_print = check_derivatives_print , + xtol_rel = 1.0e-6 )) + end = Sys.time() + if(verbose){ + print( c("Optimization completed in " , end - start )) + } + + if ( optimResult$status < 0 ) { + print( c("Exit code " , optimResult$status ) ) + stop( "Error: The optimizer did not converge" ) + } + + # return results of optimization + lv = matrix( optimResult$solution , ncol = 1 ) + l = lv[ 1:K_ , , drop = FALSE ] # inequality Lagrange multipliers + v = lv[ (K_+1):nrow( lv ) , , drop = FALSE ] # equality Lagrange multipliers + p_ = exp( log(p) -1 - A_ %*% l - Aeq_ %*% v ) + optimizationPerformance = list( converged = (optimResult$status > 0), + ml = optimResult$objective, + iterations = optimResult$iterations, + sumOfProbabilities = sum( p_ )) + } + + if(verbose) print( optimizationPerformance ) + + if ( sum( p_ ) < .999 ) { stop( "Sum of revised probabilities is less than 1!" ) } + if ( sum( p_ ) > 1.001 ) { stop( "Sum of revised probabilities is greater than 1!" ) } + + return ( list ( p_ = p_ , optimizationPerformance = optimizationPerformance ) ) +} + + + +#' Generates histogram +#' +#' @param X a vector containing the data points +#' @param p a vector containing the probabilities for each of the data points in X +#' @param nBins expected number of Bins the data set is to be broken down into +#' @param freq a boolean variable to indicate whether the graphic is a representation of frequencies +#' +#' @return a list with +#' f the frequency for each midpoint +#' x the midpoints of the nBins intervals +#' +#' @references +#' \url{http://www.symmys.com} +#' See Meucci script pHist.m used for plotting +#' @author Ram Ahluwalia \email{ram@@wingedfootcapital.com} and Xavier Valls \email{flamejat@@gmail.com} +pHist = function( X , p , nBins, freq = FALSE ) +{ + if ( length( match.call() ) < 3 ) + { + J = dim( X )[ 1 ] + nBins = round( 10 * log(J) ) + } + + dist = hist( x = X , breaks = nBins , plot = FALSE ); + n = dist$counts + x = dist$breaks + D = x[2] - x[1] + + N = length(x) + np = zeros(N , 1) + + for (s in 1:N) + { + # The boolean Index is true is X is within the interval centered at x(s) and within a half-break distance + Index = ( X >= x[s] - D/2 ) & ( X <= x[s] + D/2 ) + # np = new probabilities? + np[ s ] = sum( p[ Index ] ) + f = np/D + } + + plot( x , f , type = "h", main = "Portfolio return distribution") + + return( list( f = f , x = x ) ) +} Added: pkg/PortfolioAnalytics/R/meucci_moments.R =================================================================== --- pkg/PortfolioAnalytics/R/meucci_moments.R (rev 0) +++ pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-29 16:18:42 UTC (rev 3447) @@ -0,0 +1,29 @@ + + +#' Compute moments +#' +#' Compute the first and second moments using the Fully Flexible Views +#' framework as described in A. Meucci - "Fully Flexible Views: Theory and Practice". +#' +#' @param R xts of asset returns +#' @param p vector of posterior probabilities +#' @return a list with the first and second moments +#' \itemize{ +#' \item{\code{mu}: }{vector of expected returns} +#' \item{\code{sigma}: }{covariance matrix} +#' } +#' @references +#' A. Meucci - "Fully Flexible Views: Theory and Practice". +#' @author Ross Bennett +#' @export +meucci.moments <- function(R, p){ + R <- coredata(R) + # expected return vector + mu <- t(R) %*% posterior_probs + + # covariance matrix + Scnd_Mom = t(R) %*% (R * (posterior_probs %*% matrix( 1, 1, ncol(R)))) + Scnd_Mom = ( Scnd_Mom + t(Scnd_Mom) ) / 2 + sigma = Scnd_Mom - mu %*% t(mu) + list(mu=mu, sigma=sigma) +} Added: pkg/PortfolioAnalytics/R/meucci_ranking.R =================================================================== --- pkg/PortfolioAnalytics/R/meucci_ranking.R (rev 0) +++ pkg/PortfolioAnalytics/R/meucci_ranking.R 2014-06-29 16:18:42 UTC (rev 3447) @@ -0,0 +1,58 @@ + +#' Asset Ranking +#' +#' Express views on the relative expected asset returns as in A. Meucci, +#' "Fully Flexible Views: Theory and Practice" and compute the first +#' and second moments. +#' +#' @note This function is based on the \code{ViewRanking} function written by +#' Ram Ahluwalia in the Meucci package. +#' +#' @param R xts object of asset returns +#' @param p a vector of the prior probability values +#' @param order a vector of indexes of the relative of expected asset returns in +#' ascending order. For example, \code{order = c(2, 3, 1, 4)} means that the +#' expected returns of \code{R[,2] < R[,3], < R[,1] < R[,4]}. +#' +#' @return The estimated moments based on ranking views +#' +#' @seealso \code{\link{meucci.moments}} +#' +#' @references +#' A. Meucci, "Fully Flexible Views: Theory and Practice" \url{http://www.symmys.com/node/158} +#' See Meucci script for "RankingInformation/ViewRanking.m" +#' @example +#' data(edhec) +#' R <- edhec[,1:4] +#' p <- rep(1 / nrow(R), nrow(R)) +#' meucci.ranking(R, p, c(2, 3, 1, 4)) +#' @export +meucci.ranking <- function(R, p, order){ + R = coredata(R) + + J = nrow( R ) + N = ncol( R ) + + k = length( order ) + + # Equality constraints + # constrain probabilities to sum to one across all scenarios... + # Aeq = ones( 1 , J ) + Aeq = matrix(rep(1, J), nrow=J) + beq = matrix(1, 1) + + # Inequality constraints + # ...constrain the expectations... A*x <= 0 + # Expectation is assigned to each scenario + V = R[ , order[1:(k-1)] ] - R[ , order[2:k] ] + A = t( V ) + b = matrix(rep(0, nrow(A)), ncol=1) + + # ...compute posterior probabilities + p_ = EntropyProg( p , A , b , Aeq , beq ) + + # compute the moments + out <- meucci.moments(R, p_) + + return( out ) +} Modified: pkg/PortfolioAnalytics/sandbox/scriptFFV.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/scriptFFV.R 2014-06-29 12:50:14 UTC (rev 3446) +++ pkg/PortfolioAnalytics/sandbox/scriptFFV.R 2014-06-29 16:18:42 UTC (rev 3447) @@ -47,5 +47,6 @@ cov(R) -all.equal(coredata(R[,1] - R[,2]), A, check.attributes=FALSE) + + From noreply at r-forge.r-project.org Sun Jun 29 19:42:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 29 Jun 2014 19:42:14 +0200 (CEST) Subject: [Returnanalytics-commits] r3448 - in pkg/PortfolioAnalytics: . R man Message-ID: <20140629174214.ADFFF183C49@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-29 19:42:14 +0200 (Sun, 29 Jun 2014) New Revision: 3448 Added: pkg/PortfolioAnalytics/man/EntropyProg.Rd pkg/PortfolioAnalytics/man/meucci.moments.Rd pkg/PortfolioAnalytics/man/meucci.ranking.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/EntropyProg.R pkg/PortfolioAnalytics/R/meucci_moments.R pkg/PortfolioAnalytics/R/meucci_ranking.R Log: Adding man files and minor fixes for the meucci functions Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2014-06-29 16:18:42 UTC (rev 3447) +++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-29 17:42:14 UTC (rev 3448) @@ -69,6 +69,7 @@ S3method(summary,portfolio) S3method(update,constraint) export(CCCgarch.MM) +export(EntropyProg) export(HHI) export(add.constraint) export(add.objective) @@ -118,6 +119,8 @@ export(leverage_exposure_constraint) export(meanetl.efficient.frontier) export(meanvar.efficient.frontier) +export(meucci.moments) +export(meucci.ranking) export(minmax_objective) export(mult.portfolio.spec) export(objective) Modified: pkg/PortfolioAnalytics/R/EntropyProg.R =================================================================== --- pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 16:18:42 UTC (rev 3447) +++ pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 17:42:14 UTC (rev 3448) @@ -75,11 +75,11 @@ # set up print arguments for verbose if(verbose){ + check_derivatives_print = "all" + print_level = 2 + } else { check_derivatives_print = "none" print_level = 0 - } else { - check_derivatives_print = "all" - print_level = 2 } if ( !K_ ) # equality constraints only Modified: pkg/PortfolioAnalytics/R/meucci_moments.R =================================================================== --- pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-29 16:18:42 UTC (rev 3447) +++ pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-29 17:42:14 UTC (rev 3448) @@ -5,7 +5,7 @@ #' Compute the first and second moments using the Fully Flexible Views #' framework as described in A. Meucci - "Fully Flexible Views: Theory and Practice". #' -#' @param R xts of asset returns +#' @param R xts object of asset returns #' @param p vector of posterior probabilities #' @return a list with the first and second moments #' \itemize{ @@ -17,12 +17,12 @@ #' @author Ross Bennett #' @export meucci.moments <- function(R, p){ - R <- coredata(R) + R = coredata(R) # expected return vector - mu <- t(R) %*% posterior_probs + mu = t(R) %*% p # covariance matrix - Scnd_Mom = t(R) %*% (R * (posterior_probs %*% matrix( 1, 1, ncol(R)))) + Scnd_Mom = t(R) %*% (R * (p %*% matrix( 1, 1, ncol(R)))) Scnd_Mom = ( Scnd_Mom + t(Scnd_Mom) ) / 2 sigma = Scnd_Mom - mu %*% t(mu) list(mu=mu, sigma=sigma) Modified: pkg/PortfolioAnalytics/R/meucci_ranking.R =================================================================== --- pkg/PortfolioAnalytics/R/meucci_ranking.R 2014-06-29 16:18:42 UTC (rev 3447) +++ pkg/PortfolioAnalytics/R/meucci_ranking.R 2014-06-29 17:42:14 UTC (rev 3448) @@ -21,7 +21,7 @@ #' @references #' A. Meucci, "Fully Flexible Views: Theory and Practice" \url{http://www.symmys.com/node/158} #' See Meucci script for "RankingInformation/ViewRanking.m" -#' @example +#' @examples #' data(edhec) #' R <- edhec[,1:4] #' p <- rep(1 / nrow(R), nrow(R)) @@ -38,7 +38,7 @@ # Equality constraints # constrain probabilities to sum to one across all scenarios... # Aeq = ones( 1 , J ) - Aeq = matrix(rep(1, J), nrow=J) + Aeq = matrix(rep(1, J), ncol=J) beq = matrix(1, 1) # Inequality constraints @@ -49,7 +49,7 @@ b = matrix(rep(0, nrow(A)), ncol=1) # ...compute posterior probabilities - p_ = EntropyProg( p , A , b , Aeq , beq ) + p_ = EntropyProg( p , A , b , Aeq , beq )$p_ # compute the moments out <- meucci.moments(R, p_) Added: pkg/PortfolioAnalytics/man/EntropyProg.Rd =================================================================== --- pkg/PortfolioAnalytics/man/EntropyProg.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/EntropyProg.Rd 2014-06-29 17:42:14 UTC (rev 3448) @@ -0,0 +1,68 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{EntropyProg} +\alias{EntropyProg} +\title{Entropy pooling program for blending views on scenarios with a prior scenario-probability distribution} +\usage{ +EntropyProg(p, A = NULL, b = NULL, Aeq, beq, verbose = FALSE) +} +\arguments{ +\item{p}{a vector of initial probabilities based on prior (reference model, empirical distribution, etc.). Sum of 'p' must be 1} + +\item{Aeq}{matrix consisting of equality constraints (paired with argument 'beq'). Denoted as 'H' in the Meucci paper. (denoted as 'H' in the "Meucci - Flexible Views Theory & Practice" paper formlua 86 on page 22)} + +\item{beq}{vector corresponding to the matrix of equality constraints (paired with argument 'Aeq'). Denoted as 'h' in the Meucci paper} + +\item{A}{matrix consisting of inequality constraints (paired with argument 'b'). Denoted as 'F' in the Meucci paper} + +\item{b}{vector consisting of inequality constraints (paired with matrix A). Denoted as 'f' in the Meucci paper} + +\item{verbose}{If TRUE, prints out additional information. Default FALSE. + +' \deqn{ \tilde{p} \equiv argmin_{Fx \leq f, Hx \equiv h} \big\{ \sum_1^J x_{j} \big(ln \big( x_{j} \big) - ln \big( p_{j} \big) \big) \big\} +\\ \ell \big(x, \lambda, \nu \big) \equiv x' \big(ln \big(x\big) - ln \big(p\big) \big) + \lambda' \big(Fx - f\big) + \nu' \big(Hx - h\big)}} +} +\value{ +a list with +\itemize{ + \item{\code{p_}:}{ revised probabilities based on entropy pooling} + \item{\code{optimizationPerformance}:}{ a list with status of optimization, + value, number of iterations, and sum of probabilities} +} +} +\description{ +Entropy program will change the initial predictive distribution 'p' to a new set 'p_' that satisfies +specified moment conditions but changes other propoerties of the new distribution the least by +minimizing the relative entropy between the two distributions. Theoretical note: Relative Entropy (Kullback-Leibler information criterion KLIC) is an +asymmetric measure. +} +\details{ +We retrieve a new set of probabilities for the joint-scenarios using the Entropy pooling method +Of the many choices of 'p' that satisfy the views, we choose 'p' that minimize the entropy or distance of the new probability +distribution to the prior joint-scenario probabilities. + +We use Kullback-Leibler divergence or relative entropy dist(p,q): Sum across all scenarios [ p-t * ln( p-t / q-t ) ] +Therefore we define solution as p* = argmin (choice of p ) [ sum across all scenarios: p-t * ln( p-t / q-t) ], +such that 'p' satisfies views. The views modify the prior in a cohrent manner (minimizing distortion) +We forumulate the stress tests of the baseline scenarios as linear constraints on yet-to-be defined probabilities +Note that the numerical optimization acts on a very limited number of variables equal +to the number of views. It does not act directly on the very large number of variables +of interest, namely the probabilities of the Monte Carlo scenarios. This feature guarantees +the numerical feasability of entropy optimization. + +Note that new probabilities are generated in much the same way that the state-price density modifies +objective probabilities of pay-offs to risk-neutral probabilities in contingent-claims asset pricing + +Compute posterior (=change of measure) with Entropy Pooling, as described in +} +\author{ +Ram Ahluwalia \email{ram at wingedfootcapital.com} +} +\references{ +A. Meucci - "Fully Flexible Views: Theory and Practice". See page 22 for illustration of numerical implementation +Symmys site containing original MATLAB source code \url{http://www.symmys.com} +NLOPT open-source optimization site containing background on algorithms \url{http://ab-initio.mit.edu/wiki/index.php/NLopt} +We use the information-theoretic estimator of Kitamur and Stutzer (1997). +Reversing 'p' and 'p_' leads to the empirical likelihood" estimator of Qin and Lawless (1994). +See Robertson et al, "Forecasting Using Relative Entropy" (2002) for more theory +} + Added: pkg/PortfolioAnalytics/man/meucci.moments.Rd =================================================================== --- pkg/PortfolioAnalytics/man/meucci.moments.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/meucci.moments.Rd 2014-06-29 17:42:14 UTC (rev 3448) @@ -0,0 +1,30 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{meucci.moments} +\alias{meucci.moments} +\title{Compute moments} +\usage{ +meucci.moments(R, p) +} +\arguments{ +\item{R}{xts object of asset returns} + +\item{p}{vector of posterior probabilities} +} +\value{ +a list with the first and second moments +\itemize{ + \item{\code{mu}: }{vector of expected returns} + \item{\code{sigma}: }{covariance matrix} +} +} +\description{ +Compute the first and second moments using the Fully Flexible Views +framework as described in A. Meucci - "Fully Flexible Views: Theory and Practice". +} +\author{ +Ross Bennett +} +\references{ +A. Meucci - "Fully Flexible Views: Theory and Practice". +} + Added: pkg/PortfolioAnalytics/man/meucci.ranking.Rd =================================================================== --- pkg/PortfolioAnalytics/man/meucci.ranking.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/meucci.ranking.Rd 2014-06-29 17:42:14 UTC (rev 3448) @@ -0,0 +1,42 @@ +% Generated by roxygen2 (4.0.1): do not edit by hand +\name{meucci.ranking} +\alias{meucci.ranking} +\title{Asset Ranking} +\usage{ +meucci.ranking(R, p, order) +} +\arguments{ +\item{R}{xts object of asset returns} + +\item{p}{a vector of the prior probability values} + +\item{order}{a vector of indexes of the relative of expected asset returns in +ascending order. For example, \code{order = c(2, 3, 1, 4)} means that the +expected returns of \code{R[,2] < R[,3], < R[,1] < R[,4]}.} +} +\value{ +The estimated moments based on ranking views +} +\description{ +Express views on the relative expected asset returns as in A. Meucci, +"Fully Flexible Views: Theory and Practice" and compute the first +and second moments. +} +\note{ +This function is based on the \code{ViewRanking} function written by +Ram Ahluwalia in the Meucci package. +} +\examples{ +data(edhec) +R <- edhec[,1:4] +p <- rep(1 / nrow(R), nrow(R)) +meucci.ranking(R, p, c(2, 3, 1, 4)) +} +\references{ +A. Meucci, "Fully Flexible Views: Theory and Practice" \url{http://www.symmys.com/node/158} +See Meucci script for "RankingInformation/ViewRanking.m" +} +\seealso{ +\code{\link{meucci.moments}} +} + From noreply at r-forge.r-project.org Mon Jun 30 05:35:53 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 30 Jun 2014 05:35:53 +0200 (CEST) Subject: [Returnanalytics-commits] r3449 - in pkg/PortfolioAnalytics: R man sandbox Message-ID: <20140630033553.7546818766C@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-30 05:35:52 +0200 (Mon, 30 Jun 2014) New Revision: 3449 Added: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R Modified: pkg/PortfolioAnalytics/R/EntropyProg.R pkg/PortfolioAnalytics/R/meucci_moments.R pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/man/meucci.moments.Rd pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd Log: adding meucci fully flexible views Modified: pkg/PortfolioAnalytics/R/EntropyProg.R =================================================================== --- pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 17:42:14 UTC (rev 3448) +++ pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-30 03:35:52 UTC (rev 3449) @@ -51,6 +51,9 @@ { stopifnot("package:nloptr" %in% search() || require("nloptr",quietly = TRUE) ) + if( is.vector(b) ) b = matrix(b, nrow=length(b)) + if( is.vector(beq) ) beq = matrix(beq, nrow=length(beq)) + if( !length(b) ) A = matrix( ,nrow = 0, ncol = 0) if( !length(b) ) b = matrix( ,nrow = 0, ncol = 0) Modified: pkg/PortfolioAnalytics/R/meucci_moments.R =================================================================== --- pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-29 17:42:14 UTC (rev 3448) +++ pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-30 03:35:52 UTC (rev 3449) @@ -6,7 +6,7 @@ #' framework as described in A. Meucci - "Fully Flexible Views: Theory and Practice". #' #' @param R xts object of asset returns -#' @param p vector of posterior probabilities +#' @param posterior_p vector of posterior probabilities #' @return a list with the first and second moments #' \itemize{ #' \item{\code{mu}: }{vector of expected returns} @@ -16,13 +16,15 @@ #' A. Meucci - "Fully Flexible Views: Theory and Practice". #' @author Ross Bennett #' @export -meucci.moments <- function(R, p){ +meucci.moments <- function(R, posterior_p){ R = coredata(R) # expected return vector - mu = t(R) %*% p + print(dim(t(R))) + print(dim(posterior_p)) + mu = t(R) %*% posterior_p # covariance matrix - Scnd_Mom = t(R) %*% (R * (p %*% matrix( 1, 1, ncol(R)))) + Scnd_Mom = t(R) %*% (R * (posterior_p %*% matrix( 1, 1, ncol(R)))) Scnd_Mom = ( Scnd_Mom + t(Scnd_Mom) ) / 2 sigma = Scnd_Mom - mu %*% t(mu) list(mu=mu, sigma=sigma) Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-29 17:42:14 UTC (rev 3448) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-30 03:35:52 UTC (rev 3449) @@ -164,7 +164,7 @@ set.portfolio.moments_v2 <- function(R, portfolio, momentargs=NULL, - method=c("sample", "boudt", "black_litterman"), + method=c("sample", "boudt", "black_litterman", "meucci"), ...){ if(!hasArg(momentargs) | is.null(momentargs)) momentargs <- list() @@ -197,6 +197,7 @@ switch(method, boudt = { if(hasArg(k)) k=match.call(expand.dots=TRUE)$k else k=1 + print(k) fit <- statistical.factor.model(R=tmpR, k=k) }, black_litterman = { @@ -204,6 +205,12 @@ if(hasArg(Mu)) Mu=match.call(expand.dots=TRUE)$Mu else Mu=NULL if(hasArg(Sigma)) Sigma=match.call(expand.dots=TRUE)$Sigma else Sigma=NULL B <- black.litterman(R=tmpR, P=P, Mu=Mu, Sigma=Sigma) + }, + meucci = { + if(hasArg(posterior_p)) posterior_p=match.call(expand.dots=TRUE)$posterior_p else posterior_p=rep(1 / nrow(R), nrow(R)) + print(match.call(expand.dots=TRUE)) + print(posterior_p) + meucci.model <- meucci.moments(R=tmpR, posterior_p=posterior_p) } ) # end switch for fitting models based on method @@ -247,6 +254,9 @@ }, black_litterman = { if(is.null(momentargs$mu)) momentargs$mu = B$BLMu + }, + meucci = { + if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu } ) # end nested switch on method }, # end switch on mean @@ -265,6 +275,10 @@ black_litterman = { if(is.null(momentargs$mu)) momentargs$mu = B$BLMu if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma + }, + meucci = { + if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu + if(is.null(momentargs$sigma)) momentargs$sigma = meucci.model$sigma } ) # end nested switch on method }, # end switch on var, sd, StdDev @@ -288,6 +302,12 @@ if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) + }, + meucci = { + if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu + if(is.null(momentargs$sigma)) momentargs$sigma = meucci.model$sigma + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) } ) # end nested switch on method }, # end switch on mVaR, VaR @@ -320,13 +340,19 @@ if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) + }, + meucci = { + if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu + if(is.null(momentargs$sigma)) momentargs$sigma = meucci.model$sigma + if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR) + if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR) } ) # end nested switch on method } } # end switch on es, mES, CVaR, cVaR, ETL, mETL, ES ) # end switch on objectives } - } + } return(momentargs) } Modified: pkg/PortfolioAnalytics/man/meucci.moments.Rd =================================================================== --- pkg/PortfolioAnalytics/man/meucci.moments.Rd 2014-06-29 17:42:14 UTC (rev 3448) +++ pkg/PortfolioAnalytics/man/meucci.moments.Rd 2014-06-30 03:35:52 UTC (rev 3449) @@ -3,12 +3,12 @@ \alias{meucci.moments} \title{Compute moments} \usage{ -meucci.moments(R, p) +meucci.moments(R, posterior_p) } \arguments{ \item{R}{xts object of asset returns} -\item{p}{vector of posterior probabilities} +\item{posterior_p}{vector of posterior probabilities} } \value{ a list with the first and second moments Modified: pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd =================================================================== --- pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-29 17:42:14 UTC (rev 3448) +++ pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-30 03:35:52 UTC (rev 3449) @@ -5,7 +5,7 @@ \title{Portfolio Moments} \usage{ set.portfolio.moments_v2(R, portfolio, momentargs = NULL, - method = c("sample", "boudt", "black_litterman"), ...) + method = c("sample", "boudt", "black_litterman", "meucci"), ...) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} Added: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/meucci_ffv.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 03:35:52 UTC (rev 3449) @@ -0,0 +1,45 @@ +library(PortfolioAnalytics) +data(edhec) +R <- edhec[,1:5] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") + +# prior probabilities +p <- rep(1 / nrow(R), nrow(R)) + +# Express views +# lambda is the ad-hoc multiplier +# Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish) + +# View 1: very bearish view on R[,1] - R[,2] +V1 <- coredata(R[,1] - R[,2]) +b1 <- mean(V1) - 2 * sd(V1) + +# View 2: bearish view on R[,5] - R[,4] +V2 <- coredata(R[,5] - R[,4]) +b2 <- mean(V2) - 1 * sd(V2) + +# Compute the posterior probabilities for each view +# Equality constraints to constrain the posterior probabilities to sum to 1 +Aeq <- matrix(1, ncol=nrow(R)) +beq <- 1 +p1 <- EntropyProg(p, t(V1), b1, Aeq, beq)$p_ +p2 <- EntropyProg(p, t(V2), b2, Aeq, beq)$p_ + +# Assign confidence weights to the views and pool opinions +# 0.35 : confidence weight on reference model +# 0.25 : confidence weight on view 1 +# 0.4 : confidence weight on view 2 + +# Prior posterior of pooled opinions +p_ <- cbind(p, p1, p2) %*% c(0.35 , 0.25 , 0.4) + +m1 <- meucci.moments(R, p_) +m2 <- set.portfolio.moments(R = R, portfolio=init.portf, method="meucci", posterior_p=p_) +all.equal(m1, m2) + From noreply at r-forge.r-project.org Mon Jun 30 21:36:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 30 Jun 2014 21:36:42 +0200 (CEST) Subject: [Returnanalytics-commits] r3450 - in pkg/PortfolioAnalytics: R man sandbox Message-ID: <20140630193643.02E821874C7@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-30 21:36:42 +0200 (Mon, 30 Jun 2014) New Revision: 3450 Modified: pkg/PortfolioAnalytics/R/black_litterman.R pkg/PortfolioAnalytics/R/meucci_moments.R pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/black.litterman.Rd pkg/PortfolioAnalytics/sandbox/meucci_ffv.R Log: minor fixes to the meucci ffv code Modified: pkg/PortfolioAnalytics/R/black_litterman.R =================================================================== --- pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-30 03:35:52 UTC (rev 3449) +++ pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-30 19:36:42 UTC (rev 3450) @@ -41,6 +41,7 @@ #' is used if \code{Mu=NULL}. #' @param Sigma an N x N matrix of the prior covariance matrix. The sample #' covariance is used if \code{Sigma=NULL}. +#' @param Views a vector of length K of the views #' @return \itemize{ #' \item{BLMu:}{ posterior expected values} #' \item{BLSigma:}{ posterior covariance matrix} @@ -50,7 +51,7 @@ #' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}. #' @seealso \code{\link{BlackLittermanFormula}} #' @export -black.litterman <- function(R, P, Mu=NULL, Sigma=NULL){ +black.litterman <- function(R, P, Mu=NULL, Sigma=NULL, Views=NULL){ # Compute the sample estimate if mu is null if(is.null(Mu)){ @@ -66,7 +67,7 @@ # Compute the Omega matrix and views value Omega = tcrossprod(P %*% Sigma, P) - Views = as.numeric(sqrt( diag( Omega ) )) + if(is.null(Views)) Views = as.numeric(sqrt( diag( Omega ) )) B = BlackLittermanFormula( Mu, Sigma, P, Views, Omega ) return(B) } Modified: pkg/PortfolioAnalytics/R/meucci_moments.R =================================================================== --- pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-30 03:35:52 UTC (rev 3449) +++ pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-30 19:36:42 UTC (rev 3450) @@ -19,8 +19,6 @@ meucci.moments <- function(R, posterior_p){ R = coredata(R) # expected return vector - print(dim(t(R))) - print(dim(posterior_p)) mu = t(R) %*% posterior_p # covariance matrix Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-30 03:35:52 UTC (rev 3449) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-30 19:36:42 UTC (rev 3450) @@ -197,19 +197,17 @@ switch(method, boudt = { if(hasArg(k)) k=match.call(expand.dots=TRUE)$k else k=1 - print(k) fit <- statistical.factor.model(R=tmpR, k=k) }, black_litterman = { if(hasArg(P)) P=match.call(expand.dots=TRUE)$P else P=matrix(rep(1, ncol(R)), nrow=1) if(hasArg(Mu)) Mu=match.call(expand.dots=TRUE)$Mu else Mu=NULL if(hasArg(Sigma)) Sigma=match.call(expand.dots=TRUE)$Sigma else Sigma=NULL - B <- black.litterman(R=tmpR, P=P, Mu=Mu, Sigma=Sigma) + if(hasArg(Views)) Views=match.call(expand.dots=TRUE)$Views else Views=NULL + B <- black.litterman(R=tmpR, P=P, Mu=Mu, Sigma=Sigma, Views=Views) }, meucci = { if(hasArg(posterior_p)) posterior_p=match.call(expand.dots=TRUE)$posterior_p else posterior_p=rep(1 / nrow(R), nrow(R)) - print(match.call(expand.dots=TRUE)) - print(posterior_p) meucci.model <- meucci.moments(R=tmpR, posterior_p=posterior_p) } ) # end switch for fitting models based on method Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-30 03:35:52 UTC (rev 3449) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-30 19:36:42 UTC (rev 3450) @@ -571,7 +571,7 @@ # match the args for momentFUN .formals <- formals(momentFUN) - .formals <- modify.args(formals=.formals, arglist=NULL, ..., dots=FALSE) + .formals <- modify.args(formals=.formals, arglist=list(...), dots=TRUE) # ** pass ROI=TRUE to set.portfolio.moments so the moments are not calculated if(optimize_method %in% c("ROI", "quadprog", "glpk", "symphony", "ipop", "cplex")){ obj_names <- unlist(lapply(portfolio$objectives, function(x) x$name)) Modified: pkg/PortfolioAnalytics/man/black.litterman.Rd =================================================================== --- pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-30 03:35:52 UTC (rev 3449) +++ pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-30 19:36:42 UTC (rev 3450) @@ -3,7 +3,7 @@ \alias{black.litterman} \title{Black Litterman Estimates} \usage{ -black.litterman(R, P, Mu = NULL, Sigma = NULL) +black.litterman(R, P, Mu = NULL, Sigma = NULL, Views = NULL) } \arguments{ \item{R}{returns} @@ -15,6 +15,8 @@ \item{Sigma}{an N x N matrix of the prior covariance matrix. The sample covariance is used if \code{Sigma=NULL}.} + +\item{Views}{a vector of length K of the views} } \value{ \itemize{ Modified: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 03:35:52 UTC (rev 3449) +++ pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 19:36:42 UTC (rev 3450) @@ -1,3 +1,6 @@ +# Demonstrate Meucci's Fully Flexible Views framework to estimate moments and +# use as inputs for a minimum variance optimization + library(PortfolioAnalytics) data(edhec) R <- edhec[,1:5] @@ -5,15 +8,20 @@ # Construct initial portfolio init.portf <- portfolio.spec(assets=funds) -init.portf <- add.constraint(portfolio=init.portf, type="full_investment") -init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.constraint(portfolio=init.portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.5) init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean", multiplier=0) # prior probabilities p <- rep(1 / nrow(R), nrow(R)) # Express views # lambda is the ad-hoc multiplier +# m_k = m(V_k) + lambda * sigma(V_k) +# sigma(k) is a measure of volatility (i.e. standard deviation, interquartile range, etc.) # Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish) # View 1: very bearish view on R[,1] - R[,2] @@ -39,7 +47,50 @@ # Prior posterior of pooled opinions p_ <- cbind(p, p1, p2) %*% c(0.35 , 0.25 , 0.4) -m1 <- meucci.moments(R, p_) -m2 <- set.portfolio.moments(R = R, portfolio=init.portf, method="meucci", posterior_p=p_) -all.equal(m1, m2) +# Generate random portfolios +rp <- random_portfolios(init.portf, 10000) +# Optimization using first and second moments estimated from Meucci's Fully +# Flexible Views framework. +opt.meucci <- optimize.portfolio(R, + init.portf, + optimize_method="random", + rp=rp, + trace=TRUE, + method="meucci", + posterior_p=p_) + + +# Optimization using sample estimates for first and second moments +opt.sample <- optimize.portfolio(R, + init.portf, + optimize_method="random", + rp=rp, + trace=TRUE) + +#Extract the stats for plotting +stats.meucci <- extractStats(opt.meucci) +stats.sample <- extractStats(opt.sample) + + +# Plots +# Plot the optimal weights +chart.Weights(combine.optimizations(list(meucci=opt.meucci, sample=opt.sample))) + +# Plot the risk-reward of each chart on the same scale +xrange <- range(c(stats.meucci[,"StdDev"], stats.sample[,"StdDev"])) +yrange <- range(c(stats.meucci[,"mean"], stats.sample[,"mean"])) +layout(matrix(c(1,2)), widths=1, heights=1) +# c(bottom, left, top, right) +par(mar=c(0, 4, 4, 4) + 0.1) +plot(x=stats.meucci[,"StdDev"], stats.meucci[,"mean"], xlab="", ylab="mean", + xlim=xrange, ylim=yrange, xaxt="n", yaxt="n") +axis(2, pretty(yrange), cex.axis=0.8) +legend("topright", legend="Meucci", bty="n") +par(mar=c(5, 4, 0, 4) + 0.1) +plot(x=stats.sample[,"StdDev"], stats.sample[,"mean"], xlab="StdDev", ylab="", + xlim=xrange, ylim=yrange, yaxt="n", cex.axis=0.8) +axis(4, pretty(yrange), cex.axis=0.8) +legend("topright", legend="Sample", bty="n") +par(mar=c(5, 4, 4, 2) + 0.1) +layout(matrix(1), widths=1, heights=1) From noreply at r-forge.r-project.org Mon Jun 30 21:38:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 30 Jun 2014 21:38:58 +0200 (CEST) Subject: [Returnanalytics-commits] r3451 - in pkg/PortfolioAnalytics: demo sandbox Message-ID: <20140630193858.7FC5D1874DD@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-30 21:38:58 +0200 (Mon, 30 Jun 2014) New Revision: 3451 Added: pkg/PortfolioAnalytics/demo/meucci_ffv.R Removed: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R Modified: pkg/PortfolioAnalytics/demo/00Index Log: moving ffv script to demo Modified: pkg/PortfolioAnalytics/demo/00Index =================================================================== --- pkg/PortfolioAnalytics/demo/00Index 2014-06-30 19:36:42 UTC (rev 3450) +++ pkg/PortfolioAnalytics/demo/00Index 2014-06-30 19:38:58 UTC (rev 3451) @@ -31,3 +31,4 @@ regime_switching Demonstrate optimization with support for regime switching to switch portfolios based on the regime. higher_moments_boudt Demonstrate using a statistical factor model to estimate moments based on work by Kris Boudt. multi_layer_optimization Demonstrate multi layer optimization of optimization problem with two layers and two sub portfolios in the lower layer. +meucci_ffv Demonstrate Meucci's Fully Flexible Views framework to estimate moments and use as inputs for minimum variance optimization. Copied: pkg/PortfolioAnalytics/demo/meucci_ffv.R (from rev 3450, pkg/PortfolioAnalytics/sandbox/meucci_ffv.R) =================================================================== --- pkg/PortfolioAnalytics/demo/meucci_ffv.R (rev 0) +++ pkg/PortfolioAnalytics/demo/meucci_ffv.R 2014-06-30 19:38:58 UTC (rev 3451) @@ -0,0 +1,96 @@ +# Demonstrate Meucci's Fully Flexible Views framework to estimate moments and +# use as inputs for a minimum variance optimization + +library(PortfolioAnalytics) +data(edhec) +R <- edhec[,1:5] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.5) +init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean", multiplier=0) + +# prior probabilities +p <- rep(1 / nrow(R), nrow(R)) + +# Express views +# lambda is the ad-hoc multiplier +# m_k = m(V_k) + lambda * sigma(V_k) +# sigma(k) is a measure of volatility (i.e. standard deviation, interquartile range, etc.) +# Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish) + +# View 1: very bearish view on R[,1] - R[,2] +V1 <- coredata(R[,1] - R[,2]) +b1 <- mean(V1) - 2 * sd(V1) + +# View 2: bearish view on R[,5] - R[,4] +V2 <- coredata(R[,5] - R[,4]) +b2 <- mean(V2) - 1 * sd(V2) + +# Compute the posterior probabilities for each view +# Equality constraints to constrain the posterior probabilities to sum to 1 +Aeq <- matrix(1, ncol=nrow(R)) +beq <- 1 +p1 <- EntropyProg(p, t(V1), b1, Aeq, beq)$p_ +p2 <- EntropyProg(p, t(V2), b2, Aeq, beq)$p_ + +# Assign confidence weights to the views and pool opinions +# 0.35 : confidence weight on reference model +# 0.25 : confidence weight on view 1 +# 0.4 : confidence weight on view 2 + +# Prior posterior of pooled opinions +p_ <- cbind(p, p1, p2) %*% c(0.35 , 0.25 , 0.4) + +# Generate random portfolios +rp <- random_portfolios(init.portf, 10000) + +# Optimization using first and second moments estimated from Meucci's Fully +# Flexible Views framework. +opt.meucci <- optimize.portfolio(R, + init.portf, + optimize_method="random", + rp=rp, + trace=TRUE, + method="meucci", + posterior_p=p_) + + +# Optimization using sample estimates for first and second moments +opt.sample <- optimize.portfolio(R, + init.portf, + optimize_method="random", + rp=rp, + trace=TRUE) + +#Extract the stats for plotting +stats.meucci <- extractStats(opt.meucci) +stats.sample <- extractStats(opt.sample) + + +# Plots +# Plot the optimal weights +chart.Weights(combine.optimizations(list(meucci=opt.meucci, sample=opt.sample))) + +# Plot the risk-reward of each chart on the same scale +xrange <- range(c(stats.meucci[,"StdDev"], stats.sample[,"StdDev"])) +yrange <- range(c(stats.meucci[,"mean"], stats.sample[,"mean"])) +layout(matrix(c(1,2)), widths=1, heights=1) +# c(bottom, left, top, right) +par(mar=c(0, 4, 4, 4) + 0.1) +plot(x=stats.meucci[,"StdDev"], stats.meucci[,"mean"], xlab="", ylab="mean", + xlim=xrange, ylim=yrange, xaxt="n", yaxt="n") +axis(2, pretty(yrange), cex.axis=0.8) +legend("topright", legend="Meucci", bty="n") +par(mar=c(5, 4, 0, 4) + 0.1) +plot(x=stats.sample[,"StdDev"], stats.sample[,"mean"], xlab="StdDev", ylab="", + xlim=xrange, ylim=yrange, yaxt="n", cex.axis=0.8) +axis(4, pretty(yrange), cex.axis=0.8) +legend("topright", legend="Sample", bty="n") +par(mar=c(5, 4, 4, 2) + 0.1) +layout(matrix(1), widths=1, heights=1) Deleted: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 19:36:42 UTC (rev 3450) +++ pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 19:38:58 UTC (rev 3451) @@ -1,96 +0,0 @@ -# Demonstrate Meucci's Fully Flexible Views framework to estimate moments and -# use as inputs for a minimum variance optimization - -library(PortfolioAnalytics) -data(edhec) -R <- edhec[,1:5] -funds <- colnames(R) - -# Construct initial portfolio -init.portf <- portfolio.spec(assets=funds) -init.portf <- add.constraint(portfolio=init.portf, type="weight_sum", - min_sum=0.99, max_sum=1.01) -init.portf <- add.constraint(portfolio=init.portf, type="box", - min=0.05, max=0.5) -init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") -init.portf <- add.objective(portfolio=init.portf, type="return", name="mean", multiplier=0) - -# prior probabilities -p <- rep(1 / nrow(R), nrow(R)) - -# Express views -# lambda is the ad-hoc multiplier -# m_k = m(V_k) + lambda * sigma(V_k) -# sigma(k) is a measure of volatility (i.e. standard deviation, interquartile range, etc.) -# Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish) - -# View 1: very bearish view on R[,1] - R[,2] -V1 <- coredata(R[,1] - R[,2]) -b1 <- mean(V1) - 2 * sd(V1) - -# View 2: bearish view on R[,5] - R[,4] -V2 <- coredata(R[,5] - R[,4]) -b2 <- mean(V2) - 1 * sd(V2) - -# Compute the posterior probabilities for each view -# Equality constraints to constrain the posterior probabilities to sum to 1 -Aeq <- matrix(1, ncol=nrow(R)) -beq <- 1 -p1 <- EntropyProg(p, t(V1), b1, Aeq, beq)$p_ -p2 <- EntropyProg(p, t(V2), b2, Aeq, beq)$p_ - -# Assign confidence weights to the views and pool opinions -# 0.35 : confidence weight on reference model -# 0.25 : confidence weight on view 1 -# 0.4 : confidence weight on view 2 - -# Prior posterior of pooled opinions -p_ <- cbind(p, p1, p2) %*% c(0.35 , 0.25 , 0.4) - -# Generate random portfolios -rp <- random_portfolios(init.portf, 10000) - -# Optimization using first and second moments estimated from Meucci's Fully -# Flexible Views framework. -opt.meucci <- optimize.portfolio(R, - init.portf, - optimize_method="random", - rp=rp, - trace=TRUE, - method="meucci", - posterior_p=p_) - - -# Optimization using sample estimates for first and second moments -opt.sample <- optimize.portfolio(R, - init.portf, - optimize_method="random", - rp=rp, - trace=TRUE) - -#Extract the stats for plotting -stats.meucci <- extractStats(opt.meucci) -stats.sample <- extractStats(opt.sample) - - -# Plots -# Plot the optimal weights -chart.Weights(combine.optimizations(list(meucci=opt.meucci, sample=opt.sample))) - -# Plot the risk-reward of each chart on the same scale -xrange <- range(c(stats.meucci[,"StdDev"], stats.sample[,"StdDev"])) -yrange <- range(c(stats.meucci[,"mean"], stats.sample[,"mean"])) -layout(matrix(c(1,2)), widths=1, heights=1) -# c(bottom, left, top, right) -par(mar=c(0, 4, 4, 4) + 0.1) -plot(x=stats.meucci[,"StdDev"], stats.meucci[,"mean"], xlab="", ylab="mean", - xlim=xrange, ylim=yrange, xaxt="n", yaxt="n") -axis(2, pretty(yrange), cex.axis=0.8) -legend("topright", legend="Meucci", bty="n") -par(mar=c(5, 4, 0, 4) + 0.1) -plot(x=stats.sample[,"StdDev"], stats.sample[,"mean"], xlab="StdDev", ylab="", - xlim=xrange, ylim=yrange, yaxt="n", cex.axis=0.8) -axis(4, pretty(yrange), cex.axis=0.8) -legend("topright", legend="Sample", bty="n") -par(mar=c(5, 4, 4, 2) + 0.1) -layout(matrix(1), widths=1, heights=1) From noreply at r-forge.r-project.org Mon Jun 30 22:32:25 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 30 Jun 2014 22:32:25 +0200 (CEST) Subject: [Returnanalytics-commits] r3452 - pkg/PortfolioAnalytics/demo Message-ID: <20140630203225.4FBDA186096@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-30 22:32:24 +0200 (Mon, 30 Jun 2014) New Revision: 3452 Added: pkg/PortfolioAnalytics/demo/meucci_relative_ranking.R Modified: pkg/PortfolioAnalytics/demo/00Index Log: Adding demo script for meucci relative ranking Modified: pkg/PortfolioAnalytics/demo/00Index =================================================================== --- pkg/PortfolioAnalytics/demo/00Index 2014-06-30 19:38:58 UTC (rev 3451) +++ pkg/PortfolioAnalytics/demo/00Index 2014-06-30 20:32:24 UTC (rev 3452) @@ -32,3 +32,4 @@ higher_moments_boudt Demonstrate using a statistical factor model to estimate moments based on work by Kris Boudt. multi_layer_optimization Demonstrate multi layer optimization of optimization problem with two layers and two sub portfolios in the lower layer. meucci_ffv Demonstrate Meucci's Fully Flexible Views framework to estimate moments and use as inputs for minimum variance optimization. +meucci_relative_ranking Demonstrate Meucci's Fully Flexible Views framework to express views on relative ranking and estimate moments used as inputs for mean-variance optimization. Added: pkg/PortfolioAnalytics/demo/meucci_relative_ranking.R =================================================================== --- pkg/PortfolioAnalytics/demo/meucci_relative_ranking.R (rev 0) +++ pkg/PortfolioAnalytics/demo/meucci_relative_ranking.R 2014-06-30 20:32:24 UTC (rev 3452) @@ -0,0 +1,72 @@ +# Demonstrate Meucci's Fully Flexible Views framework to express views on +# relative ranking and estimate moments used as inputs for mean-variance +# optimization + +library(PortfolioAnalytics) +data(edhec) +R <- edhec[,1:4] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.5) +init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") + +# Prior probabilities +p <- rep(1 / nrow(R), nrow(R)) + +# Relative ordering view +# E{ R[,2] < R[,3], < R[,1] < R[,4] } +moments <- meucci.ranking(R, p, c(2, 3, 1, 4)) + +# Generate random portfolios +rp <- random_portfolios(init.portf, 5000) + +# Optimization using first and second moments estimated from Meucci's Fully +# Flexible Views framework. +opt.meucci <- optimize.portfolio(R, + init.portf, + optimize_method="random", + rp=rp, + trace=TRUE, + method="meucci", + momentargs=moments) + + +# Optimization using sample estimates for first and second moments +opt.sample <- optimize.portfolio(R, + init.portf, + optimize_method="random", + rp=rp, + trace=TRUE) + +#Extract the stats for plotting +stats.meucci <- extractStats(opt.meucci) +stats.sample <- extractStats(opt.sample) + + +# Plots +# Plot the optimal weights +chart.Weights(combine.optimizations(list(meucci=opt.meucci, sample=opt.sample)), ylim=c(0,1)) + +# Plot the risk-reward of each chart on the same scale +xrange <- range(c(stats.meucci[,"StdDev"], stats.sample[,"StdDev"])) +yrange <- range(c(stats.meucci[,"mean"], stats.sample[,"mean"])) +layout(matrix(c(1,2)), widths=1, heights=1) +# c(bottom, left, top, right) +par(mar=c(0, 4, 4, 4) + 0.1) +plot(x=stats.meucci[,"StdDev"], stats.meucci[,"mean"], xlab="", ylab="mean", + xlim=xrange, ylim=yrange, xaxt="n", yaxt="n") +axis(2, pretty(yrange), cex.axis=0.8) +legend("topleft", legend="Meucci", bty="n") +par(mar=c(5, 4, 0, 4) + 0.1) +plot(x=stats.sample[,"StdDev"], stats.sample[,"mean"], xlab="StdDev", ylab="", + xlim=xrange, ylim=yrange, yaxt="n", cex.axis=0.8) +axis(4, pretty(yrange), cex.axis=0.8) +legend("topleft", legend="Sample", bty="n") +par(mar=c(5, 4, 4, 2) + 0.1) +layout(matrix(1), widths=1, heights=1) From noreply at r-forge.r-project.org Mon Jun 30 23:40:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 30 Jun 2014 23:40:38 +0200 (CEST) Subject: [Returnanalytics-commits] r3453 - in pkg/PortfolioAnalytics/sandbox: . FFEV Message-ID: <20140630214038.6665218074F@r-forge.r-project.org> Author: rossbennett34 Date: 2014-06-30 23:40:38 +0200 (Mon, 30 Jun 2014) New Revision: 3453 Added: pkg/PortfolioAnalytics/sandbox/FFEV/ pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CVaR_Recursion.R pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CaseStudy.R pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_demo.R Log: Copying Fully Flexible Extreme Views scripts from Meucci package to a sandbox folder Added: pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CVaR_Recursion.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CVaR_Recursion.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CVaR_Recursion.R 2014-06-30 21:40:38 UTC (rev 3453) @@ -0,0 +1,134 @@ +# This script illustrates the discrete Newton recursion to process views on CVaR according to Entropy Pooling +# This script complements the article +# "Fully Flexible Extreme Views" +# by A. Meucci, D. Ardia, S. Keel +# available at www.ssrn.com +# The most recent version of this code is available at +# MATLAB Central - File Exchange + +# Prior market model (normal) on grid +emptyMatrix = matrix( nrow=0 , ncol=0 ) +market.mu = 0.0 +market.sig2 = 1.0 +market.pdf = function(x) dnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.cdf = function(x) pnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.rnd = function(x) rnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.inv = function(x) qnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.VaR95 = market.inv(0.05) +market.CVaR95 = integrate( function( x ) ( x * market.pdf( x ) ), -100, market.VaR95)$val / 0.05 + +tmp = ( ghqx - min( ghqx ) )/( max( ghqx ) - min( ghqx ) ) # rescale GH zeros so they belong to [0,1] +epsilon = 1e-10 +Lower = market.inv( epsilon ) +Upper = market.inv( 1 - epsilon ) +X = Lower + tmp * ( Upper - Lower ) # rescale mesh + +p = integrateSubIntervals( X, market.cdf ) +p = normalizeProb( p ) +J = nrow( X ) + +# Entropy posterior from extreme view on CVaR: brute-force approach + +# view of the analyst +view.CVaR95 = -3.0 + +# Iterate over different VaR95 levels +nVaR95 = 100 +VaR95 = seq(view.CVaR95, market.VaR95, len=nVaR95) +p_ = matrix(NaN, nrow = J, ncol = nVaR95 ) +s_ = matrix(NaN, nrow = nVaR95, ncol = 1 ) +KLdiv = matrix(NaN, nrow = nVaR95, ncol = 1) + +for ( i in 1:nVaR95 ) { + idx = as.matrix( X <= VaR95[i] ) + s_[i] = sum(idx) + posteriorEntropy = EntropyProg(p, t( idx ), as.matrix( 0.05 ), rbind( rep(1, J), t( idx * X ) ), rbind( 1, 0.05 * view.CVaR95 ) ) + p_[,i] = posteriorEntropy$p_ + KLdiv[i] = posteriorEntropy$optimizationPerformance$ml +} + +# Display results +plot( s_, KLdiv ) +dummy = min( KLdiv ) +idxMin = which.min( KLdiv ) +plot( s_[idxMin], KLdiv[idxMin] ) + +tmp = p_[, idxMin] +tmp = tmp / sum( tmp ) +plot( X, tmp ) +x = seq(min(X), max(X), len = J); +tmp = market.pdf(x) +tmp = tmp / sum(tmp) +plot(x, tmp) +plot(market.CVaR95, 0) +plot(view.CVaR95, 0) + +# Entropy posterior from extreme view on CVaR: Newton Raphson approach + +s = emptyMatrix + +# initial value +idx = as.matrix( cumsum(p) <= 0.05 ) +s[1] = sum(idx) +posteriorEntropy = EntropyProg(p, t( idx ), as.matrix( 0.05 ), rbind( rep(1, J), t( idx * X ) ), rbind( 1, 0.05 * view.CVaR95) ) +KLdiv = as.matrix( posteriorEntropy$optimizationPerformance$ml ) +p_ = posteriorEntropy$p_ + +# iterate +doStop = 0 +i = 1 +while ( !doStop ) { + i = i + 1 + + idx = cbind( matrix(1, 1, s[i - 1] ), matrix(0, 1, J - s[i-1] ) ) + posteriorEntropy1 = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( t(idx) * X) ), rbind( 1, 0.05 * view.CVaR95 ) ) + # [dummy, KLdiv_s] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + + idx = cbind( matrix(1, 1, s[i - 1] + 1 ), matrix(0, 1, J - s[i - 1] - 1) ) + posteriorEntropy2 = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( t(idx) * X) ), rbind( 1, 0.05 * view.CVaR95 ) ) + # [dummy, KLdiv_s1] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + + idx = cbind( matrix(1, 1, s[i - 1] + 2 ), matrix(0, 1, J - s[i - 1] - 2) ) + posteriorEntropy3 = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( t(idx) * X) ), rbind( 1, 0.05 * view.CVaR95 ) ) + # [dummy, KLdiv_s2] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + + # first difference + DE = posteriorEntropy2$optimizationPerformance$ml - posteriorEntropy1$optimizationPerformance$ml + + # second difference + D2E = posteriorEntropy3$optimizationPerformance$ml - 2 * posteriorEntropy2$optimizationPerformance$ml + posteriorEntropy1$optimizationPerformance$ml + + # optimal s + s = rbind( s, round( s[i - 1] - (DE / D2E) ) ) + + tmp = emptyMatrix + idx = cbind( matrix( 1, 1, s[i] ), matrix( 0, 1, J - s[i] ) ) + tempEntropy = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( t(idx) * X) ), rbind( 1, 0.05 * view.CVaR95 ) ) + # [tmp.p_, tmp.KLdiv] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + p_ = cbind( p_, tempEntropy$p_ ) + KLdiv = rbind( KLdiv, tempEntropy$optimizationPerformance$ml ) #ok<*AGROW> + + # if change in KLdiv less than one percent, stop + if( abs( ( KLdiv[i] - KLdiv[i - 1] ) / KLdiv[i - 1] ) < 0.01 ) { doStop = 1 } +} + +# Display results + +N = length(s) + +plot(1:N, KLdiv) +x = seq(min(X), max(X), len = J) +tmp = market.pdf(x) +tmp = tmp / sum(tmp) +plot( t( X ), tmp ) +plot( t( X ), p_[, ncol(p_)] ) +plot( market.CVaR95, 0.0 ) +plot( view.CVaR95, 0.0 ) + +# zoom here +plot( t( X ), tmp ) +plot( t( X ), p_[, 1] ) +plot( t( X ), p_[, 2] ) +plot( t( X ), p_[, ncol(p_)] ) +plot( market.CVaR95, 0 ) +plot( view.CVaR95, 0 ) \ No newline at end of file Added: pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CaseStudy.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CaseStudy.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_CaseStudy.R 2014-06-30 21:40:38 UTC (rev 3453) @@ -0,0 +1,95 @@ +# This script estimates the prior of a hedge fund return and processes extreme views on CVaR +# according to Entropy Pooling +# This script complements the article +# "Fully Flexible Extreme Views" +# by A. Meucci, D. Ardia, S. Keel +# available at www.ssrn.com +# The most recent version of this code is available at +# MATLAB Central - File Exchange + +# IMPORTANT - This script is about the methodology, not the input data, which has been modified + +xi = as.matrix( 100 * data[, 2] ) +n = nrow(xi) + +# bandwidth +bw = kernelbw(xi) + +# weights +lambda = log(2) / (n / 2) +wi = as.matrix( exp( -lambda * ( n - seq( from=n, to=1 ) ) ) ) +wi = as.matrix( apply( wi, 2, rev ) / sum( wi ) ) + +# Prior market model +# kernel density + +market.mu = mean(xi) +market.pdf = function ( x ) kernelpdf( x, xi, bw, wi ) +market.cdf = function ( x ) kernelcdf( x, xi, bw, wi ) +market.inv = function ( x ) kernelinv( x, xi, bw, wi ) +market.VaR95 = market.inv( c(0.05) ) +market.CVaR95 = integrate( function( x ) x * market.pdf( x ), -100, market.VaR95 )$val / 0.05 + +# numerical (Gauss-Hermite grid) prior +tmp = ( ghqx - min( ghqx ) )/( max( ghqx ) - min( ghqx ) ) # rescale GH zeros so they belong to [0,1] +epsilon = 1e-10 +Lower = market.inv( epsilon ) +Upper = market.inv( 1 - epsilon ) +X = Lower + tmp * ( Upper - Lower ) # rescale mesh + +p = integrateSubIntervals( X , market.cdf ) +p = normalizeProb( p ) +J = nrow( X ) + +# Entropy posterior from extreme view on mean and CVaR +view.mu = mean( xi ) - 1.0 +view.CVaR95 = market.CVaR95 - 1.0 + +# Netwton Raphson +emptyMatrix = matrix( ,nrow = 0, ncol = 0) +s = emptyMatrix +idx = as.matrix( cumsum(p) <= 0.05 ) +s[1] = sum(idx) +posteriorEntropy = EntropyProg(p, t( idx ), as.matrix( 0.05 ), rbind( rep(1, J), t( X ), t( idx * X ) ), rbind( 1, view.mu, 0.05 * view.CVaR95) ) +KLdiv = as.matrix( posteriorEntropy$optimizationPerformance$ml ) +p_ = posteriorEntropy$p_ + +doStop = 0 +i = 1 +while ( !doStop ) { + i = i + 1 + + idx = cbind( matrix(1, 1, s[i - 1] ), matrix(0, 1, J - s[i-1] ) ) + posteriorEntropy1 = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( X ), t( t(idx) * X) ), rbind( 1, view.mu, 0.05 * view.CVaR95 ) ) + # [dummy, KLdiv_s] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + + idx = cbind( matrix(1, 1, s[i - 1] + 1 ), matrix(0, 1, J - s[i - 1] - 1) ) + posteriorEntropy2 = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( X ), t( t(idx) * X) ), rbind( 1, view.mu, 0.05 * view.CVaR95 ) ) + # [dummy, KLdiv_s1] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + + idx = cbind( matrix(1, 1, s[i - 1] + 2 ), matrix(0, 1, J - s[i - 1] - 2) ) + posteriorEntropy3 = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( X ), t( t(idx) * X) ), rbind( 1, view.mu, 0.05 * view.CVaR95 ) ) + # [dummy, KLdiv_s2] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + + # first difference + DE = posteriorEntropy2$optimizationPerformance$ml - posteriorEntropy1$optimizationPerformance$ml + + # second difference + D2E = posteriorEntropy3$optimizationPerformance$ml - 2 * posteriorEntropy2$optimizationPerformance$ml + posteriorEntropy1$optimizationPerformance$ml + + # optimal s + s = rbind( s, round( s[i - 1] - (DE / D2E) ) ) + + tmp = emptyMatrix + idx = cbind( matrix( 1, 1, s[i] ), matrix( 0, 1, J - s[i] ) ) + tempEntropy = EntropyProg(p, idx, as.matrix( 0.05 ), rbind( matrix(1, 1, J), t( X ), t( t(idx) * X) ), rbind( 1, view.mu, 0.05 * view.CVaR95 ) ) + # [tmp.p_, tmp.KLdiv] = optimizeEntropy(p, [idx'; (idx .* X)'], [0.05; 0.05 * view.CVaR95], [ones(1, J); X'], [1; view.mu]); + p_ = cbind( p_, tempEntropy$p_ ) + KLdiv = rbind( KLdiv, tempEntropy$optimizationPerformance$ml ) #ok<*AGROW> + + # if change in KLdiv less than one percent, stop + if( abs( ( KLdiv[i] - KLdiv[i - 1] ) / KLdiv[i - 1] ) < 0.01 ) { doStop = 1 } +} + +plot( t(X), p ) +plot( t(X), p_[,ncol(p_)]) \ No newline at end of file Added: pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_demo.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_demo.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/FFEV/HermiteGrid_demo.R 2014-06-30 21:40:38 UTC (rev 3453) @@ -0,0 +1,83 @@ +# This script compares the performance of plain Monte Carlo +# versus grid in applying Entropy Pooling to process extreme views +# This script complements the article +# "Fully Flexible Extreme Views" A. Meucci, D. Ardia, S. Keel available at www.ssrn.com +# The most recent version of this code is available at MATLAB Central - File Exchange +library(matlab) + +#################################################################################### +# Prior market model +#################################################################################### +# analytical (normal) prior +emptyMatrix = matrix( nrow=0 , ncol=0 ) +market.mu = 0.0 +market.sig2 = 1.0 +market.pdf = function(x) dnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.cdf = function(x) pnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.rnd = function(x) rnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) +market.inv = function(x) qnorm( x , mean = market.mu , sd = sqrt(market.sig2) ) + +# numerical (Monte Carlo) prior +monteCarlo = emptyMatrix +monteCarlo.J = 100000 +monteCarlo.X = market.rnd( monteCarlo.J ) +monteCarlo.p = normalizeProb( 1/monteCarlo.J * ones( monteCarlo.J , 1 ) ) + +# numerical (Gauss-Hermite grid) prior +ghqMesh = emptyMatrix +load( "ghq1000" ) + +tmp = ( ghqx - min( ghqx ) ) / ( max( ghqx ) - min( ghqx ) ) # rescale GH zeros so they belong to [0,1] +epsilon = 1e-10 +Lower = market.inv( epsilon ) +Upper = market.inv( 1-epsilon ) +ghqMesh.X = Lower + tmp*(Upper-Lower) # rescale mesh + +p = integrateSubIntervals(ghqMesh.X , market.cdf) +ghqMesh.p = normalizeProb(p) +ghqMesh.J = nrow(ghqMesh.X) + +#################################################################################### +# Entropy posterior from extreme view on expectation +#################################################################################### +# view of the analyst +view = emptyMatrix +view.mu = -3.0 + +# analytical (known since normal model has analytical solution) +truePosterior = emptyMatrix +truePosterior = Prior2Posterior( market.mu, 1, view.mu, market.sig2, 0 ) +truePosterior$pdf = function(x) dnorm( x, truePosterior.mu , sqrt(truePosterior.sig2) ) + +# numerical (Monte Carlo) +Aeq = rbind( ones( 1 , monteCarlo.J ) , t(monteCarlo.X) ) +beq = rbind( 1 , view.mu ) +monteCarloOptimResult = EntropyProg( monteCarlo.p , emptyMatrix , emptyMatrix , Aeq , beq ) + +monteCarlo.p_ = monteCarloOptimResult$p_ +monteCarlo.KLdiv = monteCarloOptimResult$optimizationPerformance$ml + +# numerical (Gaussian-Hermite grid) +Aeq = rbind( ones( 1 , ghqMesh.J ) , t( ghqMesh.X ) ) +beq = rbind( 1 , view.mu ) +ghqMeshOptimResult = EntropyProg( ghqMesh.p , emptyMatrix , emptyMatrix , Aeq , beq ) + +ghqMesh.p_ = ghqMeshOptimResult$p_ +ghqMesh.KLdiv = ghqMeshOptimResult$optimizationPerformance$ml + +#################################################################################### +# Plots +#################################################################################### +xmin = min(ghqMesh.X) +xmax = max(ghqMesh.X) +ymax = 1.0 +xmesh = t(linspace(xmin, xmax, ghqMesh.J)) + +# Monte Carlo +plotDataMC = pHist( monteCarlo.X , monteCarlo.p_ , 50 ) +plot( plotDataMC$x , plotDataMC$f , type = "l" ) + +# Gauss Hermite Grid +plotDataGHQ = pHist(data.matrix(ghqMesh.X), ghqMesh.p_ , 50 ) +plot( plotDataGHQ$x , plotDataGHQ$f , type = "l" ) +