From noreply at r-forge.r-project.org Mon Jul 1 00:13:27 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 00:13:27 +0200 (CEST) Subject: [Returnanalytics-commits] r2478 - pkg/PortfolioAnalytics/R Message-ID: <20130630221328.00D1518587B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-01 00:13:27 +0200 (Mon, 01 Jul 2013) New Revision: 2478 Added: pkg/PortfolioAnalytics/R/constraint_fn_map.R Removed: pkg/PortfolioAnalytics/R/constraint_fnMap.R Log: adding functions to transform weight for box_constraint, group_constraint, and weight_sum_constraint. changed naming of function to be more consistent Deleted: pkg/PortfolioAnalytics/R/constraint_fnMap.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fnMap.R 2013-06-30 18:38:16 UTC (rev 2477) +++ pkg/PortfolioAnalytics/R/constraint_fnMap.R 2013-06-30 22:13:27 UTC (rev 2478) @@ -1,102 +0,0 @@ -#' Constraint mapping function -#' -#' The purpose of the mapping function is to transform a weights vector -#' that does not meet all the constraints into a weights vector that -#' does meet the constraints, if one exists, hopefully with a minimum -#' of transformation. - -#' I think our first step should be to test each constraint type, in -#' some sort of hierarchy, starting with box constraints (almost all -#' solvers support box constraints, of course), since some of the other -#' transformations will violate the box constraints, and we'll need to -#' transform back again. -#' -#' @param weights vector of weights -#' @param portfolio object of class portfolio -#' @author Ross Bennett -#' @export -constraint_fnMap <- function(weights, portfolio) { - - if (!is.portfolio(portfolio)) { - stop("Portfolio passed in is not of class portfolio") - } - - for(constraint in portfolio$constraints) { - # Check for enabled constraints - if(constraint$enabled){ - - ## box constraint - if(inherits(constraint, "box_constraint")){ - # TODO - } # box constraint - - ## weight_sum constraint - if(inherits(constraint, "weight_sum_constraint")){ - min_sum <- constraint$min_sum - max_sum <- constraint$max_sum - print(min_sum) - print(max_sum) - # normalize to max_sum - if(sum(weights) > max_sum) { weights <- (max_sum / sum(weights)) * weights } - # normalize to min_sum - if(sum(weights) < min_sum) { weights <- (min_sum / sum(weights)) * weights } - } # weight_sum constraint - - ## group constraint - if(inherits(constraint, "group_constraint")){ - groups <- constraint$groups - cLO <- constraint$cLO - cUP <- constraint$cUP - print(groups) - print(cLO) - print(cUP) - n.groups <- length(groups) - k <- 1 - l <- 0 - for(i in 1:n.groups){ - j <- groups[i] - tmp.w <- weights[k:(l+j)] - # normalize weights for a given group that sum to less than specified group min - grp.min <- cLO[i] - if(sum(tmp.w) < grp.min) { - weights[k:(l+j)] <- (grp.min / sum(tmp.w)) * tmp.w - } - # normalize weights for a given group that sum to greater than specified group max - grp.max <- cUP[i] - if(sum(tmp.w) > grp.max) { - weights[k:(l+j)] <- (grp.max / sum(tmp.w)) * tmp.w - } - k <- k + j - l <- k - 1 - } - # Normalizing the weights inside the groups changes the sum of the weights. - # Should normalizing the sum of weights take place here or somewhere else? - # Re-normalizing the weights will get us *close* to satisfying the group constraints. - # Maybe then add a penalty in constrained objective for violation of group constraints? - } # group constraint - - # Turnover constraints - # TODO - - # Diversification constraints - # TODO - } - } - return(weights) -} - -# library(PortfolioAnalytics) -# data(edhec) -# ret <- edhec[, 1:4] -# funds <- colnames(ret) -# -# pspec <- portfolio.spec(assets=funds) -# pspec <- add.constraint(portfolio=pspec, type="weight_sum", min_sum=0.99, max_sum=1.01, enabled=TRUE) -# pspec <- add.constraint(portfolio=pspec, type="box", enabled=TRUE) -# pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2,2), group_min=c(0.1, 0.2), group_max=c(0.3, 0.8), enabled=TRUE) -# -# weights <- c(0.15, 0.2, 0.15, 0.5) -# sum(weights) -# -# (w <- constraint_fnMap(weights, pspec)) -# sum(w) Added: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R (rev 0) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-06-30 22:13:27 UTC (rev 2478) @@ -0,0 +1,181 @@ +#' Constraint mapping function +#' +#' The purpose of the mapping function is to transform a weights vector +#' that does not meet all the constraints into a weights vector that +#' does meet the constraints, if one exists, hopefully with a minimum +#' of transformation. + +#' I think our first step should be to test each constraint type, in +#' some sort of hierarchy, starting with box constraints (almost all +#' solvers support box constraints, of course), since some of the other +#' transformations will violate the box constraints, and we'll need to +#' transform back again. +#' +#' @param weights vector of weights +#' @param portfolio object of class portfolio +#' @author Ross Bennett +#' @export +constraint_fn_map <- function(weights, portfolio) { + + if (!is.portfolio(portfolio)) { + stop("Portfolio passed in is not of class portfolio") + } + + # This is in a loop so the order of transformation depends on how the constraints are added by the user. + # Maybe take this out of a loop because the order of transformation is important + for(constraint in portfolio$constraints) { + # Check for enabled constraints + if(constraint$enabled){ + + ## box constraint + if(inherits(constraint, "box_constraint")){ + min <- constraint$min + max <- constraint$max + + w <- txfrm_box_constraint(weights=weights, min=min, max=max) + + # The transformation will likely change the sum of weights and violate min_sum or max_sum + # Should we normalize here by transforming the entire weights vector? + # Normalizing by transforming the entire weights may violate min and max, but will get us *close* + } # end box_constraint transformation + + ## weight_sum constraint + if(inherits(constraint, "weight_sum_constraint")){ + min_sum <- constraint$min_sum + max_sum <- constraint$max_sum + # print(min_sum) + # print(max_sum) + + w <- txfrm_weight_sum_constraint(weights=weights, min_sum=min_sum, max_sum=max_sum) + + } # end weight_sum constraint transformation + + ## group constraint + if(inherits(constraint, "group_constraint")){ + groups <- constraint$groups + cLO <- constraint$cLO + cUP <- constraint$cUP + # print(groups) + # print(cLO) + # print(cUP) + + w <- txfrm_group_constraint(weights=weights, groups=groups, cLO=cLO, cUP=cUP) + + # Normalizing the weights inside the groups changes the sum of the weights. + # Should normalizing the sum of weights take place here or somewhere else? + # Re-normalizing the weights will get us *close* to satisfying the group constraints. + # Maybe then add a penalty in constrained objective for violation of group constraints? + } # end group_constraint transformation + + # Turnover constraints + # TODO + + # Diversification constraints + # TODO + } + } + return(w) +} + +#' Transform weights that violate min or max box constraints +#' +#' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy box constraints. +#' +#' @param weights vector of weights +#' @param min vector of minimum asset weights from box constraints +#' @param max vector of maximum asset weights from box constraints +#' @author Ross Bennett +#' @export +txfrm_box_constraint <- function(weights, min, max) { + # 1. Check if any elements of the weights vector violate min or max + # 2. If min or max is violated, then set those weights equal to their respective min or max values + # The length of the weights vector must be equal to the length of min and max vectors so that an element-by-element comparison is done + if(any(weights < min) | any(weights > max)){ + # get the index of elements in the weights vector that violate min + idx.min <- which(weights < min) + # set those elements in the weights vector equal to their respective min + weights[idx.min] = min[idx.min] + # print(weights) + # get the index of elements in the weights vector that violate max + idx.max <- which(weights > max) + # set those elements in the weights vector equal to their respective max + weights[idx.max] = max[idx.max] + # print(weights) + # The transformation will likely change the sum of weights and violate min_sum or max_sum + # Should we normalize here by transforming the entire weights vector? + # Normalizing by transforming the entire weights may violate min and max, but will get us *close* + # if(sum(weights) < min_sum) weights <- min_sum / sum(weights) * weights + # if(sum(weights) > max_sum) weights <- max_sum / sum(weights) * weights + } + return(weights) +} + +#' Transform weights that violate group constraints +#' +#' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy group constraints. +#' +#' @param weights vector of weights +#' @param groups vector of groups +#' @param cLO vector of minimum group weights from group constraints +#' @param cUP vector of maximum group weights from group constraints +#' @author Ross Bennett +#' @export +txfrm_group_constraint <- function(weights, groups, cLO, cUP){ + n.groups <- length(groups) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- groups[i] + tmp.w <- weights[k:(l+j)] + # normalize weights for a given group that sum to less than specified group min + grp.min <- cLO[i] + if(sum(tmp.w) < grp.min) { + weights[k:(l+j)] <- (grp.min / sum(tmp.w)) * tmp.w + } + # normalize weights for a given group that sum to greater than specified group max + grp.max <- cUP[i] + if(sum(tmp.w) > grp.max) { + weights[k:(l+j)] <- (grp.max / sum(tmp.w)) * tmp.w + } + k <- k + j + l <- k - 1 + } + # Normalizing the weights inside the groups changes the sum of the weights. + # Should normalizing the sum of weights take place here or somewhere else? + # Re-normalizing the weights will get us *close* to satisfying the group constraints. + # Maybe then add a penalty in constrained objective for violation of group constraints? + return(weights) +} + +#' Transform weights that violate weight_sum constraints +#' +#' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy weight_sum constraints. +#' +#' @param weights vector of weights +#' @param min_sum minimum sum of asset weights +#' @param max_sum maximum sum of asset weights +#' @author Ross Bennett +#' @export +txfrm_weight_sum_constraint <- function(weights, min_sum, max_sum){ + # normalize to max_sum + if(sum(weights) > max_sum) { weights <- (max_sum / sum(weights)) * weights } + # normalize to min_sum + if(sum(weights) < min_sum) { weights <- (min_sum / sum(weights)) * weights } + return(weights) +} + +# library(PortfolioAnalytics) +# data(edhec) +# ret <- edhec[, 1:4] +# funds <- colnames(ret) +# +# pspec <- portfolio.spec(assets=funds) +# pspec <- add.constraint(portfolio=pspec, type="weight_sum", min_sum=0.99, max_sum=1.01, enabled=TRUE) +# pspec <- add.constraint(portfolio=pspec, type="box", enabled=TRUE) +# pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2,2), group_min=c(0.1, 0.2), group_max=c(0.3, 0.8), enabled=TRUE) +# +# weights <- c(0.15, 0.2, 0.15, 0.5) +# sum(weights) +# +# (w <- constraint_fn_map(weights, pspec)) +# sum(w) From noreply at r-forge.r-project.org Mon Jul 1 00:14:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 00:14:54 +0200 (CEST) Subject: [Returnanalytics-commits] r2479 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130630221455.0EA83185897@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-01 00:14:54 +0200 (Mon, 01 Jul 2013) New Revision: 2479 Added: pkg/PortfolioAnalytics/sandbox/testing_constraint_fn_map.R Log: adding testing for constraint_fn_map functions for different scenarios Added: pkg/PortfolioAnalytics/sandbox/testing_constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_constraint_fn_map.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_constraint_fn_map.R 2013-06-30 22:14:54 UTC (rev 2479) @@ -0,0 +1,54 @@ +# testing for constraint_fnMap functions + +##### test txfrm_box_constraint ##### +# transform weights that violate min and max box constraints + +min <- c(0.05, 0.08, 0.15, 0.1, 0.15) +max <- c(0.45, 0.55, 0.45, 0.6, 0.45) + +# elements 2 and 5 violate min +# element 3 violates max +w <- c(0.1, 0.06, 0.48, 0.25, 0.11) +which(w < min) +which(w > max) + +w.box <- txfrm_box_constraint(w, min, max) +sum(w.box) # max_sum is violated +w.box +any(w.box < min) +any(w.box > max) + +###### test txfrm_group_constraint ##### +# transform weights that violate group constraints +groups <- c(2,2) +cLO <- c(0.1, 0.2) +cUP <- c(0.3, 0.8) + +# cUP is violated for the first group +w <- c(0.15, 0.2, 0.15, 0.5) + +w.grp <- txfrm_group_constraint(weights=w, groups=groups, cLO=cLO, cUP=cUP) +w.grp +sum(w.grp) # min_sum is violated + +##### test txfrm_weight_sum_constraint ##### +# normalizes the weights to min_sum or max_sum by transforming the entire vector +sum(w.box) +w1 <- txfrm_weight_sum_constraint(weights=w.box, min_sum=0.99, max_sum=1.01) +w1 +min +# elements 2 and 5 barely violate min + +sum(w.grp) +w2 <- txfrm_weight_sum_constraint(weights=w.grp, min_sum=0.99, max_sum=1.01) +cLO +cUP +# the first group barely violates cUP +sum(w2[1:2]) +sum(w2[3:4]) + + + + + + From noreply at r-forge.r-project.org Mon Jul 1 00:16:50 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 00:16:50 +0200 (CEST) Subject: [Returnanalytics-commits] r2480 - in pkg/PortfolioAnalytics: . man Message-ID: <20130630221650.5A9B71859EA@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-01 00:16:49 +0200 (Mon, 01 Jul 2013) New Revision: 2480 Added: pkg/PortfolioAnalytics/man/constraint_fn_map.Rd pkg/PortfolioAnalytics/man/txfrm_box_constraint.Rd pkg/PortfolioAnalytics/man/txfrm_group_constraint.Rd pkg/PortfolioAnalytics/man/txfrm_weight_sum_constraint.Rd Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/NAMESPACE Log: updating documentation Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2013-06-30 22:14:54 UTC (rev 2479) +++ pkg/PortfolioAnalytics/DESCRIPTION 2013-06-30 22:16:49 UTC (rev 2480) @@ -44,4 +44,4 @@ 'objectiveFUN.R' 'portfolio.R' 'constraintsFUN.R' - 'constraint_fnMap.R' + 'constraint_fn_map.R' Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-06-30 22:14:54 UTC (rev 2479) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-06-30 22:16:49 UTC (rev 2480) @@ -11,7 +11,7 @@ export(charts.RP) export(constrained_group_tmp) export(constrained_objective) -export(constraint_fnMap) +export(constraint_fn_map) export(constraint_ROI) export(constraint_v2) export(constraint) @@ -51,6 +51,9 @@ export(trailingFUN) export(turnover_constraint) export(turnover_objective) +export(txfrm_box_constraint) +export(txfrm_group_constraint) +export(txfrm_weight_sum_constraint) export(update.constraint) export(volatility_constraint) export(weight_sum_constraint) Added: pkg/PortfolioAnalytics/man/constraint_fn_map.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constraint_fn_map.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/constraint_fn_map.Rd 2013-06-30 22:16:49 UTC (rev 2480) @@ -0,0 +1,27 @@ +\name{constraint_fn_map} +\alias{constraint_fn_map} +\title{Constraint mapping function} +\usage{ + constraint_fn_map(weights, portfolio) +} +\arguments{ + \item{weights}{vector of weights} + + \item{portfolio}{object of class portfolio} +} +\description{ + The purpose of the mapping function is to transform a + weights vector that does not meet all the constraints + into a weights vector that does meet the constraints, if + one exists, hopefully with a minimum of transformation. I + think our first step should be to test each constraint + type, in some sort of hierarchy, starting with box + constraints (almost all solvers support box constraints, + of course), since some of the other transformations will + violate the box constraints, and we'll need to transform + back again. +} +\author{ + Ross Bennett +} + Added: pkg/PortfolioAnalytics/man/txfrm_box_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/txfrm_box_constraint.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/txfrm_box_constraint.Rd 2013-06-30 22:16:49 UTC (rev 2480) @@ -0,0 +1,24 @@ +\name{txfrm_box_constraint} +\alias{txfrm_box_constraint} +\title{Transform weights that violate min or max box constraints} +\usage{ + txfrm_box_constraint(weights, min, max) +} +\arguments{ + \item{weights}{vector of weights} + + \item{min}{vector of minimum asset weights from box + constraints} + + \item{max}{vector of maximum asset weights from box + constraints} +} +\description{ + This is a helper function called inside constraint_fnMap + to transform the weights vector to satisfy box + constraints. +} +\author{ + Ross Bennett +} + Added: pkg/PortfolioAnalytics/man/txfrm_group_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/txfrm_group_constraint.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/txfrm_group_constraint.Rd 2013-06-30 22:16:49 UTC (rev 2480) @@ -0,0 +1,26 @@ +\name{txfrm_group_constraint} +\alias{txfrm_group_constraint} +\title{Transform weights that violate group constraints} +\usage{ + txfrm_group_constraint(weights, groups, cLO, cUP) +} +\arguments{ + \item{weights}{vector of weights} + + \item{groups}{vector of groups} + + \item{cLO}{vector of minimum group weights from group + constraints} + + \item{cUP}{vector of maximum group weights from group + constraints} +} +\description{ + This is a helper function called inside constraint_fnMap + to transform the weights vector to satisfy group + constraints. +} +\author{ + Ross Bennett +} + Added: pkg/PortfolioAnalytics/man/txfrm_weight_sum_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/txfrm_weight_sum_constraint.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/txfrm_weight_sum_constraint.Rd 2013-06-30 22:16:49 UTC (rev 2480) @@ -0,0 +1,22 @@ +\name{txfrm_weight_sum_constraint} +\alias{txfrm_weight_sum_constraint} +\title{Transform weights that violate weight_sum constraints} +\usage{ + txfrm_weight_sum_constraint(weights, min_sum, max_sum) +} +\arguments{ + \item{weights}{vector of weights} + + \item{min_sum}{minimum sum of asset weights} + + \item{max_sum}{maximum sum of asset weights} +} +\description{ + This is a helper function called inside constraint_fnMap + to transform the weights vector to satisfy weight_sum + constraints. +} +\author{ + Ross Bennett +} + From noreply at r-forge.r-project.org Mon Jul 1 10:26:28 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 10:26:28 +0200 (CEST) Subject: [Returnanalytics-commits] r2481 - in pkg/Meucci: . R data demo Message-ID: <20130701082628.5C614184288@r-forge.r-project.org> Author: xavierv Date: 2013-07-01 10:26:27 +0200 (Mon, 01 Jul 2013) New Revision: 2481 Added: pkg/Meucci/data/equities.Rda pkg/Meucci/demo/S_EquitiesInvariance.R Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/R/PerformIidAnalysis.R pkg/Meucci/demo/S_AutocorrelatedProcess.R pkg/Meucci/demo/S_BivariateSample.R Log: added S_EquitiesInvariance.R demo file and its asociate data file Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-06-30 22:16:49 UTC (rev 2480) +++ pkg/Meucci/DESCRIPTION 2013-07-01 08:26:27 UTC (rev 2481) @@ -29,7 +29,8 @@ zoo, xts (>= 0.8), matlab, - pracma + pracma, + R.utils Suggests: quadprog, mvtnorm, Modified: pkg/Meucci/R/PerformIidAnalysis.R =================================================================== --- pkg/Meucci/R/PerformIidAnalysis.R 2013-06-30 22:16:49 UTC (rev 2480) +++ pkg/Meucci/R/PerformIidAnalysis.R 2013-07-01 08:26:27 UTC (rev 2481) @@ -30,7 +30,7 @@ ########################################################################################################## ### Test "identically distributed hypothesis": split observations into two sub-samples and plot histogram Sample_1 = Data[ 1:round(length(Data) / 2) ]; - Sample_2 = Data[ round(length(Data)/2) + 1: length(Data) ]; + Sample_2 = Data[(round(length(Data)/2) + 1) : length(Data) ]; num_bins_1 = round(5 * log(length(Sample_1))); num_bins_2 = round(5 * log(length(Sample_2))); X_lim = c( min(Data) - .1 * (max(Data) - min(Data)), max(Data) + .1 * (max(Data) - min(Data))); Added: pkg/Meucci/data/equities.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/equities.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Modified: pkg/Meucci/demo/S_AutocorrelatedProcess.R =================================================================== --- pkg/Meucci/demo/S_AutocorrelatedProcess.R 2013-06-30 22:16:49 UTC (rev 2480) +++ pkg/Meucci/demo/S_AutocorrelatedProcess.R 2013-07-01 08:26:27 UTC (rev 2481) @@ -7,7 +7,6 @@ #' See Meucci's script for "S_AutocorrelatedProcess.m" #' #' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export ################################################################################################################## ### Input parameters Modified: pkg/Meucci/demo/S_BivariateSample.R =================================================================== --- pkg/Meucci/demo/S_BivariateSample.R 2013-06-30 22:16:49 UTC (rev 2480) +++ pkg/Meucci/demo/S_BivariateSample.R 2013-07-01 08:26:27 UTC (rev 2481) @@ -9,7 +9,6 @@ #' See Meucci's script for "S_BivariateSample.m" #' #' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export ################################################################################################################### ### input parameters Added: pkg/Meucci/demo/S_EquitiesInvariance.R =================================================================== --- pkg/Meucci/demo/S_EquitiesInvariance.R (rev 0) +++ pkg/Meucci/demo/S_EquitiesInvariance.R 2013-07-01 08:26:27 UTC (rev 2481) @@ -0,0 +1,42 @@ +################################################################################################################## +### This file performs the quest for invariance in the stock market +### == Chapter 3 == +################################################################################################################## +#' This file performs the quest for invariance in the stock market, as described in +#' A. Meucci "Risk and Asset Allocation", Springer, 2005, chapter 3. +#' +#' @references +#' \url{http://} +#' See Meucci's script for "S_EquitiesInvariance.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + + +################################################################################################################## +### Load daily stock prices from the utility sector in the S&P 500 +load("../data/equities.Rda"); + +################################################################################################################## +### Pick one stock from database +Stock_Index = 20; +P = Equities$Prices[ 632 : nrow( Equities$Prices ), Stock_Index ]; # select data after 1/8 rule + +################################################################################################################## +### Quest for invariance +# first invariant +X = P[ -1 ] / P[ -length( P )]; +PerformIidAnalysis( 1 : length( X ), X, 'Analysis for X' ); + +# second invariant +Y = P[ -1 ] / P[ -length( P )]; +PerformIidAnalysis(1 : length( Y ), Y, 'Analysis for Y' ); + +# third invariant +Z = X ^ 2; +PerformIidAnalysis( 1 : length(Z), Z, 'Analysis for Z' ); + +# fourth invariant +W = P[ 3 : length( P ) ] - 2 * P[ 2: ( length( P ) -1 ) ] + P[ 1 : ( length( P ) -2 ) ]; +PerformIidAnalysis( 1 : length( W ), W, 'Analysis for W' ); + From noreply at r-forge.r-project.org Mon Jul 1 12:55:43 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 12:55:43 +0200 (CEST) Subject: [Returnanalytics-commits] r2482 - pkg/Meucci/demo Message-ID: <20130701105543.8276F1853C2@r-forge.r-project.org> Author: xavierv Date: 2013-07-01 12:55:43 +0200 (Mon, 01 Jul 2013) New Revision: 2482 Added: pkg/Meucci/demo/S_EquityProjectionPricing.R Modified: pkg/Meucci/demo/S_EquitiesInvariance.R Log: added S_EquityProjectionPricing.R demo file Modified: pkg/Meucci/demo/S_EquitiesInvariance.R =================================================================== --- pkg/Meucci/demo/S_EquitiesInvariance.R 2013-07-01 08:26:27 UTC (rev 2481) +++ pkg/Meucci/demo/S_EquitiesInvariance.R 2013-07-01 10:55:43 UTC (rev 2482) @@ -1,7 +1,3 @@ -################################################################################################################## -### This file performs the quest for invariance in the stock market -### == Chapter 3 == -################################################################################################################## #' This file performs the quest for invariance in the stock market, as described in #' A. Meucci "Risk and Asset Allocation", Springer, 2005, chapter 3. #' Added: pkg/Meucci/demo/S_EquityProjectionPricing.R =================================================================== --- pkg/Meucci/demo/S_EquityProjectionPricing.R (rev 0) +++ pkg/Meucci/demo/S_EquityProjectionPricing.R 2013-07-01 10:55:43 UTC (rev 2482) @@ -0,0 +1,53 @@ + +#' This script projects the distribution of the market invariants for the stock market (i.e. the compounded returns) +#' from the estimation interval (normal assumption) to the investment horizon. Then it computes the distribution of prices +#' at the investment horizon analytically, by full Monte Carlo, and by delta/duration approximationThis file performs +#' the quest for invariance in the stock market, as described in A. Meucci "Risk and Asset Allocation", Springer, 2005, +#' chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EquitiesInvariance.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################# +### Inputs +tau_tilde = 1 / 52; # estimation period expressed in years +sig = 0.4; +P_T = 1; +NumScenarios = 1000000; +taus = c( 1/252, 1/52, 1/12, 1, 2 ); # times to horizon expressed in years +tauName = c( '1 day','1 week', '1 month', '1 year', '2 years'); + +################################################################################################################# +### loop projection/pricing over different times to horizon +for( k in 1 : length( taus ) ) +{ + tau = taus[ k ]; + + # exact simulation of horizon prices + C_Ttau = rnorm( NumScenarios, 0, sqrt( sig * sig * tau)); + P_Ttau = P_T * exp( C_Ttau ); + + # compute analytical pdf + p_lo = min( P_Ttau ); + p_hi = max( P_Ttau ); + p = seq( p_lo, p_hi, ( p_hi - p_lo ) / 1000 ); + m = log( P_T ); + s = sqrt( sig * sig * tau ); + f = dlnorm( p, m, s ); + + # compute approximate pdf + f_approx = dnorm( p, P_T, sqrt(P_T * P_T * sig * sig * tau)); + + # plots + dev.new() + NumBins = round(10 * log( NumScenarios)); + hist( P_Ttau, NumBins, freq = FALSE, xlab = "price at the horizon", ylab = "pdf", col="blue", + main = expression(paste("time to horizon ", tau, " = ", tauName[k]))); + lines( p, f, col = "red"); + lines( p, f_approx, col = "green"); + legend( "topright", 1.9, c( "full Monte Carlo", "analytical", "delta/duration" ), col = c( "blue","red", "green" ), + lty=1,lwd =c( 10,1,1), bg = "gray90" ); +} \ No newline at end of file From noreply at r-forge.r-project.org Mon Jul 1 14:52:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 14:52:03 +0200 (CEST) Subject: [Returnanalytics-commits] r2483 - pkg/PerformanceAnalytics/sandbox/Shubhankit Message-ID: <20130701125204.0FE5F1852CB@r-forge.r-project.org> Author: shubhanm Date: 2013-07-01 14:52:03 +0200 (Mon, 01 Jul 2013) New Revision: 2483 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R Log: Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R 2013-07-01 12:52:03 UTC (rev 2483) @@ -0,0 +1,36 @@ +UnSmoothReturn<- + function(R = NULL,q, ...) + { + columns = 1 + columnnames = NULL + #Error handling if R is not NULL + if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + count = q + x=edhec + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(edhec[,column], method="vector", na.rm = TRUE) + + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] + values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + return(result.df[1:q,]*R) # Unsmooth Return + + } + } \ No newline at end of file From noreply at r-forge.r-project.org Mon Jul 1 15:56:05 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 15:56:05 +0200 (CEST) Subject: [Returnanalytics-commits] r2484 - pkg/PerformanceAnalytics/sandbox/pulkit/week1/code Message-ID: <20130701135605.E256B18561D@r-forge.r-project.org> Author: pulkit Date: 2013-07-01 15:56:05 +0200 (Mon, 01 Jul 2013) New Revision: 2484 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/data.csv Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R Log: Verified PSR Optimization - added Python code with data Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py 2013-07-01 13:56:05 UTC (rev 2484) @@ -0,0 +1,155 @@ +#!/usr/bin/env python +# PSR class for Portfolio Optimization +# On 20121128 by MLdP + +import numpy as np +#------------------------------------------- +#------------------------------------------- +class PSR_Opt: + def __init__(self,series,seed,delta,maxIter,bounds=None): + # Construct the object + self.series,self.w,self.delta=series,seed,delta + self.z,self.d1Z=None,[None for i in range(series.shape[1])] + self.maxIter,self.iter,self.obs=maxIter,0,series.shape[0] + if len(bounds)==None or seed.shape[0]!=len(bounds): + self.bounds=[(0,1) for i in seed] + else: + self.bounds=bounds +#------------------------------------------- + def optimize(self): + # Optimize weights + mean=[self.get_Moments(self.series[:,i],1) for i in range(self.series.shape[1])] + w=np.array(self.w) + # Compute derivatives + while True: + if self.iter==self.maxIter:break + # Compute gradient + d1Z,z=self.get_d1Zs(mean,w) + # Evaluate result + if z>self.z and self.checkBounds(w)==True: + # Store new local optimum + self.z,self.d1Z=z,d1Z + self.w=np.array(w) + # Find direction and normalize + self.iter+=1 + w=self.stepSize(w,d1Z) + if w==None:return + return +#------------------------------------------- + def checkBounds(self,w): + # Check that boundary conditions are satisfied + flag=True + for i in range(w.shape[0]): + if w[i,0]self.bounds[i][1]:flag=False + return flag +#------------------------------------------- + def stepSize(self,w,d1Z): + # Determine step size for next iteration + x={} + for i in range(len(d1Z)): + if d1Z[i]!=0:x[abs(d1Z[i])]=i + if len(x)==0:return + index=x[max(x)] + w[index,0]+=self.delta/d1Z[index] + w/=sum(w) + return w +#------------------------------------------- + def get_d1Zs(self,mean,w): + # First order derivatives of Z + d1Z=[0 for i in range(self.series.shape[1])] + m=[0 for i in range(4)] + series=np.dot(self.series,w)[:,0] + m[0]=self.get_Moments(series,1) + for i in range(1,4):m[i]=self.get_Moments(series,i+1,m[0]) + stats=self.get_Stats(m) + meanSR,sigmaSR=self.get_SR(stats,self.obs) + for i in range(self.series.shape[1]): + d1Z[i]=self.get_d1Z(stats,m,meanSR,sigmaSR,mean,w,i) + return d1Z,meanSR/sigmaSR +#------------------------------------------- + def get_d1Z(self,stats,m,meanSR,sigmaSR,mean,w,index): + # First order derivatives of Z with respect to index + d1Mu=self.get_d1Mu(mean,index) + d1Sigma=self.get_d1Sigma(stats[1],mean,w,index) + d1Skew=self.get_d1Skew(d1Sigma,stats[1],mean,w,index,m[2]) + d1Kurt=self.get_d1Kurt(d1Sigma,stats[1],mean,w,index,m[3]) + d1meanSR=(d1Mu*stats[1]-d1Sigma*stats[0])/stats[1]**2 + d1sigmaSR=(d1Kurt*meanSR**2+2*meanSR*d1meanSR*(stats[3]-1))/4 + d1sigmaSR-=d1Skew*meanSR+d1meanSR*stats[2] + d1sigmaSR/=2*sigmaSR*(self.obs-1) + d1Z=(d1meanSR*sigmaSR-d1sigmaSR*meanSR)/sigmaSR**2 + return d1Z +#------------------------------------------- + def get_d1Mu(self,mean,index): + # First order derivative of Mu + return mean[index] +#------------------------------------------- + def get_d1Sigma(self,sigma,mean,w,index): + # First order derivative of Sigma + return self.get_dnMoments(mean,w,2,1,index)/(2*sigma) +#------------------------------------------- + def get_d1Skew(self,d1Sigma,sigma,mean,w,index,m3): + # First order derivative of Skewness + d1Skew=self.get_dnMoments(mean,w,3,1,index)*sigma**3 + d1Skew-=3*sigma**2*d1Sigma*m3 + d1Skew/=sigma**6 + return d1Skew +#------------------------------------------- + def get_d1Kurt(self,d1Sigma,sigma,mean,w,index,m4): + # First order derivative of Kurtosis + d1Kurt=self.get_dnMoments(mean,w,4,1,index)*sigma**4 + d1Kurt-=4*sigma**3*d1Sigma*m4 + d1Kurt/=sigma**8 + return d1Kurt +#------------------------------------------- + def get_dnMoments(self,mean,w,mOrder,dOrder,index): + # Get dOrder derivative on mOrder mean-centered moment with respect to w index + x0,sum=1.,0 + for i in range(dOrder):x0*=(mOrder-i) + for i in self.series: + x1,x2=0,(i[index]-mean[index])**dOrder + for j in range(len(i)):x1+=w[j,0]*(i[j]-mean[j]) + sum+=x2*x1**(mOrder-dOrder) + return x0*sum/self.obs +#------------------------------------------- + def get_SR(self,stats,n): + # Set Z* + meanSR=stats[0]/stats[1] + sigmaSR=((1-meanSR*stats[2]+meanSR**2*(stats[3]-1)/4.)/(n-1))**.5 + return meanSR,sigmaSR +#------------------------------------------- + def get_Stats(self,m): + # Compute stats + return [m[0],m[1]**.5,m[2]/m[1]**(3/2.),m[3]/m[1]**2] +#------------------------------------------- + def get_Moments(self,series,order,mean=0): + # Compute a moment + sum=0 + for i in series:sum+=(i-mean)**order + return sum/float(self.obs) +#------------------------------------------- +#------------------------------------------- +def main(): + #1) Inputs (path to csv file with returns series) + path='data.csv' + maxIter=1000 # Maximum number of iterations + delta=.005 # Delta Z (attempted gain per interation) + + #2) Load data, set seed + series=np.genfromtxt(path,delimiter=',') # load as numpy array + seed=np.ones((series.shape[1],1)) # initialize seed + bounds=[(0,1) for i in seed] # min and max boundary per weight + + #3) Create class and solve + psrOpt=PSR_Opt(series,seed,delta,maxIter,bounds) + psrOpt.optimize() + + #4) Optimize and report optimal portfolio + print 'Maximized Z-value: '+str(psrOpt.z) + print '# of iterations: '+str(psrOpt.iter) + print 'PSR optimal portfolio:' + print str(psrOpt.w) +#------------------------------------------- +# Boilerplate +if __name__=='__main__': main() Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-01 12:52:03 UTC (rev 2483) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-01 13:56:05 UTC (rev 2484) @@ -30,45 +30,45 @@ if(is.null(bounds)){ - message("Bounds not given assumeing bounds to be (0,1) for each weight") + message("Bounds not given assuming bounds to be (0,1) for each weight") bounds = matrix(rep(c(0,1),columns),nrow = columns,byrow = TRUE) } - + z = 0 + iter = 0 + w = rep(1,columns) + d1z = 0 #Optimization Function optimize<-function(){ - weights = rep(1,columns)/columns - d1z = 0 - z = 0 - iter = 0 + weights = w mean = NULL for(column in 1:columns){ - mean = c(mean,mean(x[,column])) + mean = c(mean,get_Moments(x[,column],1)) } while(TRUE){ if(iter == MaxIter) break dZ = get_d1Zs(mean,weights) - if(dZ$zz && checkBounds(weights)==TRUE){ + z = dZ$z + d1z = dZ$d1Z + w = weights } - z = dZ$z - - d1z = dZ$d1Z iter = iter + 1 - weights_new = stepSize(weights,d1z) - if(is.null(weights_new)) break - weights = weights_new + weights = stepSize(weights,dZ$d1Z) + if(is.null(weights)) break } - return(weights) + return(w) } # To Check the bounds of the weights checkBounds<-function(weights){ flag = TRUE for(i in 1:columns){ + if(weights[i] < bounds[i,1]) flag = FALSE - if(weights[i] > bounds[i,1]) flag = FALSE + if(weights[i] > bounds[i,2]) flag = FALSE } - return(TRUE) + return(flag) } #Calculate the step size to change the weights @@ -76,7 +76,8 @@ if(length(which(d1Z!=0)) == 0){ return(NULL) } - weights[which(abs(d1Z)==max(abs(d1Z)))] = weights[which(abs(d1Z)==max(abs(d1Z)))]+(delta/d1Z[which(abs(d1Z)==max(abs(d1Z)))]) + index = which(abs(d1Z) ==max(abs(d1Z))) + weights[index] = weights[index]+delta/d1Z[index] weights = weights/sum(weights) return(weights) @@ -85,13 +86,19 @@ get_d1Zs<-function(mean,weights){ d1Z = NULL m = NULL - x_portfolio = Return.portfolio(x,weights) - mu = mean(x_portfolio) - sd = StdDev(x_portfolio) - sk = skewness(x_portfolio) - kr = kurtosis(x_portfolio) - stats = c(mu,sd,sk,kr) - m = c(stats[1],stats[2]^2,stats[3]*(stats[2]^3),stats[4]*(stats[2]^4)) + x_portfolio = x%*%weights + + m[1] = get_Moments(x_portfolio,1) + for(i in 2:4){ + m = c(m,get_Moments(x_portfolio,i,m[1])) + } + stats = get_Stats(m) + #mu = mean(x_portfolio) + #sd = StdDev(x_portfolio) + #sk = skewness(x_portfolio) + #kr = kurtosis(x_portfolio) + #stats = c(mu,sd,sk,kr) + #m = c(stats[1],stats[2]^2,stats[3]*(stats[2]^3),stats[4]*(stats[2]^4)) SR = get_SR(stats,n) meanSR = SR$meanSR sigmaSR = SR$sigmaSR @@ -107,13 +114,13 @@ get_d1Z<-function(stats,m,meanSR,sigmaSR,mean,weights,index){ d1Mu = get_d1Mu(mean,index) d1Sigma = get_d1Sigma(stats[2],mean,weights,index) - d1Skew = get_d1Skew(d1Sigma,stats[2],mean,weights,index,m[2]) - d1Kurt = get_d1Kurt(d1Sigma,stats[2],mean,weights,index,m[3]) + d1Skew = get_d1Skew(d1Sigma,stats[2],mean,weights,index,m[3]) + d1Kurt = get_d1Kurt(d1Sigma,stats[2],mean,weights,index,m[4]) d1meanSR = (d1Mu*stats[2]-d1Sigma*stats[1])/stats[2]^2 d1sigmaSR = (d1Kurt * meanSR^2+2*meanSR*d1meanSR*(stats[4]-1))/4 - d1sigmaSR = d1sigmaSR - d1Skew*meanSR+d1meanSR*stats[3] + d1sigmaSR = d1sigmaSR-(d1Skew*meanSR+d1meanSR*stats[3]) d1sigmaSR = d1sigmaSR/(2*sigmaSR*(n-1)) - d1Z = (d1meanSR*sigmaSR-d1sigmaSR*(meanSR-refSR))/sigmaSR^2 + d1Z = (d1meanSR*sigmaSR-d1sigmaSR*meanSR)/sigmaSR^2 return(d1Z) } @@ -164,6 +171,16 @@ SR<-list("meanSR"=meanSR,"sigmaSR"=sigmaSR) return(SR) } + get_Stats<-function(m){ + return(c(m[1],m[2]^0.5,m[3]/(m[2]^1.5),m[4]/(m[2]^2))) + } + get_Moments<-function(series,order,mean = 0){ + sum = 0 + for(i in series){ + sum = sum + (i-mean)^order + } + return(sum/n) + } weights = optimize() result = matrix(weights,nrow = columns) Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/data.csv =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/data.csv (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/data.csv 2013-07-01 13:56:05 UTC (rev 2484) @@ -0,0 +1,152 @@ +0.0119,0.0393,0.0178,0.0791,0.0189,0.0213,0.0191,0.0573,0.0281,0.015,0.018,-0.0166,0.0317 +0.0123,0.0298,0.0122,0.0525,0.0101,0.0084,0.0122,0.0175,-6e-04,0.0034,0.0118,0.0426,0.0106 +0.0078,-0.0021,-0.0012,-0.012,0.0016,-0.0023,0.0109,-0.0119,-0.0084,0.006,0.001,0.0778,-0.0077 +0.0086,-0.017,0.003,0.0119,0.0119,-5e-04,0.013,0.0172,0.0084,-1e-04,0.0122,-0.0129,9e-04 +0.0156,-0.0015,0.0233,0.0315,0.0189,0.0346,0.0118,0.0108,0.0394,0.0197,0.0173,-0.0737,0.0275 +0.0212,0.0085,0.0217,0.0581,0.0165,0.0258,0.0108,0.0218,0.0223,0.0231,0.0198,-0.0065,0.0225 +0.0193,0.0591,0.0234,0.056,0.0247,0.0307,0.0095,0.0738,0.0454,0.02,0.0181,-0.0429,0.0435 +0.0134,-0.0473,0.0147,-0.0066,0.0017,0.0071,0.0087,-0.018,0.0107,0.0079,0.0103,-0.0072,0.0051 +0.0122,0.0198,0.035,0.0229,0.0202,0.0329,0.0119,0.029,0.0429,0.0197,0.0183,-0.0155,0.0334 +0.01,-0.0098,-0.0064,-0.0572,0.0095,0.0061,-0.0032,-0.0142,0.001,0.0094,0.0079,0.0572,-0.0099 +0,0.0133,0.0054,-0.0378,0.0041,0.0134,0.0053,0.0106,-0.0026,0.0223,0.0111,0.0217,-0.0034 +0.0068,0.0286,0.0073,0.016,0.0066,0.0154,0.0079,0.0264,0.0104,0.0158,0.0082,0.0161,0.0089 +0.0145,0.0104,0.0095,-0.0429,0.006,0.0055,-0.0026,-0.005,0.0013,0.0055,0.0132,0.0014,-0.0036 +0.0146,-0.0065,0.0227,0.0339,0.0135,0.0294,0.0098,0.0128,0.0342,0.0212,0.013,0.0155,0.0256 +0.0144,0.0122,0.0252,0.0318,0.0179,0.0263,0.0128,0.057,0.0336,0.0164,0.0145,0.0637,0.0373 +0.0126,-0.0296,0.0165,0.0041,0.0067,0.0104,0.0075,0.0034,0.012,0.0139,0.0145,0.0657,0.0125 +0.0056,0.0193,6e-04,-0.0825,0.008,-0.0083,0.004,0.0095,-0.0087,-9e-04,0.0053,0.1437,-0.0072 +-6e-04,0.0051,-0.0047,-0.0422,0.0108,2e-04,-0.008,0.012,0.0167,0.0072,0.0026,-0.0053,0.0021 +0.006,-0.001,-0.0069,0.0019,0.0012,-0.0037,0.0106,0.0058,-6e-04,7e-04,0.0011,0.0343,-7e-04 +-0.0319,0.0691,-0.0836,-0.1922,-0.0107,-0.0886,-0.0143,-0.0263,-0.0552,-0.0544,-0.0341,0.2463,-0.0616 +-0.0196,0.0454,-0.0215,-0.0395,0.0061,-0.011,-0.0362,-0.0059,0.0206,0.0076,5e-04,-0.0376,-0.0037 +-0.0214,4e-04,-0.0029,0.014,0.0052,0.0091,-0.0801,-0.0223,0.0169,0.0159,-0.014,-0.1077,-2e-04 +0.0269,-0.0089,0.0164,0.043,0.0158,0.0244,0.0052,0.0194,0.0291,0.022,0.0198,-0.0756,0.022 +0.0113,0.0221,0.0108,-0.0098,0.0209,0.0219,0.012,0.0233,0.0408,0.0224,0.0164,-0.0531,0.0222 +0.0219,-0.0167,0.0181,-0.012,0.0101,0.0201,0.0158,0.0086,0.0258,0.0112,0.0195,-0.0665,0.0202 +0.0082,0.0197,-0.0021,0.0102,0.0023,-0.0042,0.0208,-0.0111,-0.0169,0.0036,0.0085,0.0833,-0.0063 +0.0136,-0.0065,0.0159,0.0585,0.0033,0.0193,0.016,0.0024,0.0229,0.0133,0.0116,-0.0154,0.0213 +0.0243,0.021,0.0418,0.063,0.0107,0.0429,0.0106,0.0329,0.0312,0.0218,0.0238,-0.0375,0.04 +0.0166,-0.015,0.0207,0.0061,0.0089,0.0215,0.0072,-0.0055,0.0095,0.021,0.0146,9e-04,0.0119 +0.0102,0.0234,0.0273,0.0654,0.0168,0.0297,0.0088,0.0214,0.0315,0.0222,0.0148,-0.0412,0.0282 +0.0101,-0.0051,0.0084,-0.0061,0.0135,0.0096,0.0051,-0.0018,0.0177,0.0147,0.011,0.0092,0.0088 +0.0048,-0.0027,0.002,-0.0147,0.0095,-0.0027,-0.0028,-0.0061,0.0022,0.005,0.0062,0.0468,0.0028 +0.0096,0.0064,-0.0041,-0.0069,0.0095,0.009,0.0092,-2e-04,0.0113,0.0116,0.0105,0.0401,0.0052 +0.0045,-0.0354,0.0027,0.0288,0.0066,0.0054,0.0087,0.0073,0.0212,0.0096,0.007,-0.013,0.013 +0.0124,0.0166,0.022,0.0692,0.0133,0.0284,0.0106,0.0405,0.0481,0.0237,0.0137,-0.1239,0.0483 +0.014,0.0142,0.03,0.123,0.0198,0.0286,0.0097,0.0612,0.0745,0.009,0.0183,-0.1137,0.0622 +0.0227,0.0128,0.0088,0.0077,0.0075,0.0088,0.0041,0.0021,0.0075,0.0143,0.0173,0.0427,0.0169 +0.0267,-0.0022,0.0421,0.0528,0.0253,0.0346,0.0097,0.0408,0.0699,0.0239,0.0185,-0.134,0.0666 +0.0243,-0.0138,0.0103,0.0318,0.0134,0.0069,-0.0061,-0.0104,6e-04,0.0131,0.0163,-0.023,0.0039 +0.0223,-0.0241,-0.0101,-0.0541,0.0168,-0.0059,-6e-04,-0.0304,-0.0201,0.0188,0.0092,0.1028,-0.0269 +0.0149,0.0114,-0.0132,-0.0433,0.0062,-0.0034,0.0107,-0.007,-0.0097,0.0146,0.008,0.0704,-0.0122 +0.0179,-0.0124,0.0203,0.0334,0.0171,0.0268,0.0058,0.0154,0.0349,0.0167,0.0176,-0.1107,0.0311 +0.0093,-0.0131,0.0064,0.0025,0.0063,0.0057,0.0018,0.0037,6e-04,0.0116,0.0084,0.0553,-0.0022 +0.0162,0.0189,0.014,0.0368,0.021,0.0173,0.0107,0.0248,0.0345,0.0157,0.0157,-0.1135,0.0267 +0.0141,-0.0208,-0.0019,-0.0462,0.0058,0.0048,0.0076,-0.0149,-0.0016,0.0137,0.0075,0.1204,-0.0069 +0.0052,0.0075,-0.0073,-0.0256,0.004,-0.0068,6e-04,-0.0024,-0.0084,0.0026,-4e-04,0.0784,-0.0104 +-0.0081,0.0425,-0.0209,-0.0385,0.0045,-0.0136,0.0066,0.0125,-0.0153,0.0102,6e-04,0.1657,-0.0205 +-2e-04,0.0682,1e-04,0.0116,0.016,0.0127,0.0048,0.0472,0.0248,0.0125,0.0075,0.0063,0.0133 +0.0344,0.0025,0.0308,0.0586,0.0075,0.0298,0.0163,0.0214,0.0165,0.0111,0.0333,-0.0271,0.0223 +0.0182,-0.0016,0.01,-0.0221,0.012,0.0045,0.0054,-0.0072,-0.0264,0.0054,0.003,0.1021,-0.0089 +0.0162,0.0438,-0.0037,-0.0175,0.0108,-0.0042,0.0051,0.0038,-0.0199,-0.0061,-0.0011,0.062,-0.0068 +0.0157,-0.0362,0.0048,0.0114,0.0075,0.011,0.0094,0.0049,0.0246,0.0058,0.0174,-0.0991,0.0104 +0.0033,0.0081,0.0235,0.0278,0.0077,0.0185,0.0068,0.0032,0.0043,0.0161,0.0141,-0.013,0.008 +0.0012,-0.0077,0.036,0.016,0.0017,0.0063,0.0017,0.0017,0.0019,-0.0087,0.0019,0.011,0.0013 +0.0091,-0.004,0.0073,-0.0286,0.0031,0.0049,0.0054,-0.004,-0.0144,0.0079,0.001,0.0353,-0.004 +0.0142,0.0153,0.0106,0.003,0.0094,0.009,0.0105,6e-04,-0.0096,0.0099,-0.0031,0.0752,0.0019 +0.0078,0.0246,-0.0014,-0.0425,0.0023,-0.0254,-0.0013,-0.007,-0.0348,-0.0267,-0.0221,0.0941,-0.0142 +0.0117,0.0336,0.0103,0.0278,0.0058,0.0148,0.0134,0.0208,0.0099,0.0085,0.0164,-0.0298,0.0095 +0.008,-0.0543,0.0086,0.0483,0.0055,0.0105,-0.0024,0.0021,0.02,0.0014,0.0136,-0.0655,0.0058 +-0.0094,0.0148,0.0015,0.0421,0.0056,0.0107,0.0053,0.0138,0.018,0.0045,0.0097,-0.0251,0.0099 +0.0148,-0.0072,0.0186,0.0273,0.0065,0.0078,0.0086,0.0069,-0.0037,0.0077,0.0097,0.0343,0.003 +-0.0049,-0.0202,-0.0033,0.0181,-7e-04,-0.0071,0.0056,-0.0035,-0.0123,-0.0044,-0.0011,0.039,-0.0015 +0.0053,9e-04,0.0052,0.0331,0.0047,0.0153,0.0045,0.0064,0.0155,0.0073,0.0145,-0.0446,0.009 +0.0096,-0.0104,0.0139,0.0144,0.0076,0.0046,0.0113,0.0098,-0.0042,-0.0013,0.007,0.0483,0.0052 +0.0033,0.027,0.0091,1e-04,0.0053,1e-04,0.0099,0.0123,-0.0034,0,0.0031,0.0346,0.005 +4e-04,0.0655,-0.0117,-0.0292,0.0022,-0.0283,0.0069,-0.0022,-0.0249,-0.017,-0.0107,0.0548,-0.0095 +-0.0159,0.0413,-0.0133,-0.0309,-0.0013,-0.03,0.0057,-0.0078,-0.0389,-0.0174,-0.0185,0.0644,-0.014 +0.005,0.022,9e-04,0.0119,0.0069,0.006,0.0097,0.0063,0.0041,0.0061,0.0058,0.0015,0.0037 +0.0146,0.0284,-0.0044,-0.0252,0.0015,-0.007,-0.0033,0.0054,-0.016,-0.0028,-0.011,0.0731,-0.0033 +0.0104,-0.0376,-0.0031,0.0154,0.0016,0.0031,-0.0063,-0.0086,0.0123,0.0032,0.0084,-0.0405,-0.0031 +0.0251,-0.0164,0.0239,0.019,0.0025,0.0216,0.0054,0.0047,0.0224,0.0054,0.0185,-0.0547,0.0106 +0.0157,0.0489,0.0222,0.0048,0.0094,0.0044,0.0153,0.0192,-0.0149,0.0046,0.0023,0.0443,0.0077 +0.0283,0.0441,0.0243,0.0012,0.0083,0.0154,0.0106,0.0182,5e-04,0.004,0.0067,0.0162,0.0072 +0.0133,0.0402,0.0092,0.0084,0.0024,0.0026,0.0079,0.0166,-0.0037,0.0018,-4e-04,0.013,0.0031 +0.0089,-0.0445,0.0113,0.0019,0.0015,0.0083,0.0019,-0.0122,0.002,-7e-04,0.0049,-0.0075,-4e-04 +0.015,0.0065,0.0345,0.045,0.0031,0.0272,0.0091,0.0117,0.0298,0.0099,0.0186,-0.0656,0.0134 +0.0136,0.049,0.027,0.0433,0.0107,0.0301,0.0207,0.0397,0.0362,0.0154,0.0212,-0.0499,0.0205 +-0.0058,-0.0192,0.0267,0.0268,0.0034,0.0181,0.0044,0.0056,0.0128,0.0048,0.0071,-0.0162,0.0068 +-0.0072,-0.0171,0.0117,0.0104,-6e-04,0.0119,-0.0092,-0.0035,0.0118,0.0053,0.0041,-0.0361,0.0025 +-0.0087,0.0078,0.0137,0.0374,0.0031,0.0133,0.0043,0.0202,0.0179,0.007,0.0058,-0.0354,0.0078 +0.0171,-0.0019,0.0242,0.0264,0.0078,0.0133,0.0105,0.0215,0.0094,0.0077,0.0086,0.0136,0.0121 +0.0146,0.0104,0.0267,0.0259,0.0115,0.0191,0.0035,0.0111,0.0299,0.0111,0.0159,-0.0656,0.0152 +0.0092,0.0018,0.0154,0.0096,0.0046,0.0116,0.0069,0.0031,0.013,0.0044,0.0102,-0.0136,0.007 +0.0054,0.0381,0.0198,0.0403,0.0054,0.0172,0.0101,0.0293,0.0191,0.0098,0.0127,-0.0178,0.0139 +0.0119,0.0199,0.0301,0.0251,0.0109,0.0234,0.0092,0.0117,0.0192,0.0097,0.0146,-0.009,0.0156 +0.0017,0.0529,0.0075,0.0253,0.0063,0.0113,0.0084,0.015,0.0123,0.0051,0.0057,0.0018,0.0111 +0.0061,-0.0051,0.0046,0.0172,0.0032,0.0016,3e-04,0.0064,0.0041,0.0017,0.0038,-0.0148,0.0043 +0.002,-0.0532,0.0093,-0.0252,-0.0082,2e-04,0.0062,-0.0178,-0.0165,-0.0039,-0.0045,0.0384,-0.0068 +-0.0128,-0.0118,-0.001,-0.0181,0.0024,-0.0023,0.004,-0.0081,-0.0035,0,-0.0037,-0.0024,-0.0082 +-0.0106,-0.0316,0.0202,0.002,0.0042,0.0113,0.0055,-0.0019,0.0091,0.0017,0.0022,-0.0051,0.0034 +0.0013,-0.0119,0.0019,-0.0027,6e-04,-0.0082,0.0062,-0.0014,-0.0154,-0.0092,7e-04,0.0638,-0.0049 +0.004,-0.0084,0.0088,0.0133,-9e-04,0.0035,0.0036,-0.0039,-0.0022,0.0011,0.0031,0.0126,-0.001 +-0.0017,0.022,0.0104,0.028,0.0085,0.0103,0.0012,8e-04,0.021,0.0042,0.0052,-0.0216,0.0099 +-0.0044,0.0358,0.0143,0.0185,-5e-04,0.0124,0.0028,0.0138,0.0074,0.0074,0.004,-0.0092,0.0068 +0.0081,0.0475,0.0337,0.0328,0.014,0.0306,0.0075,0.028,0.0308,0.0164,0.0149,-0.0574,0.0244 +0.0056,0,0.0266,0.0201,0.0058,0.0244,0.006,0.0033,0.0178,0.0133,0.0099,-0.0391,0.0145 +-0.0096,-0.0438,0.0037,0.0143,0.0081,4e-04,0.0044,-0.0047,-0.0017,0,0.0012,0.0387,6e-04 +-0.0058,5e-04,0.0134,0.0346,0.008,0.0144,0.0085,0.0171,0.021,0.0065,0.0081,0.0118,0.0136 +-0.014,-6e-04,0.0032,-0.0197,0.0019,-4e-04,0.0024,-0.0027,-0.0096,0.0032,-0.0042,0.0244,-0.0044 +-0.0316,-0.0354,-0.0052,-0.0049,-0.003,-0.0128,-3e-04,-0.008,-0.0184,-0.0105,-0.0108,0.0393,-0.0141 +-0.0133,0.0232,6e-04,0.0072,0.0047,0.0065,-0.001,0.0088,0.0115,0.0095,-2e-04,-0.0475,0.0018 +0.0107,0.026,0.0133,0.016,0.0081,0.0133,0.001,0.0116,0.0195,0.0085,0.0095,-0.0032,0.0131 +0.0164,-0.0013,0.0173,0.0257,0.0078,0.0215,0.0081,0.0119,0.0265,0.0115,0.0149,-0.0242,0.0134 +0.0066,0.01,0.0124,0.0152,0.0062,0.0092,0.0036,0.0083,0.0097,0.0061,0.0053,0.0259,0.0079 +0.0142,0.0079,0.0112,0.0402,0.0087,0.01,0.0062,0.0269,0.0222,0.0035,0.0122,0.0198,0.0147 +-0.0015,-0.0092,-0.0032,-0.023,1e-04,-0.0173,0.0057,-0.0074,-0.0174,-0.0145,-0.0038,0.0233,-0.0149 +4e-04,0.0379,0.01,0.0279,0.0061,0.0125,0.0015,0.0164,0.0211,0.0112,0.0067,-0.03,0.016 +0.0092,-0.0153,0.0122,0.0284,0.0068,0.0142,0.0054,0.0135,0.0249,0.0138,0.0126,-0.0035,0.0191 +0.025,0.0174,0.0253,0.0526,0.0115,0.0341,0.0093,0.0258,0.0381,0.0272,0.0238,-0.0288,0.0286 +0.0116,-0.0186,0.0065,0.0161,0.0046,0.0051,0.0041,2e-04,0.0016,0.0104,0.0073,0.0064,0.0037 +0.0107,0.0284,0.0172,0.0122,0.0098,0.0185,0.0055,0.0094,0.0238,0.0144,0.0157,-0.0139,0.0164 +0.0064,0.0387,0.0193,0.0365,0.0102,0.0164,0.0121,0.0238,0.0172,0.0119,0.0126,-0.0012,0.0171 +0.0091,-0.0146,0.0086,-0.0389,2e-04,8e-04,0.0059,-0.0155,-0.0248,9e-04,-0.0025,0.0246,-0.0133 +0.0012,-0.0142,-0.0015,-0.0097,0.0063,0.0012,0.0036,-0.0015,-0.0062,0.0087,0.0021,0.0118,-0.0028 +0.0066,-0.0216,9e-04,0.0067,0.0051,-0.0011,0.0064,6e-04,-0.0031,0.0058,0.0017,0.0173,-5e-04 +0.0098,0.002,0.0099,0.0133,-9e-04,0.0112,0.0037,-0.0039,0.0114,0.0053,0.0092,-0.0156,0.0066 +0.0093,-0.0055,0.0033,0.0011,9e-04,0.0035,0.0014,-0.0067,5e-04,0.0041,0.004,-0.0236,-3e-04 +0.0054,0.0102,0.0194,0.0257,0.0065,0.0206,0.0067,0.0097,0.0194,0.0132,0.0132,-0.038,0.0163 +0.0092,0.0226,0.0179,0.0323,0.0075,0.0182,0.006,0.0199,0.02,0.0142,0.0129,-0.0268,0.0185 +0.0127,0.0146,0.0165,0.0291,0.0107,0.0168,0.0072,0.0116,0.0153,0.0133,0.0128,0.0039,0.0175 +0.013,0.0113,0.015,0.0079,0.0083,0.0201,0.0069,0.0061,0.0121,0.0191,0.0135,-0.0107,0.0121 +0.0117,-0.0144,0.0145,0.01,0.0051,0.0207,0.0106,0.0018,0.0082,0.0255,0.0114,0.0028,0.0096 +0.006,-0.0141,0.0108,0.0185,0.0101,0.0146,0.006,0.0027,0.0115,0.0063,0.0081,-0.0051,0.0096 +0.0026,0.0241,0.0164,0.0255,0.0089,0.0197,0.0071,0.0152,0.0198,0.016,0.0134,-0.0265,0.0163 +0.011,0.023,0.018,0.027,0.0121,0.0213,0.0055,0.0192,0.0224,0.0171,0.0156,-0.0199,0.0204 +0.0011,0.0229,0.0027,0.0236,0.0077,-7e-04,0.0048,0.0107,0.0077,-0.0053,0.01,0.0236,0.0082 +-0.0053,-0.0122,-0.0056,0.0275,0.0051,-0.0032,7e-04,0.0116,9e-04,-0.0054,4e-04,0.0486,0.0041 +-0.0145,-0.028,-0.0118,-0.0274,-0.0094,-0.0144,-0.0048,-0.0116,-0.016,1e-04,-0.0077,0.0092,-0.0222 +0.0161,0.0469,0.0095,0.0428,0.0123,0.0134,0.0164,0.033,0.0256,0.0131,0.0153,-0.0207,0.0199 +0.0177,0.028,0.0175,0.0485,0.0168,0.0214,0.0114,0.0304,0.0281,0.0191,0.02,-0.0026,0.0303 +-0.0131,-0.0016,-0.0169,-0.0237,-0.0018,-0.0202,-0.0094,-0.0063,-0.0225,-0.0149,-0.0112,0.0719,-0.0148 +-0.0077,0.0117,2e-04,0.013,0.0054,7e-04,0.0036,0.0104,0.0043,-0.0025,0.0022,0.0056,0.004 +-9e-04,0.0255,-0.0233,-0.0503,-0.0112,-0.0271,-0.0012,-0.001,-0.04,-0.0126,-0.0118,0.0556,-0.0272 +-0.0083,0.062,0.0014,0.028,0.012,0.0084,-0.0049,0.0312,0.014,0.006,0.0064,0.03,0.0142 +-0.0317,-0.0056,-0.0126,-0.0379,-0.0049,-0.0168,-0.0306,-0.0169,-0.0236,-0.0045,-0.0162,0.0192,-0.0262 +0.0076,-0.0078,0.0088,0.019,0.0059,0.0118,0.0187,0.0078,0.0223,0.0149,0.013,-0.0461,0.0097 +0.0107,0.0162,0.0137,0.0163,0.0126,0.0176,0.0103,0.0114,0.0227,0.0136,0.0159,-0.0142,0.0172 +-0.0081,0.033,-0.0031,-0.0274,0.0156,-0.0113,-0.0027,0.003,-0.0164,-0.0109,-0.0084,0.0751,-0.0068 +-0.0188,-0.0333,-0.0182,-0.033,-0.01,-0.0166,-0.0023,-0.0213,-0.0261,0.0011,-0.0125,0.0072,-0.0264 +-0.0066,-0.0114,-0.0072,-0.0336,-0.0135,-0.0025,-3e-04,-0.0133,-0.0146,0.0051,-0.0023,-0.0215,-0.0156 +-0.1027,0.001,-0.0518,-0.0982,-0.0285,-0.0627,-0.0506,-0.0313,-0.0675,-0.0276,-0.0538,0.0378,-0.0618 +-0.1237,0.0345,-0.0775,-0.1331,-0.0044,-0.0625,-0.0867,-0.0157,-0.0629,-0.0245,-0.0692,0.117,-0.06 +-0.0276,0.0214,-0.0435,-0.0391,-0.0587,-0.0301,-0.0308,0.0033,-0.0188,6e-04,-0.0209,0.0428,-0.0192 +0.0177,0.014,-0.0197,-0.001,5e-04,-0.0071,-0.0035,0.0118,0.0081,0.0162,0.0031,-0.0146,-0.0119 +0.0491,-0.0016,0.0082,-0.0112,0.0079,0.0132,0.0112,0.0029,-0.0017,0.0056,0.01,0.0282,0.006 +0.0164,-0.0031,-0.0122,-0.0133,-0.0046,-0.0091,0.0065,-0.0055,-0.0161,6e-04,-0.0016,0.0328,-0.0037 +0.0235,-0.018,0.0022,0.035,0.0021,0.0117,0.0057,0.0048,0.0188,0.0125,0.01,-0.0462,8e-04 +0.05,-0.014,0.0387,0.0663,-0.0012,0.0337,0.0221,0.0127,0.0375,0.0081,0.0342,-0.082,0.0092 +0.0578,0.0213,0.0504,0.0884,0.0146,0.0442,0.0365,0.0348,0.0516,0.0107,0.0392,8e-04,0.0312 +0.0241,-0.0147,0.0198,0.0013,0.0036,0.0123,0.0126,-0.0076,9e-04,0.0104,0.0101,-0.0094,0.0024 +0.0611,-0.0012,0.0311,0.0451,0.0042,0.0291,0.0322,0.0166,0.0277,0.0068,0.026,-0.0596,0.0153 +0.0315,0.0054,0.0244,0.0166,0.007,0.0207,0.0202,0.005,0.0157,0.0102,0.0162,-0.0165,0.0113 From noreply at r-forge.r-project.org Tue Jul 2 06:04:06 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 06:04:06 +0200 (CEST) Subject: [Returnanalytics-commits] r2485 - pkg/PortfolioAnalytics/R Message-ID: <20130702040406.A8F27183EEB@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-02 06:04:06 +0200 (Tue, 02 Jul 2013) New Revision: 2485 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: adding postion_limit constraint transformation function to constraint_fn_map Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-01 13:56:05 UTC (rev 2484) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-02 04:04:06 UTC (rev 2485) @@ -21,6 +21,9 @@ stop("Portfolio passed in is not of class portfolio") } + # number of assets + nassets <- length(portfolio$assets) + # This is in a loop so the order of transformation depends on how the constraints are added by the user. # Maybe take this out of a loop because the order of transformation is important for(constraint in portfolio$constraints) { @@ -72,6 +75,15 @@ # Diversification constraints # TODO + + ## position_limit constraint + if(inherits(constraint, "group_constraint")){ + max_pos <- constraint$max_pos + + w <- txfrm_position_limit_constraint(weights=weights, max_pos=max_pos, nassets=nassets) + + } # end position_limit_constraint transformation + } } return(w) @@ -164,6 +176,26 @@ return(weights) } +#' Transform weights for position_limit constraints +#' +#' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy position_limit constraints. +#' This function sets the minimum nassets-max_pos assets equal to 0 such that the max_pos number of assets will have non-zero weights. +#' +#' @param weights vector of weights +#' @param max_pos maximum position of assets with non_zero weights +#' @param nassets number of assets +#' @author Ross Bennett +#' @export +txfrm_position_limit_constraint <- function(weights, max_pos, nassets, tolerance=.Machine$double.eps^0.5){ + # account for weights that are very small (less than .Machine$double.eps^0.5) and are basically zero + # check if max_pos is violated + if(sum(abs(weights) > tolerance) > max_pos){ + # set the minimum nassets-max_pos weights equal to 0 + weights[head(order(weights), nassets - max_pos)] <- 0 + } + return(weights) +} + # library(PortfolioAnalytics) # data(edhec) # ret <- edhec[, 1:4] From noreply at r-forge.r-project.org Tue Jul 2 06:07:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 06:07:16 +0200 (CEST) Subject: [Returnanalytics-commits] r2486 - pkg/PortfolioAnalytics/R Message-ID: <20130702040716.BAD4B183EEB@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-02 06:07:16 +0200 (Tue, 02 Jul 2013) New Revision: 2486 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: changing max.pos to max_pos to be consistent with naming e.g., min_sum, max_sum, etc. Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-02 04:04:06 UTC (rev 2485) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-02 04:07:16 UTC (rev 2486) @@ -631,7 +631,7 @@ #' Allows the user to specify the maximum number of positions (i.e. number of assets with non-zero weights) #' #' @param type character type of the constraint -#' @param max.pos maximum number of positions +#' @param max_pos maximum number of positions #' @param enabled TRUE/FALSE #' @param \dots any other passthru parameters to specify box and/or group constraints #' @author Ross Bennett @@ -641,11 +641,11 @@ #' #' pspec <- portfolio.spec(assets=colnames(ret)) #' -#' pspec <- add.constraint(portfolio=pspec, type="position_limit", max.pos=3) +#' pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3) #' @export -position_limit_constraint <- function(type, max.pos, enabled=FALSE, ...){ +position_limit_constraint <- function(type, max_pos, enabled=FALSE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="position_limit_constraint", ...) - Constraint$max.pos <- max.pos + Constraint$max_pos <- max_pos return(Constraint) } From noreply at r-forge.r-project.org Tue Jul 2 13:33:19 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 13:33:19 +0200 (CEST) Subject: [Returnanalytics-commits] r2487 - in pkg/Meucci: . R data demo man Message-ID: <20130702113319.8099B18473E@r-forge.r-project.org> Author: xavierv Date: 2013-07-02 13:33:19 +0200 (Tue, 02 Jul 2013) New Revision: 2487 Added: pkg/Meucci/R/SimulateJumpDiffusionMerton.R pkg/Meucci/data/bondAttribution.Rda pkg/Meucci/data/fixedIncome.Rda pkg/Meucci/data/linearModel.Rda pkg/Meucci/data/swap2y4y.Rda pkg/Meucci/data/swapParRates.Rda pkg/Meucci/data/swaps.Rda pkg/Meucci/demo/S_FixedIncomeInvariants.R pkg/Meucci/demo/S_HorizonEffect.R pkg/Meucci/demo/S_JumpDiffusionMerton.R pkg/Meucci/man/SimulateJumpDiffusionMerton.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE Log: -added three more demo files, some ported datafiles and a function Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-02 04:07:16 UTC (rev 2486) +++ pkg/Meucci/DESCRIPTION 2013-07-02 11:33:19 UTC (rev 2487) @@ -72,3 +72,4 @@ 'ProjectionStudentT.R' 'TwoDimEllipsoid.R' 'PerformIidAnalysis.R' + 'SimulateJumpDiffusionMerton.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-02 04:07:16 UTC (rev 2486) +++ pkg/Meucci/NAMESPACE 2013-07-02 11:33:19 UTC (rev 2487) @@ -29,6 +29,7 @@ export(RejectOutlier) export(RIEfficientFrontier) export(robustBayesianPortfolioOptimization) +export(SimulateJumpDiffusionMerton) export(std) export(StudentTCopulaPdf) export(subIntervals) Added: pkg/Meucci/R/SimulateJumpDiffusionMerton.R =================================================================== --- pkg/Meucci/R/SimulateJumpDiffusionMerton.R (rev 0) +++ pkg/Meucci/R/SimulateJumpDiffusionMerton.R 2013-07-02 11:33:19 UTC (rev 2487) @@ -0,0 +1,70 @@ + +#' This function simulates a jump diffusion process, as described in A. Meucci "Risk and Asset Allocation", +#' Springer, 2005 +#' +#' @param m : [scalar] deterministic drift of diffusion +#' @param s : [scalar] standard deviation of diffusion +#' @param l : [scalar] Poisson process arrival rate +#' @param a : [scalar] drift of log-jump +#' @param D : [scalar] st.dev of log-jump +#' @param ts : [vector] time steps +#' @param J : [scalar] number of simulations +#' +#' @return X : [matrix] (J x length(ts)) of simulations +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "SimulateJumpDiffusionMerton.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +SimulateJumpDiffusionMerton = function( m, s, l, a, D, ts, J ) +{ + L = length(ts); + T = ts[ L ]; + + # simulate number of jumps; + N = rpois( J, l * T ); + + Jumps = matrix( 0, J, L ); + for( j in 1 : J ) + { + # simulate jump arrival time + t = T * rnorm(N[ j ]); + t = sort(t); + + # simulate jump size + S = a + D * rnorm(N[ j ]); + + # put things together + CumS = cumsum(S); + Jumps_ts = matrix( 0, 1, L); + for( n in 1 : L ) + { + Events = sum( t <= ts[ n ]); + if( Events ) + { + Jumps_ts[ n ] = CumS[ Events ]; + } + } + + Jumps[ j, ] = Jumps_ts; + } + + D_Diff = matrix( NaN, J, L ); + for( l in 1 : L ) + { + Dt = ts[ l ]; + if( l > 1 ) + { + Dt = ts[ l ] - ts[ l - 1 ]; + } + + D_Diff[ , l ] = m * Dt + s * sqrt(Dt) * rnorm(J); + } + + X = cbind( matrix(0, J, 1), apply(D_Diff, 2, cumsum) + Jumps ); + + return( X ); +} \ No newline at end of file Added: pkg/Meucci/data/bondAttribution.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/bondAttribution.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/data/fixedIncome.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/fixedIncome.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/data/linearModel.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/linearModel.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/data/swap2y4y.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/swap2y4y.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/data/swapParRates.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/swapParRates.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/data/swaps.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/swaps.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/demo/S_FixedIncomeInvariants.R =================================================================== --- pkg/Meucci/demo/S_FixedIncomeInvariants.R (rev 0) +++ pkg/Meucci/demo/S_FixedIncomeInvariants.R 2013-07-02 11:33:19 UTC (rev 2487) @@ -0,0 +1,29 @@ +#' This file performs the quest for invariance in the fixed income market, as described in A. Meucci +#' "Risk and Asset Allocation", Springer, 2005, Chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_FixedIncomeInvariants.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Load government yield curve and bond yield data for different dates +load("../data/fixedIncome.Rda"); + +################################################################################################################## +### Pick time-to-maturity for one point on the yield curve +ycMaturityIndex = 4; # 1..6 + +# select the yield time series for a constant time-to-maturity +yield = fixedIncome$ycYieldPercent[ , ycMaturityIndex ]; + +################################################################################################################## +### Quest for invariance +# changes in the yield curve +X = yield[ -1 ] - yield[ -length( yield ) ]; +PerformIidAnalysis( 1:length( X ), X, "Changes in yield curve" ); + +# changes in the logarithm of the yield curve +Y = log( yield[ -1 ] ) - log( yield[ -length( yield ) ] ); +PerformIidAnalysis( 1 : length( Y ), Y, "Changes in log of yield curve" ); Added: pkg/Meucci/demo/S_HorizonEffect.R =================================================================== --- pkg/Meucci/demo/S_HorizonEffect.R (rev 0) +++ pkg/Meucci/demo/S_HorizonEffect.R 2013-07-02 11:33:19 UTC (rev 2487) @@ -0,0 +1,98 @@ + +#'This script studies horizon effect on explicit factors / implicit loadings linear model, as described in +#'A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 3. +#'Compounded returns follow the linear model X = tau*muX + D*F + epsilon, where +#' tau: investment horizon (in weeks) +#' muX: expected weekly compounded returns +#' F: factor compounded returns, with zero expectation and tau-proportional covariance +#' D: matrix of factor loadings +#' epsilon: uncorrelated (idiosyncratic) shocks. +#' R = exp(X)-1 and Z = exp(F)-1 are the linear returns +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_HorizonEffect.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +# Load parameters of the model: D, muX, sigmaF, sigmaEps +load( "../data/DB_LinearModel.mat" ); + +# Specify range of investment horizon, weeks +tauRangeWeeks = 1:52; + +# constants + +N = nrow(linearModel$D); +K = ncol(linearModel$D); + +ntauRangeWeeks = length(tauRangeWeeks); +aMinusTauMuX = matrix(0, ntauRangeWeeks); +normDminusB = matrix(0, ntauRangeWeeks); +minCorrU = matrix(0, ntauRangeWeeks); +meanCorrU = matrix(0, ntauRangeWeeks); +maxCorrU = matrix(0, ntauRangeWeeks); + +for( i in 1 : ntauRangeWeeks ) +{ + tau = tauRangeWeeks[ i ]; + + # statitics of linear returns (analytically) + # let Y = [1+R; 1+Z] ~ LogN(mu*tau, covJointXF*tau) + mu = rbind(linearModel$muX, matrix(0, K)); + # covariance of [X; F] for tau=1: + covJointXF = rbind( + cbind( linearModel$D %*% linearModel$sigmaF %*% t(linearModel$D) + linearModel$sigmaEps, + linearModel$D %*% linearModel$sigmaF ), + cbind( linearModel$sigmaF %*% t( linearModel$D ), linearModel$sigmaF) + ); + E_Y = exp( mu * tau + diag( covJointXF * tau ) / 2 ); + E_YY = (E_Y %*% t( E_Y )) * exp( covJointXF * tau ); + E_R = E_Y[ 1 : N ] - matrix( 1, N ); + E_Z = E_Y[ -(1:N)] - matrix( 1, K); + E_RR = E_YY[ 1:N , 1:N ] - matrix( 1, N ) %*% t(E_R) - E_R %*% matrix( 1, 1, N ) - matrix( 1, N, N ); + E_ZZ = E_YY[-(1:N), -(1:N) ] - matrix( 1, K ) %*% t(E_Z) - E_Z %*% matrix( 1, 1, K ) - matrix( 1, K, K ); + E_RZ = E_YY[ 1:N, -(1:N) ] - matrix( 1, N ) %*% t(E_Z) - E_R %*% matrix( 1, 1, K) - matrix( 1, N, K ); + SigmaZ = E_ZZ - E_Z %*% t(E_Z); + SigmaR = E_RR - E_R %*% t(E_R); + SigmaRZ = E_RZ - E_R %*% t(E_Z); + + # compute OLS loadings for the linear return model + B = SigmaRZ %*% solve( SigmaZ ); # right division of SigmaRZ by SigmaZ + a = E_R - B %*% E_Z; + aMinusTauMuX[ i] = norm( a - tau*linearModel$muX, type="2" ); + normDminusB[ i ] = norm( linearModel$D - B, type = "F" ); + + # pairwise correlations of U + SigmaU = SigmaR - B %*% t( SigmaRZ ); + corrU = cov2cor(SigmaU); + stackedCorrU = as.array(corrU); + minCorrU[ i ] = min(min(abs(corrU))); + meanCorrU[ i ] = ( N * mean( mean( abs( corrU) ) ) - 1 ) / ( N - 1 ); + corrU[ seq(1, N * N, (N+1) ) ] = 0; + maxCorrU[ i ] = max( max( abs( corrU) ) ); +} + +################################################################################################################## +### Plots +# relationship between the constant nd the intercept +dev.new(); +plot(tauRangeWeeks, aMinusTauMuX, type= "l", xlab = expression(paste("investment horizon, ", tau,", weeks")), + main = expression( paste( "norm of ( a - ", tau,mu[X],")"^t ))); + +# relationship between the loadings D in and the loadings B +dev.new(); +plot(tauRangeWeeks, normDminusB, type = "l", xlab = expression(paste("investment horizon, ", tau,", weeks")), main = expression("norm of (D-B)"^t)); + + + +# determine if U idiosyncratic +dev.new(); +plot(tauRangeWeeks, maxCorrU, col = "red", type = "l", xlab = expression(paste("investment horizon, ", tau,", weeks")), + ylab = "", main = "pairwise correlations of elements of U" ); +lines(tauRangeWeeks, meanCorrU, col = "blue"); +lines(tauRangeWeeks, minCorrU, col = "green"); +legend( "topleft", 1.9, c( "max absolute corr", "mean absolute corr", "min absolute corr" ), col = c( "red","blue", "green" ), + lty=1, bg = "gray90" ); +} \ No newline at end of file Added: pkg/Meucci/demo/S_JumpDiffusionMerton.R =================================================================== --- pkg/Meucci/demo/S_JumpDiffusionMerton.R (rev 0) +++ pkg/Meucci/demo/S_JumpDiffusionMerton.R 2013-07-02 11:33:19 UTC (rev 2487) @@ -0,0 +1,26 @@ +#'This script simulates a jump-diffusion process, as described in A. Meucci, "Risk and Asset Allocation", +#' Springer, 2005, Chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_JumoDiffusionMerton.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Parameters +ts = seq( 1/252, 1, 1/252); # grid of time values at which the process is evaluated ("0" will be added, too) +J = 10; # number of simulations + +################################################################################################################## +### Simulate processes + +mu = 0.00; # deterministic drift +sig = 0.20; # Gaussian component + +l = 3.45; # Poisson process arrival rate +a = 0; # drift of log-jump +D = 0.2; # st.dev of log-jump + +X = SimulateJumpDiffusionMerton( mu, sig, l, a, D, ts, J ); +matplot(c( 0, ts), t(X), type="l", xlab = "time", main = "Merton jump-diffusion"); Added: pkg/Meucci/man/SimulateJumpDiffusionMerton.Rd =================================================================== --- pkg/Meucci/man/SimulateJumpDiffusionMerton.Rd (rev 0) +++ pkg/Meucci/man/SimulateJumpDiffusionMerton.Rd 2013-07-02 11:33:19 UTC (rev 2487) @@ -0,0 +1,38 @@ +\name{SimulateJumpDiffusionMerton} +\alias{SimulateJumpDiffusionMerton} +\title{This function simulates a jump diffusion process, as described in A. Meucci "Risk and Asset Allocation", +Springer, 2005} +\usage{ + SimulateJumpDiffusionMerton(m, s, l, a, D, ts, J) +} +\arguments{ + \item{m}{: [scalar] deterministic drift of diffusion} + + \item{s}{: [scalar] standard deviation of diffusion} + + \item{l}{: [scalar] Poisson process arrival rate} + + \item{a}{: [scalar] drift of log-jump} + + \item{D}{: [scalar] st.dev of log-jump} + + \item{ts}{: [vector] time steps} + + \item{J}{: [scalar] number of simulations} +} +\value{ + X : [matrix] (J x length(ts)) of simulations +} +\description{ + This function simulates a jump diffusion process, as + described in A. Meucci "Risk and Asset Allocation", + Springer, 2005 +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "SimulateJumpDiffusionMerton.m" +} + From noreply at r-forge.r-project.org Tue Jul 2 13:37:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 13:37:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2488 - in pkg/PortfolioAnalytics: . R man sandbox Message-ID: <20130702113746.09E3118473E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-02 13:37:45 +0200 (Tue, 02 Jul 2013) New Revision: 2488 Added: pkg/PortfolioAnalytics/man/txfrm_position_limit_constraint.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/man/diversification_constraint.Rd pkg/PortfolioAnalytics/man/position_limit_constraint.Rd pkg/PortfolioAnalytics/man/turnover_constraint.Rd pkg/PortfolioAnalytics/man/volatility_constraint.Rd pkg/PortfolioAnalytics/sandbox/constraints_vignette.Rnw pkg/PortfolioAnalytics/sandbox/constraints_vignette.pdf Log: changing div.target to div_target and turnover.target to turnover_target to be consistent with naming e.g. min_sum, max_sum, etc.. updating documentation Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-02 11:37:45 UTC (rev 2488) @@ -53,6 +53,7 @@ export(turnover_objective) export(txfrm_box_constraint) export(txfrm_group_constraint) +export(txfrm_position_limit_constraint) export(txfrm_weight_sum_constraint) export(update.constraint) export(volatility_constraint) Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-02 11:37:45 UTC (rev 2488) @@ -565,7 +565,7 @@ #' variance problem with ROI quadprog plugin #' #' @param type character type of the constraint -#' @param turnover.target target turnover value +#' @param turnover_target target turnover value #' @param enabled TRUE/FALSE #' @param \dots any other passthru parameters to specify box and/or group constraints #' @author Ross Bennett @@ -575,11 +575,11 @@ #' #' pspec <- portfolio.spec(assets=colnames(ret)) #' -#' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover.target=0.6) +#' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) #' @export -turnover_constraint <- function(type, turnover.target, enabled=FALSE, ...){ +turnover_constraint <- function(type, turnover_target, enabled=FALSE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="turnover_constraint", ...) - Constraint$toc <- turnover.target + Constraint$turnover_target <- turnover_target return(Constraint) } @@ -588,7 +588,7 @@ #' This function is called by add.constraint when type="diversification" is specified, \code{\link{add.constraint}} #' #' @param type character type of the constraint -#' @param div.target diversification target value +#' @param div_target diversification target value #' @param enabled TRUE/FALSE #' @param \dots any other passthru parameters to specify box and/or group constraints #' @author Ross Bennett @@ -598,11 +598,11 @@ #' #' pspec <- portfolio.spec(assets=colnames(ret)) #' -#' pspec <- add.constraint(portfolio=pspec, type="diversification", div.target=0.7) +#' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) #' @export -diversification_constraint <- function(type, div.target, enabled=FALSE, ...){ +diversification_constraint <- function(type, div_target, enabled=FALSE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...) - Constraint$div <- div.target + Constraint$div_target <- div_target return(Constraint) } @@ -612,16 +612,16 @@ #' Penalize if portfolio standard deviation deviates from volatility target #' #' @param type character type of the constraint -#' @param vol.target target volatilty constraint +#' @param vol_target target volatilty constraint #' @param enabled TRUE/FALSE #' @param \dots any other passthru parameters to specify box and/or group constraints #' @author Ross Bennett #' @export -volatility_constraint <- function(type, vol.target, enabled=FALSE, ...){ +volatility_constraint <- function(type, vol_target, enabled=FALSE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="volatility_constraint", ...) # Constraint$min.vol <- min.vol # Constraint$max.vol <- max.vol - Constraint$vol.target <- vol.target + Constraint$vol_target <- vol_target return(Constraint) } Modified: pkg/PortfolioAnalytics/man/diversification_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-02 11:37:45 UTC (rev 2488) @@ -2,13 +2,13 @@ \alias{diversification_constraint} \title{constructor for diversification_constraint} \usage{ - diversification_constraint(type, div.target, + diversification_constraint(type, div_target, enabled = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} - \item{div.target}{diversification target value} + \item{div_target}{diversification target value} \item{enabled}{TRUE/FALSE} @@ -26,7 +26,7 @@ pspec <- portfolio.spec(assets=colnames(ret)) -pspec <- add.constraint(portfolio=pspec, type="diversification", div.target=0.7) +pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) } \author{ Ross Bennett Modified: pkg/PortfolioAnalytics/man/position_limit_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-02 11:37:45 UTC (rev 2488) @@ -2,13 +2,13 @@ \alias{position_limit_constraint} \title{constructor for position_limit_constraint} \usage{ - position_limit_constraint(type, max.pos, enabled = FALSE, + position_limit_constraint(type, max_pos, enabled = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} - \item{max.pos}{maximum number of positions} + \item{max_pos}{maximum number of positions} \item{enabled}{TRUE/FALSE} @@ -28,7 +28,7 @@ pspec <- portfolio.spec(assets=colnames(ret)) -pspec <- add.constraint(portfolio=pspec, type="position_limit", max.pos=3) +pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3) } \author{ Ross Bennett #' Modified: pkg/PortfolioAnalytics/man/turnover_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-02 11:37:45 UTC (rev 2488) @@ -2,13 +2,13 @@ \alias{turnover_constraint} \title{constructor for turnover_constraint} \usage{ - turnover_constraint(type, turnover.target, + turnover_constraint(type, turnover_target, enabled = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} - \item{turnover.target}{target turnover value} + \item{turnover_target}{target turnover value} \item{enabled}{TRUE/FALSE} @@ -32,7 +32,7 @@ pspec <- portfolio.spec(assets=colnames(ret)) -pspec <- add.constraint(portfolio=pspec, type="turnover", turnover.target=0.6) +pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) } \author{ Ross Bennett Added: pkg/PortfolioAnalytics/man/txfrm_position_limit_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/txfrm_position_limit_constraint.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/txfrm_position_limit_constraint.Rd 2013-07-02 11:37:45 UTC (rev 2488) @@ -0,0 +1,26 @@ +\name{txfrm_position_limit_constraint} +\alias{txfrm_position_limit_constraint} +\title{Transform weights for position_limit constraints} +\usage{ + txfrm_position_limit_constraint(weights, max_pos, + nassets, tolerance = .Machine$double.eps^0.5) +} +\arguments{ + \item{weights}{vector of weights} + + \item{max_pos}{maximum position of assets with non_zero + weights} + + \item{nassets}{number of assets} +} +\description{ + This is a helper function called inside constraint_fnMap + to transform the weights vector to satisfy position_limit + constraints. This function sets the minimum + nassets-max_pos assets equal to 0 such that the max_pos + number of assets will have non-zero weights. +} +\author{ + Ross Bennett +} + Modified: pkg/PortfolioAnalytics/man/volatility_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/volatility_constraint.Rd 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/man/volatility_constraint.Rd 2013-07-02 11:37:45 UTC (rev 2488) @@ -2,13 +2,13 @@ \alias{volatility_constraint} \title{constructor for volatility_constraint} \usage{ - volatility_constraint(type, vol.target, enabled = FALSE, + volatility_constraint(type, vol_target, enabled = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} - \item{vol.target}{target volatilty constraint} + \item{vol_target}{target volatilty constraint} \item{enabled}{TRUE/FALSE} Modified: pkg/PortfolioAnalytics/sandbox/constraints_vignette.Rnw =================================================================== --- pkg/PortfolioAnalytics/sandbox/constraints_vignette.Rnw 2013-07-02 11:33:19 UTC (rev 2487) +++ pkg/PortfolioAnalytics/sandbox/constraints_vignette.Rnw 2013-07-02 11:37:45 UTC (rev 2488) @@ -24,10 +24,10 @@ \item[weight\_sum] The weight\_sum constraint is used to constrain the sum of weights. Common use cases of this are to apply a full investment, dollar neutral, or leverage constraint. \item[box] Box constraints are used to constrain the minimum and maximum weights of assets. Standard box constraints with a single upper bound and single lower bound as well as per asset inequality constraints on weights can be specified. A special case of box constraints is a long only constraint where the minimum weight is 0 and maximum weight is 1. \item[group] Group constraints are used to specify the minimum and maximum weights of groups of assets. A common use case to group assets by market cap or style. Note that group constraints is only implemented for the ROI solvers. Implementing the group constraints for other solvers should be possible in \code{constrained\_objective} using the \code{constrained\_group\_tmp} function. - \item[turnover] Turnover can be specified as a constraint, but is not currently implemented in any solvers. Turnover constraint may not be able to be implemented in the ROI glpk solver. It is implemented for the ROI quadprog solver in sandbox/testing\_turnover.gmv.R. Currently, turnover can be implemented as an objective function and the function has been added to the file \code{R/objectiveFUN.R}. The user can specify a turnover target \code{turnover.target}. Any deviation from the target will be penalized. - \item[diversification] Diversification can be specified as a constraint, but is not currently implemented in any solvers. This can be done in the mapping function in the next part or implemented inside \code{constrained\_objective}. The user can specify a diversification target value \code{div.target}. Any deviation from the target will be penalized. - \item[volatility] Volatility can be specified as a constraint, but it is not currently implemented for any solvers. This can be done in the mapping function in the next part or implemented inside \code{constrained\_objective}. See \code{constrained\_objective} for how volatility is handled as an objective. The user can specify a volatility target value \code{vol.target}. Any deviation from the target will be penalized. - \item[position\_limit] Integer constraint for max position cardinality constraint. This may be able to be implemented in \code{randomize\_portfolio} by generating portfolios with the number of non-zero weights equal to \code{max.pos}, then fill in weights of zero so the length of the weights vector is equal to the number of assets, then scramble the weights vector. The number of non-zero weights could also be random so that the number of non-zero weights is not always equal to \code{max.pos}. This could be implemented in the DEoptim solver with the mapping function. This might be do-able in Rglpk for max return and min ETL. Rglpk supports mixed integer types, but solve.QP does not. May be able to use branch-and-bound technique using solve.QP. + \item[turnover] Turnover can be specified as a constraint, but is not currently implemented in any solvers. Turnover constraint may not be able to be implemented in the ROI glpk solver. It is implemented for the ROI quadprog solver in sandbox/testing\_turnover.gmv.R. Currently, turnover can be implemented as an objective function and the function has been added to the file \code{R/objectiveFUN.R}. The user can specify a turnover target \code{turnover\_target}. Any deviation from the target will be penalized. + \item[diversification] Diversification can be specified as a constraint, but is not currently implemented in any solvers. This can be done in the mapping function in the next part or implemented inside \code{constrained\_objective}. The user can specify a diversification target value \code{div\_target}. Any deviation from the target will be penalized. + \item[volatility] Volatility can be specified as a constraint, but it is not currently implemented for any solvers. This can be done in the mapping function in the next part or implemented inside \code{constrained\_objective}. See \code{constrained\_objective} for how volatility is handled as an objective. The user can specify a volatility target value \code{vol\_target}. Any deviation from the target will be penalized. + \item[position\_limit] Integer constraint for max position cardinality constraint. This may be able to be implemented in \code{randomize\_portfolio} by generating portfolios with the number of non-zero weights equal to \code{max\_pos}, then fill in weights of zero so the length of the weights vector is equal to the number of assets, then scramble the weights vector. The number of non-zero weights could also be random so that the number of non-zero weights is not always equal to \code{max\_pos}. This could be implemented in the DEoptim solver with the mapping function. This might be do-able in Rglpk for max return and min ETL. Rglpk supports mixed integer types, but solve.QP does not. May be able to use branch-and-bound technique using solve.QP. \end{itemize} Constraint TODO @@ -92,29 +92,29 @@ pspec$constraints[[3]] @ -Add turnover constraint. Any deviation from \code{turnover.target} is penalized. +Add turnover constraint. Any deviation from \code{turnover\_target} is penalized. <<>>= pspec <- add.constraint(portfolio=pspec, type="turnover", - turnover.target=0.6, + turnover_target=0.6, enabled=TRUE) pspec$constraints[[4]] @ -Add diversification constraint. Any deviation from \code{div.target} will be penalized. +Add diversification constraint. Any deviation from \code{div\_target} will be penalized. <<>>= pspec <- add.constraint(portfolio=pspec, type="diversification", - div.target=0.7, + div_target=0.7, enabled=TRUE) pspec$constraints[[5]] @ -Add volatility constraint. Any deviation from \code{vol.target} will be penalized. +Add volatility constraint. Any deviation from \code{vol\_target} will be penalized. <<>>= pspec <- add.constraint(portfolio=pspec, type="volatility", - vol.target=0.035, + vol_target=0.035, enabled=TRUE) pspec$constraints[[6]] @ @@ -123,7 +123,7 @@ <<>>= pspec <- add.constraint(portfolio=pspec, type="position_limit", - max.pos=3, + max_pos=3, enabled=TRUE) pspec$constraints[[7]] @ Modified: pkg/PortfolioAnalytics/sandbox/constraints_vignette.pdf =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Tue Jul 2 19:06:55 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 19:06:55 +0200 (CEST) Subject: [Returnanalytics-commits] r2489 - in pkg/PerformanceAnalytics/sandbox/pulkit: . week2/code week3 week3/code Message-ID: <20130702170655.7E41C18475B@r-forge.r-project.org> Author: pulkit Date: 2013-07-02 19:06:54 +0200 (Tue, 02 Jul 2013) New Revision: 2489 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/tests/ pkg/PerformanceAnalytics/sandbox/pulkit/week3/vignette/ Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R Log: Added code for Triple Penance Rule Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-02 11:37:45 UTC (rev 2488) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-02 17:06:54 UTC (rev 2489) @@ -23,10 +23,7 @@ rho = seq(0,1,length.out=30) SR_B = avgSR*sqrt(columns/(1+(columns-1)*rho)) - df1<-data.frame(x=rho,y=SR_B) - df1$model<-"A" - df2<-data.frame(x=corr_avg[1,1],y=BenchmanrkSR(R)) - df2$model<-"B" - dfc<-rbind(df1,df2) - ggplot(dfc,aes(x,y,group=model)) +geom_point()+geom_line()+xlab("Correlation")+ylab("Benchmark Sharpe Ratio")+ggtitle("Benchmark SR vs Correlation") -} + plot(rho,SR_B,type="l",xlab="Correlation",ylab="Benchmark Sharpe Ratio",main="Benchmark Sharpe Ratio vs Correlation") + points(corr_avg[1,1],BenchmarkSR(R),col="blue",pch=10) + text(corr_avg[1,1],BenchmarkSR(R),"Original Point",pos=4) +} \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-02 11:37:45 UTC (rev 2488) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-02 17:06:54 UTC (rev 2489) @@ -25,7 +25,7 @@ #' #'@export #' -BenchmanrkSR<-function(R){ +BenchmarkSR<-function(R){ x = checkData(R) columns = ncol(x) #TODO : What to do if the number of columns is only one ? @@ -42,6 +42,6 @@ } } corr_avg = corr_avg*2/(columns*(columns-1)) - SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1))*corr_avg[1,1]) + SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg[1,1])) return(SR_Benchmark) } \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R 2013-07-02 17:06:54 UTC (rev 2489) @@ -0,0 +1,227 @@ +library(PerformanceAnalytics) +data(edhec) +#' @title +#' Triple Penance Rule +#' +#' @description +#' \code{TriplePenance} calculates the Maximum drawdown and the maximum +#' Time under water for a particular confidence interval. These concepts +#' are intenately related through the "triple penance" rule which states +#' that under standard portfolio theory assumptions, it takes three times +#' longer to recover from the expected maximum drawdown than the time it +#' takes to produce it, with the same confidence level. The framework is +#' generalized to deal with the case of first-order auto-correlated cashflows +#' +#' @param R Hedge Fund log Returns +#' +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + +TriplePenance<-function(R,confidence,...) +{ + x = checkData(R) + columns = ncol(x) + i = 0 + tp = data.frame() + d = data.frame() + for(i in 1:columns){ + column_MinQ <- get_minq(x[,i],confidence) + column_TuW = get_TuW(x[,i],confidence) + tp <- rbind(tp,c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW)) + } + table.TriplePenance(R,tp) + #return(tp) +} +get_minq<-function(R,confidence){ + + # DESCRIPTION: + # A function to get the maximum drawdown for first order serially autocorrelated + # returns from the quantile function defined for accumulated returns for a + # particular confidence interval + + # Inputs: + # R: The function takes Returns as the input + # + # confidence: The confidence interval of the input. + x = checkData(R) + mu = mean(x, na.rm = TRUE) + sigma_infinity = StdDev(x) + phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) + sigma = sigma_infinity*((1-phi^2)^0.5) + dp0 = 0 + q_value = 0 + bets = 0 + while(q_value <= 0){ + bets = bets + 1 + q_value = getQ(bets, phi, mu, sigma, dp0, confidence) + } + minQ = golden_section(x,0,bets,TRUE,getQ,confidence) + return(c(mu,sigma_infinity,phi,sigma,-minQ$minQ*100,minQ$t)) +} + + +getQ<-function(bets,phi,mu,sigma,dp0,confidence){ + + # DESCRIPTION: + # A function to get the quantile function for cumulative returns + # and a particular confidence interval. + + # Inputs: + # bets: The number fo steps + # + # phi: The coefficient for AR[1] + # + # mu: The mean of the returns + # + # sigma: The standard deviation of the returns + # + # dp0: The r0 or the first return + # + # confidence: The confidence level of the quantile function + mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets + var = sigma^2/(phi-1)^2 + var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1) + q_value = mu_new + qnorm(1-confidence)*(var^0.5) + return(q_value) +} + + +get_TuW<-function(R,confidence){ + + # DESCRIPTION: + # A function to generate the time under water + # + # Inputs: + # R: The function takes Returns as the input. + # + # confidence: Confidence level of the quantile function + + + x = checkData(R) + mu = mean(x, na.rm = TRUE) + sigma_infinity = StdDev(x) + phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) + sigma = sigma_infinity*((1-phi^2)^0.5) + + dp0 = 0 + q_value = 0 + bets = 0 + while(q_value <= 0){ + bets = bets + 1 + q_value = getQ(bets, phi, mu, sigma, dp0, confidence) + } + TuW = golden_section(x,bets-1,bets,TRUE,diff,confidence) + return(TuW$t) +} + +diff<-function(bets,phi,mu,sigma,dp0,confidence){ + return(abs(getQ(bets,phi,mu,sigma,dp0,confidence))) +} + +golden_section<-function(R,a,b,minimum = TRUE,function_name,confidence,...){ + + # DESCRIPTION + # A function to perform the golden search algorithm on the provided function + + # Inputs: + # R: Return series + # + # a: The starting point + # + # b: The end point + # + # minimum: If we want to calculate the minimum set minimum= TRUE(default) + # + # function_name: The name of the function + + x = checkData(R) + mu = mean(x, na.rm = TRUE) + sigma_infinity = StdDev(x) + phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) + sigma = sigma_infinity*((1-phi^2)^0.5) + + dp0 = 0 + FUN = match.fun(function_name) + tol = 10^-9 + sign = 1 + + if(!minimum){ + sign = -1 + } + N = round(ceiling(-2.078087*log(tol/abs(b-a)))) + r = 0.618033989 + c = 1.0 - r + x1 = r*a + c*b + x2 = c*a + r*b + f1 = sign * FUN(x1,phi,mu,sigma,dp0,confidence) + f2 = sign * FUN(x2,phi,mu,sigma,dp0,confidence) + for(i in 1:N){ + if(f1>f2){ + a = x1 + x1 = x2 + f1 = f2 + x2 = c*a+r*b + f2 = sign*FUN(x2,phi,mu,sigma,dp0,confidence) + } + else{ + b = x2 + x2 = x1 + f2 = f1 + x1 = r*a + c*b + f1 = sign*FUN(x1,phi,mu,sigma,dp0,confidence) + } + } + if(f1 Author: shubhanm Date: 2013-07-02 23:37:18 +0200 (Tue, 02 Jul 2013) New Revision: 2490 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R Log: Code for table of Unsmooth Returns (Getmansky, et. al. (2004) table A.4) Stage: Debugging Showing errors for columns > 1 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R 2013-07-02 21:37:18 UTC (rev 2490) @@ -0,0 +1,81 @@ +#' Compenent Decomposition of Table of Unsmooth Returns +#' +#' Creates a table of estimates of moving averages for comparison across +#' multiple instruments or funds as well as their standard error and +#' smoothing index +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param ci confidence interval, defaults to 95\% +#' @param n number of series lags +#' @param p confidence level for calculation, default p=.99 +#' @param digits number of digits to round results to +#' @author R +#' @keywords ts smooth return models +#' +#' @export +table.UnsmoothReturn <- + function (R, n = 3, p= 0.95, digits = 4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # n : Number of lags + # p = Confifence Level + # Output: + # A table of estimates of Moving Average + + y = checkData(R, method = "zoo") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + # for each column, do the following: + for(column in 1:columns) { + x = na.omit(y[,column,drop=FALSE]) + + z = c( + arma(x,0,2)$theta[1], + arma(x,0,2)$se.theta[1], + arma(x,0,2)$theta[2], + arma(x,0,2)$se.theta[2], + (arma(x,0,2)$theta*arma(x,0,2)$theta) + ) + znames = c( + "Moving Average(1)", + "Std Error of MA(1)", + "Moving Average(2)", + "Std Error of MA(2)", + "Smoothing Invest" + + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + +} + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: table.UnSmoothReturn.R +# +############################################################################### From noreply at r-forge.r-project.org Wed Jul 3 00:52:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 3 Jul 2013 00:52:25 +0200 (CEST) Subject: [Returnanalytics-commits] r2491 - pkg/PerformanceAnalytics/sandbox/Shubhankit Message-ID: <20130702225225.6C39F185327@r-forge.r-project.org> Author: shubhanm Date: 2013-07-03 00:52:25 +0200 (Wed, 03 Jul 2013) New Revision: 2491 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R Log: Code for calculation of Unsmooth Returns Table Decomposition using Maximum Likelihood Estimator Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R 2013-07-02 22:52:25 UTC (rev 2491) @@ -0,0 +1,79 @@ +#' Compenent Decomposition of Table of Unsmooth Returns +#' +#' Creates a table of estimates of moving averages for comparison across +#' multiple instruments or funds as well as their standard error and +#' smoothing index +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param ci confidence interval, defaults to 95\% +#' @param n number of series lags +#' @param p confidence level for calculation, default p=.99 +#' @param digits number of digits to round results to +#' @author R +#' @keywords ts smooth return models +#' +#' @export +table.UnsmoothReturn <- + function (R, n = 3, p= 0.95, digits = 4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # n : Number of lags + # p = Confifence Level + # Output: + # A table of estimates of Moving Average + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + + z = c(arma(x,0,2)$theta[1], + arma(x,0,2)$se.theta[1], + arma(x,0,2)$theta[2], + arma(x,0,2)$se.theta[2], + arma(x,0,2)$se.theta[2]) + znames = c( + "Moving Average(1)", + "Std Error of MA(1)", + "Moving Average(2)", + "Std Error of MA(2)", + "Smoothing Invest" + + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + +} + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: table.UnSmoothReturn.R +# +############################################################################### From noreply at r-forge.r-project.org Wed Jul 3 03:44:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 3 Jul 2013 03:44:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2492 - pkg/PortfolioAnalytics/R Message-ID: <20130703014431.D745A185805@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-03 03:44:29 +0200 (Wed, 03 Jul 2013) New Revision: 2492 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: adding rp_transform function that transforms a vector to satisfy min_sum/max_sum constraints and min/max box constraints using randomize_portfolio logic Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-02 22:52:25 UTC (rev 2491) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-03 01:44:29 UTC (rev 2492) @@ -196,6 +196,114 @@ return(weights) } +#' Transform a weights vector to min_sum/max_sum leverage and min/max box constraints using logic from randomize_portfolio +#' +#' This function uses a block of code from \link{\code{randomize_portfolio}} +#' to transform the weight vector if either the weight_sum (leverage) +#' constraints or box constraints are violated. +#' The resulting weights vector might be quite different from the original weights vector. +#' +#' @param w weights vector to be transformed +#' @param min_sum minimum sum of all asset weights, default 0.99 +#' @param max_sum maximum sum of all asset weights, default 1.01 +#' @param min numeric or named vector specifying minimum weight box constraints +#' @param max numeric or named vector specifying maximum weight box constraints +#' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200 +#' @return named weighting vector +#' @author Peter Carl, Brian G. Peterson, Ross Bennett (based on an idea by Pat Burns) +#' @export +rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, max_permutations=200){ + # Uses logic from randomize_portfolio to "normalize" a weights vector to + # satisfy min_sum and max_sum while account for min and max box constraints + # Modified from randomize_portfolio to trigger the while loops if any weights + # violate min or max box constraints. A weights vector would not be transformed + # in randomize_portfolio if min_sum and max_sum were satisfied, but the + # min/max constraints were violated. + + # generate a sequence of weights based on min/max box constraints + weight_seq <- generatesequence(min=min(min), max=max(max), by=0.005) + + # start the permutations counter + permutations <- 1 + + # create a temporary weights vector that will be modified in the while loops + tmp_w <- w + + # while portfolio is outside min_sum/max_sum or min/max and we have not reached max_permutations + while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max)) & permutations <= max_permutations) { + permutations = permutations + 1 + # check our box constraints on total portfolio weight + # reduce(increase) total portfolio size till you get a match + # 1> check to see which bound you've failed on, brobably set this as a pair of while loops + # 2> randomly select a column and move only in the direction *towards the bound*, maybe call a function inside a function + # 3> check and repeat + + random_index <- sample(1:length(tmp_w), length(tmp_w)) + i = 1 + # while sum of weights is less than min_sum or min/max box constraint is violated + while ((sum(tmp_w) <= min_sum | any(tmp_w < min) | any(tmp_w > max)) & i <= length(tmp_w)) { + # randomly permute and increase a random portfolio element + cur_index <- random_index[i] + cur_val <- tmp_w[cur_index] + if (length(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])]) > 1) { + # randomly sample an element from weight_seq that is greater than cur_val and less than max + tmp_w[cur_index] <- sample(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])], 1) + # print(paste("new val:",tmp_w[cur_index])) + } else { + if (length(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])]) == 1) { + tmp_w[cur_index] <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])] + } + } + i=i+1 # increment our counter + } # end increase loop + # while sum of weights is greater than max_sum or min/max box constraint is violated + while ((sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max)) & i <= length(tmp_w)) { + # randomly permute and decrease a random portfolio element + cur_index <- random_index[i] + cur_val <- tmp_w[cur_index] + if (length(weight_seq <= cur_val & weight_seq >= min[cur_index] ) > 1) { + # randomly sample an element from weight_seq that is less than cur_val and greater than min + tmp_w[cur_index] <- sample(weight_seq[which(weight_seq <= cur_val & weight_seq >= min[cur_index] )], 1) + } else { + if (length(weight_seq <= cur_val & weight_seq >= min[cur_index] ) == 1) { + tmp_w[cur_index] <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])] + } + } + i=i+1 # increment our counter + } # end decrease loop + } # end final walk towards the edges + + portfolio <- tmp_w + + colnames(portfolio)<-colnames(w) + + # checks for infeasible portfolio + if (sum(portfolio)<=min_sum | sum(portfolio)>=max_sum){ + portfolio <- w + warning("Infeasible portfolio created, defaulting to w, perhaps increase max_permutations.") + } + if(isTRUE(all.equal(w,portfolio))) { + if (sum(w)>=min_sum & sum(w)<=max_sum) { + warning("Unable to generate a feasible portfolio different from w, perhaps adjust your parameters.") + return(w) + } else { + warning("Unable to generate a feasible portfolio, perhaps adjust your parameters.") + return(NULL) + } + } + return(portfolio) +} + +# test +# w <- c(0.1, 0.25, 0.3, 0.15, 0.05, 0.15) +# min <- rep(0.1, length(w)) +# max <- rep(0.45, length(w)) +# w1 <- rp_normalize(w=w, min_sum=0.99, max_sum=1.01, min=min, max=max) +# w1 +# sum(w1) +# any(w1 < min) +# any(w1 > max) + # library(PortfolioAnalytics) # data(edhec) # ret <- edhec[, 1:4] From noreply at r-forge.r-project.org Wed Jul 3 03:55:19 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 3 Jul 2013 03:55:19 +0200 (CEST) Subject: [Returnanalytics-commits] r2493 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130703015520.1A0E8184A37@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-03 03:55:18 +0200 (Wed, 03 Jul 2013) New Revision: 2493 Added: pkg/PortfolioAnalytics/man/rp_transform.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: updating documentation Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-03 01:44:29 UTC (rev 2492) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-03 01:55:18 UTC (rev 2493) @@ -46,6 +46,7 @@ export(randomize_portfolio) export(return_objective) export(risk_budget_objective) +export(rp_transform) export(set.portfolio.moments) export(summary.optimize.portfolio.rebalancing) export(trailingFUN) Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-03 01:44:29 UTC (rev 2492) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-03 01:55:18 UTC (rev 2493) @@ -198,7 +198,7 @@ #' Transform a weights vector to min_sum/max_sum leverage and min/max box constraints using logic from randomize_portfolio #' -#' This function uses a block of code from \link{\code{randomize_portfolio}} +#' This function uses a block of code from \code{\link{randomize_portfolio}} #' to transform the weight vector if either the weight_sum (leverage) #' constraints or box constraints are violated. #' The resulting weights vector might be quite different from the original weights vector. Added: pkg/PortfolioAnalytics/man/rp_transform.Rd =================================================================== --- pkg/PortfolioAnalytics/man/rp_transform.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-03 01:55:18 UTC (rev 2493) @@ -0,0 +1,41 @@ +\name{rp_transform} +\alias{rp_transform} +\title{Transform a weights vector to min_sum/max_sum leverage and min/max box constraints using logic from randomize_portfolio} +\usage{ + rp_transform(w, min_sum = 0.99, max_sum = 1.01, min, max, + max_permutations = 200) +} +\arguments{ + \item{w}{weights vector to be transformed} + + \item{min_sum}{minimum sum of all asset weights, default + 0.99} + + \item{max_sum}{maximum sum of all asset weights, default + 1.01} + + \item{min}{numeric or named vector specifying minimum + weight box constraints} + + \item{max}{numeric or named vector specifying maximum + weight box constraints} + + \item{max_permutations}{integer: maximum number of + iterations to try for a valid portfolio, default 200} +} +\value{ + named weighting vector +} +\description{ + This function uses a block of code from + \code{\link{randomize_portfolio}} to transform the weight + vector if either the weight_sum (leverage) constraints or + box constraints are violated. The resulting weights + vector might be quite different from the original weights + vector. +} +\author{ + Peter Carl, Brian G. Peterson, Ross Bennett (based on an + idea by Pat Burns) +} + From noreply at r-forge.r-project.org Wed Jul 3 08:38:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 3 Jul 2013 08:38:24 +0200 (CEST) Subject: [Returnanalytics-commits] r2494 - in pkg/Meucci: . R demo man Message-ID: <20130703063824.F1AF118346D@r-forge.r-project.org> Author: xavierv Date: 2013-07-03 08:38:24 +0200 (Wed, 03 Jul 2013) New Revision: 2494 Added: pkg/Meucci/R/BlackScholesCallPrice.R pkg/Meucci/R/InterExtrapolate.R pkg/Meucci/demo/S_CallsProjectionPricing.R pkg/Meucci/man/BlackScholesCallPrice.Rd pkg/Meucci/man/InterExtrapolate.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE Log: -added S_CallsProjectionPricing demo script and its associated functions Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-03 01:55:18 UTC (rev 2493) +++ pkg/Meucci/DESCRIPTION 2013-07-03 06:38:24 UTC (rev 2494) @@ -73,3 +73,5 @@ 'TwoDimEllipsoid.R' 'PerformIidAnalysis.R' 'SimulateJumpDiffusionMerton.R' + 'BlackScholesCallPrice.R' + 'InterExtrapolate.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-03 01:55:18 UTC (rev 2493) +++ pkg/Meucci/NAMESPACE 2013-07-03 06:38:24 UTC (rev 2494) @@ -1,3 +1,4 @@ +export(BlackScholesCallPrice) export(Central2Raw) export(CMAcombination) export(CMAseparation) @@ -11,6 +12,7 @@ export(GenerateLogNormalDistribution) export(hermitePolynomial) export(integrateSubIntervals) +export(InterExtrapolate) export(linreturn) export(LognormalCopulaPdf) export(LognormalMoments2Parameters) Added: pkg/Meucci/R/BlackScholesCallPrice.R =================================================================== --- pkg/Meucci/R/BlackScholesCallPrice.R (rev 0) +++ pkg/Meucci/R/BlackScholesCallPrice.R 2013-07-03 06:38:24 UTC (rev 2494) @@ -0,0 +1,33 @@ +#' Compute the Black-Scholes price of a European call option +#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005. +#' +#' @param spot : [scalar] spot price of underlying +#' @param K : [scalar] strike of the call optioon +#' @param r : [scalar] risk free rate as a fraction +#' @param vol : [scalar] volatility of the underlying as a fraction +#' @param T : [scalar] time to maturity in years +#' +#' @return c : [scalar] price of European call(s) +#' @return delta : [scalar] delta of the call(s) +#' @return cash : [scalar] cash held in a replicating portfolio +#' +#' @note +#' Code is vectorized, so the inputs can be vectors or matrices (but sizes must match) +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "BlackScholesCallPrice.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +BlackScholesCallPrice = function(spot, K, r, vol, T) +{ + d1 = ( log( spot / K ) + ( r + vol * vol / 2) * T) / (vol * sqrt(T)); + d2 = d1 - vol * sqrt(T); + delta = pnorm(d1); + cash = -K * exp( -r * T ) * pnorm( d2 ); + c = spot * delta + cash; + + return( list( c = c, delta = delta, cash = cash ) ); +} \ No newline at end of file Added: pkg/Meucci/R/InterExtrapolate.R =================================================================== --- pkg/Meucci/R/InterExtrapolate.R (rev 0) +++ pkg/Meucci/R/InterExtrapolate.R 2013-07-03 06:38:24 UTC (rev 2494) @@ -0,0 +1,174 @@ +#' Interpolate and extrapolate using n-linear interpolation (tensor product linear). +#' +#' @param V : [array] p-dimensional array to be interpolated/extrapolated at the list of points in the array Xi. +# interpne will work in any number of dimensions >= 1 +#' @param Xi : [array] (n x p) array of n points to interpolate/extrapolate. Each point is one row of the array Xi. +#' @param nodelist : [cell array] (optional) cell array of nodes in each dimension. +# If nodelist is not provided, then by default I will assume nodelist[[i]] = 1:size(V,i). The nodes in +# nodelist need not be uniformly spaced. +#' @param method : [string] (optional) chacter string, denotes the interpolation method used. default method = 'linear' +# 'linear' --> n-d linear tensor product interpolation/extrapolation +# 'nearest' --> n-d nearest neighbor interpolation/extrapolation +# in 2-d, 'linear' is equivalent to a bilinear interpolant +# in 3-d, it is commonly known as trilinear interpolation. +#' +#' @return Vpred : [array] (n x 1) array of interpolated/extrapolated values +#' +#' @note +#' Initially written by John D'Errico +#' Vpred = interpne(V,Xi) +#' Vpred = interpne(V,Xi,nodelist) +#' Vpred = interpne(V,Xi,nodelist,method) +#' Extrapolating long distances outside the support of V is rarely advisable. +#' +#' @examples +#' +#' [x1,x2] = meshgrid(0:.2:1); +#' z = exp(x1+x2); +#' Xi = rand(100,2)*2-.5; +#' Zi = interpne(z,Xi,{0:.2:1, 0:.2:1},'linear'); +#' surf(0:.2:1,0:.2:1,z) +#' hold on +#' plot3(Xi(:,1),Xi(:,2),Zi,'ro') +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "InterExtrapolate.R" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +InterExtrapolate = function( V, Xi, nodelist, method, ...) +{ + # get some sizes + + vsize = dim( V ); + ndims = length( vsize ); + nargin = length( match.call() ) -1; + if( ndims != ncol( Xi ) ) stop("Xi is not compatible in size with the array V for interpolation.") + + # default for nodelist + if ( nargin < 3 || length(nodelist) == 0 ) + { + nodelist= vector( "list", ndims ); + + for( i in 1 : ndims ) + { + nodelist[[ i ]] = rbind( 1 : vsize[ i ] ); + } + } + + if ( length( nodelist ) != ndims ) + stop( "nodelist is incompatible with the size of V.") + + nll = lapply( nodelist, length ); + + if( any( nll!= vsize) ) + stop( "nodelist is incompatible with the size of V." ) + + # get deltax for the node spacing + dx = nodelist; + + for( i in 1 : ndims ) + { + nodelist[[i]] = nodelist[[i]][]; # not sure about this doing anything + dx[[i]] = diff(nodelist[[i]][,]); + if ( any( dx[[i]] <= 0) ) + stop( "The nodes in nodelist must be monotone increasing." ); + } + + # check for method + if ( nargin < 4 ) method = 'linear'; + + + + if( ! is.character(method) ) stop("method must be a character string if supplied."); + + + validmethod = c( "linear", "nearest"); + + if(!any(validmethod == method ) ) + stop(paste(" No match found for method = ", method)) + + # Which cell of the array does each point lie in? + # This includes extrapolated points, which are also taken + # to fall in a cell. histc will do all the real work. + + ind = matrix( 0, nrow(Xi), ndims); + + for( i in 1 : ndims) + { + hc = histc(Xi[ , i ], nodelist[[i]]); ##ok + + # catch any point along the very top edge. + hc$bin[ hc$bin == vsize[ i ] ] = vsize[ i ] - 1; + + ind[ , i ] = hc$bin; + + k = which( hc$bin == 0); + + # look for any points external to the nodes + if( !(length(k)==0) ) + { + # bottom end + ind[ k[ Xi[ k, i] < nodelist[[i]][ 1 ]], i ] = 1; + + # top end + ind[ k[ Xi[ k, i] > nodelist[[i]][ length(nodelist[[1]][1]) ]], i ] = vsize[ i ] - 1; + } + } + + # where in each cell does each point fall? + t = matrix( 0, nrow(Xi), ndims); + + for( i in 1 : ndims) + { + t[ , i ] = (Xi[ , i ] - nodelist[[i]][ ind[ , i ] ] )/ dx[[i]][ind[ , i ]]; + } + + sub = cumprod( c( 1 ,vsize[ 1 : ( length( vsize ) - 1 ) ] ) ); + base = 1 + ( ind-1 ) %*% sub; + + # which interpolation method do we use? + + switch( method, + nearest = + { + # nearest neighbor is really simple to do. + t = round(t); + t[ t > 1 ] = 1; + t[ t < 0 ] = 0; + + Vpred = V[ base + t %*% sub ]; + }, + + linear = + { + # tensor product linear is not too nasty. + Vpred = matrix( 0, nrow(Xi), 1); + # define the 2^ndims corners of a hypercube (MATLAB's corners = (dec2bin(0:(2^ndims-1))== '1');) + corners = lapply( strsplit( intToBin ( 0 : ( 2^ndims - 1 ) ), split=""), as.integer ); + + nc = length( corners ); + + for( i in 1 : nc ) + { + #accessing + s = V[ base + (corners[[i]] %*% sub)[1]]; + for( j in 1 : ndims ) + { + # this will work for extrapolation too + if( corners[[i]][ j ] == 0 ){ + s = s * ( 1 - t[ , j ] ); + }else + { + s = s * t[ , j ]; + } + } + + Vpred = Vpred + s; + } + } ) # end switch method + + return( Vpred ); +} \ No newline at end of file Added: pkg/Meucci/demo/S_CallsProjectionPricing.R =================================================================== --- pkg/Meucci/demo/S_CallsProjectionPricing.R (rev 0) +++ pkg/Meucci/demo/S_CallsProjectionPricing.R 2013-07-03 06:38:24 UTC (rev 2494) @@ -0,0 +1,105 @@ +library(mvtnorm); +library(pracma); + +#'This script projects the distribution of the market invariants for the derivatives market +#'Then it computes the distribution of prices at the investment horizon as described in A. Meucci, +#'"Risk and Asset Allocation", Springer, 2005, Chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_CallsProjectionPricing.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + +################################################################################################################## +### Load data + +# load 'spot' for underlying and current vol surface, given by +# 'impVol' for different 'days2Maturity' and 'moneyness' (K/S) +load("../data/implVol.Rda"); + +################################################################################################################## +### Inputs + +tau_tilde = 5; # estimation step (days) +tau = 40; # time to horizon (days) +Time2Mats = c( 100, 150, 200, 250, 300 ); # current time to maturity of call options in days +Strikes = c( 850, 880, 910, 940, 970 ); # strikes of call options, same dimension as Time2Mat + +r_free = 0.04; # risk-free rate +J = 10000; # number of simulations + +################################################################################################################## +numCalls = length( Time2Mats ); +timeLength = length( implVol$spot ); +numSurfPoints = length( implVol$days2Maturity ) * length( implVol$moneyness ); + +################################################################################################################## +### Estimate invariant distribution assuming normality +# variables in X are changes in log(spot) and changes in log(imp.vol) +# evaluated at the 'numSurfPoints' points on the vol surface (vectorized). +X = matrix( 0, timeLength - 1, numSurfPoints + 1 ); +# log-changes of underlying spot +X[ , 1 ] = diff( log( implVol$spot ) ); + +# log-changes of implied vol for different maturities +impVolSeries = matrix( implVol$impVol, timeLength, numSurfPoints ); +for( i in 1 : numSurfPoints ) +{ + X[ , i+1 ] = diff( log( impVolSeries[ , i ] ) ); +} + +muX = apply( X , 2, mean ); +SigmaX = cov( X ); + +################################################################################################################## +### Project distribution to investment horizon +muX = muX * tau / tau_tilde; +SigmaX = SigmaX * tau / tau_tilde; + +################################################################################################################## +### Linearly interpolate the vol surface at the current time to obtain implied vol for the given calls today, and price the calls +spot_T = implVol$spot[ length(implVol$spot) ]; +volSurf_T = drop( implVol$impVol[ length(implVol$impVol[, 1, 1] ), , ]); +time2Mat_T = Time2Mats; +moneyness_T = Strikes/spot_T; + +impVol_T = t( InterExtrapolate( volSurf_T,t( rbind( time2Mat_T, moneyness_T )), list( implVol$days2Maturity,implVol$moneyness ) ) ); +callPrice_T = BlackScholesCallPrice( spot_T, Strikes, r_free, impVol_T, Time2Mats/252 )$c; + +################################################################################################################## +### Generate simulations at horizon +X_ = rmvnorm( J, muX, SigmaX ); + +# interpolate vol surface at horizon for the given calls +spot_ = spot_T * exp(X_[ , 1 ] ); +impVol_ = matrix( 0, J, numCalls); +for( j in 1 : J ) +{ + volSurf = volSurf_T * exp( matrix(X_[ j, -1 ],length( implVol$days2Maturity ),length( implVol$moneyness ))); + time2Mat_ = Time2Mats - tau; + moneyness_ = Strikes / spot_[ j ]; + impVol_[ j, ] = t( InterExtrapolate( volSurf,t( rbind( time2Mat_T, moneyness_T )), list( implVol$days2Maturity,implVol$moneyness ) )); +} + +# price the calls at the horizon +callPrice_ = matrix( 0, J, numCalls ); +for( i in 1 : numCalls ) +{ + callPrice_[ , i ] = BlackScholesCallPrice( spot_, Strikes[ i ], r_free, impVol_[ , i ], time2Mat_[ i ] / 252 )$c; +} + +m = nrow( callPrice_ ); +n = ncol( callPrice_ ); +LinearRets = callPrice_ /kronecker( matrix( 1, J, 1), callPrice_T)-1 + +NumBins = round(10 * log(J)); + +for( i in 1 : numCalls) +{ + dev.new(); + par( mfrow = c( 2 , 1)); + hist( callPrice_[ , i ], NumBins, xlab = "call price"); + plot(spot_, callPrice_[ ,i ], xlab = "spot price", ylab = "call price" ); +} \ No newline at end of file Added: pkg/Meucci/man/BlackScholesCallPrice.Rd =================================================================== --- pkg/Meucci/man/BlackScholesCallPrice.Rd (rev 0) +++ pkg/Meucci/man/BlackScholesCallPrice.Rd 2013-07-03 06:38:24 UTC (rev 2494) @@ -0,0 +1,43 @@ +\name{BlackScholesCallPrice} +\alias{BlackScholesCallPrice} +\title{Compute the Black-Scholes price of a European call option +as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.} +\usage{ + BlackScholesCallPrice(spot, K, r, vol, T) +} +\arguments{ + \item{spot}{: [scalar] spot price of underlying} + + \item{K}{: [scalar] strike of the call optioon} + + \item{r}{: [scalar] risk free rate as a fraction} + + \item{vol}{: [scalar] volatility of the underlying as a + fraction} + + \item{T}{: [scalar] time to maturity in years} +} +\value{ + c : [scalar] price of European call(s) + + delta : [scalar] delta of the call(s) + + cash : [scalar] cash held in a replicating portfolio +} +\description{ + Compute the Black-Scholes price of a European call option + as described in A. Meucci, "Risk and Asset Allocation", + Springer, 2005. +} +\note{ + Code is vectorized, so the inputs can be vectors or + matrices (but sizes must match) +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "BlackScholesCallPrice.m" +} + Added: pkg/Meucci/man/InterExtrapolate.Rd =================================================================== --- pkg/Meucci/man/InterExtrapolate.Rd (rev 0) +++ pkg/Meucci/man/InterExtrapolate.Rd 2013-07-03 06:38:24 UTC (rev 2494) @@ -0,0 +1,53 @@ +\name{InterExtrapolate} +\alias{InterExtrapolate} +\title{Interpolate and extrapolate using n-linear interpolation (tensor product linear).} +\usage{ + InterExtrapolate(V, Xi, nodelist, method, ...) +} +\arguments{ + \item{V}{: [array] p-dimensional array to be + interpolated/extrapolated at the list of points in the + array Xi.} + + \item{Xi}{: [array] (n x p) array of n points to + interpolate/extrapolate. Each point is one row of the + array Xi.} + + \item{nodelist}{: [cell array] (optional) cell array of + nodes in each dimension.} + + \item{method}{: [string] (optional) chacter string, + denotes the interpolation method used. default method = + 'linear'} +} +\value{ + Vpred : [array] (n x 1) array of + interpolated/extrapolated values +} +\description{ + Interpolate and extrapolate using n-linear interpolation + (tensor product linear). +} +\note{ + Initially written by John D'Errico Vpred = interpne(V,Xi) + Vpred = interpne(V,Xi,nodelist) Vpred = + interpne(V,Xi,nodelist,method) Extrapolating long + distances outside the support of V is rarely advisable. +} +\examples{ +[x1,x2] = meshgrid(0:.2:1); + z = exp(x1+x2); + Xi = rand(100,2)*2-.5; + Zi = interpne(z,Xi,{0:.2:1, 0:.2:1},'linear'); + surf(0:.2:1,0:.2:1,z) + hold on + plot3(Xi(:,1),Xi(:,2),Zi,'ro') +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "InterExtrapolate.R" +} + From noreply at r-forge.r-project.org Wed Jul 3 12:42:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 3 Jul 2013 12:42:16 +0200 (CEST) Subject: [Returnanalytics-commits] r2495 - pkg/PerformanceAnalytics/sandbox/Shubhankit Message-ID: <20130703104216.3F9BD18127E@r-forge.r-project.org> Author: shubhanm Date: 2013-07-03 12:42:15 +0200 (Wed, 03 Jul 2013) New Revision: 2495 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R Log: Week 3 : Expected Maxm Drawdown Using Brownian Motion Assumptions Reference : (Ismial Magdon) Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R 2013-07-03 10:42:15 UTC (rev 2495) @@ -0,0 +1,194 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +table.EMaxDDGBM <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev(x) + gamma<-sqrt(pi/8) + + if(mu==0){ + + Ed<-2*gamma*sig*sqrt(T) + + } + + else{ + + alpha<-mu*sqrt(T/(2*sig^2)) + + x<-alpha^2 + + if(mu>0){ + + mQp<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, + + 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, + + 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900, + + 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000, + + 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690, + + 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171, + + 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162, + + 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999, + + 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992, + + 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457, + + 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985, + + 2.621743),ncol=2) + + + + if(x<0.0005){ + + Qp<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y + + } + + if(x>5000){ + + Qp<-0.25*log(x)+0.49088 + + } + + Ed<-(2*sig^2/mu)*Qp + + } + + if(mu<0){ + + mQn<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150, + + 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400, + + 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800, + + 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000, + + 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000, + + 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708, + + 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229, + + 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056, + + 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393, + + 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455, + + 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380, + + 4.990430, 5.498820),ncol=2) + + + + + + if(x<0.0005){ + + Qn<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y + + } + + if(x>5000){ + + Qn<-x+0.50 + + } + + Ed<-(2*sig^2/mu)*(-Qn) + + } + + } + + # return(Ed) + + z = c((mu*100), + (sig*100), + (Ed*100)) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Expected Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### From noreply at r-forge.r-project.org Thu Jul 4 00:49:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Jul 2013 00:49:48 +0200 (CEST) Subject: [Returnanalytics-commits] r2496 - in pkg/PortfolioAnalytics: . R man sandbox Message-ID: <20130703224948.DB726185889@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-04 00:49:48 +0200 (Thu, 04 Jul 2013) New Revision: 2496 Added: pkg/PortfolioAnalytics/man/group_fail.Rd pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/rp_transform.Rd Log: Updating rp_transform to include group constraints. Added testing script and updated documentation. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-03 10:42:15 UTC (rev 2495) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-03 22:49:48 UTC (rev 2496) @@ -27,6 +27,7 @@ export(generatesequence) export(get.constraints) export(group_constraint) +export(group_fail) export(is.constraint) export(is.objective) export(is.portfolio) Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-03 10:42:15 UTC (rev 2495) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-03 22:49:48 UTC (rev 2496) @@ -196,11 +196,11 @@ return(weights) } -#' Transform a weights vector to min_sum/max_sum leverage and min/max box constraints using logic from randomize_portfolio +#' Transform a weights vector to satisfy leverage, box, and group constraints using logic from \code{randomize_portfolio} #' #' This function uses a block of code from \code{\link{randomize_portfolio}} #' to transform the weight vector if either the weight_sum (leverage) -#' constraints or box constraints are violated. +#' constraints, box constraints, or group constraints are violated. #' The resulting weights vector might be quite different from the original weights vector. #' #' @param w weights vector to be transformed @@ -208,18 +208,28 @@ #' @param max_sum maximum sum of all asset weights, default 1.01 #' @param min numeric or named vector specifying minimum weight box constraints #' @param max numeric or named vector specifying maximum weight box constraints +#' @param groups vector specifying the groups of the assets +#' @param cLO numeric or vector specifying minimum weight group constraints +#' @param cUP numeric or vector specifying minimum weight group constraints #' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200 #' @return named weighting vector #' @author Peter Carl, Brian G. Peterson, Ross Bennett (based on an idea by Pat Burns) #' @export -rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, max_permutations=200){ +rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_permutations=200){ # Uses logic from randomize_portfolio to "normalize" a weights vector to - # satisfy min_sum and max_sum while account for min and max box constraints + # satisfy min_sum and max_sum while accounting for box and group constraints # Modified from randomize_portfolio to trigger the while loops if any weights # violate min or max box constraints. A weights vector would not be transformed # in randomize_portfolio if min_sum and max_sum were satisfied, but the # min/max constraints were violated. + # return w if all constraints are satisfied + if((sum(w) >= min_sum & sum(w) <= max_sum) & + (all(w >= min) & all(w <= max)) & + (all(!group_fail(weights, groups, cLO, cUP)))){ + return(w) + } + # generate a sequence of weights based on min/max box constraints weight_seq <- generatesequence(min=min(min), max=max(max), by=0.005) @@ -229,8 +239,8 @@ # create a temporary weights vector that will be modified in the while loops tmp_w <- w - # while portfolio is outside min_sum/max_sum or min/max and we have not reached max_permutations - while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max)) & permutations <= max_permutations) { + # while portfolio is outside min_sum/max_sum or min/max or group constraints and we have not reached max_permutations + while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & permutations <= max_permutations) { permutations = permutations + 1 # check our box constraints on total portfolio weight # reduce(increase) total portfolio size till you get a match @@ -240,8 +250,8 @@ random_index <- sample(1:length(tmp_w), length(tmp_w)) i = 1 - # while sum of weights is less than min_sum or min/max box constraint is violated - while ((sum(tmp_w) <= min_sum | any(tmp_w < min) | any(tmp_w > max)) & i <= length(tmp_w)) { + # while sum of weights is less than min_sum or min/max box or group constraint is violated + while ((sum(tmp_w) <= min_sum | any(tmp_w < min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { # randomly permute and increase a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -256,8 +266,11 @@ } i=i+1 # increment our counter } # end increase loop - # while sum of weights is greater than max_sum or min/max box constraint is violated - while ((sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max)) & i <= length(tmp_w)) { + # need to reset i here otherwise the decreasing loop will be ignored + # group_fail does not test for direction of violation, just that group constraints were violated + i = 1 + # while sum of weights is greater than max_sum or min/max box or group constraint is violated + while ((sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { # randomly permute and decrease a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -294,6 +307,40 @@ return(portfolio) } +#' Test if group constraints have been violated +#' +#' The function loops through each group and tests if cLO or cUP have been violated +#' for the given group. This is a helper function for \code{\link{rp_transform}}. +#' +#' @param weights weights vector to test +#' @param groups vector specifying the groups of the assets +#' @param cLO numeric or vector specifying minimum weight group constraints +#' @param cUP numeric or vector specifying minimum weight group constraints +#' @return logical vector: TRUE if group constraints are violated for a given group +#' @author Ross Bennett +#' @export +group_fail <- function(weights, groups, cLO, cUP){ + # return FALSE if groups, cLO, or cUP is NULL + if(is.null(groups) | is.null(cLO) | is.null(cUP)) return(FALSE) + + n.groups <- length(groups) + group_fail <- vector(mode="logical", length=n.groups) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- groups[i] + tmp.w <- weights[k:(l+j)] + grp.min <- cLO[i] + grp.max <- cUP[i] + # return TRUE if grp.min or grp.max is violated + group_fail[i] <- ( sum(tmp.w) < grp.min | sum(tmp.w) > grp.max ) + k <- k + j + l <- k - 1 + } + # returns logical vector of groups. TRUE if either cLO or cUP is violated + return(group_fail) +} + # test # w <- c(0.1, 0.25, 0.3, 0.15, 0.05, 0.15) # min <- rep(0.1, length(w)) Added: pkg/PortfolioAnalytics/man/group_fail.Rd =================================================================== --- pkg/PortfolioAnalytics/man/group_fail.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/group_fail.Rd 2013-07-03 22:49:48 UTC (rev 2496) @@ -0,0 +1,30 @@ +\name{group_fail} +\alias{group_fail} +\title{Test if group constraints have been violated} +\usage{ + group_fail(weights, groups, cLO, cUP) +} +\arguments{ + \item{weights}{weights vector to test} + + \item{groups}{vector specifying the groups of the assets} + + \item{cLO}{numeric or vector specifying minimum weight + group constraints} + + \item{cUP}{numeric or vector specifying minimum weight + group constraints} +} +\value{ + logical vector: TRUE if group constraints are violated + for a given group +} +\description{ + The function loops through each group and tests if cLO or + cUP have been violated for the given group. This is a + helper function for \code{\link{rp_transform}}. +} +\author{ + Ross Bennett +} + Modified: pkg/PortfolioAnalytics/man/rp_transform.Rd =================================================================== --- pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-03 10:42:15 UTC (rev 2495) +++ pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-03 22:49:48 UTC (rev 2496) @@ -1,9 +1,9 @@ \name{rp_transform} \alias{rp_transform} -\title{Transform a weights vector to min_sum/max_sum leverage and min/max box constraints using logic from randomize_portfolio} +\title{Transform a weights vector to satisfy leverage, box, and group constraints using logic from \code{randomize_portfolio}} \usage{ rp_transform(w, min_sum = 0.99, max_sum = 1.01, min, max, - max_permutations = 200) + groups, cLO, cUP, max_permutations = 200) } \arguments{ \item{w}{weights vector to be transformed} @@ -20,6 +20,14 @@ \item{max}{numeric or named vector specifying maximum weight box constraints} + \item{groups}{vector specifying the groups of the assets} + + \item{cLO}{numeric or vector specifying minimum weight + group constraints} + + \item{cUP}{numeric or vector specifying minimum weight + group constraints} + \item{max_permutations}{integer: maximum number of iterations to try for a valid portfolio, default 200} } @@ -29,10 +37,10 @@ \description{ This function uses a block of code from \code{\link{randomize_portfolio}} to transform the weight - vector if either the weight_sum (leverage) constraints or - box constraints are violated. The resulting weights - vector might be quite different from the original weights - vector. + vector if either the weight_sum (leverage) constraints, + box constraints, or group constraints are violated. The + resulting weights vector might be quite different from + the original weights vector. } \author{ Peter Carl, Brian G. Peterson, Ross Bennett (based on an Added: pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R 2013-07-03 22:49:48 UTC (rev 2496) @@ -0,0 +1,96 @@ +library(PortfolioAnalytics) + +# Testing to see how rp_transform handles group constraints + +##### EX1 ##### +# first group exceeds cUP +weights <- c(0.15, 0.35, 0.50) +sum(weights) + +groups <- c(2, 1) +cLO <- c(0.1, 0.10) +cUP <- c(0.45, 0.8) +min_sum <- 0.99 +max_sum <- 1.01 +min <- rep(0.05, length(weights)) +max <- rep(0.65, length(weights)) + +group_fail(weights, groups, cLO, cUP) + +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 200) +w +group_fail(w, groups, cLO, cUP) + +##### EX2 ##### +# The assets are grouped into 3 groups of 2 +# The sum of the weights for the first group assets must be between 0.05 and 0.35 +# The sum of the weights for the second group of assets must be between 0.10 and 0.45 +# The sum of the weights for the last group of assets must be between 0.05 and 0.25 + +# first group exceeds cUP +weights <- c(0.15, 0.30, 0.15, 0.25, 0.05, 0.10) +sum(weights) + +groups <- c(2, 2, 2) +cLO <- c(0.05, 0.10, 0.05) +cUP <- c(0.4, 0.45, 0.35) +min_sum <- 0.99 +max_sum <- 1.01 +min <- rep(0.05, length(weights)) +max <- rep(0.65, length(weights)) + + +group_fail(weights, groups, cLO, cUP) + +# groups is NULL and box and leverage constraints are satisfied so this should +# just return the original weights vector +w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, 500) +w + +# The first group exceeds cUP so the weights vector should be modified +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 1000) +w +group_fail(w, groups, cLO, cUP) + +##### Ex3 ##### +# The second group is below cLO and the third weight is below min +weights <- c(0.15, 0.25, 0.08, 0.2, 0.22, 0.10) +sum(weights) + +groups <- c(2, 1, 3) +cLO <- c(0.05, 0.10, 0.05) +cUP <- c(0.4, 0.45, 0.65) +min_sum <- 0.99 +max_sum <- 1.01 +min <- rep(0.1, length(weights)) +max <- rep(0.65, length(weights)) + + +group_fail(weights, groups, cLO, cUP) + +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) +w +group_fail(w, groups, cLO, cUP) + +##### Ex4 ##### +# The second group is above cUP and the fourth group is below cLO +weights <- c(0.06, 0.1, 0.07, 0.2, 0.22, 0.10, 0.05, 0.08, 0.05, 0.04, 0.03) +sum(weights[1:2]) +sum(weights[3:6]) +sum(weights[7:10]) +sum(weights[10:11]) +sum(weights) + +groups <- c(2, 4, 3, 2) +cLO <- c(0.05, 0.10, 0.05, 0.08) +cUP <- c(0.4, 0.55, 0.65, 0.45) +min_sum <- 0.99 +max_sum <- 1.01 +min <- rep(0.05, length(weights)) +max <- rep(0.65, length(weights)) + +group_fail(weights, groups, cLO, cUP) + +# Note that this was typically not working with max_permutations=200 +# Relax constraints or increase max_permutations +rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 1000) From noreply at r-forge.r-project.org Thu Jul 4 01:49:27 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Jul 2013 01:49:27 +0200 (CEST) Subject: [Returnanalytics-commits] r2497 - pkg/PortfolioAnalytics/R Message-ID: <20130703234927.65E901852C9@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-04 01:49:26 +0200 (Thu, 04 Jul 2013) New Revision: 2497 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: removing volatility as a constraint type Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-03 22:49:48 UTC (rev 2496) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-03 23:49:26 UTC (rev 2497) @@ -187,7 +187,7 @@ #' @param \dots any other passthru parameters to specify constraints #' @param indexnum if you are updating a specific constraint, the index number in the $objectives list to update #' @author Ross Bennett -#' @seealso \code{\link{constraint_v2}}, \code{\link{weight_sum_constraint}}, \code{\link{box_constraint}}, \code{\link{group_constraint}}, \code{\link{turnover_constraint}}, \code{\link{diversification_constraint}}, \code{\link{volatility_constraint}}, \code{\link{position_limit_constraint}} +#' @seealso \code{\link{constraint_v2}}, \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}} #' @export add.constraint <- function(portfolio, type, enabled=FALSE, ..., indexnum=NULL){ # Check to make sure that the portfolio passed in is a portfolio object @@ -242,11 +242,6 @@ enabled=enabled, ...=...) }, - # Volatility constraint - volatility = {tmp_constraint <- volatility_constraint(type=type, - enabled=enabled, - ...=...) - }, # Position limit constraint position_limit = {tmp_constraint <- position_limit_constraint(type=type, enabled=enabled, @@ -606,25 +601,6 @@ return(Constraint) } -#' constructor for volatility_constraint -#' -#' This function is called by add.constraint when type="volatility" is specified, \code{\link{add.constraint}} -#' Penalize if portfolio standard deviation deviates from volatility target -#' -#' @param type character type of the constraint -#' @param vol_target target volatilty constraint -#' @param enabled TRUE/FALSE -#' @param \dots any other passthru parameters to specify box and/or group constraints -#' @author Ross Bennett -#' @export -volatility_constraint <- function(type, vol_target, enabled=FALSE, ...){ - Constraint <- constraint_v2(type, enabled=enabled, constrclass="volatility_constraint", ...) - # Constraint$min.vol <- min.vol - # Constraint$max.vol <- max.vol - Constraint$vol_target <- vol_target - return(Constraint) -} - #' constructor for position_limit_constraint #' #' This function is called by add.constraint when type="position_limit" is specified, \code{\link{add.constraint}} From noreply at r-forge.r-project.org Thu Jul 4 14:23:50 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Jul 2013 14:23:50 +0200 (CEST) Subject: [Returnanalytics-commits] r2498 - in pkg/Meucci: . R demo man Message-ID: <20130704122350.3471E181268@r-forge.r-project.org> Author: xavierv Date: 2013-07-04 14:23:49 +0200 (Thu, 04 Jul 2013) New Revision: 2498 Added: pkg/Meucci/R/Central2Raw.R pkg/Meucci/R/CentralAndStandardizedStatistics.R pkg/Meucci/R/Cumul2Raw.R pkg/Meucci/R/Raw2Central.R pkg/Meucci/R/Raw2Cumul.R pkg/Meucci/demo/S_LinVsLogReturn.R pkg/Meucci/demo/S_ProjectSummaryStatistics.R pkg/Meucci/demo/S_PureResidualBonds.R pkg/Meucci/man/CentralAndStandardizedStatistics.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE pkg/Meucci/R/PerformIidAnalysis.R pkg/Meucci/man/Central2Raw.Rd pkg/Meucci/man/Cumul2Raw.Rd pkg/Meucci/man/PerformIidAnalysis.Rd pkg/Meucci/man/Raw2Central.Rd pkg/Meucci/man/Raw2Cumul.Rd Log: - added 3 new demo scripts and the new functions needed to make them run Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/DESCRIPTION 2013-07-04 12:23:49 UTC (rev 2498) @@ -75,3 +75,8 @@ 'SimulateJumpDiffusionMerton.R' 'BlackScholesCallPrice.R' 'InterExtrapolate.R' + 'Central2Raw.R' + 'CentralAndStandardizedStatistics.R' + 'Cumul2Raw.R' + 'Raw2Central.R' + 'Raw2Cumul.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/NAMESPACE 2013-07-04 12:23:49 UTC (rev 2498) @@ -1,5 +1,6 @@ export(BlackScholesCallPrice) export(Central2Raw) +export(CentralAndStandardizedStatistics) export(CMAcombination) export(CMAseparation) export(ComputeMoments) Added: pkg/Meucci/R/Central2Raw.R =================================================================== --- pkg/Meucci/R/Central2Raw.R (rev 0) +++ pkg/Meucci/R/Central2Raw.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,30 @@ +#' Map central moments into raw moments +#' +#' @param mu : [vector] (length N corresponding to order N) central moments +#' +#' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' +#' @references +#' \url{http://} +#' See Meucci's script for "Central2Raw.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +Central2Raw = function(mu) +{ + N = length(mu); + mu_ = mu; + + for ( n in 2 : N ) + { + mu_[ n ] = ( ( -1 ) ^( n+1 ) ) * ( mu[ 1 ] )^(n); + for( k in 1 : (n-1) ) + { + mu_[ n ] = mu_[ n ] + choose( n, k ) * ( (-1) ^ ( n - k + 1 )) * mu_[ k ] * (mu_[ 1 ]) ^ ( n - k); + } + mu_[ n ] = mu_[ n ] + mu[ n ]; + } + + return( mu_); +} \ No newline at end of file Added: pkg/Meucci/R/CentralAndStandardizedStatistics.R =================================================================== --- pkg/Meucci/R/CentralAndStandardizedStatistics.R (rev 0) +++ pkg/Meucci/R/CentralAndStandardizedStatistics.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,39 @@ +#' Compute central and standardized statistics, as described in A. Meucci +#' "Risk and Asset Allocation", Springer, 2005 +#' +#' @param X : [vector] (J x 1) draws from the distribution +#' @param N : [scalar] highest degree for the central moment +#' +#' @return ga : [vector] (1 x N) standardized statistics up to order N +#' @return mu : [vector] (1 x N) central moments up to order N +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "CentralAndStandardizedStatistics.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +CentralAndStandardizedStatistics = function( X, N ) +{ + # compute central moments + mu = matrix( 0, 1, N); + mu[ 1 ] = mean(X); + for( n in 2 : N ) + { + mu[ n ] = centeredmoment(X, n); + } + + # compute standardized statistics + + ga = mu; + + ga[ 2 ] = sqrt( mu[ 2 ]); + for( n in 3 : N ) + { + ga[ n ] = mu[ n ] / (ga[ 2 ] ^ n); + } + + return( list( ga = ga, mu = mu ) ); + +} \ No newline at end of file Added: pkg/Meucci/R/Cumul2Raw.R =================================================================== --- pkg/Meucci/R/Cumul2Raw.R (rev 0) +++ pkg/Meucci/R/Cumul2Raw.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,30 @@ +#' Map cumulative moments into raw moments, as described in A. Meucci "Risk and Asset Allocation", +#' Springer, 2005 +#' +#' @param ka : [vector] (length N corresponding to order N) cumulative moments +#' +#' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Cumul2Raw.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export +Cumul2Raw = function( ka ) +{ + N = length( ka ); + mu_ = ka; + + for( n in 2 : N ) + { + #ka[ n ] = mu_[ n ]; Doesn't make sense + + for( k in 1 : (n-1) ) + { + mu_[ n ] = mu_[ n ] + choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ]; + } + } + + return( mu_ ); +} \ No newline at end of file Modified: pkg/Meucci/R/PerformIidAnalysis.R =================================================================== --- pkg/Meucci/R/PerformIidAnalysis.R 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/R/PerformIidAnalysis.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -11,7 +11,7 @@ # under i.i.d. the location-dispersion ellipsoid should be a circle #' #' @references -#' \url{http://} +#' \url{http://symmys.com/node/170} #' See Meucci's script for "PerformIidAnalysis.m" #' #' @author Xavier Valls \email{flamejat@@gmail.com} Added: pkg/Meucci/R/Raw2Central.R =================================================================== --- pkg/Meucci/R/Raw2Central.R (rev 0) +++ pkg/Meucci/R/Raw2Central.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,33 @@ +#' Map raw moments into central moments, as described in A. Meucci "Risk and Asset Allocation", +#' Springer, 2005 +#' +#' @param mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' +#' @return mu : [vector] (length N corresponding to order N) central moments +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Raw2Central.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +Raw2Central = function( mu_ ) +{ + N = length( mu_ ); + mu = mu_; + + for( n in 2 : N ) + { + mu[ n ] = ( (-1) ^ n ) * ( mu_[ 1 ] )^( n ); + + for( k in 1 : (n-1) ) + { + mu[ n ] = mu[ n ] + choose( n, k ) * ((-1)^(n-k)) * mu_[ k ] * (mu_[ 1 ])^(n-k) ; + } + + mu[ n ] = mu[ n ] + mu_[ n ]; + } + + return( mu ); +} \ No newline at end of file Added: pkg/Meucci/R/Raw2Cumul.R =================================================================== --- pkg/Meucci/R/Raw2Cumul.R (rev 0) +++ pkg/Meucci/R/Raw2Cumul.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,30 @@ +#' Map raw moments into cumulative moments, as described in A. Meucci "Risk and Asset Allocation", +#' Springer, 2005 +#' +#' @param mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' +#' @return ka : [vector] (length N corresponding to order N) cumulative moments +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Raw2Cumul.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export +Raw2Cumul = function( mu_ ) +{ + N = length( mu_ ); + ka = mu_; + + for( n in 2 : N ) + { + #ka[ n ] = mu_[ n ]; Doesn't make sense + + for( k in 1 : (n-1) ) + { + ka[ n ] = ka[ n ] - choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ]; + } + } + + return( ka ); +} \ No newline at end of file Added: pkg/Meucci/demo/S_LinVsLogReturn.R =================================================================== --- pkg/Meucci/demo/S_LinVsLogReturn.R (rev 0) +++ pkg/Meucci/demo/S_LinVsLogReturn.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,84 @@ +#' This script project a distribution in the future according to the i.i.d.-implied square-root rule, as described +#' in A. Meucci "Risk and Asset Allocation", Springer, 2005, chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_LinVsLogReturn.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + +################################################################################################################## +### Inputs +# in general R=exp(C)-1. Furtheremore, here we assume C~N(m*t,s^2*t) +m = 0.05; +s = 0.25; + +ts = seq( 0.1, 3, 0.3 ); +ps = matrix( c( 0.01, 0.99 ) ); + +D = 0.7 * min( abs( diff( ts ) ) ); +C = list( q = NULL, x = NULL, pdf = NULL); +R = list( q = NULL, x = NULL, pdf = NULL); + +Steps = 100; + +for( i in 1 : length(ts) ) +{ + t = ts[ i ]; + + q = qnorm( ps, m * t ,s * sqrt( t ) ); + + x = seq( min(q), max(q) , (max(q)-min(q))/Steps ); + + pdf = dnorm( x, m*t, s*sqrt(t)); + pdf = pdf / max( pdf ) * D; + + C$q = cbind( C$q, q ); + C$pdf = cbind( C$pdf, pdf ); + C$x = cbind( C$x, x ); + + q = exp( q )-1; + + x = seq( min(q), max(q), (max(q)-min(q))/Steps ); + + pdf = dlnorm( x + 1, m * t, s * sqrt( t ) ); + pdf = pdf / max( pdf ) * D; + + R$pdf = cbind( R$pdf, pdf); + R$x = cbind( R$x, x ); +} + + +R$q = exp( C$q ) - 1; + +Col = rgb( 0.8, 0.8, 0.8 ); + +subplot('Position', ( 0.05, 0.55, 0.9, 0.4 ) ); + +par(mfrow=c(2,1)); + + +matplot(c( 0, ts ), t(cbind( 0*ps, C$q )), type="l", lty=1, col = "red", + xlab ="", ylab ="", main = "compounded returns" ); + + +for( i in 1 : length(ts) ) +{ + xx = rbind( ts[i] , ts[i] + C$pdf[ ,i ] , ts[i]); + yy = rbind( min(C$x[,i]) , C$x[ ,i ], max(C$x[,i])); + polygon(xx, yy, col= Col); +} + + +matplot(c( 0, ts ), t(cbind( 0*ps, R$q )), type="l", lty=1, col = "red", + xlab ="", ylab ="", main = "linear returns" ); + +for( i in 1 : length(ts) ) +{ + xx = rbind( ts[i] , ts[i] + R$pdf[ ,i ] , ts[i]); + yy = rbind( min(R$x[,i]) , R$x[ ,i ], max(R$x[,i])); + polygon(xx, yy, col= Col); +} + +# xlim and ylim should be ylim = min(yy)*1.5 max(yy)*1.5, xlim=c(0, max(xx)*1.01)) respectively in each one of the plots \ No newline at end of file Added: pkg/Meucci/demo/S_ProjectSummaryStatistics.R =================================================================== --- pkg/Meucci/demo/S_ProjectSummaryStatistics.R (rev 0) +++ pkg/Meucci/demo/S_ProjectSummaryStatistics.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,58 @@ + +#' This script projects summary statistics to arbitrary horizons, as described in A. Meucci +#' "Risk and Asset Allocation", Springer, 2005, chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ProjectSummaryStatistics.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs + +N = 6; # focus on first N standardized summary statistics +K = 100; # projection horizon + +# generate arbitrary distribution +J = 100000; # number of scenarios + +Z = rnorm( J ); +X = sin( Z ) + log( cos( Z ) + 2 ); + +################################################################################################################## +### Compute single-period standardized statistics and central moments +CaSS = CentralAndStandardizedStatistics( X, N ); +print( CaSS$ga ); +print( CaSS$mu ); + +# compute single-period non-central moments +mu_ = Central2Raw( CaSS$mu ); +print( mu_); + +# compute single-period cumulants +ka = Raw2Cumul(mu_); +print(ka); + +# compute multi-period cumulants +Ka = K * ka; +print(Ka); + +# compute multi-period non-central moments +Mu_ = Cumul2Raw(Ka); +print(Mu_); + +# compute multi-period central moments +Mu = Raw2Central(Mu_); +print(Mu); + +# compute multi-period standardized statistics +Ga = Mu; +Ga[ 2 ] = sqrt( Mu[ 2 ]); + +for( n in 3 : N ) +{ + Ga[ n ] = Mu[ n ] / ( Ga[ 2 ] ^ n ); +} + +print(Ga); \ No newline at end of file Added: pkg/Meucci/demo/S_PureResidualBonds.R =================================================================== --- pkg/Meucci/demo/S_PureResidualBonds.R (rev 0) +++ pkg/Meucci/demo/S_PureResidualBonds.R 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,39 @@ + +#' This script models the joint distribution of the yet-to-be realized key rates of the government curve, +#' as described in A. Meucci "Risk and Asset Allocation", Springer, 2005, chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_PureResidualBonds.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Load data +load("../data/bondAttribution.Rda"); + + +################################################################################################################## +# bondAttribution$B = key rate durations +# bondAttribution$F = key rate weekly changes +# bondAttribution$X = bonds returns net of carry + +Dim = dim(bondAttribution$B); + +U = 0 * bondAttribution$X; + +for( t in 1 : Dim[1] ) +{ + U[ t, ] = bondAttribution$X[ t, ] - bondAttribution$F[ t, ] %*% drop(bondAttribution$B[ t, , ]); +} + +C = cor(cbind( U, bondAttribution$F ) ); + + +C_U = C[ 1:Dim[3], 1:Dim[3] ]; +C_FU = C[ 1:Dim[3], -(1:Dim[3]) ]; + +# not systematic-plus-idiosyncratic model +print(C_U); +print(C_FU); + Modified: pkg/Meucci/man/Central2Raw.Rd =================================================================== --- pkg/Meucci/man/Central2Raw.Rd 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/man/Central2Raw.Rd 2013-07-04 12:23:49 UTC (rev 2498) @@ -1,33 +1,47 @@ -\name{Central2Raw} -\alias{Central2Raw} -\title{Transforms first n central moments into first n raw moments (first central moment defined as expectation)} -\usage{ - Central2Raw(mu) -} -\arguments{ - \item{mu}{a vector of central moments} -} -\value{ - mu_ a vector of non-central moments -} -\description{ - step 2 of projection process: From the central moments of - step 1, we compute the non-central moments. To do so we - start with the first non-central moment and apply - recursively an identity (formula 20) -} -\details{ - \deqn{ \tilde{ \mu }^{ \big(1\big) }_{X} \equiv \mu - ^{\big(1\big)}_{X} \\ \tilde{ \mu }^{ \big(n\big) }_{X} - \equiv \mu ^{n}_{X} \sum_{k=0}^{n-1} \big(-1\big)^{n-k+1} - \mu ^{n-k}_{X} \tilde{ \mu }^{\big(k\big)}_{X} } -} -\author{ - Ram Ahluwalia \email{rahluwalia at gmail.com} -} -\references{ - A. Meucci - "Exercises in Advanced Risk and Portfolio - Management". See page 10. Symmys site containing original - MATLAB source code \url{http://www.symmys.com} -} - +\name{Central2Raw} +\alias{Central2Raw} +\title{Transforms first n central moments into first n raw moments (first central moment defined as expectation)} +\usage{ + Central2Raw(mu) + + Central2Raw(mu) +} +\arguments{ + \item{mu}{a vector of central moments} + + \item{mu}{: [vector] (length N corresponding to order N) + central moments} +} +\value{ + mu_ a vector of non-central moments + + mu_ : [vector] (length N corresponding to order N) + corresponding raw moments +} +\description{ + step 2 of projection process: From the central moments of + step 1, we compute the non-central moments. To do so we + start with the first non-central moment and apply + recursively an identity (formula 20) + + Map central moments into raw moments +} +\details{ + \deqn{ \tilde{ \mu }^{ \big(1\big) }_{X} \equiv \mu + ^{\big(1\big)}_{X} \\ \tilde{ \mu }^{ \big(n\big) }_{X} + \equiv \mu ^{n}_{X} \sum_{k=0}^{n-1} \big(-1\big)^{n-k+1} + \mu ^{n-k}_{X} \tilde{ \mu }^{\big(k\big)}_{X} } +} +\author{ + Ram Ahluwalia \email{rahluwalia at gmail.com} + + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + A. Meucci - "Exercises in Advanced Risk and Portfolio + Management". See page 10. Symmys site containing original + MATLAB source code \url{http://www.symmys.com} + + \url{http://} See Meucci's script for "Central2Raw.m" +} + Added: pkg/Meucci/man/CentralAndStandardizedStatistics.Rd =================================================================== --- pkg/Meucci/man/CentralAndStandardizedStatistics.Rd (rev 0) +++ pkg/Meucci/man/CentralAndStandardizedStatistics.Rd 2013-07-04 12:23:49 UTC (rev 2498) @@ -0,0 +1,31 @@ +\name{CentralAndStandardizedStatistics} +\alias{CentralAndStandardizedStatistics} +\title{Compute central and standardized statistics, as described in A. Meucci +"Risk and Asset Allocation", Springer, 2005} +\usage{ + CentralAndStandardizedStatistics(X, N) +} +\arguments{ + \item{X}{: [vector] (J x 1) draws from the distribution} + + \item{N}{: [scalar] highest degree for the central + moment} +} +\value{ + ga : [vector] (1 x N) standardized statistics up to order + N + + mu : [vector] (1 x N) central moments up to order N +} +\description{ + Compute central and standardized statistics, as described + in A. Meucci "Risk and Asset Allocation", Springer, 2005 +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "CentralAndStandardizedStatistics.m" +} + Modified: pkg/Meucci/man/Cumul2Raw.Rd =================================================================== --- pkg/Meucci/man/Cumul2Raw.Rd 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/man/Cumul2Raw.Rd 2013-07-04 12:23:49 UTC (rev 2498) @@ -1,36 +1,52 @@ -\name{Cumul2Raw} -\alias{Cumul2Raw} -\title{Transforms cumulants of Y-t into raw moments} -\usage{ - Cumul2Raw(ka) -} -\arguments{ - \item{ka}{cumulants of Y} -} -\value{ - mu_ the raw non-central moments of Y -} -\description{ - step 5 of the projection process: -} -\details{ - From the cumulants of Y we compute the raw non-central - moments of Y - - We do so recursively by the identity in formula (24) - which follows from applying (21) and re-arranging terms - - \deqn{ \tilde{ \mu } ^{ \big(n\big) }_{Y} \equiv \kappa^{ - \big(n\big) }_{Y} + \sum_{k=1}^{n-1} (n-1)C_{k-1} - \kappa_{Y}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{Y} } -} -\author{ - Ram Ahluwalia \email{rahluwalia at gmail.com} -} -\references{ - A. Meucci - "Annualization and General Projection of - Skewness, Kurtosis and All Summary Statistics" - formula - (24) Symmys site containing original MATLAB source code - \url{http://www.symmys.com/node/136} -} - +\name{Cumul2Raw} +\alias{Cumul2Raw} +\title{Transforms cumulants of Y-t into raw moments} +\usage{ + Cumul2Raw(ka) + + Cumul2Raw(ka) +} +\arguments{ + \item{ka}{cumulants of Y} + + \item{ka}{: [vector] (length N corresponding to order N) + cumulative moments} +} +\value{ + mu_ the raw non-central moments of Y + + mu_ : [vector] (length N corresponding to order N) + corresponding raw moments +} +\description{ + step 5 of the projection process: + + Map cumulative moments into raw moments, as described in + A. Meucci "Risk and Asset Allocation", Springer, 2005 +} +\details{ + From the cumulants of Y we compute the raw non-central + moments of Y + + We do so recursively by the identity in formula (24) + which follows from applying (21) and re-arranging terms + + \deqn{ \tilde{ \mu } ^{ \big(n\big) }_{Y} \equiv \kappa^{ + \big(n\big) }_{Y} + \sum_{k=1}^{n-1} (n-1)C_{k-1} + \kappa_{Y}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{Y} } +} +\author{ + Ram Ahluwalia \email{rahluwalia at gmail.com} + + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + A. Meucci - "Annualization and General Projection of + Skewness, Kurtosis and All Summary Statistics" - formula + (24) Symmys site containing original MATLAB source code + \url{http://www.symmys.com/node/136} + + \url{http://symmys.com/node/170} See Meucci's script for + "Cumul2Raw.m" +} + Modified: pkg/Meucci/man/PerformIidAnalysis.Rd =================================================================== --- pkg/Meucci/man/PerformIidAnalysis.Rd 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/man/PerformIidAnalysis.Rd 2013-07-04 12:23:49 UTC (rev 2498) @@ -24,7 +24,7 @@ Xavier Valls \email{flamejat at gmail.com} } \references{ - \url{http://} See Meucci's script for + \url{http://symmys.com/node/170} See Meucci's script for "PerformIidAnalysis.m" } Modified: pkg/Meucci/man/Raw2Central.Rd =================================================================== --- pkg/Meucci/man/Raw2Central.Rd 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/man/Raw2Central.Rd 2013-07-04 12:23:49 UTC (rev 2498) @@ -1,35 +1,51 @@ -\name{Raw2Central} -\alias{Raw2Central} -\title{Transforms the first n raw moments into the first n central moments} -\usage{ - Raw2Central(mu_) -} -\arguments{ - \item{mu_}{the raw (multi-period) non-central moment of - Y-t} -} -\value{ - mu (multi-period) central moment of Y-t -} -\description{ - step 6 of projection process: -} -\details{ - compute multi-period central moments. - - Note the first central moment defined as expectation. - - \deqn{\tilde{ \mu } ^ {\big(n\big)} _{X} \equiv E \big\{ - X^{n} \big\}, \\ \mu ^{ \big(n\big) }_{X} \equiv - \sum_0^{n-1} \big(-1\big)^{n-k} \mu ^{n-k}_{X} \tilde{ - \mu }^{k}_{X} + \tilde{ \mu }_{X}^{n} } -} -\author{ - Ram Ahluwalia \email{rahluwalia at gmail.com} -} -\references{ - A. Meucci - "Exercises in Advanced Risk and Portfolio - Management". See page 9 Symmys site containing original - MATLAB source code \url{http://www.symmys.com} -} - +\name{Raw2Central} +\alias{Raw2Central} +\title{Transforms the first n raw moments into the first n central moments} +\usage{ + Raw2Central(mu_) + + Raw2Central(mu_) +} +\arguments{ + \item{mu_}{the raw (multi-period) non-central moment of + Y-t} + + \item{mu_}{: [vector] (length N corresponding to order N) + corresponding raw moments} +} +\value{ + mu (multi-period) central moment of Y-t + + mu : [vector] (length N corresponding to order N) central + moments +} +\description{ + step 6 of projection process: + + Map raw moments into central moments, as described in A. + Meucci "Risk and Asset Allocation", Springer, 2005 +} +\details{ + compute multi-period central moments. + + Note the first central moment defined as expectation. + + \deqn{\tilde{ \mu } ^ {\big(n\big)} _{X} \equiv E \big\{ + X^{n} \big\}, \\ \mu ^{ \big(n\big) }_{X} \equiv + \sum_0^{n-1} \big(-1\big)^{n-k} \mu ^{n-k}_{X} \tilde{ + \mu }^{k}_{X} + \tilde{ \mu }_{X}^{n} } +} +\author{ + Ram Ahluwalia \email{rahluwalia at gmail.com} + + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + A. Meucci - "Exercises in Advanced Risk and Portfolio + Management". See page 9 Symmys site containing original + MATLAB source code \url{http://www.symmys.com} + + \url{http://symmys.com/node/170} See Meucci's script for + "Raw2Central.m" +} + Modified: pkg/Meucci/man/Raw2Cumul.Rd =================================================================== --- pkg/Meucci/man/Raw2Cumul.Rd 2013-07-03 23:49:26 UTC (rev 2497) +++ pkg/Meucci/man/Raw2Cumul.Rd 2013-07-04 12:23:49 UTC (rev 2498) @@ -1,37 +1,53 @@ -\name{Raw2Cumul} -\alias{Raw2Cumul} -\title{Transforms raw moments into cumulants} -\usage{ - Raw2Cumul(mu_) -} -\arguments{ - \item{mu_}{non-central moments of the invariant X-t} -} -\value{ - ka cumulants of X-t -} -\description{ - Step 3 of the projection process: From the non-central - moments of X-t, we compute the cumulants. -} -\details{ - This process follows from the Taylor approximations for - any small z and ln(1+x)~x for any small x, and from the - definition of the first cumulant in (17). The we apply - recursively the identity in formula (21). See Kendall and - Stuart (1969) - - \deqn{ \kappa^{ \big(n\big) }_{X} \equiv \tilde{ \mu } ^{ - \big(n\big) }_{X} - \sum_{k=1}^{n-1} (n-1)C_{k-1} - \kappa_{X}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{X} } -} -\author{ - Ram Ahluwalia \email{rahluwalia at gmail.com} -} -\references{ - A. Meucci - "Annualization and General Projection of - Skewness, Kurtosis and All Summary Statistics" - formula - (21) Symmys site containing original MATLAB source code - \url{http://www.symmys.com/node/136} -} - +\name{Raw2Cumul} +\alias{Raw2Cumul} +\title{Transforms raw moments into cumulants} +\usage{ + Raw2Cumul(mu_) + + Raw2Cumul(mu_) +} +\arguments{ + \item{mu_}{non-central moments of the invariant X-t} + + \item{mu_}{: [vector] (length N corresponding to order N) + corresponding raw moments} +} +\value{ + ka cumulants of X-t + + ka : [vector] (length N corresponding to order N) + cumulative moments +} +\description{ + Step 3 of the projection process: From the non-central + moments of X-t, we compute the cumulants. + + Map raw moments into cumulative moments, as described in + A. Meucci "Risk and Asset Allocation", Springer, 2005 +} +\details{ + This process follows from the Taylor approximations for + any small z and ln(1+x)~x for any small x, and from the + definition of the first cumulant in (17). The we apply + recursively the identity in formula (21). See Kendall and + Stuart (1969) + + \deqn{ \kappa^{ \big(n\big) }_{X} \equiv \tilde{ \mu } ^{ + \big(n\big) }_{X} - \sum_{k=1}^{n-1} (n-1)C_{k-1} + \kappa_{X}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{X} } +} +\author{ + Ram Ahluwalia \email{rahluwalia at gmail.com} + + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + A. Meucci - "Annualization and General Projection of + Skewness, Kurtosis and All Summary Statistics" - formula + (21) Symmys site containing original MATLAB source code + \url{http://www.symmys.com/node/136} + + \url{http://symmys.com/node/170} See Meucci's script for + "Raw2Cumul.m" +} + From noreply at r-forge.r-project.org Thu Jul 4 16:20:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Jul 2013 16:20:24 +0200 (CEST) Subject: [Returnanalytics-commits] r2499 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130704142024.6F3F1184F53@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-04 16:20:24 +0200 (Thu, 04 Jul 2013) New Revision: 2499 Added: pkg/PortfolioAnalytics/man/get_constraints.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/man/add.constraint.Rd Log: revised function to get constraints from portfolio object. updating documentation Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-04 12:23:49 UTC (rev 2498) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-04 14:20:24 UTC (rev 2499) @@ -25,7 +25,7 @@ export(extractStats) export(extractWeights.rebal) export(generatesequence) -export(get.constraints) +export(get_constraints) export(group_constraint) export(group_fail) export(is.constraint) @@ -58,5 +58,4 @@ export(txfrm_position_limit_constraint) export(txfrm_weight_sum_constraint) export(update.constraint) -export(volatility_constraint) export(weight_sum_constraint) Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-04 12:23:49 UTC (rev 2498) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-04 14:20:24 UTC (rev 2499) @@ -485,69 +485,74 @@ inherits( x, "constraint" ) } -#' Helper function to get the enabled constraints out of the portfolio object, see \code{\link{portfolio.spec}} +#' Helper function to get the enabled constraints out of the portfolio object #' #' When the v1_constraint object is instantiated via constraint, the arguments #' min_sum, max_sum, min, and max are either specified by the user or default #' values are assigned. These are required by other functions such as -#' optimize.portfolio. This function will check that these variables are in -#' the portfolio object in the constraints list. This function could be used -#' at the beginning of optimize.portfolio to check the constraints in the -#' portfolio object. -#' -#' Returns an object of class constraint which is a flat list of weight_sum, box, and group constraints. -#' Uses the same naming as the v1_constraint object which may be useful when passed to other functions. +#' optimize.portfolio and constrained . This function will check that these +#' variables are in the portfolio object in the constraints list. This +#' function could be used at the beginning of optimize.portfolio or other +#' functions to extract the constraints from the portfolio object. Uses the +#' same naming as the v1_constraint object which may be useful when passed +#' to other functions. +#' #' @param portfolio an object of class 'portfolio' +#' @return an object of class 'constraint' which is a flattened list of enabled constraints #' @author Ross Bennett -#' @seealso \code{\link{portfolio.spec}}, \code{\link{constraint_v2}} +#' @seealso \code{\link{portfolio.spec}} #' @export -get.constraints <- function(portfolio){ - # Check that object passed in is a portfolio objec +get_constraints <- function(portfolio){ if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class portfolio") - tmp.constraints <- portfolio$constraints + if(length(pspec$constraints) == 0) stop("No constraints passed in") - # Check that constraints are passed in - if(length(tmp.constraints) == 0) stop("No constraints passed in") - out <- list() + out$min_sum <- NA + out$max_sum <- NA + out$min <- NA + out$max <- NA - # Required constraints - out$min_sum <- NULL - out$max_sum <- NULL - out$min <- NULL - out$max <- NULL - - for(i in 1:length(tmp.constraints)){ - if(tmp.constraints[[i]]$enabled){ - # weight_sum constraint - if(tmp.constraints[[i]]$type == "weight_sum"){ - # Extract min_sum and max_sum - out$min_sum <- tmp.constraints[[i]]$min_sum - out$max_sum <- tmp.constraints[[i]]$max_sum + for(constraint in portfolio$constraints) { + if(constraint$enabled){ + if(inherits(constraint, "weight_sum_constraint")){ + out$min_sum <- constraint$min_sum + out$max_sum <- constraint$max_sum } - # box constraints - if(tmp.constraints[[i]]$type == "box"){ - # Extract min and max - out$min <- tmp.constraints[[i]]$min - out$max <- tmp.constraints[[i]]$max + if(inherits(constraint, "box_constraint")){ + out$min <- constraint$min + out$max <- constraint$max } - # group constraints - if(tmp.constraints[[i]]$type == "group"){ - # Extract groups, cLO, and cUP - out$groups <- tmp.constraints[[i]]$groups - out$cLO <- tmp.constraints[[i]]$cLO - out$cUP <- tmp.constraints[[i]]$cUP + if(inherits(constraint, "group_constraint")){ + out$groups <- constraint$groups + out$group_labels <- constraint$group_labels + out$cLO <- constraint$cLO + out$cUP <- constraint$cUP } + if(inherits(constraint, "turnover_constraint")){ + out$turnover_target <- constraint$turnover_target + } + if(inherits(constraint, "diversification_constraint")){ + out$div_target <- constraint$div_target + } + if(inherits(constraint, "position_limit_constraint")){ + out$max_pos <- constraint$max_pos + } } } - # Error if no constraints are enabled - if(length(out) == 0) stop("No constraints are enabled") - # Error if required constraints are not specified - if(is.null(out$min) | is.null(out$max) | is.null(out$max_sum) | is.null(out$min_sum)) { - stop("Must specify weight_sum constraints (min_sum and max_sum) and box constraints ( min and max") + # min_sum, max_sum, min, and max are required to be passed in and enabled + if(is.na(out$min_sum) | is.na(out$max_sum)) { + # return(NULL) + stop("Leverage constraint min_sum and max_sum are not enabled or passed in") } + if(length(out$min) == 1 | length(out$max) == 1) { + if(is.na(out$min) | is.na(out$max)){ + # return(NULL) + stop("Box constraints min and max are not enabled or passed in") + } + } + # structure and return class of type constraint return(structure(out, class="constraint")) } Modified: pkg/PortfolioAnalytics/man/add.constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.constraint.Rd 2013-07-04 12:23:49 UTC (rev 2498) +++ pkg/PortfolioAnalytics/man/add.constraint.Rd 2013-07-04 14:20:24 UTC (rev 2499) @@ -47,7 +47,6 @@ \code{\link{group_constraint}}, \code{\link{turnover_constraint}}, \code{\link{diversification_constraint}}, - \code{\link{volatility_constraint}}, \code{\link{position_limit_constraint}} } Added: pkg/PortfolioAnalytics/man/get_constraints.Rd =================================================================== --- pkg/PortfolioAnalytics/man/get_constraints.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/get_constraints.Rd 2013-07-04 14:20:24 UTC (rev 2499) @@ -0,0 +1,33 @@ +\name{get_constraints} +\alias{get_constraints} +\title{Helper function to get the enabled constraints out of the portfolio object} +\usage{ + get_constraints(portfolio) +} +\arguments{ + \item{portfolio}{an object of class 'portfolio'} +} +\value{ + an object of class 'constraint' which is a flattened list + of enabled constraints +} +\description{ + When the v1_constraint object is instantiated via + constraint, the arguments min_sum, max_sum, min, and max + are either specified by the user or default values are + assigned. These are required by other functions such as + optimize.portfolio and constrained . This function will + check that these variables are in the portfolio object in + the constraints list. This function could be used at the + beginning of optimize.portfolio or other functions to + extract the constraints from the portfolio object. Uses + the same naming as the v1_constraint object which may be + useful when passed to other functions. +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{portfolio.spec}} +} + From noreply at r-forge.r-project.org Thu Jul 4 20:03:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Jul 2013 20:03:37 +0200 (CEST) Subject: [Returnanalytics-commits] r2500 - in pkg/PortfolioAnalytics: . R man sandbox Message-ID: <20130704180338.149F4185742@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-04 20:03:37 +0200 (Thu, 04 Jul 2013) New Revision: 2500 Added: pkg/PortfolioAnalytics/man/fn_map.Rd pkg/PortfolioAnalytics/sandbox/testing_fn_map.R Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: adding improved constraint mapping function fn_map with testing script Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-04 14:20:24 UTC (rev 2499) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-04 18:03:37 UTC (rev 2500) @@ -24,6 +24,7 @@ export(extractStats.optimize.portfolio.ROI) export(extractStats) export(extractWeights.rebal) +export(fn_map) export(generatesequence) export(get_constraints) export(group_constraint) Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-04 14:20:24 UTC (rev 2499) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-04 18:03:37 UTC (rev 2500) @@ -89,6 +89,122 @@ return(w) } +#' mapping function to transform or penalize weights that violate constraints +#' +#' The purpose of the mapping function is to transform a weights vector +#' that does not meet all the constraints into a weights vector that +#' does meet the constraints, if one exists, hopefully with a minimum +#' of transformation. +#' +#' I think our first step should be to test each constraint type, in +#' some sort of hierarchy, starting with box constraints (almost all +#' solvers support box constraints, of course), since some of the other +#' transformations will violate the box constraints, and we'll need to +#' transform back again. +#' +#' This function will replace constraint_fn_map +#' +#' leverage, box, group, and position limit constraints are transformed +#' diversification and turnover constraints are penalized +#' +#' @param weights vector of weights +#' @param portfolio object of class portfolio +#' @return +#' \itemize{ +#' \item{weights: }{vector of transformed weights meeting constraints} +#' \item{out: }{penalty term} +#' } +#' @author Ross Bennett +#' @export +fn_map <- function(weights, portfolio, ...){ + + if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class 'portfolio'") + + nassets <- length(portfolio$assets) + + # step 1: Get the constraints out of the portfolio object + constraints <- get_constraints(portfolio) + min_sum <- constraints$min_sum + max_sum <- constraints$max_sum + # rp_transform will rarely find a feasible portfolio if there is not some + # 'wiggle room' between min_sum and max_sum + if((max_sum - min_sum) < 0.02){ + min_sum <- min_sum - 0.01 + max_sum <- max_sum + 0.01 + } + min <- constraints$min + max <- constraints$max + groups <- constraints$groups + cLO <- constraints$cLO + cUP <- constraints$cUP + div_target <- constraints$div_target + turnover_target <- constraints$turnover_target + max_pos <- constraints$max_pos + tolerance <- .Machine$double.eps^0.5 + if(!hasArg(penalty)) penalty <- 1e4 + if(!hasArg(multiplier)) multiplier <- 1 + + out <- 0 + + tmp_weights <- weights + + # step 2: check that the vector of weights satisfies the constraints, + # transform weights if constraint is violated + # TRUE if the weights vector is in compliance with the constraints + # FALSE if the weights vector violates the constraint + + # check leverage constraints + if(!is.null(min_sum) & !is.null(max_sum)){ + if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ + print("leverage constraint violated, transforming weights.") + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) + # tmp_weights <- txfrm_weight_sum_constraint(tmp_weights, min_sum, max_sum) + } + } + + # check box constraints + if(!is.null(min) & !is.null(max)){ + if(!(all(tmp_weights >= min) & all(tmp_weights <= max))){ + print("box constraints violated, transforming weights.") + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) + # tmp_weights <- txfrm_box_constraint(tmp_weights, min, max) + } + } + + # check group constraints + if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){ + if(any(group_fail(tmp_weights, groups, cLO, cUP))){ + print("group constraints violated, transforming weights.") + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) + # tmp_weights <- txfrm_group_constraint(tmp_weights, groups, cLO, cUP) + } + } + + # check position_limit constraints + if(!is.null(max_pos)){ + if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){ + # print("position_limit constraint violated, transforming weights.") + # tmp_weights <- txfrm_position_limit_constraint(tmp_weights, max_pos, nassets) + } + } + + # check diversification constraint + if(!is.null(div_target)){ + print("transform or penalize to meet diversification target") + # penalize instead of transform? + div <- diversification(tmp_weights) + out = out + penalty * abs(multiplier) * abs(div - div_target) + } + + if(!is.null(turnover_target)){ + # print("transform or penalize to meet turnover target") + # penalize instead of transform + to <- turnover(tmp_weights) + out = out + penalty * abs(multiplier) * abs(to - turnover_target) + } + return(list(weights=tmp_weights, out=out)) +} + #' Transform weights that violate min or max box constraints #' #' This is a helper function called inside constraint_fnMap to transform the weights vector to satisfy box constraints. Added: pkg/PortfolioAnalytics/man/fn_map.Rd =================================================================== --- pkg/PortfolioAnalytics/man/fn_map.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/fn_map.Rd 2013-07-04 18:03:37 UTC (rev 2500) @@ -0,0 +1,39 @@ +\name{fn_map} +\alias{fn_map} +\title{mapping function to transform or penalize weights that violate constraints} +\usage{ + fn_map(weights, portfolio, ...) +} +\arguments{ + \item{weights}{vector of weights} + + \item{portfolio}{object of class portfolio} +} +\value{ + \itemize{ \item{weights: }{vector of transformed weights + meeting constraints} \item{out: }{penalty term} } +} +\description{ + The purpose of the mapping function is to transform a + weights vector that does not meet all the constraints + into a weights vector that does meet the constraints, if + one exists, hopefully with a minimum of transformation. +} +\details{ + I think our first step should be to test each constraint + type, in some sort of hierarchy, starting with box + constraints (almost all solvers support box constraints, + of course), since some of the other transformations will + violate the box constraints, and we'll need to transform + back again. + + This function will replace constraint_fn_map + + leverage, box, group, and position limit constraints are + transformed diversification and turnover constraints are + penalized +} +\author{ + Ross Bennett +} + Added: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-04 18:03:37 UTC (rev 2500) @@ -0,0 +1,37 @@ +library(PortfolioAnalytics) + +data(edhec) +ret <- edhec[, 1:4] +funds <- colnames(ret) + +pspec <- portfolio.spec(assets=funds) + +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=T) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.05, max=0.65, enabled=T) +pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2, 2), + group_min=c(0.08, 0.05), group_max=c(0.55, 0.85), enabled=T) +pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.4, enabled=T) +pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.6, enabled=T) +pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3, enabled=F) +portfolio <- pspec + + +# leverage constraints are violated +weights <- c(0.15, 0.25, 0.4, 0.1) +sum(weights) + +fn_map(weights, portfolio) + +# box constraints are violated +weights <- c(0.05, 0.7, 0.1, 0.15) +sum(weights) + +fn_map(weights, portfolio) + +# group constraints are violated +weights <- c(0.1, 0.65, 0.1, 0.15) +sum(weights) + +fn_map(weights, portfolio) + + From noreply at r-forge.r-project.org Fri Jul 5 09:59:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jul 2013 09:59:11 +0200 (CEST) Subject: [Returnanalytics-commits] r2501 - pkg/PerformanceAnalytics/sandbox/pulkit/week1/code Message-ID: <20130705075911.12926183B9C@r-forge.r-project.org> Author: pulkit Date: 2013-07-05 09:59:10 +0200 (Fri, 05 Jul 2013) New Revision: 2501 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R Log: Added c code for PSR Optimization Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py 2013-07-04 18:03:37 UTC (rev 2500) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSROpt.py 2013-07-05 07:59:10 UTC (rev 2501) @@ -3,6 +3,7 @@ # On 20121128 by MLdP import numpy as np +import time #------------------------------------------- #------------------------------------------- class PSR_Opt: @@ -143,7 +144,10 @@ #3) Create class and solve psrOpt=PSR_Opt(series,seed,delta,maxIter,bounds) + start = time.time() psrOpt.optimize() + end = time.time() + print(end-start) #4) Optimize and report optimal portfolio print 'Maximized Z-value: '+str(psrOpt.z) Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-04 18:03:37 UTC (rev 2500) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-05 07:59:10 UTC (rev 2501) @@ -47,7 +47,6 @@ while(TRUE){ if(iter == MaxIter) break dZ = get_d1Zs(mean,weights) - print(dZ$z) if(dZ$z>z && checkBounds(weights)==TRUE){ z = dZ$z d1z = dZ$d1Z @@ -84,13 +83,13 @@ } #To get the first differentials get_d1Zs<-function(mean,weights){ - d1Z = NULL - m = NULL + d1Z = numeric(columns) + m = numeric(4) x_portfolio = x%*%weights m[1] = get_Moments(x_portfolio,1) for(i in 2:4){ - m = c(m,get_Moments(x_portfolio,i,m[1])) + m[i] = get_Moments(x_portfolio,i,m[1]) } stats = get_Stats(m) #mu = mean(x_portfolio) @@ -104,7 +103,7 @@ sigmaSR = SR$sigmaSR for(i in 1:columns){ - d1Z = c(d1Z,get_d1Z(stats,m,meanSR,sigmaSR,mean,weights,i)) + d1Z[i] = get_d1Z(stats,m,meanSR,sigmaSR,mean,weights,i) } dZ = list("d1Z"=d1Z,"z"=meanSR/sigmaSR) @@ -153,15 +152,20 @@ x0 = x0*(mOrder-i) } x_mat = as.matrix(na.omit(x)) - for(i in 1:n){ - x1 = 0 - x2 = (x_mat[i,index]-mean[index])^dOrder - for(j in 1:columns){ - x1 = x1 + weights[j]*(x_mat[i,j]-mean[j]) - } - sum = sum + x2*x1^(mOrder-dOrder) - } - return(x0*sum/n) + sum = 0 + output = .Call("sums",mat = x_mat,index,mean,dOrder,weights,mOrder,sum) + #for(i in 1:n){ + # x1 = 0 + # x2 = (x_mat[i,index]-mean[index])^dOrder + #if(index == 1){ + # print(x2) + #} + # for(j in 1:columns){ + # x1 = x1 + weights[j]*(x_mat[i,j]-mean[j]) + # } + # sum = sum + x2*x1^(mOrder-dOrder) + # } + return(x0*(output)/n) } # TO get meanSR and sigmaSR @@ -181,7 +185,6 @@ } return(sum/n) } - weights = optimize() result = matrix(weights,nrow = columns) rownames(result) = columnnames @@ -191,6 +194,3 @@ - - - Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c 2013-07-05 07:59:10 UTC (rev 2501) @@ -0,0 +1,34 @@ +#include +#include +#include + +SEXP sums(SEXP mat,SEXP index,SEXP Rmean,SEXP dOrder,SEXP Rweights,SEXP mOrder,SEXP sum){ + double x1,x2,diff; + int a,b,row,column; + SEXP Rdim = getAttrib(mat,R_DimSymbol); + row = INTEGER(Rdim)[0]; + column = INTEGER(Rdim)[1]; + mat = coerceVector(mat,REALSXP); + dOrder = coerceVector(dOrder,INTSXP); + mOrder = coerceVector(mOrder,INTSXP); + index = coerceVector(index,INTSXP); + int ind = INTEGER(index)[0]; + int d = INTEGER(dOrder)[0]; + int m = INTEGER(mOrder)[0]; + double *mean = REAL(Rmean); + double *weights = REAL(Rweights); + double s = 0; + for(a = 0;a Author: rossbennett34 Date: 2013-07-05 15:34:48 +0200 (Fri, 05 Jul 2013) New Revision: 2502 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/rp_transform.Rd pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R Log: added position limit constraints to rp_transform Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-05 07:59:10 UTC (rev 2501) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-05 13:34:48 UTC (rev 2502) @@ -312,11 +312,11 @@ return(weights) } -#' Transform a weights vector to satisfy leverage, box, and group constraints using logic from \code{randomize_portfolio} +#' Transform a weights vector to satisfy leverage, box, group, and position_limit constraints using logic from \code{randomize_portfolio} #' #' This function uses a block of code from \code{\link{randomize_portfolio}} #' to transform the weight vector if either the weight_sum (leverage) -#' constraints, box constraints, or group constraints are violated. +#' constraints, box constraints, group constraints, or position_limit constraints are violated. #' The resulting weights vector might be quite different from the original weights vector. #' #' @param w weights vector to be transformed @@ -327,11 +327,12 @@ #' @param groups vector specifying the groups of the assets #' @param cLO numeric or vector specifying minimum weight group constraints #' @param cUP numeric or vector specifying minimum weight group constraints +#' @param max_pos maximum assets with non-zero weights #' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200 #' @return named weighting vector #' @author Peter Carl, Brian G. Peterson, Ross Bennett (based on an idea by Pat Burns) #' @export -rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_permutations=200){ +rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_pos=NULL, max_permutations=200){ # Uses logic from randomize_portfolio to "normalize" a weights vector to # satisfy min_sum and max_sum while accounting for box and group constraints # Modified from randomize_portfolio to trigger the while loops if any weights @@ -339,15 +340,21 @@ # in randomize_portfolio if min_sum and max_sum were satisfied, but the # min/max constraints were violated. + tolerance=.Machine$double.eps^0.5 + if(is.null(max_pos)) max_pos <- length(w) + # return w if all constraints are satisfied if((sum(w) >= min_sum & sum(w) <= max_sum) & (all(w >= min) & all(w <= max)) & - (all(!group_fail(weights, groups, cLO, cUP)))){ + (all(!group_fail(weights, groups, cLO, cUP))) & + (sum(abs(w) > tolerance) <= max_pos)){ return(w) } # generate a sequence of weights based on min/max box constraints weight_seq <- generatesequence(min=min(min), max=max(max), by=0.005) + # make sure there is a 0 in weight_seq + if(!is.null(max_pos) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq) # start the permutations counter permutations <- 1 @@ -355,19 +362,38 @@ # create a temporary weights vector that will be modified in the while loops tmp_w <- w - # while portfolio is outside min_sum/max_sum or min/max or group constraints and we have not reached max_permutations - while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & permutations <= max_permutations) { + # Create a temporary min vector that will be modified, because a feasible + # portfolio is rarely created if all(min > 0). This is due to the while + # loop that checks any(tmp_w < min). + tmp_min <- min + + # while portfolio is outside min_sum/max_sum or tmp_min/max or group or postion_limit constraints and we have not reached max_permutations + while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP)) | (sum(abs(tmp_w) > tolerance) > max_pos)) & permutations <= max_permutations) { permutations = permutations + 1 # check our box constraints on total portfolio weight # reduce(increase) total portfolio size till you get a match - # 1> check to see which bound you've failed on, brobably set this as a pair of while loops + # 1> check to see which bound you've failed on, probably set this as a pair of while loops # 2> randomly select a column and move only in the direction *towards the bound*, maybe call a function inside a function # 3> check and repeat - random_index <- sample(1:length(tmp_w), length(tmp_w)) + # reset tmp_w and tmp_min to their original values + tmp_w <- w + tmp_min <- min + + random_index <- sample(1:length(tmp_w), max_pos) + + # Get the index values that are not in random_index and set them equal to 0 + full_index <- 1:length(tmp_w) + not_index <- setdiff(full_index, random_index) + tmp_w[not_index] <- 0 + + # set some tmp_min values equal to zero so the while loops do not see a + # violation of any(tmp_w < tmp_min) + tmp_min[not_index] <- 0 + i = 1 - # while sum of weights is less than min_sum or min/max box or group constraint is violated - while ((sum(tmp_w) <= min_sum | any(tmp_w < min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { + # while sum of weights is less than min_sum or tmp_min/max box or group constraint is violated + while ((sum(tmp_w) <= min_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { # randomly permute and increase a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -385,17 +411,17 @@ # need to reset i here otherwise the decreasing loop will be ignored # group_fail does not test for direction of violation, just that group constraints were violated i = 1 - # while sum of weights is greater than max_sum or min/max box or group constraint is violated - while ((sum(tmp_w) >= max_sum | any(tmp_w < min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { + # while sum of weights is greater than max_sum or tmp_min/max box or group constraint is violated + while ((sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { # randomly permute and decrease a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] - if (length(weight_seq <= cur_val & weight_seq >= min[cur_index] ) > 1) { - # randomly sample an element from weight_seq that is less than cur_val and greater than min - tmp_w[cur_index] <- sample(weight_seq[which(weight_seq <= cur_val & weight_seq >= min[cur_index] )], 1) + if (length(weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] ) > 1) { + # randomly sample an element from weight_seq that is less than cur_val and greater than tmp_min + tmp_w[cur_index] <- sample(weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] , 1) } else { - if (length(weight_seq <= cur_val & weight_seq >= min[cur_index] ) == 1) { - tmp_w[cur_index] <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])] + if (length(weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] ) == 1) { + tmp_w[cur_index] <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] } } i=i+1 # increment our counter Modified: pkg/PortfolioAnalytics/man/rp_transform.Rd =================================================================== --- pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-05 07:59:10 UTC (rev 2501) +++ pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-05 13:34:48 UTC (rev 2502) @@ -1,9 +1,10 @@ \name{rp_transform} \alias{rp_transform} -\title{Transform a weights vector to satisfy leverage, box, and group constraints using logic from \code{randomize_portfolio}} +\title{Transform a weights vector to satisfy leverage, box, group, and position_limit constraints using logic from \code{randomize_portfolio}} \usage{ rp_transform(w, min_sum = 0.99, max_sum = 1.01, min, max, - groups, cLO, cUP, max_permutations = 200) + groups, cLO, cUP, max_pos = NULL, + max_permutations = 200) } \arguments{ \item{w}{weights vector to be transformed} @@ -28,6 +29,8 @@ \item{cUP}{numeric or vector specifying minimum weight group constraints} + \item{max_pos}{maximum assets with non-zero weights} + \item{max_permutations}{integer: maximum number of iterations to try for a valid portfolio, default 200} } @@ -38,9 +41,10 @@ This function uses a block of code from \code{\link{randomize_portfolio}} to transform the weight vector if either the weight_sum (leverage) constraints, - box constraints, or group constraints are violated. The - resulting weights vector might be quite different from - the original weights vector. + box constraints, group constraints, or position_limit + constraints are violated. The resulting weights vector + might be quite different from the original weights + vector. } \author{ Peter Carl, Brian G. Peterson, Ross Bennett (based on an Modified: pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R 2013-07-05 07:59:10 UTC (rev 2501) +++ pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R 2013-07-05 13:34:48 UTC (rev 2502) @@ -17,7 +17,7 @@ group_fail(weights, groups, cLO, cUP) -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 200) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 2, 200) w group_fail(w, groups, cLO, cUP) @@ -42,13 +42,13 @@ group_fail(weights, groups, cLO, cUP) -# groups is NULL and box and leverage constraints are satisfied so this should +# groups and max_pos are NULL and box and leverage constraints are satisfied so this should # just return the original weights vector -w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, 500) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, max_pos=NULL, 500) w # The first group exceeds cUP so the weights vector should be modified -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 1000) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 4, 1000) w group_fail(w, groups, cLO, cUP) @@ -68,7 +68,7 @@ group_fail(weights, groups, cLO, cUP) -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 5, 500) w group_fail(w, groups, cLO, cUP) @@ -93,4 +93,5 @@ # Note that this was typically not working with max_permutations=200 # Relax constraints or increase max_permutations -rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 1000) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 7, 1000) +w From noreply at r-forge.r-project.org Fri Jul 5 15:52:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jul 2013 15:52:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2503 - pkg/PortfolioAnalytics/R Message-ID: <20130705135232.00BF7185598@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-05 15:52:31 +0200 (Fri, 05 Jul 2013) New Revision: 2503 Modified: pkg/PortfolioAnalytics/R/random_portfolios.R Log: fixed potential bug in randomize_portfolio that I found with rp_transform. length((weight_seq<=cur_val) & (weight_seq>=min[cur_index])) will always be equal to the length of weight_seq, need to subset first Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-05 13:34:48 UTC (rev 2502) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-05 13:52:31 UTC (rev 2503) @@ -116,10 +116,10 @@ # randomly permute and decrease a random portfolio element cur_index<-random_index[i] cur_val <- tportfolio[cur_index] - if (length(weight_seq<=cur_val & weight_seq>=min[cur_index] )>1) { - tportfolio[cur_index]<-sample(weight_seq[which(weight_seq<=cur_val & weight_seq>=min[cur_index] )],1) + if (length(weight_seq[(weight_seq<=cur_val) & (weight_seq>=min[cur_index])] )>1) { + tportfolio[cur_index]<-sample(weight_seq[(weight_seq<=cur_val) & (weight_seq>=min[cur_index] )],1) } else { - if (length(weight_seq<=cur_val & weight_seq>=min[cur_index] )==1) { + if (length(weight_seq[(weight_seq<=cur_val) & (weight_seq>=min[cur_index])] )==1) { tportfolio[cur_index]<-weight_seq[(weight_seq<=cur_val) & (weight_seq>=min[cur_index])] } } From noreply at r-forge.r-project.org Fri Jul 5 17:26:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jul 2013 17:26:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2504 - pkg/PerformanceAnalytics/sandbox/pulkit/week1/code Message-ID: <20130705152601.53CDC185181@r-forge.r-project.org> Author: pulkit Date: 2013-07-05 17:26:00 +0200 (Fri, 05 Jul 2013) New Revision: 2504 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c Log: updated the c code Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-05 13:52:31 UTC (rev 2503) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-05 15:26:00 UTC (rev 2504) @@ -27,8 +27,8 @@ columns = ncol(x) n = nrow(x) columnnames = colnames(x) + k<-rep(0,5) - if(is.null(bounds)){ message("Bounds not given assuming bounds to be (0,1) for each weight") bounds = matrix(rep(c(0,1),columns),nrow = columns,byrow = TRUE) @@ -101,10 +101,11 @@ SR = get_SR(stats,n) meanSR = SR$meanSR sigmaSR = SR$sigmaSR + for(i in 1:columns){ - for(i in 1:columns){ d1Z[i] = get_d1Z(stats,m,meanSR,sigmaSR,mean,weights,i) } + dZ = list("d1Z"=d1Z,"z"=meanSR/sigmaSR) return(dZ) @@ -148,9 +149,11 @@ get_dnMoments<-function(mean,weights,mOrder,dOrder,index){ sum = 0 x0 = 1 + for(i in 0:(dOrder-1)){ x0 = x0*(mOrder-i) } + x_mat = as.matrix(na.omit(x)) sum = 0 output = .Call("sums",mat = x_mat,index,mean,dOrder,weights,mOrder,sum) @@ -180,12 +183,15 @@ } get_Moments<-function(series,order,mean = 0){ sum = 0 - for(i in series){ - sum = sum + (i-mean)^order - } + mat = as.matrix(series) + sum = .Call("sums_m",mat,mean,order) + # for(i in series){ + # sum = sum + (i-mean)^order + # } return(sum/n) } weights = optimize() + print(k) result = matrix(weights,nrow = columns) rownames(result) = columnnames colnames(result) = "weight" Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c 2013-07-05 13:52:31 UTC (rev 2503) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c 2013-07-05 15:26:00 UTC (rev 2504) @@ -31,4 +31,30 @@ return sum; } - +SEXP sums_m(SEXP mat,SEXP Rmean,SEXP order){ + int i,j,row,column; + SEXP Rsum; + SEXP Rdim = getAttrib(mat,R_DimSymbol); + row = INTEGER(Rdim)[0]; + column = INTEGER(Rdim)[1]; + mat = coerceVector(mat,REALSXP); + order = coerceVector(order,INTSXP); + int o = INTEGER(order)[0]; + Rmean = coerceVector(Rmean,REALSXP); + double m = REAL(Rmean)[0]; + PROTECT(Rsum = allocVector(REALSXP,1)); + double s = REAL(Rsum)[0]; + s = 0; + for(i = 0;i Author: rossbennett34 Date: 2013-07-05 18:54:52 +0200 (Fri, 05 Jul 2013) New Revision: 2505 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/sandbox/testing_fn_map.R Log: Revising fn_map function for rp_transform with position limits. Penalize diversification and turnover only if outside +/- 5% Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-05 15:26:00 UTC (rev 2504) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-05 16:54:52 UTC (rev 2505) @@ -156,8 +156,9 @@ # check leverage constraints if(!is.null(min_sum) & !is.null(max_sum)){ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ - print("leverage constraint violated, transforming weights.") - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + # print("leverage constraint violated, transforming weights.") + # print(tmp_weights) # tmp_weights <- txfrm_weight_sum_constraint(tmp_weights, min_sum, max_sum) } } @@ -165,8 +166,9 @@ # check box constraints if(!is.null(min) & !is.null(max)){ if(!(all(tmp_weights >= min) & all(tmp_weights <= max))){ - print("box constraints violated, transforming weights.") - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + # print("box constraints violated, transforming weights.") + # print(tmp_weights) # tmp_weights <- txfrm_box_constraint(tmp_weights, min, max) } } @@ -174,8 +176,9 @@ # check group constraints if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){ if(any(group_fail(tmp_weights, groups, cLO, cUP))){ - print("group constraints violated, transforming weights.") - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, 500) + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + # print("group constraints violated, transforming weights.") + # print(tmp_weights) # tmp_weights <- txfrm_group_constraint(tmp_weights, groups, cLO, cUP) } } @@ -183,25 +186,35 @@ # check position_limit constraints if(!is.null(max_pos)){ if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){ + tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) # print("position_limit constraint violated, transforming weights.") + # print(tmp_weights) # tmp_weights <- txfrm_position_limit_constraint(tmp_weights, max_pos, nassets) } } # check diversification constraint if(!is.null(div_target)){ - print("transform or penalize to meet diversification target") # penalize instead of transform? div <- diversification(tmp_weights) - out = out + penalty * abs(multiplier) * abs(div - div_target) + # only penalize if not within +/- 5% of target + if((div < div_target * .95) | (div > div_target * 1.05)){ + # print("transform or penalize to meet diversification target") + out = out + penalty * abs(multiplier) * abs(div - div_target) + } } + # check turnover constraint if(!is.null(turnover_target)){ - # print("transform or penalize to meet turnover target") # penalize instead of transform to <- turnover(tmp_weights) - out = out + penalty * abs(multiplier) * abs(to - turnover_target) + # only penalize if not within +/- 5% of target + if((to < turnover_target * 0.95) | (to > turnover_target * 1.05)){ + # print("transform or penalize to meet turnover target") + out = out + penalty * abs(multiplier) * abs(to - turnover_target) + } } + names(tmp_weights) <- names(weights) return(list(weights=tmp_weights, out=out)) } @@ -343,9 +356,24 @@ tolerance=.Machine$double.eps^0.5 if(is.null(max_pos)) max_pos <- length(w) + # Create a temporary min vector that will be modified, because a feasible + # portfolio is rarely created if all(min > 0). This is due to the while + # loop that checks any(tmp_w < min). + tmp_min <- min + + # If weight_i = 0 and min_i > 0, then this will violate box constraints + # even though weight_i = 0 to satisfy position_limit constraints. Modify + # the tmp_min vector and set tmp_min_i equal to zero where weights_i = 0. + # If w is less than or equal to tolerance then it is essentially 0 + if(any(abs(w) <= tolerance)){ + if(any(tmp_min[which(abs(w) <= tolerance)] > 0)){ + tmp_min[which(abs(w) <= tolerance)] <- -tolerance + } + } + # return w if all constraints are satisfied if((sum(w) >= min_sum & sum(w) <= max_sum) & - (all(w >= min) & all(w <= max)) & + (all(w >= tmp_min) & all(w <= max)) & (all(!group_fail(weights, groups, cLO, cUP))) & (sum(abs(w) > tolerance) <= max_pos)){ return(w) @@ -362,11 +390,6 @@ # create a temporary weights vector that will be modified in the while loops tmp_w <- w - # Create a temporary min vector that will be modified, because a feasible - # portfolio is rarely created if all(min > 0). This is due to the while - # loop that checks any(tmp_w < min). - tmp_min <- min - # while portfolio is outside min_sum/max_sum or tmp_min/max or group or postion_limit constraints and we have not reached max_permutations while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP)) | (sum(abs(tmp_w) > tolerance) > max_pos)) & permutations <= max_permutations) { permutations = permutations + 1 Modified: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-05 15:26:00 UTC (rev 2504) +++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-05 16:54:52 UTC (rev 2505) @@ -10,20 +10,25 @@ pspec <- add.constraint(portfolio=pspec, type="box", min=0.05, max=0.65, enabled=T) pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2, 2), group_min=c(0.08, 0.05), group_max=c(0.55, 0.85), enabled=T) -pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.4, enabled=T) -pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.6, enabled=T) -pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3, enabled=F) +pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.4, enabled=F) +pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.6, enabled=F) +pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3, enabled=T) portfolio <- pspec -# leverage constraints are violated +# leverage and position_limit constraints are violated weights <- c(0.15, 0.25, 0.4, 0.1) sum(weights) fn_map(weights, portfolio) -# box constraints are violated -weights <- c(0.05, 0.7, 0.1, 0.15) +# box constraints are violated but postion_limit is already satisfied +# issue because min vector does not have a zero value and weights[1] = 0 +# all constraints are satisfied so there should be no transformation +# Is it reasonable to expect the user to have a min vector with zeros when using position_limit constraints? +# I try to catch this and modify the tmp_min vector so this does not trigger +# violation of box constraints +weights <- c(0, 0.55, 0.3, 0.15) sum(weights) fn_map(weights, portfolio) @@ -34,4 +39,8 @@ fn_map(weights, portfolio) +# normalize weights from the equal weights seed portfolio +weights <- portfolio$assets +sum(weights) +fn_map(weights, portfolio) From noreply at r-forge.r-project.org Fri Jul 5 18:59:02 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jul 2013 18:59:02 +0200 (CEST) Subject: [Returnanalytics-commits] r2506 - pkg/PortfolioAnalytics/R Message-ID: <20130705165902.1D5431804C8@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-05 18:59:01 +0200 (Fri, 05 Jul 2013) New Revision: 2506 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: Removing constraint_fn_map function in favor of using fn_map function Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-05 16:54:52 UTC (rev 2505) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-05 16:59:01 UTC (rev 2506) @@ -1,94 +1,4 @@ -#' Constraint mapping function -#' -#' The purpose of the mapping function is to transform a weights vector -#' that does not meet all the constraints into a weights vector that -#' does meet the constraints, if one exists, hopefully with a minimum -#' of transformation. -#' I think our first step should be to test each constraint type, in -#' some sort of hierarchy, starting with box constraints (almost all -#' solvers support box constraints, of course), since some of the other -#' transformations will violate the box constraints, and we'll need to -#' transform back again. -#' -#' @param weights vector of weights -#' @param portfolio object of class portfolio -#' @author Ross Bennett -#' @export -constraint_fn_map <- function(weights, portfolio) { - - if (!is.portfolio(portfolio)) { - stop("Portfolio passed in is not of class portfolio") - } - - # number of assets - nassets <- length(portfolio$assets) - - # This is in a loop so the order of transformation depends on how the constraints are added by the user. - # Maybe take this out of a loop because the order of transformation is important - for(constraint in portfolio$constraints) { - # Check for enabled constraints - if(constraint$enabled){ - - ## box constraint - if(inherits(constraint, "box_constraint")){ - min <- constraint$min - max <- constraint$max - - w <- txfrm_box_constraint(weights=weights, min=min, max=max) - - # The transformation will likely change the sum of weights and violate min_sum or max_sum - # Should we normalize here by transforming the entire weights vector? - # Normalizing by transforming the entire weights may violate min and max, but will get us *close* - } # end box_constraint transformation - - ## weight_sum constraint - if(inherits(constraint, "weight_sum_constraint")){ - min_sum <- constraint$min_sum - max_sum <- constraint$max_sum - # print(min_sum) - # print(max_sum) - - w <- txfrm_weight_sum_constraint(weights=weights, min_sum=min_sum, max_sum=max_sum) - - } # end weight_sum constraint transformation - - ## group constraint - if(inherits(constraint, "group_constraint")){ - groups <- constraint$groups - cLO <- constraint$cLO - cUP <- constraint$cUP - # print(groups) - # print(cLO) - # print(cUP) - - w <- txfrm_group_constraint(weights=weights, groups=groups, cLO=cLO, cUP=cUP) - - # Normalizing the weights inside the groups changes the sum of the weights. - # Should normalizing the sum of weights take place here or somewhere else? - # Re-normalizing the weights will get us *close* to satisfying the group constraints. - # Maybe then add a penalty in constrained objective for violation of group constraints? - } # end group_constraint transformation - - # Turnover constraints - # TODO - - # Diversification constraints - # TODO - - ## position_limit constraint - if(inherits(constraint, "group_constraint")){ - max_pos <- constraint$max_pos - - w <- txfrm_position_limit_constraint(weights=weights, max_pos=max_pos, nassets=nassets) - - } # end position_limit_constraint transformation - - } - } - return(w) -} - #' mapping function to transform or penalize weights that violate constraints #' #' The purpose of the mapping function is to transform a weights vector From noreply at r-forge.r-project.org Fri Jul 5 20:58:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jul 2013 20:58:16 +0200 (CEST) Subject: [Returnanalytics-commits] r2507 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130705185816.8A36318425C@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-05 20:58:16 +0200 (Fri, 05 Jul 2013) New Revision: 2507 Added: pkg/PortfolioAnalytics/man/summary.portfolio.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/generics.R Log: Adding summary method for objects of class portfolio. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-05 16:59:01 UTC (rev 2506) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-05 18:58:16 UTC (rev 2507) @@ -11,7 +11,6 @@ export(charts.RP) export(constrained_group_tmp) export(constrained_objective) -export(constraint_fn_map) export(constraint_ROI) export(constraint_v2) export(constraint) @@ -51,6 +50,7 @@ export(rp_transform) export(set.portfolio.moments) export(summary.optimize.portfolio.rebalancing) +export(summary.portfolio) export(trailingFUN) export(turnover_constraint) export(turnover_objective) Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-07-05 16:59:01 UTC (rev 2506) +++ pkg/PortfolioAnalytics/R/generics.R 2013-07-05 18:58:16 UTC (rev 2507) @@ -38,4 +38,69 @@ print(object[[i]]$constrained_objective) } } +} + +#' Summary method for objects of class 'portfolio' +#' +#' @param portfolio object of class portfolio +#' @author Ross Bennett +#' @export +summary.portfolio <- function(portfolio){ + if(!is.portfolio(portfolio)) stop("object passed in is not of class 'portfolio'") + + cat(rep("*", 50) ,"\n", sep="") + cat("PortfolioAnalytics Portfolio Specification", "\n") + cat(rep("*", 50) ,"\n", sep="") + + # Assets + cat("\nAssets\n") + nassets <- length(portfolio$assets) + cat("Number of assets:", nassets, "\n") + + # Constraints + cat("\nConstraints\n") + nconstraints <- length(portfolio$constraints) + # logical vector of enabled constraints + enabled.constraints <- sapply(pspec$constraints, function(x) x$enabled) + # character vector of constraint types + names.constraints <- sapply(pspec$constraints, function(x) x$type) + cat("Number of constraints:", nconstraints, "\n") + cat("Number of enabled constraints:", sum(enabled.constraints), "\n") + if(sum(enabled.constraints) > 0){ + cat("Enabled constraint types\n") + for(type in names.constraints[enabled.constraints]) { + cat("\t\t-", type, "\n") + } + } + cat("Number of disabled constraints:", nconstraints - sum(enabled.constraints), "\n") + if((nconstraints - sum(enabled.constraints)) > 0){ + cat("Disabled constraint types\n") + for(type in setdiff(names.constraints, names.constraints[enabled.constraints])) { + cat("\t\t-", type, "\n") + } + } + + # Objectives + cat("\nObjectives\n") + nobjectives <- length(portfolio$objectives) + # logical vector of enabled objectives + enabled.objectives <- sapply(pspec$objectives, function(x) x$enabled) + # character vector of objective names + names.objectives <- sapply(pspec$objectives, function(x) x$name) + cat("Number of objectives:", nobjectives, "\n") + cat("Number of enabled objectives:", sum(enabled.objectives), "\n") + if(sum(enabled.objectives) > 0){ + cat("Enabled objective names\n") + for(name in names.objectives[enabled.objectives]) { + cat("\t\t-", name, "\n") + } + } + cat("Number of disabled objectives:", nobjectives - sum(enabled.objectives), "\n") + if((nobjectives - sum(enabled.objectives)) > 0){ + cat("Disabled objective types\n") + for(name in setdiff(names.objectives, names.objectives[enabled.objectives])) { + cat("\t\t-", name, "\n") + } + } + cat("\n") } \ No newline at end of file Added: pkg/PortfolioAnalytics/man/summary.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/summary.portfolio.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/summary.portfolio.Rd 2013-07-05 18:58:16 UTC (rev 2507) @@ -0,0 +1,16 @@ +\name{summary.portfolio} +\alias{summary.portfolio} +\title{Summary method for objects of class 'portfolio'} +\usage{ + summary.portfolio(portfolio) +} +\arguments{ + \item{portfolio}{object of class portfolio} +} +\description{ + Summary method for objects of class 'portfolio' +} +\author{ + Ross Bennett +} + From noreply at r-forge.r-project.org Sat Jul 6 07:55:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 6 Jul 2013 07:55:13 +0200 (CEST) Subject: [Returnanalytics-commits] r2508 - pkg/PerformanceAnalytics/sandbox/Shubhankit Message-ID: <20130706055513.63086184B9C@r-forge.r-project.org> Author: shubhanm Date: 2013-07-06 07:55:12 +0200 (Sat, 06 Jul 2013) New Revision: 2508 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R Log: Week 3: Normalized Drawdown through Monte Carlo Simulation Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R 2013-07-06 05:55:12 UTC (rev 2508) @@ -0,0 +1,86 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +table.NormDD <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + n <- 1000 + dt <- 1/T; + r0 <- 100; + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev.annualized(x) + r <- matrix(0,T+1,n) # matrix to hold short rate paths + r[1,] <- r0 + drawdown <- matrix(0,n) + # return(Ed) + + for(j in 1:n){ + for(i in 2:(T+1)){ + + dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) + r[i,j] <- r[i-1,j] + dr + } + drawdown[j] = maxDrawdown(r[,j]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)*100))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + t <- seq(0, T, dt) + matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### From noreply at r-forge.r-project.org Sat Jul 6 15:04:21 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 6 Jul 2013 15:04:21 +0200 (CEST) Subject: [Returnanalytics-commits] r2509 - pkg/PortfolioAnalytics/R Message-ID: <20130706130422.0BA0A185087@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-06 15:04:21 +0200 (Sat, 06 Jul 2013) New Revision: 2509 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: modified rp_transform to stop execution and execute error action Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 05:55:12 UTC (rev 2508) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 13:04:21 UTC (rev 2509) @@ -366,19 +366,23 @@ colnames(portfolio)<-colnames(w) # checks for infeasible portfolio + # Stop execution and return an error if an infeasible portfolio is created + # This will be useful in fn_map so that we can catch the error and take + # action (try again with more permutations, relax constraints, different + # method to normalize, etc.) if (sum(portfolio)<=min_sum | sum(portfolio)>=max_sum){ portfolio <- w - warning("Infeasible portfolio created, defaulting to w, perhaps increase max_permutations.") + stop("Infeasible portfolio created, perhaps increase max_permutations and/or adjust your parameters.") } - if(isTRUE(all.equal(w,portfolio))) { - if (sum(w)>=min_sum & sum(w)<=max_sum) { - warning("Unable to generate a feasible portfolio different from w, perhaps adjust your parameters.") - return(w) - } else { - warning("Unable to generate a feasible portfolio, perhaps adjust your parameters.") - return(NULL) - } - } +# if(isTRUE(all.equal(w,portfolio))) { +# if (sum(w)>=min_sum & sum(w)<=max_sum) { +# warning("Unable to generate a feasible portfolio different from w, perhaps adjust your parameters.") +# return(w) +# } else { +# warning("Unable to generate a feasible portfolio, perhaps adjust your parameters.") +# return(NULL) +# } +# } return(portfolio) } From noreply at r-forge.r-project.org Sat Jul 6 18:42:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 6 Jul 2013 18:42:48 +0200 (CEST) Subject: [Returnanalytics-commits] r2510 - pkg/PortfolioAnalytics/R Message-ID: <20130706164248.62CB6184870@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-06 18:42:48 +0200 (Sat, 06 Jul 2013) New Revision: 2510 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: modified fn_map to wrap a try() around the rp_constraint() function for flexibility of how to handle constraints if a feasible portfolio cannot be created Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 13:04:21 UTC (rev 2509) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 16:42:48 UTC (rev 2510) @@ -66,7 +66,15 @@ # check leverage constraints if(!is.null(min_sum) & !is.null(max_sum)){ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + if(inherits(tmp_weights, "try-error")){ + # Default to initial weights + tmp_weights <- weights + # Other actions to consider + # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) + # different normalization method + # return initial weights and penalize? + } # print("leverage constraint violated, transforming weights.") # print(tmp_weights) # tmp_weights <- txfrm_weight_sum_constraint(tmp_weights, min_sum, max_sum) @@ -76,7 +84,15 @@ # check box constraints if(!is.null(min) & !is.null(max)){ if(!(all(tmp_weights >= min) & all(tmp_weights <= max))){ - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + if(inherits(tmp_weights, "try-error")){ + # Default to initial weights + tmp_weights <- weights + # Other actions to consider + # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) + # different normalization method + # return initial weights and penalize? + } # print("box constraints violated, transforming weights.") # print(tmp_weights) # tmp_weights <- txfrm_box_constraint(tmp_weights, min, max) @@ -86,7 +102,15 @@ # check group constraints if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){ if(any(group_fail(tmp_weights, groups, cLO, cUP))){ - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + if(inherits(tmp_weights, "try-error")){ + # Default to initial weights + tmp_weights <- weights + # Other actions to consider + # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) + # different normalization method + # return initial weights and penalize? + } # print("group constraints violated, transforming weights.") # print(tmp_weights) # tmp_weights <- txfrm_group_constraint(tmp_weights, groups, cLO, cUP) @@ -96,7 +120,15 @@ # check position_limit constraints if(!is.null(max_pos)){ if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){ - tmp_weights <- rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + if(inherits(tmp_weights, "try-error")){ + # Default to initial weights + tmp_weights <- weights + # Other actions to consider + # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) + # different normalization method + # return initial weights and penalize? + } # print("position_limit constraint violated, transforming weights.") # print(tmp_weights) # tmp_weights <- txfrm_position_limit_constraint(tmp_weights, max_pos, nassets) From noreply at r-forge.r-project.org Sat Jul 6 21:36:06 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 6 Jul 2013 21:36:06 +0200 (CEST) Subject: [Returnanalytics-commits] r2511 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130706193606.7C5C618517F@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-06 21:36:06 +0200 (Sat, 06 Jul 2013) New Revision: 2511 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/sandbox/testing_fn_map.R Log: Modified fn_map() to relax box constraints if a feasible portfolio could not be created with rp_transform(). Added example of this in testing script. Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 16:42:48 UTC (rev 2510) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-06 19:36:06 UTC (rev 2511) @@ -12,8 +12,6 @@ #' transformations will violate the box constraints, and we'll need to #' transform back again. #' -#' This function will replace constraint_fn_map -#' #' leverage, box, group, and position limit constraints are transformed #' diversification and turnover constraints are penalized #' @@ -56,7 +54,11 @@ out <- 0 + # We will modify the weights vector so create a temporary copy + # modified for transformation or to relax constraints tmp_weights <- weights + tmp_min <- min + tmp_max <- max # step 2: check that the vector of weights satisfies the constraints, # transform weights if constraint is violated @@ -66,7 +68,8 @@ # check leverage constraints if(!is.null(min_sum) & !is.null(max_sum)){ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + # Try to transform only considering leverage and box constraints + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -82,12 +85,40 @@ } # check box constraints - if(!is.null(min) & !is.null(max)){ - if(!(all(tmp_weights >= min) & all(tmp_weights <= max))){ - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + if(!is.null(tmp_min) & !is.null(tmp_max)){ + if(!(all(tmp_weights >= tmp_min) & all(tmp_weights <= tmp_max))){ + # Try to transform only considering leverage and box constraints + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights + i <- 1 + # loop while constraints are violated and relax constraints + while((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum | any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) & i <= 5){ + # check if min is violated + if(any(tmp_weights < tmp_min)){ + # Find which elements of min are violated and decrease by a random amount + tmp_min[which(tmp_weights < tmp_min)] <- tmp_min[which(tmp_weights < tmp_min)] - runif(1, 0.01, 0.05) + } + # check if max is violated + if(any(tmp_weights > tmp_max)){ + # Find which elements of min are violated and increase by a random amount + tmp_max[which(tmp_weights < tmp_max)] <- tmp_max[which(tmp_weights < tmp_max)] + runif(1, 0.01, 0.05) + } + + # Now try the transformation again + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) + # Default to original weights if this fails again + if(inherits(tmp_weights, "try-error")) tmp_weights <- weights + i <- i + 1 + } + # We have a feasible portfolio in terms of min_sum and max_sum, + # but were unable to produce a portfolio that satisfies box constraints + if(isTRUE(all.equal(tmp_weights, weights))){ + # reset min and max to their original values and penalize later + tmp_min <- min + tmp_max <- max + } # Other actions to consider # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) # different normalization method @@ -102,7 +133,8 @@ # check group constraints if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){ if(any(group_fail(tmp_weights, groups, cLO, cUP))){ - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + # Try to transform only considering leverage, box, and group constraints + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos=NULL, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -120,7 +152,8 @@ # check position_limit constraints if(!is.null(max_pos)){ if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){ - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500)) + # Try to transform only considering leverage, box, group, and position_limit constraints + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -157,7 +190,7 @@ } } names(tmp_weights) <- names(weights) - return(list(weights=tmp_weights, out=out)) + return(list(weights=tmp_weights, min=tmp_min, max=tmp_max, out=out)) } #' Transform weights that violate min or max box constraints Modified: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-06 16:42:48 UTC (rev 2510) +++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-06 19:36:06 UTC (rev 2511) @@ -33,7 +33,7 @@ fn_map(weights, portfolio) -# group constraints are violated +# group and position limit constraints are violated weights <- c(0.1, 0.65, 0.1, 0.15) sum(weights) @@ -44,3 +44,19 @@ sum(weights) fn_map(weights, portfolio) + +##### relaxing box constraints ##### +pspec <- portfolio.spec(assets=funds) + +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=T) +# make min infeasible and too restrictive +pspec <- add.constraint(portfolio=pspec, type="box", min=0.3, max=0.75, enabled=T) + +# weights satisfy leverage constraints but not box constraints +weights <- c(0.15, 0.05, 0.25, 0.55) +sum(weights) + +# min constraint needs to be relaxed +# note how min has been changed +fn_map(weights, pspec) + From noreply at r-forge.r-project.org Sun Jul 7 00:31:12 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 7 Jul 2013 00:31:12 +0200 (CEST) Subject: [Returnanalytics-commits] r2512 - pkg/PerformanceAnalytics/sandbox/Shubhankit Message-ID: <20130706223112.1D97F18495A@r-forge.r-project.org> Author: shubhanm Date: 2013-07-07 00:31:01 +0200 (Sun, 07 Jul 2013) New Revision: 2512 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R Log: Week 3: Stack Bar Plot of Autocorrelation Lag Factors Status : Backtested Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R 2013-07-06 22:31:01 UTC (rev 2512) @@ -0,0 +1,47 @@ +#' Stacked Bar Plot of Autocorrelation Lag Coefficients +#' +#' A wrapper to create box and whiskers plot of comparitive inputs +#' +#' 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 Burghardt, Duncan and Liu(2013) +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @return Stack Bar plot of lagged return coefficients +#' @author R +#' @seealso \code{\link[graphics]{boxplot}} +#' @references Burghardt, Duncan and Liu(2013) \emph{It's the autocorrelation, stupid}. AlternativeEdge Note November, 2012 } +#' @keywords Autocorrelation lag factors +#' @examples +#' +#' data(edhec) +#' chart.Autocorrelation(edhec) +#' +#' +#' @export +chart.Autocorrelation <- + function (R, ...) + { # @author R + + # DESCRIPTION: + # A wrapper to create box and whiskers plot, of autocorrelation lag coeffiecients + # of the First six factors + + R = checkData(R, method="xts") + +# Graph autos with adjacent bars using rainbow colors + +aa= table.Autocorrelation(R) +barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient", + , xlab = "Fund Type",beside=TRUE, col=rainbow(6)) + + # Place the legend at the top-left corner with no frame + # using rainbow colors + legend("topright", c("1","2","3","4","5","6"), cex=0.6, + bty="n", fill=rainbow(6)); + + + + +} \ No newline at end of file From noreply at r-forge.r-project.org Sun Jul 7 16:47:29 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 7 Jul 2013 16:47:29 +0200 (CEST) Subject: [Returnanalytics-commits] r2513 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130707144730.04496185510@r-forge.r-project.org> Author: pulkit Date: 2013-07-07 16:47:29 +0200 (Sun, 07 Jul 2013) New Revision: 2513 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R Log: Golden Section Algorithm Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R 2013-07-07 14:47:29 UTC (rev 2513) @@ -0,0 +1,64 @@ +#' @title +#' Golden Section Algorithm +#' +#' @description +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + + +golden_section<-function(a,b,minimum = TRUE,function_name,confidence,...){ + + # DESCRIPTION + # A function to perform the golden search algorithm on the provided function + + # Inputs: + # + # a: The starting point + # + # b: The end point + # + # minimum: If we want to calculate the minimum set minimum= TRUE(default) + # + # function_name: The name of the function + + FUN = match.fun(function_name) + tol = 10^-9 + sign = 1 + + if(!minimum){ + sign = -1 + } + N = round(ceiling(-2.078087*log(tol/abs(b-a)))) + r = 0.618033989 + c = 1.0 - r + x1 = r*a + c*b + x2 = c*a + r*b + f1 = sign * FUN(x1,...) + f2 = sign * FUN(x2,...) + for(i in 1:N){ + if(f1>f2){ + a = x1 + x1 = x2 + f1 = f2 + x2 = c*a+r*b + f2 = sign*FUN(x2,...) + } + else{ + b = x2 + x2 = x1 + f2 = f1 + x1 = r*a + c*b + f1 = sign*FUN(x1,...) + } + } + if(f1 Author: pulkit Date: 2013-07-07 19:28:51 +0200 (Sun, 07 Jul 2013) New Revision: 2514 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R Log: Time Under Water Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R 2013-07-07 17:28:51 UTC (rev 2514) @@ -0,0 +1,93 @@ +#' @title +#' Time Under Water +#' +#' @description +#' \code{TriplePenance} calculates the maximum +#' Time under water for a particular confidence interval. +#' +#'@param confidence The confidence level +#' @param R Hedge Fund log Returns +#' +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + +TuW<-function(R,confidence,...){ + x = checkData(R) + columns = ncol(R) + i = 0 + tp = matrix(nrow=columns) + + +getQ<-function(bets,phi,mu,sigma,dp0,confidence){ + + # DESCRIPTION: + # A function to get the quantile function for cumulative returns + # and a particular confidence interval. + + # Inputs: + # bets: The number fo steps + # + # phi: The coefficient for AR[1] + # + # mu: The mean of the returns + # + # sigma: The standard deviation of the returns + # + # dp0: The r0 or the first return + # + # confidence: The confidence level of the quantile function + mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets + var = sigma^2/(phi-1)^2 + var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1) + q_value = mu_new + qnorm(1-confidence)*(var^0.5) + return(q_value) +} + + +get_TuW<-function(R,confidence){ + + # DESCRIPTION: + # A function to generate the time under water + # + # Inputs: + # R: The function takes Returns as the input. + # + # confidence: Confidence level of the quantile function + + + x = checkData(R) + mu = mean(x, na.rm = TRUE) + sigma_infinity = StdDev(x) + phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) + sigma = sigma_infinity*((1-phi^2)^0.5) + + dp0 = 0 + q_value = 0 + bets = 0 + while(q_value <= 0){ + bets = bets + 1 + q_value = getQ(bets, phi, mu, sigma, dp0, confidence) + } + TuW = golden_section(bets-1,bets,TRUE,diff,mu,sigma_infinity,phi,sigma,dp0,confidence) + return(TuW$x) +} + + + +diff<-function(bets,phi,mu,sigma,dp0,confidence){ + return(abs(getQ(bets,phi,mu,sigma,dp0,confidence))) +} + + + + for(i in 1:columns){ + column_TuW = get_TuW(x[,i],confidence) + tp[i] <- column_TuW + } + + +rownames(tp)<-colnames(R) +colnames(tp)<-"Max Time Under Water" +return(tp) +} + + From noreply at r-forge.r-project.org Sun Jul 7 21:48:17 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 7 Jul 2013 21:48:17 +0200 (CEST) Subject: [Returnanalytics-commits] r2515 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130707194818.13C46183D96@r-forge.r-project.org> Author: pulkit Date: 2013-07-07 21:48:17 +0200 (Sun, 07 Jul 2013) New Revision: 2515 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R Removed: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R Log: Maximum Drawdown Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R 2013-07-07 17:28:51 UTC (rev 2514) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R 2013-07-07 19:48:17 UTC (rev 2515) @@ -5,7 +5,7 @@ #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). -golden_section<-function(a,b,minimum = TRUE,function_name,confidence,...){ +golden_section<-function(a,b,minimum = TRUE,function_name,...){ # DESCRIPTION # A function to perform the golden search algorithm on the provided function @@ -51,10 +51,10 @@ } } if(f1f2){ - a = x1 - x1 = x2 - f1 = f2 - x2 = c*a+r*b - f2 = sign*FUN(x2,phi,mu,sigma,dp0,confidence) - } - else{ - b = x2 - x2 = x1 - f2 = f1 - x1 = r*a + c*b - f1 = sign*FUN(x1,phi,mu,sigma,dp0,confidence) - } - } - if(f1 Author: shubhanm Date: 2013-07-08 02:36:43 +0200 (Mon, 08 Jul 2013) New Revision: 2516 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/ Log: Repository File Paths Chronological Change Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,36 @@ +GLMSmoothIndex<- + function(R = NULL, ...) + { + columns = 1 + columnnames = NULL + #Error handling if R is not NULL + if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + count = q + x=edhec + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(edhec[,column], method="vector", na.rm = TRUE) + + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] + values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + return(result.df) + + } + } \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,71 @@ +LoSharpeRatio<- + function(R = NULL,Rf=0.,q = 0., ...) + { +columns = 1 +columnnames = NULL +#Error handling if R is not NULL +if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + + if(q==0){ + stop("AutoCorrelation Coefficient Should be greater than 0") + + } + else{ + # A potfolio is constructed by applying the weights + + count = q + x=edhec + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(edhec[,column], method="vector", na.rm = TRUE) + + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] + LjungBox = Box.test(y,type="Ljung-Box",lag=q) + values = c(acflag6, LjungBox$p.value) + # values = base::round(as.numeric(values),digits) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + # Calculate Neta's + for(column in 1:columns) { + sum = 0 + z = checkData(edhec[,column], method="vector", na.rm = TRUE) + for(q in 1:(q-1) ) + { + sum = sum + (count-q)*result.df[column,q] + + } + + netaq = count/(sqrt(count+2*sum)) + if(column == 1) { + netacol = data.frame(Value = netaq) + colnames(netacol) = columnnames[column] + } + else { + nextcol = data.frame(Value = netaq) + colnames(nextcol) = columnnames[column] + netacol = cbind(netacol, nextcol) + } + + } + shrp = SharpeRatio(x, Rf, FUN="VaR" , method="gaussian") + results = Shrp*netacol + colnames(results) = colnames(x) + return(results) + } + } +} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,36 @@ +UnSmoothReturn<- + function(R = NULL,q, ...) + { + columns = 1 + columnnames = NULL + #Error handling if R is not NULL + if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + count = q + x=edhec + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(edhec[,column], method="vector", na.rm = TRUE) + + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] + values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + return(result.df[1:q,]*R) # Unsmooth Return + + } + } \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,79 @@ +#' Compenent Decomposition of Table of Unsmooth Returns +#' +#' Creates a table of estimates of moving averages for comparison across +#' multiple instruments or funds as well as their standard error and +#' smoothing index +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param ci confidence interval, defaults to 95\% +#' @param n number of series lags +#' @param p confidence level for calculation, default p=.99 +#' @param digits number of digits to round results to +#' @author R +#' @keywords ts smooth return models +#' +#' @export +table.UnsmoothReturn <- + function (R, n = 3, p= 0.95, digits = 4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # n : Number of lags + # p = Confifence Level + # Output: + # A table of estimates of Moving Average + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + + z = c(arma(x,0,2)$theta[1], + arma(x,0,2)$se.theta[1], + arma(x,0,2)$theta[2], + arma(x,0,2)$se.theta[2], + arma(x,0,2)$se.theta[2]) + znames = c( + "Moving Average(1)", + "Std Error of MA(1)", + "Moving Average(2)", + "Std Error of MA(2)", + "Smoothing Invest" + + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + +} + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: table.UnSmoothReturn.R +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,194 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +table.EMaxDDGBM <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev(x) + gamma<-sqrt(pi/8) + + if(mu==0){ + + Ed<-2*gamma*sig*sqrt(T) + + } + + else{ + + alpha<-mu*sqrt(T/(2*sig^2)) + + x<-alpha^2 + + if(mu>0){ + + mQp<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, + + 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, + + 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900, + + 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000, + + 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690, + + 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171, + + 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162, + + 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999, + + 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992, + + 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457, + + 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985, + + 2.621743),ncol=2) + + + + if(x<0.0005){ + + Qp<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y + + } + + if(x>5000){ + + Qp<-0.25*log(x)+0.49088 + + } + + Ed<-(2*sig^2/mu)*Qp + + } + + if(mu<0){ + + mQn<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150, + + 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400, + + 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800, + + 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000, + + 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000, + + 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708, + + 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229, + + 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056, + + 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393, + + 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455, + + 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380, + + 4.990430, 5.498820),ncol=2) + + + + + + if(x<0.0005){ + + Qn<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y + + } + + if(x>5000){ + + Qn<-x+0.50 + + } + + Ed<-(2*sig^2/mu)*(-Qn) + + } + + } + + # return(Ed) + + z = c((mu*100), + (sig*100), + (Ed*100)) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Expected Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,47 @@ +#' Stacked Bar Plot of Autocorrelation Lag Coefficients +#' +#' A wrapper to create box and whiskers plot of comparitive inputs +#' +#' 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 Burghardt, Duncan and Liu(2013) +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @return Stack Bar plot of lagged return coefficients +#' @author R +#' @seealso \code{\link[graphics]{boxplot}} +#' @references Burghardt, Duncan and Liu(2013) \emph{It's the autocorrelation, stupid}. AlternativeEdge Note November, 2012 } +#' @keywords Autocorrelation lag factors +#' @examples +#' +#' data(edhec) +#' chart.Autocorrelation(edhec) +#' +#' +#' @export +chart.Autocorrelation <- + function (R, ...) + { # @author R + + # DESCRIPTION: + # A wrapper to create box and whiskers plot, of autocorrelation lag coeffiecients + # of the First six factors + + R = checkData(R, method="xts") + +# Graph autos with adjacent bars using rainbow colors + +aa= table.Autocorrelation(R) +barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient", + , xlab = "Fund Type",beside=TRUE, col=rainbow(6)) + + # Place the legend at the top-left corner with no frame + # using rainbow colors + legend("topright", c("1","2","3","4","5","6"), cex=0.6, + bty="n", fill=rainbow(6)); + + + + +} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R 2013-07-08 00:36:43 UTC (rev 2516) @@ -0,0 +1,86 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +table.NormDD <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + n <- 1000 + dt <- 1/T; + r0 <- 100; + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev.annualized(x) + r <- matrix(0,T+1,n) # matrix to hold short rate paths + r[1,] <- r0 + drawdown <- matrix(0,n) + # return(Ed) + + for(j in 1:n){ + for(i in 2:(T+1)){ + + dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) + r[i,j] <- r[i-1,j] + dr + } + drawdown[j] = maxDrawdown(r[,j]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)*100))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + t <- seq(0, T, dt) + matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### From noreply at r-forge.r-project.org Mon Jul 8 05:41:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 05:41:25 +0200 (CEST) Subject: [Returnanalytics-commits] r2517 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130708034125.71EA218534A@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-08 05:41:25 +0200 (Mon, 08 Jul 2013) New Revision: 2517 Added: pkg/PortfolioAnalytics/sandbox/rp_shaw.R Log: adding testing script using ideas from the Shaw 2011 paper on generating random portfolios Added: pkg/PortfolioAnalytics/sandbox/rp_shaw.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/rp_shaw.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/rp_shaw.R 2013-07-08 03:41:25 UTC (rev 2517) @@ -0,0 +1,148 @@ +# R script to test the ideas in the Shaw 2011 paper + +# Function based on the Shaw 2011 paper to generate sets of portfolio weights +# with FEV biasing +rp_shaw <- function(N, p, k, L){ + # N = number of assets + # p = vector of values of p for level of FEV-biasing + # k = number of portfolios for each value of p + # L = lower bounds + + # generate uniform[0, 1] random numbers + U <- runif(n=k*N, 0, 1) + Umat <- matrix(data=U, nrow=k, ncol=N) + + # List to store the portfolios for each value of p + out <- list() + + # Create k portfolios for each value of p + # Total of k * length(p) portfolios + for(i in 1:length(p)){ + q <- 2^p[i] + tmp_Umat <- t(apply(Umat, 1, function(x) L + (1 - sum(L)) * log(x)^q / sum(log(x)^q))) + out[[i]] <- tmp_Umat + } + return(out) +} + +# Quick test of the rp_shaw function +# create 10 portfolios for 4 assets +tmp <- rp_shaw(N=6, p=0:5, k=10, L=rep(0, 6)) +tmp +do.call("rbind", tmp) + +##### Shaw 2011 Example ##### + +# Replicate exaple from Shaw 2011 +# covariance matrix 4.19 +Sigma <- rbind(c(0.0549686, 0.144599, -0.188442, 0.0846818, 0.21354, 0.0815392), + c(0.144599, 1.00269, -0.837786, 0.188534, 0.23907, -0.376582), + c(-0.188442, -0.837786, 1.65445, 0.404402, 0.34708, -0.350142), + c(0.0846818, 0.188534, 0.404402, 0.709815, 1.13685, -0.177787), + c(0.21354, 0.23907, 0.34708, 1.13685, 2.13408, 0.166434), + c(0.0815392, -0.376582, -0.350142, -0.177787, 0.166434, 0.890896)) +w_optimum <- c(0.883333, 0, 0.11667, 0, 0, 0) + +# Create 3,600,000 portfolios +# Create 600,000 portfolios of 6 assets for each value of p +# This is slow... takes about 30 seconds +# Investigate possible solutions for parallel random number generation in R +system.time( +tmp_shaw <- rp_shaw(N=6, p=0:5, k=600000, L=rep(0, 6)) +) +tmp <- do.call("rbind", tmp_shaw) + +# Calculate the objective function on the tmp matrix +# get this working in parallel + +# Define objective function +obj_fun <- function(x) t(x) %*% Sigma %*% x + +# single-core version using apply +# takes about 70 seconds +system.time( + obj1 <- apply(tmp, 1, obj_fun) +) + +# single-core version using lapply +# faster than apply... takes about 38 seconds +system.time( + obj2 <- unlist(lapply(1:nrow(tmp), function(x) obj_fun(tmp[x,]))) +) +all.equal(obj1, obj2) + +# multi-core version using mclapply +# faster than lapply version... takes about 24 seconds +library(multicore) +system.time( + obj3 <- unlist(mclapply(1:nrow(tmp), function(x) obj_fun(tmp[x,]))) +) +all.equal(obj1, obj3) + +# library(foreach) +# system.time( +# obj4 <- foreach(i=1:nrow(tmp)) %dopar% obj_fun(tmp[i,]) +# ) +# all.equal(obj1, obj4) + +# Find the minimum of the objective measure +tmp_min <- min(obj1) + +# Find the optimal weights that minimize the objective measure +w <- tmp[which.min(obj1),] + +# view the weights +print(round(w,6)) +print(w_optimum) + +# solution is close +print(all.equal(round(w,6), w_optimum)) + +##### Lower Bounds ##### +# Specify lower bounds +L <- c(0.1, 0.05, 0.05, 0.08) + +U <- runif(4, 0, 1) +log(U) / sum(log(U)) +# w_i = L_i + sum(L) * log(U_i)/sum(log(U) +w <- L + (1 - sum(L)) * log(U) / sum(log(U)) +w +sum(w) +all(w >= L) + +##### Lower Bounds with FEV Biasing ##### + +# N = number of assets +# p = vector of values of p for level of FEV-biasing +# k = number of portfolios for each value of p +# L = lower bounds +N <- 4 +k <- 10 +p <- 0:5 +L <- c(0.1, 0.05, 0.05, 0.08) + +U <- runif(n=k*N, 0, 1) +Umat <- matrix(data=U, nrow=k, ncol=N) + +# List to store the portfolios for each value of p +out <- list() + +# Create k portfolios for each value of p +# Total of k * length(p) portfolios +for(i in 1:length(p)){ + q <- 2^p[i] + tmp_Umat <- t(apply(Umat, 1, function(x) L + (1 - sum(L)) * log(x)^q / sum(log(x)^q))) + out[[i]] <- tmp_Umat +} +out + +# rbind each matrix in the list together +tmp <- do.call("rbind", out) +tmp + +# check that all the weights sum to 1 +apply(tmp, 1, sum) + +# check that all weights obey the lower bounds +apply(tmp, 1, function(x) all(x >= L)) + From noreply at r-forge.r-project.org Mon Jul 8 08:00:41 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 08:00:41 +0200 (CEST) Subject: [Returnanalytics-commits] r2518 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130708060041.A60A71808F5@r-forge.r-project.org> Author: shubhanm Date: 2013-07-08 08:00:40 +0200 (Mon, 08 Jul 2013) New Revision: 2518 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R Log: Week 2 : Autocorrelated adjusted Standard Deviation Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R 2013-07-08 06:00:40 UTC (rev 2518) @@ -0,0 +1,73 @@ +#' calculate a multiperiod or annualized Autocorrleation adjusted Standard Deviation +#' +#' @aliases sd.multiperiod sd.annualized StdDev.annualized +#' @param x an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param lag : number of autocorrelated lag factors inputted by user +#' @param scale number of periods in a year (daily scale = 252, monthly scale = +#' 12, quarterly scale = 4) +#' @param \dots any other passthru parameters +#' @author R +#' @seealso \code{\link[stats]{sd}} \cr +#' \url{http://wikipedia.org/wiki/inverse-square_law} +#' @references Burghardt, G., and L. Liu, \emph{ It's the Autocorrelation, Stupid (November 2012) Newedge +working paper.http://www.amfmblog.com/assets/Newedge-Autocorrelation.pdf \cr +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(edhec) +#' ACsd.annualized(edhec,3) + +#' +#' @export +#' @rdname ACStdDev.annualized +ACStdDev.annualized <- ACsd.annualized <- ACsd.multiperiod <- + function (x,lag, scale = NA, ...) + { + if(is.na(scale) && !xtsible(x)) + stop("'x' needs to be timeBased or xtsible, or scale must be specified." ) + + if(is.na(scale)) { + freq = periodicity(x) + switch(freq$scale, + #kChec + 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} + ) + } + + if (is.vector(x)) { + correl = acf(x,lag) + + #scale standard deviation by multiplying by the square root of the number of periods to scale by + sqrt(scale*(1+ 2*sum(correl$acf[2:(lag+1)])))*sd(x, na.rm=TRUE) + } else { + if(!xtsible(x) & is.na(scale)) + stop("'x' needs to be timeBased or xtsible, or scale must be specified." ) + x = checkData (x) + + result = apply(x, 2, sd.multiperiod, scale=scale) + + dim(result) = c(1,NCOL(x)) + colnames(result) = colnames(x) + rownames(result) = "Annualized Standard Deviation" + return(result) + } + } + +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2013 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: ACStdDev.annualized.R +# +############################################################################### From noreply at r-forge.r-project.org Mon Jul 8 08:54:28 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 08:54:28 +0200 (CEST) Subject: [Returnanalytics-commits] r2519 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130708065428.CF699184685@r-forge.r-project.org> Author: shubhanm Date: 2013-07-08 08:54:28 +0200 (Mon, 08 Jul 2013) New Revision: 2519 Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R Log: Modified Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R 2013-07-08 06:00:40 UTC (rev 2518) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/ACStdDev.annualized.R 2013-07-08 06:54:28 UTC (rev 2519) @@ -11,7 +11,7 @@ #' @seealso \code{\link[stats]{sd}} \cr #' \url{http://wikipedia.org/wiki/inverse-square_law} #' @references Burghardt, G., and L. Liu, \emph{ It's the Autocorrelation, Stupid (November 2012) Newedge -working paper.http://www.amfmblog.com/assets/Newedge-Autocorrelation.pdf \cr +#' working paper.http://www.amfmblog.com/assets/Newedge-Autocorrelation.pdf \cr #' @keywords ts multivariate distribution models #' @examples #' From noreply at r-forge.r-project.org Mon Jul 8 09:29:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 09:29:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2520 - pkg/Meucci/demo Message-ID: <20130708072931.3077F183FB9@r-forge.r-project.org> Author: xavierv Date: 2013-07-08 09:29:30 +0200 (Mon, 08 Jul 2013) New Revision: 2520 Added: pkg/Meucci/demo/S_EigenvalueDispersion.R Log: -added S_EigenvalueDispersion demo script Added: pkg/Meucci/demo/S_EigenvalueDispersion.R =================================================================== --- pkg/Meucci/demo/S_EigenvalueDispersion.R (rev 0) +++ pkg/Meucci/demo/S_EigenvalueDispersion.R 2013-07-08 07:29:30 UTC (rev 2520) @@ -0,0 +1,60 @@ +library(mvtnorm) + +#'This script displays the sample eigenvalues dispersion phenomenon, as described in A. Meucci, +#'"Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EigenValueDispersion.R" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs + +N = 50; +SampleLenght = seq( N , 10 * N, N) +nSim = 50; + +################################################################################################################## +### Generate mesh and surface + +Mu = matrix( 0, N, 1 ); +Sigma= diag( 1, N ); + +# compute true eigenvalues +Eigen = eigen(Sigma); +Index = order( -( Eigen$values )); +EVec = Eigen$vectors[ , Index ]; +EVal = diag( Eigen$Values[ Index, Index ]); + +# compute eigenvalues of sample estimator +nSampleLenght = length( SampleLenght ); +Store_EVal_Hat = matrix( NaN, nSampleLenght, N ); # preallocation for speed +for( i in 1 : nSampleLenght ) + { + T = SampleLenght[ i ]; + EVal_Hat = 0; + for( n in 1 : nSim ) + { + X = rmvnorm( T, Mu, Sigma ); + Sigma_Hat = cov( X ); + L = eigen( Sigma_Hat )$values; + Index = order(-(L)); + L = L[ Index]; + + EVal_Hat = EVal_Hat + L; + } + EVal_Hat = EVal_Hat / nSim; + + Store_EVal_Hat[ i, ] = t(EVal_Hat); +} + +################################################################################################################## +### Display surface +dev.new(); + +persp( SampleLenght/N, 1 :N , Store_EVal_Hat, + theta = 7 * 45, phi = 30, expand=0.6, col='lightblue', shade=0.75, ltheta=120, + ticktype='detailed', xlab = "eigenvalue #", ylab = "sample lenght/N"); + From noreply at r-forge.r-project.org Mon Jul 8 12:08:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 12:08:13 +0200 (CEST) Subject: [Returnanalytics-commits] r2521 - pkg/Meucci/demo Message-ID: <20130708100813.99FAD1804C8@r-forge.r-project.org> Author: xavierv Date: 2013-07-08 12:08:13 +0200 (Mon, 08 Jul 2013) New Revision: 2521 Added: pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R Log: -added S_EstimateExpectedValueEvaluation demo script Added: pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R =================================================================== --- pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R (rev 0) +++ pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R 2013-07-08 10:08:13 UTC (rev 2521) @@ -0,0 +1,143 @@ +#'This script script familiarizes the user with the evaluation of an estimator replicability, loss, error, bias and inefficiency +#', as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EigenValueprintersion.R" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs +T = 52; # number of observations in time series +Mu = 0.1; +Sigma = 0.2; + +################################################################################################################## +### Plain vanilla estimation +# unknown functional of the distribution to be estimated, in this case the expected value +G_fX = exp( Mu + 0.5 * Sigma^2 ); +print( G_fX ); + +i_T = matrix( rlnorm( T, Mu, Sigma ), 1, T); # series generated by "nature": do not know the distribution + +G_Hat_1 = function(X) X[ , 1 ] * X[ ,3 ]; # estimator of unknown functional G_1=x(1)*x(3) +G_Hat_2 = function(X) apply( X, 1,mean); # estimator of unknown functional G_1=sample mean + +G1 = G_Hat_1( i_T ); +G2 = G_Hat_2( i_T ); +print( G1 ); +print( G2 ); + +################################################################################################################## +### Replicability vs. "luck" +# unknown functional of the distribution to be estimated, in this case the expected value +G_fX = exp( Mu + 0.5 * Sigma^2 ); + +nSim = 10000; +I_T = matrix( rlnorm( nSim * T, Mu, Sigma ), nSim, T); # randomize series generated by "nature" to check replicability + +G1 = G_Hat_1( I_T ); # estimator of unknown functional G_1=x(1)*x(3) +G2 = G_Hat_2( I_T ); # estimator of unknown functional G_2=sample mean + +Loss_G1 = (G1 - G_fX)^2; +Loss_G2 = (G2 - G_fX)^2; + +Err_G1 = sqrt(mean(Loss_G1)); +Err_G2 = sqrt(mean(Loss_G2)); + +Bias_G1 = abs(mean(G1) - G_fX); +Bias_G2 = abs(mean(G2) - G_fX); + +Ineff_G1 = sd( G1 ); +Ineff_G2 = sd( G2 ); + +################################################################################################################## +### printlay results +dev.new() +NumBins = round( 10 * log( nSim ) ); +par( mfrow = c(2,1) ); +hist(G1, NumBins); +points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); +#set(h, 'markersize', 20, 'col', 'r'); + +hist(G2, NumBins); +points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); +#set(h, 'markersize', 20, 'col', 'r'); + + +# loss +dev.new(); +par( mfrow = c(2,1) ); +hist(Loss_G1, NumBins, main = "estimator: x(1)*x(3)"); + +hist(Loss_G2, NumBins, main = "estimator: sample mean" ); + + +################################################################################################################## +### Stress test replicability +Mus = seq( 0, 0.7, 0.1 ); + +Err_G1sq = NULL; +Err_G2sq = NULL; +Bias_G1sq = NULL; +Bias_G2sq = NULL; +Ineff_G1sq = NULL; +Ineff_G2sq = NULL; + +for( j in 1 : length(Mus) ) +{ + Mu = Mus[ j ]; + + # unknown functional of the distribution to be estimated, in this case the expected value + G_fX = exp( Mu + 0.5 * Sigma^2); + I_T = matrix( rlnorm( nSim * T, Mu, Sigma ), nSim, T); # randomize series generated by "nature" to check replicability + + G1 = G_Hat_1(I_T); # estimator of unknown functional G_1=x(1)*x(3) + G2 = G_Hat_2(I_T); # estimator of unknown functional G_2=sample mean + + Loss_G1 = ( G1 - G_fX )^2; + Loss_G2 = ( G2 - G_fX )^2; + + Err_G1 = sqrt(mean(Loss_G1)); + Err_G2 = sqrt(mean(Loss_G2)); + Err_G1sq = cbind( Err_G1sq, Err_G1^2 ); ##ok<*AGROW> #store results + Err_G2sq = cbind( Err_G2sq, Err_G2^2 ); + + Bias_G1 = abs( mean( G1 )- G_fX ); + Bias_G2 = abs( mean( G2 )- G_fX ); + Bias_G1sq = cbind( Bias_G1sq, Bias_G1^2 ); #store results + Bias_G2sq = cbind( Bias_G2sq, Bias_G2^2 ); + + Ineff_G1 = sd(G1); + Ineff_G2 = sd(G2); + Ineff_G1sq = cbind(Ineff_G1sq, Ineff_G1^2); #store results + Ineff_G2sq = cbind(Ineff_G2sq, Ineff_G2^2); + + dev.new(); + NumBins = round(10*log(nSim)); + par( mfrow = c(2,1) ); + + hist(G1, NumBins); + points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); + + hist(G2, NumBins); + points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); + +} + +dev.new(); +par( mfrow = c(2,1) ); + +b = barplot(Bias_G1sq + Ineff_G1sq, col = "red", main = "stress-test of estimator: x(1)*x(3)"); +barplot( Ineff_G1sq, col="blue", add = TRUE); +lines( b, Err_G1sq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); + + +b=barplot( Bias_G2sq + Ineff_G2sq , col = "red", main = "stress-test of estimator sample mean"); +barplot( Ineff_G2sq, col="blue", add = TRUE); +lines(b, Err_G2sq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); From noreply at r-forge.r-project.org Mon Jul 8 21:19:58 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 21:19:58 +0200 (CEST) Subject: [Returnanalytics-commits] r2522 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130708191958.945BB184B7B@r-forge.r-project.org> Author: shubhanm Date: 2013-07-08 21:19:58 +0200 (Mon, 08 Jul 2013) New Revision: 2522 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R Log: Week 2: Table for Comparative Analysis of Smooth and Unsmooth Returns for GLM Model Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R 2013-07-08 19:19:58 UTC (rev 2522) @@ -0,0 +1,76 @@ +#' Compenent Decomposition of Table of Unsmooth Returns for GLM Model +#' +#' Creates a table of comparitive changes in Normality Properties for Third +#' and Fourth Moment Vectors i.e. Skewness and Kurtosis for Orignal and Unsmooth +#' Returns Respectively +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param ci confidence interval, defaults to 95\% +#' @param n number of series lags +#' @param digits number of digits to round results to +#' @author R +#' @keywords ts unsmooth GLM return models +#' +#' @export +table.ComparitiveReturn.GLM <- + function (R, n = 3, digits = 4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # n : Number of lags + # p = Confifence Level + # Output: + # A table of estimates of Moving Average + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + skew = skewness(x) + arma.coeff= arma(x,0,n) + kurt= kurtosis(x) + z = c(skew, + ((sum(arma.coeff$theta^2)^1.5)*(skew/(sum(arma.coeff$theta^3)))), + kurt, + (kurt*(sum(arma.coeff$theta^2)^2)/(sum(arma.coeff$theta^4)))) + znames = c( + "Skewness ( Orignal) ", + "Skewness (Unsmooth)", + "Kurtosis (Orignal)", + "Kurtosis (Unsmooth)") + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: table.ComparitiveReturn.GLM +# +############################################################################### From noreply at r-forge.r-project.org Mon Jul 8 22:51:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 22:51:22 +0200 (CEST) Subject: [Returnanalytics-commits] r2523 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130708205122.3A77B184D15@r-forge.r-project.org> Author: shubhanm Date: 2013-07-08 22:51:21 +0200 (Mon, 08 Jul 2013) New Revision: 2523 Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R Log: Modified Code Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R 2013-07-08 19:19:58 UTC (rev 2522) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.ComparitiveReturn.GLM.R 2013-07-08 20:51:21 UTC (rev 2523) @@ -42,7 +42,7 @@ z = c(skew, ((sum(arma.coeff$theta^2)^1.5)*(skew/(sum(arma.coeff$theta^3)))), kurt, - (kurt*(sum(arma.coeff$theta^2)^2)/(sum(arma.coeff$theta^4)))) + (kurt*(sum(arma.coeff$theta^2)^2-6*(sum(arma.coeff$theta^2)*sum(arma.coeff$theta^2)))/(sum(arma.coeff$theta^4)))) znames = c( "Skewness ( Orignal) ", "Skewness (Unsmooth)", From noreply at r-forge.r-project.org Tue Jul 9 01:53:40 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 01:53:40 +0200 (CEST) Subject: [Returnanalytics-commits] r2524 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130708235340.42DAC18477E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-09 01:53:39 +0200 (Tue, 09 Jul 2013) New Revision: 2524 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/sandbox/testing_fn_map.R Log: Modified fn_map to relax group constraints. Updated testing_fn_map script with example Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-08 20:51:21 UTC (rev 2523) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-08 23:53:39 UTC (rev 2524) @@ -59,6 +59,8 @@ tmp_weights <- weights tmp_min <- min tmp_max <- max + tmp_cLO <- cLO + tmp_cUP <- cUP # step 2: check that the vector of weights satisfies the constraints, # transform weights if constraint is violated @@ -94,6 +96,7 @@ tmp_weights <- weights i <- 1 # loop while constraints are violated and relax constraints + # try to relax constraints up to 5 times while((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum | any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) & i <= 5){ # check if min is violated if(any(tmp_weights < tmp_min)){ @@ -131,13 +134,36 @@ } # check group constraints - if(!is.null(groups) & !is.null(cLO) & !is.null(cUP)){ - if(any(group_fail(tmp_weights, groups, cLO, cUP))){ + if(!is.null(groups) & !is.null(tmp_cLO) & !is.null(tmp_cUP)){ + if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))){ # Try to transform only considering leverage, box, and group constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights + i <- 1 + # loop while constraints are violated and relax constraints + # Try to relax constraints up to 5 times + while(((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum) | (any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) | any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))) & i <= 5){ + if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))){ + # I know which group failed, but not if it was cUP or cLO that was violated + # Maybe I can modify group_fail to report back what was violated and only relax cLO or cUP, not both + # This relaxes both cLO and cUP + tmp_cLO[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cLO[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] - runif(1, 0.01, 0.05) + tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + runif(1, 0.01, 0.05) + } + # Now try the transformation again + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, 500)) + if(inherits(tmp_weights, "try-error")) tmp_weights <- weights + i <- i + 1 + } + # We have a feasible portfolio in terms of min_sum and max_sum, + # but were unable to produce a portfolio that satisfies group constraints + if(isTRUE(all.equal(tmp_weights, weights))){ + # reset min and max to their original values and penalize later + tmp_cLO <- cLO + tmp_cUP <- cUP + } # Other actions to consider # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) # different normalization method @@ -153,7 +179,7 @@ if(!is.null(max_pos)){ if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){ # Try to transform only considering leverage, box, group, and position_limit constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -190,7 +216,7 @@ } } names(tmp_weights) <- names(weights) - return(list(weights=tmp_weights, min=tmp_min, max=tmp_max, out=out)) + return(list(weights=tmp_weights, min=tmp_min, max=tmp_max, cLO=tmp_cLO, cUP=tmp_cUP, out=out)) } #' Transform weights that violate min or max box constraints Modified: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-08 20:51:21 UTC (rev 2523) +++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-08 23:53:39 UTC (rev 2524) @@ -60,3 +60,18 @@ # note how min has been changed fn_map(weights, pspec) +##### relaxing group constraints ##### +pspec <- portfolio.spec(assets=funds) + +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=T) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.05, max=0.7, enabled=T) +# Make group constraints too restrictive +pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2, 2), + group_min=c(0.05, 0.01), group_max=c(0.45, 0.55), enabled=T) + +# weights satisfy leverage and box constraints, but not group +weights <- c(0.15, 0.05, 0.10, 0.7) + +# group constraints needs to be relaxed +# note how cLO and cUP have been changed +fn_map(weights, pspec) From noreply at r-forge.r-project.org Tue Jul 9 02:16:28 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 02:16:28 +0200 (CEST) Subject: [Returnanalytics-commits] r2525 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130709001628.1BF121858CA@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-09 02:16:27 +0200 (Tue, 09 Jul 2013) New Revision: 2525 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/sandbox/testing_fn_map.R Log: Added optional argument to fn_map to enable/disable relaxing of constraints Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-08 23:53:39 UTC (rev 2524) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-09 00:16:27 UTC (rev 2525) @@ -17,6 +17,7 @@ #' #' @param weights vector of weights #' @param portfolio object of class portfolio +#' @param relax TRUE/FALSE, default FALSE. Enable constraints to be relaxed #' @return #' \itemize{ #' \item{weights: }{vector of transformed weights meeting constraints} @@ -24,7 +25,7 @@ #' } #' @author Ross Bennett #' @export -fn_map <- function(weights, portfolio, ...){ +fn_map <- function(weights, portfolio, relax=FALSE, ...){ if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class 'portfolio'") @@ -94,44 +95,40 @@ if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights - i <- 1 - # loop while constraints are violated and relax constraints - # try to relax constraints up to 5 times - while((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum | any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) & i <= 5){ - # check if min is violated - if(any(tmp_weights < tmp_min)){ - # Find which elements of min are violated and decrease by a random amount - tmp_min[which(tmp_weights < tmp_min)] <- tmp_min[which(tmp_weights < tmp_min)] - runif(1, 0.01, 0.05) + # Try to relax constraints if relax=TRUE + if(relax){ + i <- 1 + # loop while constraints are violated and relax constraints + # try to relax constraints up to 5 times + while((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum | any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) & i <= 5){ + # check if min is violated + if(any(tmp_weights < tmp_min)){ + # Find which elements of min are violated and decrease by a random amount + tmp_min[which(tmp_weights < tmp_min)] <- tmp_min[which(tmp_weights < tmp_min)] - runif(1, 0.01, 0.05) + } + # check if max is violated + if(any(tmp_weights > tmp_max)){ + # Find which elements of min are violated and increase by a random amount + tmp_max[which(tmp_weights < tmp_max)] <- tmp_max[which(tmp_weights < tmp_max)] + runif(1, 0.01, 0.05) + } + + # Now try the transformation again + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) + # Default to original weights if this fails again + if(inherits(tmp_weights, "try-error")) tmp_weights <- weights + i <- i + 1 } - # check if max is violated - if(any(tmp_weights > tmp_max)){ - # Find which elements of min are violated and increase by a random amount - tmp_max[which(tmp_weights < tmp_max)] <- tmp_max[which(tmp_weights < tmp_max)] + runif(1, 0.01, 0.05) + # We have a feasible portfolio in terms of min_sum and max_sum, + # but were unable to produce a portfolio that satisfies box constraints + if(isTRUE(all.equal(tmp_weights, weights))){ + # reset min and max to their original values and penalize later + tmp_min <- min + tmp_max <- max } - - # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) - # Default to original weights if this fails again - if(inherits(tmp_weights, "try-error")) tmp_weights <- weights - i <- i + 1 - } - # We have a feasible portfolio in terms of min_sum and max_sum, - # but were unable to produce a portfolio that satisfies box constraints - if(isTRUE(all.equal(tmp_weights, weights))){ - # reset min and max to their original values and penalize later - tmp_min <- min - tmp_max <- max - } - # Other actions to consider - # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) - # different normalization method - # return initial weights and penalize? - } - # print("box constraints violated, transforming weights.") - # print(tmp_weights) - # tmp_weights <- txfrm_box_constraint(tmp_weights, min, max) - } - } + } # end if(relax) statement + } # end try-error recovery + } # end check for box constraint violation + } # end check for NULL arguments # check group constraints if(!is.null(groups) & !is.null(tmp_cLO) & !is.null(tmp_cUP)){ @@ -141,39 +138,35 @@ if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights - i <- 1 - # loop while constraints are violated and relax constraints - # Try to relax constraints up to 5 times - while(((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum) | (any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) | any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))) & i <= 5){ - if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))){ - # I know which group failed, but not if it was cUP or cLO that was violated - # Maybe I can modify group_fail to report back what was violated and only relax cLO or cUP, not both - # This relaxes both cLO and cUP - tmp_cLO[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cLO[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] - runif(1, 0.01, 0.05) - tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + runif(1, 0.01, 0.05) + # Try to relax constraints if relax=TRUE + if(relax){ + i <- 1 + # loop while constraints are violated and relax constraints + # Try to relax constraints up to 5 times + while(((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum) | (any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) | any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))) & i <= 5){ + if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))){ + # I know which group failed, but not if it was cUP or cLO that was violated + # Maybe I can modify group_fail to report back what was violated and only relax cLO or cUP, not both + # This relaxes both cLO and cUP + tmp_cLO[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cLO[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] - runif(1, 0.01, 0.05) + tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + runif(1, 0.01, 0.05) + } + # Now try the transformation again + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, 500), silent=TRUE) + if(inherits(tmp_weights, "try-error")) tmp_weights <- weights + i <- i + 1 } - # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, 500)) - if(inherits(tmp_weights, "try-error")) tmp_weights <- weights - i <- i + 1 - } - # We have a feasible portfolio in terms of min_sum and max_sum, - # but were unable to produce a portfolio that satisfies group constraints - if(isTRUE(all.equal(tmp_weights, weights))){ - # reset min and max to their original values and penalize later - tmp_cLO <- cLO - tmp_cUP <- cUP - } - # Other actions to consider - # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) - # different normalization method - # return initial weights and penalize? - } - # print("group constraints violated, transforming weights.") - # print(tmp_weights) - # tmp_weights <- txfrm_group_constraint(tmp_weights, groups, cLO, cUP) - } - } + # We have a feasible portfolio in terms of min_sum and max_sum, + # but were unable to produce a portfolio that satisfies group constraints + if(isTRUE(all.equal(tmp_weights, weights))){ + # reset min and max to their original values and penalize later + tmp_cLO <- cLO + tmp_cUP <- cUP + } + } # end if(relax) statement + } # end try-error recovery + } # end check for group constraint violation + } # end check for NULL arguments # check position_limit constraints if(!is.null(max_pos)){ Modified: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-08 23:53:39 UTC (rev 2524) +++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-09 00:16:27 UTC (rev 2525) @@ -58,7 +58,7 @@ # min constraint needs to be relaxed # note how min has been changed -fn_map(weights, pspec) +fn_map(weights, pspec, TRUE) ##### relaxing group constraints ##### pspec <- portfolio.spec(assets=funds) @@ -67,11 +67,11 @@ pspec <- add.constraint(portfolio=pspec, type="box", min=0.05, max=0.7, enabled=T) # Make group constraints too restrictive pspec <- add.constraint(portfolio=pspec, type="group", groups=c(2, 2), - group_min=c(0.05, 0.01), group_max=c(0.45, 0.55), enabled=T) + group_min=c(0.05, 0.01), group_max=c(0.45, 0.5), enabled=T) # weights satisfy leverage and box constraints, but not group weights <- c(0.15, 0.05, 0.10, 0.7) # group constraints needs to be relaxed # note how cLO and cUP have been changed -fn_map(weights, pspec) +fn_map(weights, pspec, TRUE) From noreply at r-forge.r-project.org Tue Jul 9 02:35:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 02:35:39 +0200 (CEST) Subject: [Returnanalytics-commits] r2526 - in pkg/PortfolioAnalytics: R man Message-ID: <20130709003539.9B979185810@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-09 02:35:39 +0200 (Tue, 09 Jul 2013) New Revision: 2526 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/fn_map.Rd Log: Updating documentation and help file for fn_map function Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-09 00:16:27 UTC (rev 2525) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-09 00:35:39 UTC (rev 2526) @@ -12,15 +12,24 @@ #' transformations will violate the box constraints, and we'll need to #' transform back again. #' -#' leverage, box, group, and position limit constraints are transformed -#' diversification and turnover constraints are penalized +#' If relax=TRUE, we will attempt to relax the constraints if a feasible +#' portfolio could not be formed with an initial call to \code{rp_transform}. +#' We will attempt to relax the constraints up to 5 times. If we do not have a +#' feasible portfolio after attempting to relax the constraints, then we will +#' default to returning the weights vector that violates the constraints. #' +#' Leverage, box, group, and position limit constraints are transformed. Diversification and turnover constraints are penalized +#' #' @param weights vector of weights #' @param portfolio object of class portfolio -#' @param relax TRUE/FALSE, default FALSE. Enable constraints to be relaxed +#' @param relax TRUE/FALSE, default FALSE. Enable constraints to be relaxed. #' @return #' \itemize{ #' \item{weights: }{vector of transformed weights meeting constraints} +#' \item{min: }{vector of min box constraints that may have been modified if relax=TRUE} +#' \item{max: }{vector of max box constraints that may have been modified if relax=TRUE} +#' \item{cLO: }{vector of lower bound group constraints that may have been modified if relax=TRUE} +#' \item{cUP: }{vector of upper bound group constraints that may have been modified if relax=TRUE} #' \item{out: }{penalty term} #' } #' @author Ross Bennett Modified: pkg/PortfolioAnalytics/man/fn_map.Rd =================================================================== --- pkg/PortfolioAnalytics/man/fn_map.Rd 2013-07-09 00:16:27 UTC (rev 2525) +++ pkg/PortfolioAnalytics/man/fn_map.Rd 2013-07-09 00:35:39 UTC (rev 2526) @@ -2,16 +2,26 @@ \alias{fn_map} \title{mapping function to transform or penalize weights that violate constraints} \usage{ - fn_map(weights, portfolio, ...) + fn_map(weights, portfolio, relax = FALSE, ...) } \arguments{ \item{weights}{vector of weights} \item{portfolio}{object of class portfolio} + + \item{relax}{TRUE/FALSE, default FALSE. Enable + constraints to be relaxed.} } \value{ \itemize{ \item{weights: }{vector of transformed weights - meeting constraints} \item{out: }{penalty term} } + meeting constraints} \item{min: }{vector of min box + constraints that may have been modified if relax=TRUE} + \item{max: }{vector of max box constraints that may have + been modified if relax=TRUE} \item{cLO: }{vector of lower + bound group constraints that may have been modified if + relax=TRUE} \item{cUP: }{vector of upper bound group + constraints that may have been modified if relax=TRUE} + \item{out: }{penalty term} } } \description{ The purpose of the mapping function is to transform a @@ -27,10 +37,16 @@ violate the box constraints, and we'll need to transform back again. - This function will replace constraint_fn_map + If relax=TRUE, we will attempt to relax the constraints + if a feasible portfolio could not be formed with an + initial call to \code{rp_transform}. We will attempt to + relax the constraints up to 5 times. If we do not have a + feasible portfolio after attempting to relax the + constraints, then we will default to returning the + weights vector that violates the constraints. - leverage, box, group, and position limit constraints are - transformed diversification and turnover constraints are + Leverage, box, group, and position limit constraints are + transformed. Diversification and turnover constraints are penalized } \author{ From noreply at r-forge.r-project.org Tue Jul 9 04:53:42 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 04:53:42 +0200 (CEST) Subject: [Returnanalytics-commits] r2527 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130709025342.DBAB0184EE3@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-09 04:53:42 +0200 (Tue, 09 Jul 2013) New Revision: 2527 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/sandbox/testing_fn_map.R Log: adding functionality to relax position limit constraints in fn_map Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-09 00:35:39 UTC (rev 2526) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-09 02:53:42 UTC (rev 2527) @@ -71,6 +71,7 @@ tmp_max <- max tmp_cLO <- cLO tmp_cUP <- cUP + tmp_max_pos <- max_pos # step 2: check that the vector of weights satisfies the constraints, # transform weights if constraint is violated @@ -85,16 +86,9 @@ if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights - # Other actions to consider - # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) - # different normalization method - # return initial weights and penalize? - } - # print("leverage constraint violated, transforming weights.") - # print(tmp_weights) - # tmp_weights <- txfrm_weight_sum_constraint(tmp_weights, min_sum, max_sum) - } - } + } # end try-error recovery + } # end check for leverage constraint violation + } # end check for NULL arguments # check box constraints if(!is.null(tmp_min) & !is.null(tmp_max)){ @@ -178,23 +172,27 @@ } # end check for NULL arguments # check position_limit constraints - if(!is.null(max_pos)){ - if(!(sum(abs(tmp_weights) > tolerance) <= max_pos)){ + if(!is.null(tmp_max_pos)){ + if(!(sum(abs(tmp_weights) > tolerance) <= tmp_max_pos)){ # Try to transform only considering leverage, box, group, and position_limit constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights - # Other actions to consider - # relax constraints (rp_transform checks all constraints together so we may not know which constraint is too restrictive) - # different normalization method - # return initial weights and penalize? - } - # print("position_limit constraint violated, transforming weights.") - # print(tmp_weights) - # tmp_weights <- txfrm_position_limit_constraint(tmp_weights, max_pos, nassets) - } - } + if(relax){ + i <- 1 + while((sum(abs(tmp_weights) > tolerance) > tmp_max_pos) & (tmp_max_pos <= nassets) & (i <= 5)){ + # increment tmp_max_pos by 1 + tmp_max_pos <- tmp_max_pos + 1 + # Now try the transformation again + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, 500), silent=TRUE) + if(inherits(tmp_weights, "try-error")) tmp_weights <- weights + i <- i + 1 + } + } # end if(relax) statement + } # end try-error recovery + } # end check for position limit constraint violation + } # end check for NULL arguments # check diversification constraint if(!is.null(div_target)){ @@ -218,7 +216,13 @@ } } names(tmp_weights) <- names(weights) - return(list(weights=tmp_weights, min=tmp_min, max=tmp_max, cLO=tmp_cLO, cUP=tmp_cUP, out=out)) + return(list(weights=tmp_weights, + min=tmp_min, + max=tmp_max, + cLO=tmp_cLO, + cUP=tmp_cUP, + max_pos=tmp_max_pos, + out=out)) } #' Transform weights that violate min or max box constraints Modified: pkg/PortfolioAnalytics/sandbox/testing_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-09 00:35:39 UTC (rev 2526) +++ pkg/PortfolioAnalytics/sandbox/testing_fn_map.R 2013-07-09 02:53:42 UTC (rev 2527) @@ -75,3 +75,19 @@ # group constraints needs to be relaxed # note how cLO and cUP have been changed fn_map(weights, pspec, TRUE) + +##### relaxing position limits constraints ##### +pspec <- portfolio.spec(assets=funds) + +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=T) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.05, max=0.4, enabled=T) +# Make position limit constraint too restrictive +pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=2, enabled=T) + +# weights satisfy leverage and box constraints, but not group +weights <- c(0.4, 0.05, 0.15, 0.4) + +# position limit constraint needs to be relaxed +# note how max_pos has been increased to 3 +fn_map(weights, pspec, TRUE) + From noreply at r-forge.r-project.org Tue Jul 9 09:06:21 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 09:06:21 +0200 (CEST) Subject: [Returnanalytics-commits] r2528 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130709070621.F1EBD180488@r-forge.r-project.org> Author: pulkit Date: 2013-07-09 09:06:21 +0200 (Tue, 09 Jul 2013) New Revision: 2528 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenance.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R Log: table for Triple Penance Rule Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R 2013-07-09 02:53:42 UTC (rev 2527) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R 2013-07-09 07:06:21 UTC (rev 2528) @@ -3,8 +3,12 @@ #' #' @description #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). +#' +#'@param a initial point +#'@param b final point +#'@param minimum TRUE to calculate the minimum and FALSE to calculate the Maximum +#'@param function_name The name of the function - golden_section<-function(a,b,minimum = TRUE,function_name,...){ # DESCRIPTION Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R 2013-07-09 02:53:42 UTC (rev 2527) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R 2013-07-09 07:06:21 UTC (rev 2528) @@ -1,18 +1,12 @@ -library(PerformanceAnalytics) -data(edhec) + #' @title #' Triple Penance Rule #' #' @description -#' \code{TriplePenance} calculates the Maximum drawdown and the maximum -#' Time under water for a particular confidence interval. These concepts -#' are intenately related through the "triple penance" rule which states -#' that under standard portfolio theory assumptions, it takes three times -#' longer to recover from the expected maximum drawdown than the time it -#' takes to produce it, with the same confidence level. The framework is -#' generalized to deal with the case of first-order auto-correlated cashflows -#' -#' @param R Hedge Fund log Returns +#' \code{MaxDD} calculates the Maximum drawdown for a particular confidence interval. +#' +#' @param R Returns +#' @param confidence the confidence interval #' #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). @@ -22,60 +16,8 @@ columns = ncol(x) i = 0 tp = matrix(nrow=columns,ncol=2) -get_minq<-function(R,confidence){ - - # DESCRIPTION: - # A function to get the maximum drawdown for first order serially autocorrelated - # returns from the quantile function defined for accumulated returns for a - # particular confidence interval - # Inputs: - # R: The function takes Returns as the input - # - # confidence: The confidence interval of the input. - x = checkData(R) - mu = mean(x, na.rm = TRUE) - sigma_infinity = StdDev(x) - phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) - sigma = sigma_infinity*((1-phi^2)^0.5) - dp0 = 0 - q_value = 0 - bets = 0 - while(q_value <= 0){ - bets = bets + 1 - q_value = getQ(bets, phi, mu, sigma, dp0, confidence) - } - minQ = golden_section(0,bets,TRUE,getQ,phi,mu,sigma,dp0,confidence) - return(c(-minQ$value*100,minQ$x)) -} - -getQ<-function(bets,phi,mu,sigma,dp0,confidence){ - - # DESCRIPTION: - # A function to get the quantile function for cumulative returns - # and a particular confidence interval. - - # Inputs: - # bets: The number fo steps - # - # phi: The coefficient for AR[1] - # - # mu: The mean of the returns - # - # sigma: The standard deviation of the returns - # - # dp0: The r0 or the first return - # - # confidence: The confidence level of the quantile function - mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets - var = sigma^2/(phi-1)^2 - var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1) - q_value = mu_new + qnorm(1-confidence)*(var^0.5) - return(q_value) -} - - for(i in 1:columns){ column_MinQ <- get_minq(x[,i],confidence) tp[i,] <- column_MinQ Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenance.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenance.R 2013-07-09 07:06:21 UTC (rev 2528) @@ -0,0 +1,86 @@ +get_minq<-function(R,confidence){ + + # DESCRIPTION: + # A function to get the maximum drawdown for first order serially autocorrelated + # returns from the quantile function defined for accumulated returns for a + # particular confidence interval + + # Inputs: + # R: The function takes Returns as the input + # + # confidence: The confidence interval of the input. + x = checkData(R) + mu = mean(x, na.rm = TRUE) + sigma_infinity = StdDev(x) + phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) + sigma = sigma_infinity*((1-phi^2)^0.5) + dp0 = 0 + q_value = 0 + bets = 0 + while(q_value <= 0){ + bets = bets + 1 + q_value = getQ(bets, phi, mu, sigma, dp0, confidence) + } + minQ = golden_section(0,bets,TRUE,getQ,phi,mu,sigma,dp0,confidence) + return(c(-minQ$value*100,minQ$x)) +} + + +getQ<-function(bets,phi,mu,sigma,dp0,confidence){ + + # DESCRIPTION: + # A function to get the quantile function for cumulative returns + # and a particular confidence interval. + + # Inputs: + # bets: The number fo steps + # + # phi: The coefficient for AR[1] + # + # mu: The mean of the returns + # + # sigma: The standard deviation of the returns + # + # dp0: The r0 or the first return + # + # confidence: The confidence level of the quantile function + mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets + var = sigma^2/(phi-1)^2 + var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1) + q_value = mu_new + qnorm(1-confidence)*(var^0.5) + return(q_value) +} +get_TuW<-function(R,confidence){ + + # DESCRIPTION: + # A function to generate the time under water + # + # Inputs: + # R: The function takes Returns as the input. + # + # confidence: Confidence level of the quantile function + + + x = checkData(R) + mu = mean(x, na.rm = TRUE) + sigma_infinity = StdDev(x) + phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) + sigma = sigma_infinity*((1-phi^2)^0.5) + + dp0 = 0 + q_value = 0 + bets = 0 + while(q_value <= 0){ + bets = bets + 1 + q_value = getQ(bets, phi, mu, sigma, dp0, confidence) + } + TuW = golden_section(bets-1,bets,TRUE,diff_Q,phi,mu,sigma,dp0,confidence) + return(TuW$x) +} + + + +diff_Q<-function(bets,phi,mu,sigma,dp0,confidence){ + return(abs(getQ(bets,phi,mu,sigma,dp0,confidence))) +} + Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R 2013-07-09 02:53:42 UTC (rev 2527) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R 2013-07-09 07:06:21 UTC (rev 2528) @@ -5,8 +5,8 @@ #' \code{TriplePenance} calculates the maximum #' Time under water for a particular confidence interval. #' -#'@param confidence The confidence level -#' @param R Hedge Fund log Returns +#' @param R return series +#' @param confidence the confidence interval #' #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). @@ -15,70 +15,6 @@ columns = ncol(R) i = 0 tp = matrix(nrow=columns) - - -getQ<-function(bets,phi,mu,sigma,dp0,confidence){ - - # DESCRIPTION: - # A function to get the quantile function for cumulative returns - # and a particular confidence interval. - - # Inputs: - # bets: The number fo steps - # - # phi: The coefficient for AR[1] - # - # mu: The mean of the returns - # - # sigma: The standard deviation of the returns - # - # dp0: The r0 or the first return - # - # confidence: The confidence level of the quantile function - mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets - var = sigma^2/(phi-1)^2 - var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1) - q_value = mu_new + qnorm(1-confidence)*(var^0.5) - return(q_value) -} - - -get_TuW<-function(R,confidence){ - - # DESCRIPTION: - # A function to generate the time under water - # - # Inputs: - # R: The function takes Returns as the input. - # - # confidence: Confidence level of the quantile function - - - x = checkData(R) - mu = mean(x, na.rm = TRUE) - sigma_infinity = StdDev(x) - phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)])) - sigma = sigma_infinity*((1-phi^2)^0.5) - - dp0 = 0 - q_value = 0 - bets = 0 - while(q_value <= 0){ - bets = bets + 1 - q_value = getQ(bets, phi, mu, sigma, dp0, confidence) - } - TuW = golden_section(bets-1,bets,TRUE,diff,phi,mu,sigma,dp0,confidence) - return(TuW$x) -} - - - -diff<-function(bets,phi,mu,sigma,dp0,confidence){ - return(abs(getQ(bets,phi,mu,sigma,dp0,confidence))) -} - - - for(i in 1:columns){ column_TuW = get_TuW(x[,i],confidence) tp[i] <- column_TuW Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R 2013-07-09 07:06:21 UTC (rev 2528) @@ -0,0 +1,39 @@ +#' @title +#' Table for displaying the Mximum Drawdown and the Time under Water +#' +#' @description +#' \code{table.Penance} Displays the table showing mean,Standard Deviation , phi, sigma , MaxDD,time at which MaxDD occurs, MaxTuW and the penance. +#' +#' @param R Returns +#' @param confidence the confidence interval +#' +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + +table.Penance<-function(R,confidence){ + # DESCRIPTION: + # Maximum Drawdown and Time under Water considering first-order serial correlation + # + # Input: + # R log returns + # + # Output: + # Creates a Table showing mean stdDev phi sigma MaxDD t* MaxTuW and Penance + # + # Function: + x = checkData(R) + columns = ncol(x) + tp = data.frame() + for(i in 1:columns){ + phi = cov(x[,i][-1],x[,i][-length(x[,i])])/(cov(x[,i][-length(x[,i])])) + sigma_infinity = StdDev(x[,i]) + sigma = sigma_infinity*((1-phi^2)^0.5) + column_MinQ<-c(mean(x[,i]),sigma_infinity,phi,sigma) + column_MinQ <- c(column_MinQ,get_minq(x[,i],confidence)) + column_TuW = get_TuW(x[,i],confidence) + tp <- rbind(tp,c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW)) + } + row.names(tp)<-colnames(R) + colnames(tp) = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance") + print(tp) + +} From noreply at r-forge.r-project.org Tue Jul 9 09:23:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 09:23:10 +0200 (CEST) Subject: [Returnanalytics-commits] r2529 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1 Message-ID: <20130709072310.CB347183FB9@r-forge.r-project.org> Author: shubhanm Date: 2013-07-09 09:23:10 +0200 (Tue, 09 Jul 2013) New Revision: 2529 Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R Log: Modified Version Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R 2013-07-09 07:06:21 UTC (rev 2528) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R 2013-07-09 07:23:10 UTC (rev 2529) @@ -17,7 +17,6 @@ # A potfolio is constructed by applying the weights count = q - x=edhec columns = ncol(x) columnnames = colnames(x) From noreply at r-forge.r-project.org Tue Jul 9 14:32:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 9 Jul 2013 14:32:03 +0200 (CEST) Subject: [Returnanalytics-commits] r2530 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130709123203.717E4183EF4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-09 14:32:03 +0200 (Tue, 09 Jul 2013) New Revision: 2530 Added: pkg/PortfolioAnalytics/sandbox/draft_mapping_function_vignette.Rnw Log: adding draft version of mapping function vignette to explain the basic algorithm and process used in fn_map Added: pkg/PortfolioAnalytics/sandbox/draft_mapping_function_vignette.Rnw =================================================================== --- pkg/PortfolioAnalytics/sandbox/draft_mapping_function_vignette.Rnw (rev 0) +++ pkg/PortfolioAnalytics/sandbox/draft_mapping_function_vignette.Rnw 2013-07-09 12:32:03 UTC (rev 2530) @@ -0,0 +1,127 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage[OT1]{fontenc} +\usepackage{Sweave} +\usepackage{verbatim} +\usepackage{Rd} +\usepackage{Sweave} +\usepackage{amsmath} + +\begin{document} + +\title{Constraint Mapping Function in PortfolioAnalytics} +% \author{Ross Bennett} + +\maketitle + +\begin{abstract} +The purpose of this vignette is to discuss how the constraint mapping function is implemented in PortfolioAnalytics. The content is based on emails about the mapping function and my documentation of the \code{fn\_map} function and those functions used within. +\end{abstract} + +\tableofcontents + +\section{Purpose of Mapping Function} +The purpose of the mapping function is to transform a weights vector that does not meet all the constraints into a weights vector that does meet the constraints, if one exists, hopefully with a minimum of transformation. + +\section{Random Portfolios} +In the random portfolios code, we've used a couple of techniques pioneered by Pat Burns. The philosophical idea is that your optimum portfolio is most likely to exist at the edges of the feasible space. + +At the first R/Finance conference, Pat used the analogy of a mountain lake, where the lake represents the feasible space. With a combination of lots of different constraints, the shore of the lake will not be smooth or regular. The lake (the feasible space) may not take up a large percentage of the terrain. + +If we randomly place a rock anywhere in the terrain, some of them will land in the lake, inside the feasible space, but most will land outside, on the slopes of the mountains that surround the lake. The goal should be to nudge these towards the shores of the lake (our feasible space). + +\subsection{Random Portfolios Algorithm Outline} +The function used to transform the weights vector to satisfy constraints is the \code{rp\_transform} function. This function uses logic from random portfolios and the basic outline is described by the following steps: + +\begin{enumerate} +\item Generate a set to draw from of uniform numbers that satisfy all box constraints. +\item Check if leverage, box, group, or position limit constraints are satisfied. Assuming constraints are violated... +\item Check to see if \code{min\_sum}, box, group, or leverage constraints are violated. If violated, do a random draw for a weight that is greater than the value of the current weight and less than maximum box constraint for the selected weight. +\item Check to see if \code{max\_sum}, box, group, or leverage constraints are violated. If violated, do a random draw for a weight that is less than the value of the current weight and greater than minimum box constraint for the selected weight +\item Return to check if leverage, box, group, or position limit constraints are satisfied. +\end{enumerate} + +Note that leverage and box constraints are required arguments to \code{rp\_transform} while group and position limit constraints are optional. + + +\section{Hierarchy} +\begin{enumerate} +\item leverage +\item box +\item group +\item position limit +\item turnover (currently just penalized) +\item diversification (currently just penalized) +\end{enumerate} + +\section{Implementation Steps} +The \code{fn\_map} function is implemented in the following steps: +\begin{enumerate} +\item[Step 1] Test weights vector for violation \code{min\_sum} or {max\_sum}. +If violated, transform the weights vector with \code{rp\_transform} taking into account both leverage and box constraints. + +\item[Step 2] Test weights vector for violation of \code{min} or \code{max} box constraints. +If violated, transform the weights vector with \code{rp\_transform} taking into account both leverage and box constraints. + +If we can't generate a feasible portfolio and \code{relax=TRUE}, we try relaxing \code{min} or \code{max}. For example, if the $i^{th}$ element of \code{min} is violated, we relax the $i^{th}$ element of \code{min}. We attempt to relax the constraint up to 5 times, successively decreasing the $i^{th}$ element of \code{min} by a randomly generated number drawn from $U \sim [0.01, 0.05]$. If we still can't generate a feasible portfolio after relaxing constraints, then default to the \code{weights} vector passed in to the box constraints transformation. + +\item[Step 3] Test weights vector for violation of \code{cLO} or \code{cUP} group constraints. +If violated, transform the weights vector with \code{rp\_transform} taking into account leverage, box, and group constraints. + +If we can't generate a feasible portfolio, try relaxing \code{cLO} and \code{cUP}. For example, if the $i^{th}$ element of \code{cLO} of \code{cUP} is violated, we relax the $i^{th}$element of \code{cLO} and \code{cUP} that was violated. We attempt to relax the constraint up to 5 times, successively decreasing \code{cLO} and increasing \code{cUP} by a randomly generated number drawn from $U \sim [0.01, 0.05]$. If we still can't generate a feasible portfolio after relaxing constraints, then default to the \code{weights} vector passed in to the group constraints transformation. + +\item[Step 4] Test weights vector for violation of \code{max\_pos}. +If violated, transform the weights vector with \code{rp\_transform} taking into account leverage, box, and position limit constraints. + +If we can't generate a feasible portfolio, try relaxing \code{max\_pos} incrementing \code{max\_pos} by 1 up to 5 times or until \code{max\_pos} is equal to the number of assets. If we still can't generate a feasible portfolio after relaxing constraints, then default to the \code{weights} vector passed in to the position limit constraints transformation. +\end{enumerate} + +\subsection{Challenges} +\begin{itemize} +\item Recovering the transformed vector from a optimization solver that doesn't directly support a mapping function. I've got some tricks for this using environments that we can revisit after we get the basic methodology working. +\item Allowing for progressively relaxing constraints when the constraints are simply too restrictive. Perhaps Doug has some documentation on this as he's done it in the past, or perhaps we can simply deal with it in the penalty part of \code{constrained\_objective}. +\end{itemize} + +\section{Extra} +I think our first step should be to test each constraint type, in some sort of hierarchy, starting with box constraints (almost all solvers support box constraints, of course), since some of the other transformations will violate the box constraints, and we'll need to transform back again. + +\begin{itemize} +%% Box +\item Box Constraints +\begin{itemize} +\item \code{rp\_transform} uses logic from random portfolios to transform a weights vector while taking into account leverage, box and constraints. +\item \code{txfrm\_box\_constraint} takes a weight vector that violates min/max box constraints and will set any weight that violates min or max to its min or max, respectively. This is too simplistic and does not take into account leverage or group constraints. +\end{itemize} +%% Leverage +\item Leverage Constraints +\begin{itemize} +\item \code{rp\_transform} uses logic from random portfolios to transform a weights vector while taking into account leverage and box constraints. +\item \code{txfrm\_weight\_sum\_constraint} takes a weight vector that violates min\_sum/max\_sum leverage constraints and normalizes the entire weights vector to satisfy leverage constraints. This is too simplistic and does not take into account min/max box constraints. This is similar to the code used in \code{constrained\_objective} to normalize weights. +\end{itemize} +%% Group +\item Group Constraints +\begin{itemize} +\item \code{txfrm\_group\_constraint} loops through the groups and checks if cLO or cUP is violated. If cLO or cUP is violated, then the weights of the given group are normalized to equal cLO or cUP, whichever is violated. This will likely change the sum of the weights vector and violate min\_sum/max\_sum so we will have to "re-transform". +\item \code{rp\_transform} uses logic from random portfolios to transform a weights vector while taking into account leverage, box, group, and position limit constraints. +\end{itemize} +%% Diversification +\item Diversification Constraints +\begin{itemize} +\item I'm having a hard time coming up with a straightforward solution to transform the vector of weights to meet the diversification constraint. One idea I was working on was to generate N random portfolios and select the portfolio with the closest diversification value. +\item Would it be better to just handle this like an objective and penalize in \code{constrained\_objective}? +\end{itemize} +%% Turnover +\item Turnover Constraints +\begin{itemize} +\item I'm having a hard time coming up with a straightforward solution to transform the vector of weights to meet the turnover constraint. One idea I was working on was to generate N random portfolios and select the portfolio with the closest turnover value. +\item Would it be better to just handle this like an objective and penalize in \code{constrained\_objective}? +\end{itemize} +%% Position Limit +\item Position Limit Constraints +\begin{itemize} +\item \code{txfrm\_position\_limit\_constraint} sets the \code{nassets} - \code{max\_pos} minimum weights equal to 0. +\item \code{rp\_transform} uses logic from random portfolios to transform a weights vector while taking into account leverage, box, group, and position limit constraints. +\item An issue is that for any $min\_i > 0$, this will violate the min box constraint and be penalized later. Would it make sense to change min\_i to 0 for asset\_i that is set equal to 0? +\end{itemize} +\end{itemize} + +\end{document} \ No newline at end of file From noreply at r-forge.r-project.org Wed Jul 10 04:07:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 10 Jul 2013 04:07:15 +0200 (CEST) Subject: [Returnanalytics-commits] r2531 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130710020715.A60361858E4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-10 04:07:15 +0200 (Wed, 10 Jul 2013) New Revision: 2531 Added: pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R Log: adding simple testing script to test leverage constraint transformation Added: pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R 2013-07-10 02:07:15 UTC (rev 2531) @@ -0,0 +1,96 @@ + +library(PortfolioAnalytics) + +# Use random_portfolios to generate weights that do not meet the full +# investment constraint where the sum of the weights range from 0.8 to 1.2 + +# Note: slow using random portfolios + +sum_seq <- seq(from=0.8, to=1.5, by=0.1) + +##### Random Portfolios: 50 assets 5,000 portfolios +nassets <- 50 +npermutations <- 500 +min <- rep(0.02, nassets) +max <- rep(0.5, nassets) +rp <- list() +for(i in 1:10){ +min_sum <- sample(sum_seq, 1) +max_sum <- min_sum + 0.01 + +cset <- constraint(assets=nassets, min=min, max=max, + min_sum=min_sum, max_sum=max_sum, + weight_seq=generatesequence(min=0.02, max=0.4, by=0.005)) + +rp[[i]] <- random_portfolios(rpconstraints=cset, permutations=npermutations) +} + +rp <- do.call(rbind, rp) + +# transform the entire vector to meet leverage constraints +tmp_rp <- t(apply(rp, 1, txfrm_weight_sum_constraint, min_sum=0.99, max_sum=1.01)) + +# percentage of portfolios that satisfy box constraints after the simple transformation +sum(apply(tmp_rp, 1, function(x) all(x >= min & x <= max))) / (nrow(tmp_rp)) * 100 + +# only works if I relax min and +new_rp <- t(apply(tmp_rp, 1, rp_transform, min=rep(-0.05, nassets), max=rep(0.5, nassets), + groups=NULL, cLO=NULL, cUP=NULL, + max_permutations=500)) + +##### Random Portfolios: 250 assets 5,000 portfolios +nassets <- 250 +npermutations <- 500 +min <- rep(0, nassets) +max <- rep(0.5, nassets) +rp <- list() +for(i in 1:10){ + min_sum <- sample(sum_seq, 1) + max_sum <- min_sum + 0.01 + + cset <- constraint(assets=nassets, min=min, max=max, + min_sum=min_sum, max_sum=max_sum, + weight_seq=generatesequence(min=0, max=0.5, by=0.005)) + + rp[[i]] <- random_portfolios(rpconstraints=cset, permutations=npermutations) +} + +rp <- do.call(rbind, rp) + +# transform the entire vector to meet leverage constraints +tmp_rp <- t(apply(rp, 1, txfrm_weight_sum_constraint, min_sum=0.99, max_sum=1.01)) +summary(rowSums(tmp_rp)) +# percentage of portfolios that satisfy box constraints after the simple transformation +sum(apply(tmp_rp, 1, function(x) all(x >= min & x <= max))) / (nrow(tmp_rp)) * 100 + +new_rp <- t(apply(tmp_rp, 1, rp_transform, min=min, max=max, groups=NULL, cLO=NULL, cUP=NULL)) + + +# generate portfolios of uniform random numbers that satisfy box constraints, +# but will violate leverage constraints +N <- 500 +k <- 10000 +min <- -0.01 +max <- 0.15 + +set.seed(123) +tmp <- runif(N*k, min, max) +tmp_mat <- matrix(tmp, nrow=k) + +summary(rowSums(tmp_mat)) + +# transform the entire vector to meet leverage constraints +tmp_rp <- t(apply(tmp_mat, 1, txfrm_weight_sum_constraint, min_sum=0.99, max_sum=1.01)) + +min <- c(rep(-0.01, 200), 0.01, rep(-0.01, 299)) +max <- rep(0.15, 500) +# percentage of portfolios that satisfy box constraints after the simple transformation +sum(apply(tmp_rp, 1, function(x) all(x >= min & x <= max))) / (nrow(tmp_rp)) * 100 + +# All portfolios seem to satisfy box constraints if min is a vector of all 0s or +# all elements are less than 0 and the sum of the weights is greater than 1 + +# If elements of the min vector are positive, then 0 portfolios satisfy constraints + +# very sensitive to box constraint parameters and sum of the weights + From noreply at r-forge.r-project.org Wed Jul 10 04:26:09 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 10 Jul 2013 04:26:09 +0200 (CEST) Subject: [Returnanalytics-commits] r2532 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130710022609.C2D8318582E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-10 04:26:09 +0200 (Wed, 10 Jul 2013) New Revision: 2532 Modified: pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R Log: modify to allow changin values of min Modified: pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R 2013-07-10 02:07:15 UTC (rev 2531) +++ pkg/PortfolioAnalytics/sandbox/leverage_transformation_testing.R 2013-07-10 02:26:09 UTC (rev 2532) @@ -11,7 +11,9 @@ ##### Random Portfolios: 50 assets 5,000 portfolios nassets <- 50 npermutations <- 500 -min <- rep(0.02, nassets) +min <- rep(0, nassets) +# random_index <- sample(1:nassets, 5) +# min[random_index] <- 0.01 max <- rep(0.5, nassets) rp <- list() for(i in 1:10){ @@ -20,7 +22,7 @@ cset <- constraint(assets=nassets, min=min, max=max, min_sum=min_sum, max_sum=max_sum, - weight_seq=generatesequence(min=0.02, max=0.4, by=0.005)) + weight_seq=generatesequence(min=0, max=0.5, by=0.005)) rp[[i]] <- random_portfolios(rpconstraints=cset, permutations=npermutations) } @@ -42,6 +44,8 @@ nassets <- 250 npermutations <- 500 min <- rep(0, nassets) +random_index <- sample(1:nassets, 10) +min[random_index] <- 0.01 max <- rep(0.5, nassets) rp <- list() for(i in 1:10){ @@ -59,7 +63,7 @@ # transform the entire vector to meet leverage constraints tmp_rp <- t(apply(rp, 1, txfrm_weight_sum_constraint, min_sum=0.99, max_sum=1.01)) -summary(rowSums(tmp_rp)) + # percentage of portfolios that satisfy box constraints after the simple transformation sum(apply(tmp_rp, 1, function(x) all(x >= min & x <= max))) / (nrow(tmp_rp)) * 100 From noreply at r-forge.r-project.org Wed Jul 10 12:29:06 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 10 Jul 2013 12:29:06 +0200 (CEST) Subject: [Returnanalytics-commits] r2533 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4 Message-ID: <20130710102906.78D511800CB@r-forge.r-project.org> Author: shubhanm Date: 2013-07-10 12:29:02 +0200 (Wed, 10 Jul 2013) New Revision: 2533 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R Log: Week 4: Chart for Acar and Shane Maximum Loss and Maximum Drawdown in Financial Markets (1997) Stage : Implementation Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R 2013-07-10 10:29:02 UTC (rev 2533) @@ -0,0 +1,91 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +chart.ArcarJames <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= 36; + n <- 1000 + #tlength <- 36 + musig.ratio=seq(-2,2,by=.1) + dt <- 1/T; + s0 <- 100; + # for each column, do the following: + for(ratio in 1:length(musig.ratio)) + { + for(column in 1:columns) { + x = y[,column] + mu = musig.ratio[ratio] *.01 + sig= .01 + r <- matrix(0,T+1,n) # matrix to hold stock path + r[1,] <- s0 + drawdown <- matrix(0,length(musig.ratio,n) + # return(Ed) + + for(j in 1:n){ + for(i in 2:(T+1)){ + + dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) + r[i,j] <- r[i-1,j] + dr + } + drawdown[ratio,j] = maxDrawdown(r[ratio,j]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)*100))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + t <- seq(0, T, dt) + matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### From noreply at r-forge.r-project.org Wed Jul 10 12:48:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 10 Jul 2013 12:48:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2534 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130710104831.1AADC18479F@r-forge.r-project.org> Author: pulkit Date: 2013-07-10 12:48:30 +0200 (Wed, 10 Jul 2013) New Revision: 2534 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R Log: changes in table.Penance Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R 2013-07-10 10:29:02 UTC (rev 2533) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R 2013-07-10 10:48:30 UTC (rev 2534) @@ -12,20 +12,29 @@ MaxDD<-function(R,confidence,...) { - x = checkData(R) - columns = ncol(x) - i = 0 - tp = matrix(nrow=columns,ncol=2) - - - for(i in 1:columns){ - column_MinQ <- get_minq(x[,i],confidence) - tp[i,] <- column_MinQ - } - row.names(tp)<-colnames(R) - colnames(tp) = c("MaxDD(in %)","t*") - return(tp) + x = checkData(R) + if(ncol(x)==1 || is.null(R) || is.vector(R)){ + + calcul = FALSE + for(i in (1:length(x))){ + if(!is.na(x[i])){ + calcul = TRUE + } + } + x = na.omit(x) + if(!calcul){ + result = NA + } + else{ + result = get_minq(x,confidence) + } + return(result) + } + + result = apply(x,MARGIN = 2,get_minq,confidence) + rownames(result) = c("MaxDD(in %)","t*") + return(result) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R 2013-07-10 10:29:02 UTC (rev 2533) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R 2013-07-10 10:48:30 UTC (rev 2534) @@ -11,19 +11,33 @@ #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). TuW<-function(R,confidence,...){ - x = checkData(R) - columns = ncol(R) - i = 0 - tp = matrix(nrow=columns) - for(i in 1:columns){ - column_TuW = get_TuW(x[,i],confidence) - tp[i] <- column_TuW + x = checkData(R) + + if(ncol(x)==1 || is.null(R) || is.vector(R)){ + + calcul = FALSE + for(i in (1:length(x))){ + if(!is.na(x[i])){ + calcul = TRUE + } } - - -rownames(tp)<-colnames(R) -colnames(tp)<-"Max Time Under Water" -return(tp) -} + x = na.omit(x) + if(!calcul){ + result = NA + } + else{ + result = get_TuW(x,confidence) + } + return(result) + } + else{ + result=apply(x,MARGIN = 2, get_TuW,confidence) + result<-as.data.frame(result) + result<-t(result) + rownames(result)=paste("Max Time Under Water") + return(result) + } + + } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R 2013-07-10 10:29:02 UTC (rev 2533) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R 2013-07-10 10:48:30 UTC (rev 2534) @@ -20,20 +20,26 @@ # Creates a Table showing mean stdDev phi sigma MaxDD t* MaxTuW and Penance # # Function: - x = checkData(R) - columns = ncol(x) - tp = data.frame() - for(i in 1:columns){ - phi = cov(x[,i][-1],x[,i][-length(x[,i])])/(cov(x[,i][-length(x[,i])])) - sigma_infinity = StdDev(x[,i]) - sigma = sigma_infinity*((1-phi^2)^0.5) - column_MinQ<-c(mean(x[,i]),sigma_infinity,phi,sigma) - column_MinQ <- c(column_MinQ,get_minq(x[,i],confidence)) - column_TuW = get_TuW(x[,i],confidence) - tp <- rbind(tp,c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW)) + x = checkData(R) + columns = ncol(x) + columnnames = colnames(x) + rownames = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance") + for(column in 1:columns){ + phi = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])])) + sigma_infinity = StdDev(x[,column]) + sigma = sigma_infinity*((1-phi^2)^0.5) + column_MinQ<-c(mean(x[,column]),sigma_infinity,phi,sigma) + column_MinQ <- c(column_MinQ,get_minq(x[,column],confidence)) + column_TuW = get_TuW(x[,column],confidence) + v = c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW) + if(column == 1){ + result = data.frame(Value = v, row.names = rownames) } - row.names(tp)<-colnames(R) - colnames(tp) = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance") - print(tp) - + else{ + nextcolumn = data.frame(Value = v,row.names = rownames) + result = cbind(result,nextcolumn) + } + } + colnames(result) = columnnames + result } From noreply at r-forge.r-project.org Wed Jul 10 14:52:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 10 Jul 2013 14:52:15 +0200 (CEST) Subject: [Returnanalytics-commits] r2535 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4 Message-ID: <20130710125215.C47FC184543@r-forge.r-project.org> Author: shubhanm Date: 2013-07-10 14:52:15 +0200 (Wed, 10 Jul 2013) New Revision: 2535 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarNumberofObservations.R Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R Log: Stage : Development Replication of Fig 3 and 4 Arcar and Shane Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R 2013-07-10 10:48:30 UTC (rev 2534) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarJames.R 2013-07-10 12:52:15 UTC (rev 2535) @@ -40,11 +40,10 @@ x = y[,column] mu = musig.ratio[ratio] *.01 sig= .01 - r <- matrix(0,T+1,n) # matrix to hold stock path + r <- matrix(0,T+1,n) # matrix to hold Asset Path r[1,] <- s0 - drawdown <- matrix(0,length(musig.ratio,n) - # return(Ed) - + drawdown <- matrix(0,length(musig.ratio),n) + for(j in 1:n){ for(i in 2:(T+1)){ @@ -86,6 +85,6 @@ # This R package is distributed under the terms of the GNU Public License (GPL) # for full details see the file COPYING # -# $Id: EMaxDDGBM +# $Id: chart.ArcarJames # ############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarNumberofObservations.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarNumberofObservations.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/chart.ArcarNumberofObservations.R 2013-07-10 12:52:15 UTC (rev 2535) @@ -0,0 +1,114 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +chart.ArcarJames <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= 36; + n <- 1000 + #tlength <- 36 + musig.ratio=seq(-2,2,by=.1) + dt <- 1/T; + s0 <- 100; + for(column in 1:columns) { + x = y[,column] + mu = musig.ratio[ratio] *.01 + sig= .01 + r <- matrix(0,T+1,n) # matrix to hold Asset Path + r[1,] <- s0 + drawdown <- matrix(0,length(musig.ratio),n) + # Generate k random walks across time {0, 1, ... , T} + T <- 100 + k <- 250 + initial.value <- 100 + GetRandomWalk <- function() { + # Add a standard normal at each step + initial.value + c(0, cumsum(rnorm(T))) + + } + # Matrix of random walks + values <- replicate(k, GetRandomWalk()) + # Create an empty plot + dev.new(height=8, width=12) + plot(0:T, rep(NA, T + 1), main=sprintf("%s Random Walks", k), + xlab="time", ylab="value", + ylim=100 + 4.5 * c(-1, 1) * sqrt(T)) + mtext(sprintf("%s%s} with initial value of %s", + "Across time {0, 1, ... , ", T, initial.value)) + for (i in 1:k) { + lines(0:T, values[ , i], lwd=0.25) + } + for (sign in c(-1, 1)) { + curve(initial.value + sign * 1.96 * sqrt(x), from=0, to=T, + n=2*T, col="darkred", lty=2, lwd=1.5, add=TRUE) + } + legend("topright", "1.96 * sqrt(t)", + bty="n", lwd=1.5, lty=2, col="darkred") + + for(j in 1:n){ + for(i in 2:(T+1)){ + + dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) + r[i,j] <- r[i-1,j] + dr + } + drawdown[ratio,j] = maxDrawdown(r[ratio,j]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)*100))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + t <- seq(0, T, dt) + matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: chart.ArcarNumberofObservations +# +############################################################################### From noreply at r-forge.r-project.org Wed Jul 10 16:05:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 10 Jul 2013 16:05:20 +0200 (CEST) Subject: [Returnanalytics-commits] r2536 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130710140520.5A207183B35@r-forge.r-project.org> Author: pulkit Date: 2013-07-10 16:05:20 +0200 (Wed, 10 Jul 2013) New Revision: 2536 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MonteSimulTriplePenance.R Log: Monte Carlo Simulation for Triple Penance Rule Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MonteSimulTriplePenance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MonteSimulTriplePenance.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MonteSimulTriplePenance.R 2013-07-10 14:05:20 UTC (rev 2536) @@ -0,0 +1,34 @@ +#' @title +#' Monte Carlo Simulation for the Triple Penance Rule +#' +#' @param R Hedge Fund log Returns +#' +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + + + +monte_simul<-function(size){ + + phi = 0.5 + mu = 1 + sigma = 2 + dp0 = 1 + bets = 25 + confidence = 0.95 + + q_value = getQ(bets, phi, mu, sigma, dp0, confidence) + ms = NULL + + for(i in 1:size){ + ms[i] = sum((1-phi)*mu + rnorm(bets)*sigma + delta*phi) + } + q_ms = quantile(ms,(1-confidence)*100) + diff = q_value - q_ms + + print(q_value) + print(q_ms) + print(q_value - q_ms) +} + + + From noreply at r-forge.r-project.org Thu Jul 11 04:34:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 04:34:00 +0200 (CEST) Subject: [Returnanalytics-commits] r2537 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130711023400.A4339183B9C@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 04:33:59 +0200 (Thu, 11 Jul 2013) New Revision: 2537 Added: pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: added set.portfolio.moments_v2 to accept a portfolio object. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-10 14:05:20 UTC (rev 2536) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 02:33:59 UTC (rev 2537) @@ -48,6 +48,7 @@ export(return_objective) export(risk_budget_objective) export(rp_transform) +export(set.portfolio.moments_v2) export(set.portfolio.moments) export(summary.optimize.portfolio.rebalancing) export(summary.portfolio) Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-10 14:05:20 UTC (rev 2536) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-11 02:33:59 UTC (rev 2537) @@ -141,6 +141,89 @@ 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 +#' @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") + next() + } else { + + # How would this be specified in the new portfolio.spec? As a constraint or in the portfolio part? + # + 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,...) + } + } + } + } + + + lcl<-grep('clean',portfolio) + if(!identical(lcl,integer(0))) { + for (objective in portfolio[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 portfolio$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) +} + garch.mm <- function(R,mu_ts, covlist,momentargs=list(),...) { #momentargs<-list() #momentargs$mu<-mu_ts[last(index(R)),] Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-10 14:05:20 UTC (rev 2536) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 02:33:59 UTC (rev 2537) @@ -465,6 +465,58 @@ return(out) } +##### version 2 of optimize.portfolio ##### +optimize.portfolio_v2 <- function( + R, + portfolio, + optimize_method=c("DEoptim","random","ROI","ROI_old","pso","GenSA"), + search_size=20000, + trace=FALSE, ..., + rp=NULL, + momentFUN='set.portfolio.moments_v2' +) +{ + optimize_method=optimize_method[1] + tmptrace=NULL + start_t<-Sys.time() + + #store the call for later + call <- match.call() + + if (is.null(portfolio) | !is.portfolio(portfolio)){ + stop("you must pass in an object of class portfolio to control the optimization") + } + + R <- checkData(R) + N <- length(portfolio$assets) + if (ncol(R) > N) { + R <- R[,names(portfolio$assets)] + } + T <- nrow(R) + + out <- list() + + weights <- NULL + + dotargs <- list(...) + + # set portfolio moments only once + if(!is.function(momentFUN)){ + momentFUN <- match.fun(momentFUN) + } + # TODO FIXME should match formals later + #dotargs <- set.portfolio.moments(R, constraints, momentargs=dotargs) + .mformals <- dotargs + .mformals$R <- R + .mformals$portfolio <- portfolio + mout <- try((do.call(momentFUN,.mformals)) ,silent=TRUE) + if(inherits(mout,"try-error")) { + message(paste("portfolio moment function failed with message",mout)) + } else { + dotargs <- mout + } +} + #' portfolio optimization with support for rebalancing or rolling periods #' #' This function may eventually be wrapped into optimize.portfolio Added: pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd 2013-07-11 02:33:59 UTC (rev 2537) @@ -0,0 +1,25 @@ +\name{set.portfolio.moments_v2} +\alias{set.portfolio.moments_v2} +\title{set portfolio moments for use by lower level optimization functions} +\usage{ + set.portfolio.moments_v2(R, portfolio, momentargs = NULL, + ...) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{portfolio}{an object of type "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{\dots}{any other passthru parameters} +} +\description{ + set portfolio moments for use by lower level optimization + functions +} + From noreply at r-forge.r-project.org Thu Jul 11 05:40:14 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 05:40:14 +0200 (CEST) Subject: [Returnanalytics-commits] r2538 - pkg/PortfolioAnalytics/R Message-ID: <20130711034015.062361844AC@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 05:40:14 +0200 (Thu, 11 Jul 2013) New Revision: 2538 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Adding constrained_objective_v2 to accept a portfolio object. Modified optimize.portfolio_v2 for DEoptim Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-11 02:33:59 UTC (rev 2537) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-11 03:40:14 UTC (rev 2538) @@ -334,4 +334,329 @@ } else { return(list(out=as.numeric(out),weights=w,objective_measures=tmp_return)) } -} \ No newline at end of file +} + +#' constrained_objective_v2 2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives +#' +#' function to calculate a numeric return value for a portfolio based on a set of constraints, +#' we'll try to make as few assumptions as possible, and only run objectives that are required by the user +#' +#' If the user has passed in either min_sum or max_sum constraints for the portfolio, or both, +#' and are using a numerical optimization method like DEoptim, and normalize=TRUE, the default, +#' we'll normalize the weights passed in to whichever boundary condition has been violated. +#' If using random portfolios, all the portfolios generated will meet the constraints by construction. +#' NOTE: this means that the weights produced by a numeric optimization algorithm like DEoptim +#' might violate your constraints, so you'd need to renormalize them after optimizing +#' We apply the same normalization in \code{\link{optimize.portfolio}} so that the weights you see have been +#' normalized to min_sum if the generated portfolio is smaller than min_sum or max_sum if the +#' generated portfolio is larger than max_sum. +#' This normalization increases the speed of optimization and convergence by several orders of magnitude in many cases. +#' +#' You may find that for some portfolios, normalization is not desirable, if the algorithm +#' cannot find a direction in which to move to head towards an optimal portfolio. In these cases, +#' it may be best to set normalize=FALSE, and penalize the portfolios if the sum of the weighting +#' vector lies outside the min_sum and/or max_sum. +#' +#' Whether or not we normalize the weights using min_sum and max_sum, and are using a numerical optimization +#' engine like DEoptim, we will penalize portfolios that violate weight constraints in much the same way +#' we penalize other constraints. If a min_sum/max_sum normalization has not occurred, convergence +#' can take a very long time. We currently do not allow for a non-normalized full investment constraint. +#' Future version of this function could include this additional constraint penalty. +#' +#' When you are optimizing a return objective, you must specify a negative multiplier +#' for the return objective so that the function will maximize return. If you specify a target return, +#' any return less than your target will be penalized. If you do not specify a target return, +#' you may need to specify a negative VTR (value to reach) , or the function will not converge. +#' Try the maximum expected return times the multiplier (e.g. -1 or -10). +#' Adding a return objective defaults the multiplier to -1. +#' +#' Additional parameters for random portfolios or \code{\link[DEoptim]{DEoptim.control}} may be passed in via \dots +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns +#' @param w a vector of weights to test +#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization, see \code{\link{constraint}} +#' @param \dots any other passthru parameters +#' @param trace TRUE/FALSE whether to include debugging and additional detail in the output list +#' @param normalize TRUE/FALSE whether to normalize results to min/max sum (TRUE), or let the optimizer penalize portfolios that do not conform (FALSE) +#' @param storage TRUE/FALSE default TRUE for DEoptim with trace, otherwise FALSE. not typically user-called +#' @seealso \code{\link{constraint}}, \code{\link{objective}}, \code{\link[DEoptim]{DEoptim.control}} +#' @author Kris Boudt, Peter Carl, Brian G. Peterson, Ross Bennett +#' @export +constrained_objective_v2 <- function(w, R, portfolio, ..., trace=FALSE, normalize=TRUE, storage=FALSE) +{ + if (ncol(R) > length(w)) { + R <- R[ ,1:length(w)] + } + if(!hasArg(penalty)) penalty <- 1e4 + N <- length(w) + T <- nrow(R) + if(hasArg(optimize_method)) + optimize_method <- match.call(expand.dots=TRUE)$optimize_method else optimize_method <- '' + if(hasArg(verbose)) + verbose <- match.call(expand.dots=TRUE)$verbose + else verbose <- FALSE + + # get the constraints from the portfolio object + constraints <- get_constraints(portfolio) + + # check for valid portfolio + if (!is.portfolio(portfolio)) { + stop("portfolio object passed in is not of class portfolio") + } + + # check that the assets and the weighting vector have the same length + if (N != length(portfolio$assets)){ + warning("length of portfolio asset list and weights vector do not match, results may be bogus") + } + + out <- 0 + + # do the get here + store_output <- try(get('.objectivestorage',pos='.GlobalEnv'), silent=TRUE) + if(inherits(store_output,"try-error")) storage <- FALSE else storage <- TRUE + + # may be replaced by fn_map later + if(isTRUE(normalize)){ + if(!is.null(constraints$min_sum) | !is.null(constraints$max_sum)){ + # the user has passed in either min_sum or max_sum constraints for the portfolio, or both. + # we'll normalize the weights passed in to whichever boundary condition has been violated + # NOTE: this means that the weights produced by a numeric optimization algorithm like DEoptim + # might violate your constraints, so you'd need to renormalize them after optimizing + # we'll create functions for that so the user is less likely to mess it up. + + #' NOTE: need to normalize in the optimization wrapper too before we return, since we've normalized in here + #' In Kris' original function, this was manifested as a full investment constraint + #' the normalization process produces much faster convergence, + #' and then we penalize parameters outside the constraints in the next block + if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { + max_sum <- constraints$max_sum + if(sum(w) > max_sum) { w <- (max_sum / sum(w)) * w } # normalize to max_sum + } + + if(!is.null(constraints$min_sum) & constraints$min_sum != -Inf ) { + min_sum <- constraints$min_sum + if(sum(w) < min_sum) { w <- (min_sum / sum(w)) * w } # normalize to min_sum + } + + } # end min_sum and max_sum normalization + } else { + # the user wants the optimization algorithm to figure it out + if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { + max_sum <- constraints$max_sum + if(sum(w) > max_sum) { out <- out + penalty * (sum(w) - max_sum) } # penalize difference to max_sum + } + if(!is.null(constraints$min_sum) & constraints$min_sum != -Inf ) { + min_sum <- constraints$min_sum + if(sum(w) < min_sum) { out <- out + penalty * (min_sum - sum(w)) } # penalize difference to min_sum + } + } + + #' penalize weights outside my constraints (can be caused by normalization) + if (!is.null(constraints$max)){ + max <- constraints$max + out <- out + sum(w[which(w > max[1:N])] - constraints$max[which(w > max[1:N])]) * penalty + } + if (!is.null(constraints$min)){ + min <- constraints$min + out <- out + sum(constraints$min[which(w < min[1:N])] - w[which(w < min[1:N])]) * penalty + } + + nargs <- list(...) + if(length(nargs)==0) nargs <- NULL + if (length('...')==0 | is.null('...')) { + # rm('...') + nargs <- NULL + } + + nargs <- set.portfolio.moments_v2(R, portfolio, momentargs=nargs) + + if(is.null(portfolio$objectives)) { + warning("no objectives specified in portfolio") + } else{ + if(isTRUE(trace) | isTRUE(storage)) tmp_return <- list() + for (objective in portfolio$objectives){ + #check for clean bits to pass in + if(objective$enabled){ + tmp_measure <- NULL + multiplier <- objective$multiplier + #if(is.null(objective$arguments) | !is.list(objective$arguments)) objective$arguments<-list() + switch(objective$name, + mean =, + median = { + fun = match.fun(objective$name) + nargs$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product + }, + sd =, + StdDev = { + fun = match.fun(StdDev) + }, + mVaR =, + VaR = { + fun = match.fun(VaR) + if(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method) & is.null(nargs$portfolio_method)) nargs$portfolio_method='single' + if(is.null(objective$arguments$invert)) objective$arguments$invert = FALSE + }, + es =, + mES =, + CVaR =, + cVaR =, + ES = { + fun = match.fun(ES) + if(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method)& is.null(nargs$portfolio_method)) nargs$portfolio_method='single' + if(is.null(objective$arguments$invert)) objective$arguments$invert = FALSE + }, + turnover = { + fun = match.fun(turnover) # turnover function included in objectiveFUN.R + }, +{ # see 'S Programming p. 67 for this matching + fun <- try(match.fun(objective$name)) +} + ) + if(is.function(fun)){ + .formals <- formals(fun) + onames <- names(.formals) + if(is.list(objective$arguments)){ + #TODO FIXME only do this if R and weights are in the argument list of the fn + if(is.null(nargs$R) | !length(nargs$R)==length(R)) nargs$R <- R + + if(is.null(nargs$weights)) nargs$weights <- w + + pm <- pmatch(names(objective$arguments), onames, nomatch = 0L) + if (any(pm == 0L)) + warning(paste("some arguments stored for", objective$name, "do not match")) + # this line overwrites the names of things stored in $arguments with names from formals. + # I'm not sure it's a good idea, so commenting for now, until we prove we need it + #names(objective$arguments[pm > 0L]) <- onames[pm] + .formals[pm] <- objective$arguments[pm > 0L] + #now add dots + if (length(nargs)) { + dargs <- nargs + pm <- pmatch(names(dargs), onames, nomatch = 0L) + names(dargs[pm > 0L]) <- onames[pm] + .formals[pm] <- dargs[pm > 0L] + } + .formals$... <- NULL + } + } # TODO do some funky return magic here on try-error + + tmp_measure <- try((do.call(fun,.formals)), silent=TRUE) + + if(isTRUE(trace) | isTRUE(storage)) { + if(is.null(names(tmp_measure))) names(tmp_measure) <- objective$name + tmp_return[[objective$name]] <- tmp_measure + } + + if(inherits(tmp_measure, "try-error")) { + message(paste("objective name", objective$name, "generated an error or warning:", tmp_measure)) + next() + } + + # now set the new value of the objective output + if(inherits(objective, "return_objective")){ + if (!is.null(objective$target) & is.numeric(objective$target)){ # we have a target + out <- out + penalty*abs(objective$multiplier)*abs(tmp_measure - objective$target) + } + # target is null or doesn't exist, just maximize, or minimize violation of constraint + out <- out + objective$multiplier*tmp_measure + } # end handling for return objectives + + if(inherits(objective, "portfolio_risk_objective")){ + if (!is.null(objective$target) & is.numeric(objective$target)){ # we have a target + out <- out + penalty*abs(objective$multiplier)*abs(tmp_measure - objective$target) + #should we also penalize risk too low for risk targets? or is a range another objective? + # # half penalty for risk lower than target + # if( prw < (.9*Riskupper) ){ out = out + .5*(penalty*( prw - Riskupper)) } + } + # target is null or doesn't exist, just maximize, or minimize violation of constraint + out <- out + abs(objective$multiplier)*tmp_measure + } # univariate risk objectives + + if(inherits(objective, "turnover_objective")){ + if (!is.null(objective$target) & is.numeric(objective$target)){ # we have a target + out <- out + penalty*abs(objective$multiplier)*abs(tmp_measure - objective$target) + } + # target is null or doesn't exist, just maximize, or minimize violation of constraint + out <- out + abs(objective$multiplier)*tmp_measure + } # univariate turnover objectives + + if(inherits(objective, "minmax_objective")){ + if (!is.null(objective$min) & !is.null(objective$max)){ # we have a min and max + if(tmp_measure > objective$max){ + out <- out + penalty * objective$multiplier * (tmp_measure - objective$max) + } + if(tmp_measure < objective$min){ + out <- out + penalty * objective$multiplier * (objective$min - tmp_measure) + } + } + } # temporary minmax objective + + if(inherits(objective, "risk_budget_objective")){ + # setup + + # out = out + penalty*sum( (percrisk-RBupper)*( percrisk > RBupper ),na.rm=TRUE ) + penalty*sum( (RBlower-percrisk)*( percrisk < RBlower ),na.rm=TRUE ) + # add risk budget constraint + if(!is.null(objective$target) & is.numeric(objective$target)){ + #in addition to a risk budget constraint, we have a univariate target + # the first element of the returned list is the univariate measure + # we'll use the univariate measure exactly like we would as a separate objective + out = out + penalty*abs(objective$multiplier)*abs(tmp_measure[[1]]-objective$target) + #should we also penalize risk too low for risk targets? or is a range another objective? + # # half penalty for risk lower than target + # if( prw < (.9*Riskupper) ){ out = out + .5*(penalty*( prw - Riskupper)) } + } + percrisk = tmp_measure[[3]] # third element is percent component contribution + RBupper = objective$max_prisk + RBlower = objective$min_prisk + if(!is.null(RBupper) | !is.null(RBlower)){ + out = out + penalty * objective$multiplier * sum( (percrisk-RBupper)*( percrisk > RBupper ),na.rm=TRUE ) + penalty*sum( (RBlower-percrisk)*( percrisk < RBlower ),na.rm=TRUE ) + } + # if(!is.null(objective$min_concentration)){ + # if(isTRUE(objective$min_concentration)){ + # max_conc<-max(tmp_measure[[2]]) #second element is the contribution in absolute terms + # # out=out + penalty * objective$multiplier * max_conc + # out = out + objective$multiplier * max_conc + # } + # } + # Combined min_con and min_dif to take advantage of a better concentration obj measure + if(!is.null(objective$min_difference) || !is.null(objective$min_concentration)){ + if(isTRUE(objective$min_difference)){ + # max_diff<-max(tmp_measure[[2]]-(sum(tmp_measure[[2]])/length(tmp_measure[[2]]))) #second element is the contribution in absolute terms + # Uses Herfindahl index to calculate concentration; added scaling perc diffs back to univariate numbers + max_diff <- sqrt(sum(tmp_measure[[3]]^2))/100 #third element is the contribution in percentage terms + # out = out + penalty * objective$multiplier * max_diff + out = out + penalty*objective$multiplier * max_diff + } + } + } # end handling of risk_budget objective + + } # end enabled check + } # end loop over objectives + } # end objectives processing + + if(isTRUE(verbose)) { + print('weights: ') + print(paste(w,' ')) + print(paste("output of objective function", out)) + print(unlist(tmp_return)) + } + + if(is.na(out) | is.nan(out) | is.null(out)){ + #this should never happen + warning('NA or NaN produced in objective function for weights ',w) + out <- penalty + } + + #return + if (isTRUE(storage)){ + #add the new objective results + store_output[[length(store_output)+1]] <- list(out=as.numeric(out), weights=w, objective_measures=tmp_return) + # do the assign here + assign('.objectivestorage', store_output, pos='.GlobalEnv') + } + if(!isTRUE(trace)){ + return(out) + } else { + return(list(out=as.numeric(out), weights=w, objective_measures=tmp_return)) + } +} Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 02:33:59 UTC (rev 2537) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 03:40:14 UTC (rev 2538) @@ -476,9 +476,9 @@ momentFUN='set.portfolio.moments_v2' ) { - optimize_method=optimize_method[1] - tmptrace=NULL - start_t<-Sys.time() + optimize_method <- optimize_method[1] + tmptrace <- NULL + start_t <- Sys.time() #store the call for later call <- match.call() @@ -500,6 +500,9 @@ dotargs <- list(...) + # Get the constraints from the portfolio object + constraints <- get_constraints(portfolio) + # set portfolio moments only once if(!is.function(momentFUN)){ momentFUN <- match.fun(momentFUN) @@ -515,6 +518,131 @@ } else { dotargs <- mout } + + # Function to normalize weights to min_sum and max_sum + # This function could be replaced by rp_transform + normalize_weights <- function(weights){ + # normalize results if necessary + if(!is.null(constraints$min_sum) | !is.null(constraints$max_sum)){ + # the user has passed in either min_sum or max_sum constraints for the portfolio, or both. + # we'll normalize the weights passed in to whichever boundary condition has been violated + # NOTE: this means that the weights produced by a numeric optimization algorithm like DEoptim + # might violate your constraints, so you'd need to renormalize them after optimizing + # we'll create functions for that so the user is less likely to mess it up. + + ##' NOTE: need to normalize in the optimization wrapper too before we return, since we've normalized in here + ##' In Kris' original function, this was manifested as a full investment constraint + if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { + max_sum=constraints$max_sum + if(sum(weights)>max_sum) { weights<-(max_sum/sum(weights))*weights } # normalize to max_sum + } + + if(!is.null(constraints$min_sum) & constraints$min_sum != -Inf ) { + min_sum=constraints$min_sum + if(sum(weights) 2000) NP <- 2000 + if(!hasArg(itermax)) { + itermax <- round(search_size / NP) + if(itermax < 50) itermax <- 50 #set minimum number of generations + } + + #check to see whether we need to disable foreach for parallel optimization, esp if called from inside foreach + if(hasArg(parallel)) parallel <- match.call(expand.dots=TRUE)$parallel else parallel <- TRUE + if(!isTRUE(parallel) && 'package:foreach' %in% search()){ + registerDoSEQ() + } + + DEcformals <- formals(DEoptim.control) + DEcargs <- names(DEcformals) + if( is.list(dotargs) ){ + pm <- pmatch(names(dotargs), DEcargs, nomatch = 0L) + names(dotargs[pm > 0L]) <- DEcargs[pm] + DEcformals$NP <- NP + DEcformals$itermax <- itermax + DEcformals[pm] <- dotargs[pm > 0L] + if(!hasArg(strategy)) DEcformals$strategy=6 # use DE/current-to-p-best/1 + if(!hasArg(reltol)) DEcformals$reltol=.000001 # 1/1000 of 1% change in objective is significant + if(!hasArg(steptol)) DEcformals$steptol=round(N*1.5) # number of assets times 1.5 tries to improve + if(!hasArg(c)) DEcformals$c=.4 # JADE mutation parameter, this could maybe use some adjustment + if(!hasArg(storepopfrom)) DEcformals$storepopfrom=1 + if(isTRUE(parallel) && 'package:foreach' %in% search()){ + if(!hasArg(parallelType) ) DEcformals$parallelType='auto' #use all cores + if(!hasArg(packages) ) DEcformals$packages <- names(sessionInfo()$otherPkgs) #use all packages + } + + #TODO FIXME also check for a passed in controlDE list, including checking its class, and match formals + } + + if(isTRUE(trace)) { + #we can't pass trace=TRUE into constrained objective with DEoptim, because it expects a single numeric return + tmptrace <- trace + assign('.objectivestorage', list(), pos='.GlobalEnv') + trace=FALSE + } + + # get upper and lower weights parameters from constraints + upper <- constraints$max + lower <- constraints$min + + if(hasArg(rpseed)) seed=match.call(expand.dots=TRUE)$rpseed else rpseed=TRUE + if(isTRUE(rpseed)) { + # initial seed population is generated with random_portfolios function + if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01 + # This part should still work, but will need to change random_portfolios over to accept portfolio object + rpconstraint <- constraint(assets=length(lower), min_sum=constraints$min_sum - eps, max_sum=constraints$max_sum + eps, + min=lower, max=upper, weight_seq=generatesequence()) + rp <- random_portfolios(rpconstraints=rpconstraint, permutations=NP) + DEcformals$initialpop=rp + } + controlDE <- do.call(DEoptim.control, DEcformals) + + # need to modify constrained_objective to accept a portfolio object + minw = try(DEoptim( constrained_objective_v2, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=...)) # add ,silent=TRUE here? + + if(inherits(minw, "try-error")) { minw=NULL } + if(is.null(minw)){ + message(paste("Optimizer was unable to find a solution for target")) + return (paste("Optimizer was unable to find a solution for target")) + } + + if(isTRUE(tmptrace)) trace <- tmptrace + + weights <- as.vector(minw$optim$bestmem) + weights <- normalize_weights(weights) + names(weights) <- colnames(R) + + out <- list(weights=weights, objective_measures=constrained_objective_v2(w=weights, R=R, portfolio, trace=TRUE)$objective_measures, out=minw$optim$bestval, call=call) + if (isTRUE(trace)){ + out$DEoutput <- minw + out$DEoptim_objective_results <- try(get('.objectivestorage',pos='.GlobalEnv'),silent=TRUE) + rm('.objectivestorage',pos='.GlobalEnv') + } + + } ## end case for DEoptim + + # Prepare for final object to return + end_t <- Sys.time() + # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets)) + message(c("elapsed time:", end_t-start_t)) + out$portfolio <- portfolio + out$data_summary <- list(first=first(R), last=last(R)) + out$elapsed_time <- end_t - start_t + out$end_t <- as.character(Sys.time()) + class(out) <- c(paste("optimize.portfolio", optimize_method, sep='.'), "optimize.portfolio") + return(out) } #' portfolio optimization with support for rebalancing or rolling periods From noreply at r-forge.r-project.org Thu Jul 11 05:44:06 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 05:44:06 +0200 (CEST) Subject: [Returnanalytics-commits] r2539 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130711034406.69715185774@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 05:44:05 +0200 (Thu, 11 Jul 2013) New Revision: 2539 Added: pkg/PortfolioAnalytics/man/constrained_objective_v2.Rd pkg/PortfolioAnalytics/man/print.constraint.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/generics.R Log: Adding print method for objects of type constraint. Updating documentation Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 03:40:14 UTC (rev 2538) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 03:44:05 UTC (rev 2539) @@ -10,6 +10,7 @@ export(charts.DE) export(charts.RP) export(constrained_group_tmp) +export(constrained_objective_v2) export(constrained_objective) export(constraint_ROI) export(constraint_v2) @@ -42,6 +43,7 @@ export(portfolio_risk_objective) export(portfolio.spec) export(position_limit_constraint) +export(print.constraint) export(random_portfolios) export(random_walk_portfolios) export(randomize_portfolio) Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-07-11 03:40:14 UTC (rev 2538) +++ pkg/PortfolioAnalytics/R/generics.R 2013-07-11 03:44:05 UTC (rev 2539) @@ -103,4 +103,13 @@ } } cat("\n") -} \ No newline at end of file +} + +#' print method for objects of class 'constraint' +#' +#' @param portfolio object of class constraint +#' @author Ross Bennett +#' @export +print.constraint <- function(obj){ + print.default(obj) +} Added: pkg/PortfolioAnalytics/man/constrained_objective_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constrained_objective_v2.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/constrained_objective_v2.Rd 2013-07-11 03:44:05 UTC (rev 2539) @@ -0,0 +1,93 @@ +\name{constrained_objective_v2} +\alias{constrained_objective_v2} +\title{constrained_objective_v2 2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives} +\usage{ + constrained_objective_v2(w, R, portfolio, ..., + trace = FALSE, normalize = TRUE, storage = FALSE) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{w}{a vector of weights to test} + + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization, see + \code{\link{constraint}}} + + \item{\dots}{any other passthru parameters} + + \item{trace}{TRUE/FALSE whether to include debugging and + additional detail in the output list} + + \item{normalize}{TRUE/FALSE whether to normalize results + to min/max sum (TRUE), or let the optimizer penalize + portfolios that do not conform (FALSE)} + + \item{storage}{TRUE/FALSE default TRUE for DEoptim with + trace, otherwise FALSE. not typically user-called} +} +\description{ + function to calculate a numeric return value for a + portfolio based on a set of constraints, we'll try to + make as few assumptions as possible, and only run + objectives that are required by the user +} +\details{ + If the user has passed in either min_sum or max_sum + constraints for the portfolio, or both, and are using a + numerical optimization method like DEoptim, and + normalize=TRUE, the default, we'll normalize the weights + passed in to whichever boundary condition has been + violated. If using random portfolios, all the portfolios + generated will meet the constraints by construction. + NOTE: this means that the weights produced by a numeric + optimization algorithm like DEoptim might violate your + constraints, so you'd need to renormalize them after + optimizing We apply the same normalization in + \code{\link{optimize.portfolio}} so that the weights you + see have been normalized to min_sum if the generated + portfolio is smaller than min_sum or max_sum if the + generated portfolio is larger than max_sum. This + normalization increases the speed of optimization and + convergence by several orders of magnitude in many cases. + + You may find that for some portfolios, normalization is + not desirable, if the algorithm cannot find a direction + in which to move to head towards an optimal portfolio. + In these cases, it may be best to set normalize=FALSE, + and penalize the portfolios if the sum of the weighting + vector lies outside the min_sum and/or max_sum. + + Whether or not we normalize the weights using min_sum and + max_sum, and are using a numerical optimization engine + like DEoptim, we will penalize portfolios that violate + weight constraints in much the same way we penalize other + constraints. If a min_sum/max_sum normalization has not + occurred, convergence can take a very long time. We + currently do not allow for a non-normalized full + investment constraint. Future version of this function + could include this additional constraint penalty. + + When you are optimizing a return objective, you must + specify a negative multiplier for the return objective so + that the function will maximize return. If you specify a + target return, any return less than your target will be + penalized. If you do not specify a target return, you + may need to specify a negative VTR (value to reach) , or + the function will not converge. Try the maximum expected + return times the multiplier (e.g. -1 or -10). Adding a + return objective defaults the multiplier to -1. + + Additional parameters for random portfolios or + \code{\link[DEoptim]{DEoptim.control}} may be passed in + via \dots +} +\author{ + Kris Boudt, Peter Carl, Brian G. Peterson, Ross Bennett +} +\seealso{ + \code{\link{constraint}}, \code{\link{objective}}, + \code{\link[DEoptim]{DEoptim.control}} +} + Added: pkg/PortfolioAnalytics/man/print.constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.constraint.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.constraint.Rd 2013-07-11 03:44:05 UTC (rev 2539) @@ -0,0 +1,16 @@ +\name{print.constraint} +\alias{print.constraint} +\title{print method for objects of class 'constraint'} +\usage{ + print.constraint(obj) +} +\arguments{ + \item{portfolio}{object of class constraint} +} +\description{ + print method for objects of class 'constraint' +} +\author{ + Ross Bennett +} + From noreply at r-forge.r-project.org Thu Jul 11 13:13:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 13:13:54 +0200 (CEST) Subject: [Returnanalytics-commits] r2540 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130711111354.78C54183C82@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 13:13:54 +0200 (Thu, 11 Jul 2013) New Revision: 2540 Added: pkg/PortfolioAnalytics/man/random_portfolios_v2.Rd pkg/PortfolioAnalytics/man/randomize_portfolio_v2.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/random_portfolios.R Log: modifying random portfolios code to accept a portfolio object and updating documentaion Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 03:44:05 UTC (rev 2539) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 11:13:54 UTC (rev 2540) @@ -44,8 +44,10 @@ export(portfolio.spec) export(position_limit_constraint) export(print.constraint) +export(random_portfolios_v2) export(random_portfolios) export(random_walk_portfolios) +export(randomize_portfolio_v2) export(randomize_portfolio) export(return_objective) export(risk_budget_objective) Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-11 03:44:05 UTC (rev 2539) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-11 11:13:54 UTC (rev 2540) @@ -196,6 +196,150 @@ return(result) } +#' version 2 generate random permutations of a portfolio seed meeting your constraints on the weights of each asset +#' +#' @param portfolio an object of type "portfolio" specifying the constraints for the optimization, see \code{\link{portfolio.spec}} +#' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200 +#' @param rounding integer how many decimals should we round to +#' @return named weighting vector +#' @author Peter Carl, Brian G. Peterson, (based on an idea by Pat Burns) +#' @export +randomize_portfolio_v2 <- function (portfolio, max_permutations=200) { + # @author: Peter Carl, Brian Peterson (based on an idea by Pat Burns) + # generate random permutations of a portfolio seed meeting your constraints on the weights of each asset + # set the portfolio to the seed + seed <- portfolio$assets + nassets <- length(seed) + + # get the constraints from the portfolio object + constraints <- get_constraints(portfolio) + + min_mult <- pconstraints$min_mult + if(is.null(min_mult)) min_mult <- rep(-Inf,nassets) + max_mult <- rpconstraints$max_mult + if(is.null(max_mult)) max_mult <- rep(Inf,nassets) + min_sum <- constraints$min_sum + max_sum <- constraints$max_sum + weight_seq <- constraints$weight_seq + if(is.null(weight_seq)){ + weight_seq <- generatesequence(min=min(constraints$min), max=max(constraints$max), by=0.002) + } + weight_seq <- as.vector(weight_seq) + max <- rpconstraints$max + min <- rpconstraints$min + portfolio <- as.vector(seed) + rownames(portfolio) <- NULL + + # initialize our loop + permutations <- 1 + + # create a temporary portfolio so we don't return a non-feasible portfolio + tportfolio <- portfolio + # first randomly permute each element of the temporary portfolio + random_index <- sample(1:length(tportfolio), length(tportfolio)) + for (i in 1:length(tportfolio)) { + cur_index <- random_index[i] + cur_val <- tportfolio[cur_index] + # randomly permute a random portfolio element + tportfolio[cur_index] <- sample(weight_seq[(weight_seq >= cur_val * min_mult[cur_index]) & (weight_seq <= cur_val * max_mult[cur_index]) & (weight_seq <= max[cur_index]) & (weight_seq >= min[cur_index])], 1) + } + + #while portfolio is outside min/max sum and we have not reached max_permutations + while ((sum(tportfolio) <= min_sum | sum(tportfolio) >= max_sum) & permutations <= max_permutations) { + permutations <- permutations+1 + # check our box constraints on total portfolio weight + # reduce(increase) total portfolio size till you get a match + # 1> check to see which bound you've failed on, brobably set this as a pair of while loops + # 2> randomly select a column and move only in the direction *towards the bound*, maybe call a function inside a function + # 3> check and repeat + random_index <- sample(1:length(tportfolio), length(tportfolio)) + i <- 1 + while (sum(tportfolio) <= min_sum & i <= length(tportfolio)) { + # randomly permute and increase a random portfolio element + cur_index <- random_index[i] + cur_val <- tportfolio[cur_index] + if (length(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])]) > 1) + { + # randomly sample one of the larger weights + tportfolio[cur_index] <- sample(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])], 1) + # print(paste("new val:",tportfolio[cur_index])) + } else { + if (length(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])]) == 1) { + tportfolio[cur_index] <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])] + } + } + i <- i + 1 # increment our counter + } # end increase loop + while (sum(tportfolio) >= max_sum & i <= length(tportfolio)) { + # randomly permute and decrease a random portfolio element + cur_index <- random_index[i] + cur_val <- tportfolio[cur_index] + if (length(weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])] ) > 1) { + # randomly sample one of the smaller weights + tportfolio[cur_index] <- sample(weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index] )], 1) + } else { + if (length(weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])] ) == 1) { + tportfolio[cur_index] <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])] + } + } + i <- i + 1 # increment our counter + } # end decrease loop + } # end final walk towards the edges + + portfolio <- tportfolio + + colnames(portfolio) <- colnames(seed) + if (sum(portfolio) <= min_sum | sum(tportfolio) >= max_sum){ + portfolio <- seed + warning("Infeasible portfolio created, defaulting to seed, perhaps increase max_permutations.") + } + if(isTRUE(all.equal(seed,portfolio))) { + if (sum(seed) >= min_sum & sum(seed) <= max_sum) { + warning("Unable to generate a feasible portfolio different from seed, perhaps adjust your parameters.") + return(seed) + } else { + warning("Unable to generate a feasible portfolio, perhaps adjust your parameters.") + return(NULL) + } + } + return(portfolio) +} + +#' version 2 generate an arbitary number of constrained random portfolios +#' +#' repeatedly calls \code{\link{randomize_portfolio}} to generate an +#' arbitrary number of constrained random portfolios. +#' +#' @param portfolio an object of type "portfolio" specifying the constraints for the optimization, see \code{\link{constraint}} +#' @param permutations integer: number of unique constrained random portfolios to generate +#' @param \dots any other passthru parameters +#' @return matrix of random portfolio weights +#' @seealso \code{\link{portfolio.spec}}, \code{\link{objective}}, \code{\link{randomize_portfolio_v2}} +#' @author Peter Carl, Brian G. Peterson, (based on an idea by Pat Burns) +#' @export +random_portfolios_v2 <- function( portfolio, permutations=100, ...) +{ # + # this function generates a series of portfolios that are a "random walk" from the current portfolio + seed <- portfolio$assets + result <- matrix(nrow=permutations, ncol=length(seed)) + result[1,] <- seed + result[2,] <- rep(1/length(seed),length(seed)) + # rownames(result)[1]<-"seed.portfolio" + # rownames(result)[2]<-"equal.weight" + i <- 3 + while (i <= permutations) { + result[i,] <- as.matrix(randomize_portfolio_v2(portfolio=portfolio, ...)) + if(i == permutations) { + result <- unique(result) + i <- nrow(result) + result <- rbind(result, matrix(nrow=(permutations-i), ncol=length(seed))) + } + i <- i + 1 + } + colnames(result) <- names(seed) + return(result) +} + # EXAMPLE: start_t<- Sys.time(); x=random_walk_portfolios(rep(1/5,5), generatesequence(min=0.01, max=0.30, by=0.01), max_permutations=500, permutations=5000, min_sum=.99, max_sum=1.01); end_t<-Sys.time(); end_t-start_t; # > nrow(unique(x)) # [1] 4906 Added: pkg/PortfolioAnalytics/man/random_portfolios_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/random_portfolios_v2.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/random_portfolios_v2.Rd 2013-07-11 11:13:54 UTC (rev 2540) @@ -0,0 +1,33 @@ +\name{random_portfolios_v2} +\alias{random_portfolios_v2} +\title{version 2 generate an arbitary number of constrained random portfolios} +\usage{ + random_portfolios_v2(portfolio, permutations = 100, ...) +} +\arguments{ + \item{portfolio}{an object of type "portfolio" specifying + the constraints for the optimization, see + \code{\link{constraint}}} + + \item{permutations}{integer: number of unique constrained + random portfolios to generate} + + \item{\dots}{any other passthru parameters} +} +\value{ + matrix of random portfolio weights +} +\description{ + repeatedly calls \code{\link{randomize_portfolio}} to + generate an arbitrary number of constrained random + portfolios. +} +\author{ + Peter Carl, Brian G. Peterson, (based on an idea by Pat + Burns) +} +\seealso{ + \code{\link{portfolio.spec}}, \code{\link{objective}}, + \code{\link{randomize_portfolio_v2}} +} + Added: pkg/PortfolioAnalytics/man/randomize_portfolio_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/randomize_portfolio_v2.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/randomize_portfolio_v2.Rd 2013-07-11 11:13:54 UTC (rev 2540) @@ -0,0 +1,30 @@ +\name{randomize_portfolio_v2} +\alias{randomize_portfolio_v2} +\title{version 2 generate random permutations of a portfolio seed meeting your constraints on the weights of each asset} +\usage{ + randomize_portfolio_v2(portfolio, max_permutations = 200) +} +\arguments{ + \item{portfolio}{an object of type "portfolio" specifying + the constraints for the optimization, see + \code{\link{portfolio.spec}}} + + \item{max_permutations}{integer: maximum number of + iterations to try for a valid portfolio, default 200} + + \item{rounding}{integer how many decimals should we round + to} +} +\value{ + named weighting vector +} +\description{ + version 2 generate random permutations of a portfolio + seed meeting your constraints on the weights of each + asset +} +\author{ + Peter Carl, Brian G. Peterson, (based on an idea by Pat + Burns) +} + From noreply at r-forge.r-project.org Thu Jul 11 13:20:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 13:20:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2541 - pkg/PortfolioAnalytics/R Message-ID: <20130711112033.5C1C21844F2@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 13:20:33 +0200 (Thu, 11 Jul 2013) New Revision: 2541 Modified: pkg/PortfolioAnalytics/R/random_portfolios.R Log: fixing error in randommize_portfolio_v2 Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-11 11:13:54 UTC (rev 2540) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-11 11:20:33 UTC (rev 2541) @@ -214,9 +214,9 @@ # get the constraints from the portfolio object constraints <- get_constraints(portfolio) - min_mult <- pconstraints$min_mult + min_mult <- constraints$min_mult if(is.null(min_mult)) min_mult <- rep(-Inf,nassets) - max_mult <- rpconstraints$max_mult + max_mult <- constraints$max_mult if(is.null(max_mult)) max_mult <- rep(Inf,nassets) min_sum <- constraints$min_sum max_sum <- constraints$max_sum @@ -225,8 +225,8 @@ weight_seq <- generatesequence(min=min(constraints$min), max=max(constraints$max), by=0.002) } weight_seq <- as.vector(weight_seq) - max <- rpconstraints$max - min <- rpconstraints$min + max <- constraints$max + min <- constraints$min portfolio <- as.vector(seed) rownames(portfolio) <- NULL From noreply at r-forge.r-project.org Thu Jul 11 14:00:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 14:00:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2542 - pkg/PortfolioAnalytics/R Message-ID: <20130711120045.70B80185B09@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 14:00:45 +0200 (Thu, 11 Jul 2013) New Revision: 2542 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: modifying DEoptim portion in optimize.portfolio and optimize.portfolio_v2 to allow user to specify an rpseed Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 11:20:33 UTC (rev 2541) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 12:00:45 UTC (rev 2542) @@ -191,8 +191,14 @@ upper = constraints$max lower = constraints$min - if(hasArg(rpseed)) seed=match.call(expand.dots=TRUE)$rpseed else rpseed=TRUE - if(isTRUE(rpseed)) { + if(hasArg(rpseed)){ + seed <- match.call(expand.dots=TRUE)$rpseed + DEcformals$initialpop <- seed + rpseed <- FALSE + } else { + rpseed <- TRUE + } + if(hasArg(rpseed) & isTRUE(rpseed)) { # initial seed population is generated with random_portfolios function if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01 rpconstraint<-constraint(assets=length(lower), min_sum=constraints$min_sum-eps, max_sum=constraints$max_sum+eps, @@ -469,9 +475,9 @@ optimize.portfolio_v2 <- function( R, portfolio, - optimize_method=c("DEoptim","random","ROI","ROI_old","pso","GenSA"), - search_size=20000, - trace=FALSE, ..., + optimize_method=c("DEoptim","random","ROI","ROI_old","pso","GenSA"), + search_size=20000, + trace=FALSE, ..., rp=NULL, momentFUN='set.portfolio.moments_v2' ) @@ -558,7 +564,7 @@ itermax <- round(search_size / NP) if(itermax < 50) itermax <- 50 #set minimum number of generations } - + print(NP) #check to see whether we need to disable foreach for parallel optimization, esp if called from inside foreach if(hasArg(parallel)) parallel <- match.call(expand.dots=TRUE)$parallel else parallel <- TRUE if(!isTRUE(parallel) && 'package:foreach' %in% search()){ @@ -597,15 +603,18 @@ upper <- constraints$max lower <- constraints$min - if(hasArg(rpseed)) seed=match.call(expand.dots=TRUE)$rpseed else rpseed=TRUE - if(isTRUE(rpseed)) { + if(hasArg(rpseed)){ + seed <- match.call(expand.dots=TRUE)$rpseed + DEcformals$initialpop <- seed + rpseed <- FALSE + } else { + rpseed <- TRUE + } + if(hasArg(rpseed) & isTRUE(rpseed)) { # initial seed population is generated with random_portfolios function - if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01 - # This part should still work, but will need to change random_portfolios over to accept portfolio object - rpconstraint <- constraint(assets=length(lower), min_sum=constraints$min_sum - eps, max_sum=constraints$max_sum + eps, - min=lower, max=upper, weight_seq=generatesequence()) - rp <- random_portfolios(rpconstraints=rpconstraint, permutations=NP) - DEcformals$initialpop=rp + # if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01 + rp <- random_portfolios_v2(portfolio=portfolio, permutations=NP) + DEcformals$initialpop <- rp } controlDE <- do.call(DEoptim.control, DEcformals) From noreply at r-forge.r-project.org Thu Jul 11 14:03:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 14:03:48 +0200 (CEST) Subject: [Returnanalytics-commits] r2543 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130711120348.BDD8D185B09@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-11 14:03:48 +0200 (Thu, 11 Jul 2013) New Revision: 2543 Added: pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R Log: adding testing script for optimize.portfolio and optimize.portfolio_v2 Added: pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-11 12:03:48 UTC (rev 2543) @@ -0,0 +1,42 @@ +library(PortfolioAnalytics) +library(DEoptim) +library(ROI) + +data(edhec) +ret <- edhec[, 1:4] +funds <- colnames(ret) + +gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, + weight_seq = generatesequence(min=0, max=1, by=0.002)) +gen.constr <- add.objective(constraints=gen.constr, type="return", name="mean", enabled=TRUE, multiplier=-1) +# gen.constr <- add.objective(constraints=gen.constr, type="risk", name="CVaR", enabled=FALSE, multiplier=0) + +pspec <- portfolio.spec(assets=funds, weight_seq = generatesequence(min=0, max=1, by=0.002)) +pspec <- add.constraint(portfolio=pspec, type="leverage", min_sum=0.99, max_sum=1.01, enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", multiplier=-1, enabled=TRUE) +# pspec <- add.objective_v2(portfolio=pspec, type="risk", name="CVaR", multiplier=0, enabled=TRUE) + +# tmp1 <- set.portfolio.moments(R=ret, constraints=gen.constr) +# tmp2 <- set.portfolio.moments_v2(R=ret, portfolio=pspec) +# all.equal(tmp1, tmp2) + +##### Simple test for DEoptim with optimize.portfolio_v2 ##### +# generate an initial population with random_portfolios +rp <- random_portfolios_v2(portfolio=pspec, permutations=40) + +set.seed(123) +opt_out <- optimize.portfolio(R=ret, gen.constr, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) + +set.seed(123) +opt <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) + +all.equal(opt_out$weights, opt$weights) +all.equal(opt_out$objective_measures, opt$objective_measures) + + +##### Test version of random_portfolios ##### +tmp <- random_portfolios(gen.constr) +tmp1 <- random_portfolios_v2(pspec) +all(rowSums(tmp1) <= 1.01) & all(rowSums(tmp1) >= 0.99) + From noreply at r-forge.r-project.org Thu Jul 11 21:54:42 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 11 Jul 2013 21:54:42 +0200 (CEST) Subject: [Returnanalytics-commits] r2544 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130711195442.2995A1855D5@r-forge.r-project.org> Author: pulkit Date: 2013-07-11 21:54:41 +0200 (Thu, 11 Jul 2013) New Revision: 2544 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/chart.Penance.R Log: Added chart for penance vs phi Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/chart.Penance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/chart.Penance.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/chart.Penance.R 2013-07-11 19:54:41 UTC (rev 2544) @@ -0,0 +1,29 @@ +#'@title +#'Penance vs phi plot +#' +#'A plot for Penance vs phi for the given portfolio +#' +#'@param R an xts, vector, matrix, data frame, +#'timeSeries or zoo object of asset returns. +#'@param confidence the confidence level +#' +#'@reference Bailey, David H. and Lopez de Prado, Marcos,Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + +chart.Penance<-function(R,confidence,...){ + x = checkData(R) + columns = ncol(x) + columnnames = colnames(x) + phi = 1:columns + penance = 1:columns + for(column in 1:columns){ + phi[column] = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])])) + penance[column]<-get_minq(x[,column],confidence)[1]/get_TuW(x[,column],confidence) + } + plot(x=phi,y=penance,xlab="Phi",ylab = "Penance",main="Penance vs Phi") + text(phi,penance,columnnames,pos = 4) +} + + + + + From noreply at r-forge.r-project.org Fri Jul 12 00:32:28 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 00:32:28 +0200 (CEST) Subject: [Returnanalytics-commits] r2545 - pkg/PortfolioAnalytics/R Message-ID: <20130711223228.A3A4E185658@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 00:32:28 +0200 (Fri, 12 Jul 2013) New Revision: 2545 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: adding random method to optimize.portfolio_v2 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 19:54:41 UTC (rev 2544) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:32:28 UTC (rev 2545) @@ -642,6 +642,47 @@ } ## end case for DEoptim + # case for random portfolios optimization method + if(optimize_method=="random"){ + #' call random_portfolios() with portfolio and search_size to create matrix of portfolios + if(missing(rp) | is.null(rp)){ + rp <- random_portfolios_v2(portfolio=portfolio, permutations=search_size) + } + #' store matrix in out if trace=TRUE + if (isTRUE(trace)) out$random_portfolios <- rp + #' write foreach loop to call constrained_objective() with each portfolio + if ("package:foreach" %in% search() & !hasArg(parallel)){ + rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective_v2(w=rp[ii,], R, portfolio, trace=trace,...=dotargs) + } else { + rp_objective_results <- apply(rp, 1, constrained_objective_v2, R=R, portfolio=portfolio, trace=trace, ...=dotargs) + } + #' if trace=TRUE , store results of foreach in out$random_results + if(isTRUE(trace)) out$random_portfolio_objective_results <- rp_objective_results + #' loop through results keeping track of the minimum value of rp_objective_results[[objective]]$out + search <- vector(length=length(rp_objective_results)) + # first we construct the vector of results + for (i in 1:length(search)) { + if (isTRUE(trace)) { + search[i] <- ifelse(try(rp_objective_results[[i]]$out), rp_objective_results[[i]]$out,1e6) + } else { + search[i] <- as.numeric(rp_objective_results[[i]]) + } + } + # now find the weights that correspond to the minimum score from the constrained objective + # and normalize_weights so that we meet our min_sum/max_sum constraints + if (isTRUE(trace)) { + min_objective_weights <- try(normalize_weights(rp_objective_results[[which.min(search)]]$weights)) + } else { + min_objective_weights <- try(normalize_weights(rp[which.min(search),])) + } + #' re-call constrained_objective on the best portfolio, as above in DEoptim, with trace=TRUE to get results for out list + out$weights <- min_objective_weights + out$objective_measures <- try(constrained_objective_v2(w=min_objective_weights, R=R, portfolio=portfolio,trace=TRUE)$objective_measures) + out$call <- call + #' construct out list to be as similar as possible to DEoptim list, within reason + + } ## end case for random + # Prepare for final object to return end_t <- Sys.time() # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets)) From noreply at r-forge.r-project.org Fri Jul 12 00:41:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 00:41:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2546 - pkg/PortfolioAnalytics/R Message-ID: <20130711224145.BEC0118504E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 00:41:45 +0200 (Fri, 12 Jul 2013) New Revision: 2546 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: adding ROI method to optimize.portfolio_v2. Made allowance for ES or ETL to be specified instead of just CVaR. Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:32:28 UTC (rev 2545) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:41:45 UTC (rev 2546) @@ -683,6 +683,83 @@ } ## end case for random + if(optimize_method == "ROI"){ + # This takes in a regular portfolio object and extracts the desired business objectives + # and converts them to matrix form to be inputed into a closed form solver + # Applying box constraints + bnds <- list(lower = list(ind = seq.int(1L, N), val = as.numeric(constraints$min)), + upper = list(ind = seq.int(1L, N), val = as.numeric(constraints$max))) + # retrieve the objectives to minimize, these should either be "var" and/or "mean" + # we can either miniminze variance or maximize quiadratic utility (we will be minimizing the neg. quad. utility) + moments <- list(mean=rep(0, N)) + alpha <- 0.05 + target <- NA + for(objective in portfolio$objectives){ + if(objective$enabled){ + if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR", objective$name == "ES", objective$name == "ETL"))) + stop("ROI only solves mean, var, or sample ETL/ES/CVaR type business objectives, choose a different optimize_method.") + moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) + target <- ifelse(!is.null(objective$target), objective$target, target) + alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha) + lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, 1) + } + } + plugin <- ifelse(any(names(moments)=="var"), "quadprog", "glpk") + if(plugin == "quadprog") ROI_objective <- ROI:::Q_objective(Q=2*lambda*moments$var, L=-moments$mean) + if(plugin == "glpk") ROI_objective <- ROI:::L_objective(L=-moments$mean) + Amat <- rbind(rep(1, N), rep(1, N)) + dir.vec <- c(">=","<=") + rhs.vec <- c(constraints$min_sum, constraints$max_sum) + if(!is.na(target)) { + Amat <- rbind(Amat, moments$mean) + dir.vec <- c(dir.vec, "==") + rhs.vec <- c(rhs.vec, target) + } + if(try(!is.null(constraints$groups), silent=TRUE)){ + if(sum(constraints$groups) != N) + stop("Number of assets in each group needs to sum to number of total assets.") + n.groups <- length(constraints$groups) + if(!all(c(length(constraints$cLO),length(constraints$cLO)) == n.groups) ) + stop("Number of group constraints exceeds number of groups.") + Amat.group <- matrix(0, nrow=n.groups, ncol=N) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- constraints$groups[i] + Amat.group[i, k:(l+j)] <- 1 + k <- l + j + 1 + l <- k - 1 + } + if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) + if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) + Amat <- rbind(Amat, Amat.group, -Amat.group) + dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) + rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) + } + if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) { + Rmin <- ifelse(is.na(target), 0, target) + ROI_objective <- ROI:::L_objective(c(rep(0,N), rep(1/(alpha*T),T), 1)) + Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1))) + dir.vec <- c(">=","<=",">=",rep(">=",T)) + rhs.vec <- c(constraints$min_sum, constraints$max_sum, Rmin ,rep(0, T)) + if(try(!is.null(constraints$groups), silent=TRUE)){ + zeros <- matrix(0, nrow=n.groups, ncol=(T+1)) + Amat <- rbind(Amat, cbind(Amat.group, zeros), cbind(-Amat.group, zeros)) + dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) + rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) + } + } + opt.prob <- ROI:::OP(objective=ROI_objective, + constraints=ROI:::L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), + bounds=bnds) + roi.result <- ROI:::ROI_solve(x=opt.prob, solver=plugin) + weights <- roi.result$solution[1:N] + names(weights) <- colnames(R) + out$weights <- weights + out$out <- roi.result$objval + out$call <- call + } ## end case for ROI + # Prepare for final object to return end_t <- Sys.time() # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets)) From noreply at r-forge.r-project.org Fri Jul 12 00:44:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 00:44:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2547 - pkg/PortfolioAnalytics/R Message-ID: <20130711224432.1DB6718504E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 00:44:31 +0200 (Fri, 12 Jul 2013) New Revision: 2547 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: adding pso method to optimize.portfolio_v2 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:41:45 UTC (rev 2546) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:44:31 UTC (rev 2547) @@ -760,6 +760,53 @@ out$call <- call } ## end case for ROI + ## case if method=pso---particle swarm + if(optimize_method=="pso"){ + stopifnot("package:pso" %in% search() || require("pso",quietly = TRUE) ) + if(hasArg(maxit)) maxit=match.call(expand.dots=TRUE)$maxit else maxit=N*50 + controlPSO <- list(trace=FALSE, fnscale=1, maxit=1000, maxf=Inf, abstol=-Inf, reltol=0) + PSOcargs <- names(controlPSO) + + if( is.list(dotargs) ){ + pm <- pmatch(names(dotargs), PSOcargs, nomatch = 0L) + names(dotargs[pm > 0L]) <- PSOcargs[pm] + controlPSO$maxit <- maxit + controlPSO[pm] <- dotargs[pm > 0L] + if(!hasArg(reltol)) controlPSO$reltol <- .000001 # 1/1000 of 1% change in objective is significant + if(hasArg(trace) && try(trace==TRUE,silent=TRUE)) controlPSO$trace <- TRUE + if(hasArg(trace) && isTRUE(trace)) { + controlPSO$trace <- TRUE + controlPSO$trace.stats=TRUE + } + } + + # get upper and lower weights parameters from constraints + upper <- constraints$max + lower <- constraints$min + + minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective_v2, R=R, portfolio=portfolio, + lower = lower[1:N] , upper = upper[1:N] , control = controlPSO)) # add ,silent=TRUE here? + + if(inherits(minw,"try-error")) { minw=NULL } + if(is.null(minw)){ + message(paste("Optimizer was unable to find a solution for target")) + return (paste("Optimizer was unable to find a solution for target")) + } + + weights <- as.vector( minw$par) + weights <- normalize_weights(weights) + names(weights) <- colnames(R) + + out <- list(weights=weights, + objective_measures=constrained_objective_v2(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures, + out=minw$value, + call=call) + if (isTRUE(trace)){ + out$PSOoutput=minw + } + + } ## end case for pso + # Prepare for final object to return end_t <- Sys.time() # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets)) From noreply at r-forge.r-project.org Fri Jul 12 00:49:08 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 00:49:08 +0200 (CEST) Subject: [Returnanalytics-commits] r2548 - pkg/PortfolioAnalytics/R Message-ID: <20130711224908.6C86C185322@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 00:49:08 +0200 (Fri, 12 Jul 2013) New Revision: 2548 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: adding GenSA method to optimize.portfolio_v2 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:44:31 UTC (rev 2547) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:49:08 UTC (rev 2548) @@ -807,6 +807,50 @@ } ## end case for pso + ## case if method=GenSA---Generalized Simulated Annealing + if(optimize_method=="GenSA"){ + stopifnot("package:GenSA" %in% search() || require("GenSA",quietly = TRUE) ) + if(hasArg(maxit)) maxit=match.call(expand.dots=TRUE)$maxit else maxit=N*50 + controlGenSA <- list(maxit = 5000, threshold.stop = NULL, temp = 5230, + visiting.param = 2.62, acceptance.param = -5, max.time = NULL, + nb.stop.improvement = 1e+06, smooth = TRUE, max.call = 1e+07, + verbose = FALSE) + GenSAcargs <- names(controlGenSA) + + if( is.list(dotargs) ){ + pm <- pmatch(names(dotargs), GenSAcargs, nomatch = 0L) + names(dotargs[pm > 0L]) <- GenSAcargs[pm] + controlGenSA$maxit <- maxit + controlGenSA[pm] <- dotargs[pm > 0L] + if(hasArg(trace) && try(trace==TRUE,silent=TRUE)) controlGenSA$verbose <- TRUE + } + + upper <- constraints$max + lower <- constraints$min + + minw = try(GenSA( par = rep(1/N, N), lower = lower[1:N] , upper = upper[1:N], control = controlGenSA, + fn = constrained_objective_v2 , R=R, portfolio=portfolio)) # add ,silent=TRUE here? + + if(inherits(minw,"try-error")) { minw=NULL } + if(is.null(minw)){ + message(paste("Optimizer was unable to find a solution for target")) + return (paste("Optimizer was unable to find a solution for target")) + } + + weights <- as.vector(minw$par) + weights <- normalize_weights(weights) + names(weights) <- colnames(R) + + out = list(weights=weights, + objective_measures=constrained_objective_v2(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures, + out=minw$value, + call=call) + if (isTRUE(trace)){ + out$GenSAoutput=minw + } + + } ## end case for GenSA + # Prepare for final object to return end_t <- Sys.time() # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets)) From noreply at r-forge.r-project.org Fri Jul 12 01:02:28 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 01:02:28 +0200 (CEST) Subject: [Returnanalytics-commits] r2549 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130711230228.306EF1813E7@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 01:02:27 +0200 (Fri, 12 Jul 2013) New Revision: 2549 Added: pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: adding documentation to optimize.portfolio_v2 and updating namespace Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 22:49:08 UTC (rev 2548) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 23:02:27 UTC (rev 2549) @@ -34,6 +34,7 @@ export(is.portfolio) export(minmax_objective) export(objective) +export(optimize.portfolio_v2) export(optimize.portfolio.parallel) export(optimize.portfolio.rebalancing) export(optimize.portfolio) Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 22:49:08 UTC (rev 2548) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 23:02:27 UTC (rev 2549) @@ -472,6 +472,55 @@ } ##### version 2 of optimize.portfolio ##### +#' version 2 wrapper for constrained optimization of portfolios +#' +#' This function aims to provide a wrapper for constrained optimization of +#' portfolios that allows the user to specify constraints and business +#' objectives. +#' +#' This function currently supports DEoptim, random portfolios, ROI, pso, and GenSA as back ends. +#' Additional back end contributions for Rmetrics, ghyp, etc. would be welcome. +#' +#' When using random portfolios, search_size is precisely that, how many +#' portfolios to test. You need to make sure to set your feasible weights +#' in generatesequence to make sure you have search_size unique +#' portfolios to test, typically by manipulating the 'by' parameter +#' to select something smaller than .01 +#' (I often use .002, as .001 seems like overkill) +#' +#' When using DE, search_size is decomposed into two other parameters +#' which it interacts with, NP and itermax. +#' +#' NP, the number of members in each population, is set to cap at 2000 in +#' DEoptim, and by default is the number of parameters (assets/weights) *10. +#' +#' itermax, if not passed in dots, defaults to the number of parameters (assets/weights) *50. +#' +#' When using GenSA and want to set \code{verbose=TRUE}, instead use \code{trace}. +#' +#' The extension to ROI solves a limited type of convex optimization problems: +#' 1) Maxmimize portfolio return subject leverage, box, and/or constraints on weights +#' 2) Minimize portfolio variance subject to leverage, box, and/or group constraints (otherwise known as global minimum variance portfolio) +#' 3) Minimize portfolio variance subject to leverage, box, and/or group constraints and a desired portfolio return +#' 4) Maximize quadratic utility subject to leverage, box, and/or group constraints and risk aversion parameter (this is passed into \code{optimize.portfolio} as as added argument to the \code{constraints} object) +#' 5) Mean CVaR optimization subject to leverage, box, and/or group constraints and target portfolio return +#' Lastly, because these convex optimization problem are standardized, there is no need for a penalty term. +#' Therefore, the \code{multiplier} argument in \code{\link{add.objective}} passed into the complete constraint object are ingnored by the solver. +#' +#' If you would like to interface with \code{optimize.portfolio} using matrix formulations, then use \code{ROI_old}. +#' +#' @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{constraint}}, if using closed for solver, need to pass a \code{\link{constraint_ROI}} object. +#' @param optimize_method one of "DEoptim", "random", "ROI","ROI_old", "pso", "GenSA". For using \code{ROI_old}, need to use a constraint_ROI object in constraints. For using \code{ROI}, pass standard \code{constratint} object in \code{constraints} argument. Presently, ROI has plugins for \code{quadprog} and \code{Rglpk}. +#' @param search_size integer, how many portfolios to test, default 20,000 +#' @param trace TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched +#' @param \dots any other passthru parameters +#' @param rp matrix of random portfolio weights, default NULL, mostly for automated use by rebalancing optimization or repeated tests on same portfolios +#' @param momentFUN the name of a function to call to set portfolio moments, default \code{\link{set.portfolio.moments_v2}} +#' +#' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information +#' @author Kris Boudt, Peter Carl, Brian G. Peterson +#' @export optimize.portfolio_v2 <- function( R, portfolio, Added: pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd 2013-07-11 23:02:27 UTC (rev 2549) @@ -0,0 +1,107 @@ +\name{optimize.portfolio_v2} +\alias{optimize.portfolio_v2} +\title{version 2 wrapper for constrained optimization of portfolios} +\usage{ + optimize.portfolio_v2(R, portfolio, + optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), + search_size = 20000, trace = FALSE, ..., rp = NULL, + momentFUN = "set.portfolio.moments_v2") +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization, see + \code{\link{constraint}}, if using closed for solver, + need to pass a \code{\link{constraint_ROI}} object.} + + \item{optimize_method}{one of "DEoptim", "random", + "ROI","ROI_old", "pso", "GenSA". For using + \code{ROI_old}, need to use a constraint_ROI object in + constraints. For using \code{ROI}, pass standard + \code{constratint} object in \code{constraints} argument. + Presently, ROI has plugins for \code{quadprog} and + \code{Rglpk}.} + + \item{search_size}{integer, how many portfolios to test, + default 20,000} + + \item{trace}{TRUE/FALSE if TRUE will attempt to return + additional information on the path or portfolios + searched} + + \item{\dots}{any other passthru parameters} + + \item{rp}{matrix of random portfolio weights, default + NULL, mostly for automated use by rebalancing + optimization or repeated tests on same portfolios} + + \item{momentFUN}{the name of a function to call to set + portfolio moments, default + \code{\link{set.portfolio.moments_v2}}} +} +\value{ + a list containing the optimal weights, some summary + statistics, the function call, and optionally trace + information +} +\description{ + This function aims to provide a wrapper for constrained + optimization of portfolios that allows the user to + specify constraints and business objectives. +} +\details{ + This function currently supports DEoptim, random + portfolios, ROI, pso, and GenSA as back ends. Additional + back end contributions for Rmetrics, ghyp, etc. would be + welcome. + + When using random portfolios, search_size is precisely + that, how many portfolios to test. You need to make sure + to set your feasible weights in generatesequence to make + sure you have search_size unique portfolios to test, + typically by manipulating the 'by' parameter to select + something smaller than .01 (I often use .002, as .001 + seems like overkill) + + When using DE, search_size is decomposed into two other + parameters which it interacts with, NP and itermax. + + NP, the number of members in each population, is set to + cap at 2000 in DEoptim, and by default is the number of + parameters (assets/weights) *10. + + itermax, if not passed in dots, defaults to the number of + parameters (assets/weights) *50. + + When using GenSA and want to set \code{verbose=TRUE}, + instead use \code{trace}. + + The extension to ROI solves a limited type of convex + optimization problems: 1) Maxmimize portfolio return + subject leverage, box, and/or constraints on weights 2) + Minimize portfolio variance subject to leverage, box, + and/or group constraints (otherwise known as global + minimum variance portfolio) 3) Minimize portfolio + variance subject to leverage, box, and/or group + constraints and a desired portfolio return 4) Maximize + quadratic utility subject to leverage, box, and/or group + constraints and risk aversion parameter (this is passed + into \code{optimize.portfolio} as as added argument to + the \code{constraints} object) 5) Mean CVaR optimization + subject to leverage, box, and/or group constraints and + target portfolio return Lastly, because these convex + optimization problem are standardized, there is no need + for a penalty term. Therefore, the \code{multiplier} + argument in \code{\link{add.objective}} passed into the + complete constraint object are ingnored by the solver. + + If you would like to interface with + \code{optimize.portfolio} using matrix formulations, then + use \code{ROI_old}. +} +\author{ + Kris Boudt, Peter Carl, Brian G. Peterson +} + From noreply at r-forge.r-project.org Fri Jul 12 03:06:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 03:06:46 +0200 (CEST) Subject: [Returnanalytics-commits] r2550 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130712010646.1EFBC185B1B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 03:06:45 +0200 (Fri, 12 Jul 2013) New Revision: 2550 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R Log: adding tests to the testing_optimize.portfolio_v2.R. Fixed minor bug in optimize.portfolio Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 23:02:27 UTC (rev 2549) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 01:06:45 UTC (rev 2550) @@ -348,7 +348,7 @@ Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1))) dir.vec <- c(">=","<=",">=",rep(">=",T)) rhs.vec <- c(constraints$min_sum, constraints$max_sum, Rmin ,rep(0, T)) - if(try(!is.null(groups), silent=TRUE)){ + if(try(!is.null(constraints$groups), silent=TRUE)){ zeros <- matrix(0, nrow=n.groups, ncol=(T+1)) Amat <- rbind(Amat, cbind(Amat.group, zeros), cbind(-Amat.group, zeros)) dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) Modified: pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-11 23:02:27 UTC (rev 2549) +++ pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-12 01:06:45 UTC (rev 2550) @@ -6,35 +6,93 @@ ret <- edhec[, 1:4] funds <- colnames(ret) +# Set up constraints and objectives using old interface gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, weight_seq = generatesequence(min=0, max=1, by=0.002)) gen.constr <- add.objective(constraints=gen.constr, type="return", name="mean", enabled=TRUE, multiplier=-1) -# gen.constr <- add.objective(constraints=gen.constr, type="risk", name="CVaR", enabled=FALSE, multiplier=0) +# Set up constraints and objectives using new interface pspec <- portfolio.spec(assets=funds, weight_seq = generatesequence(min=0, max=1, by=0.002)) pspec <- add.constraint(portfolio=pspec, type="leverage", min_sum=0.99, max_sum=1.01, enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", multiplier=-1, enabled=TRUE) -# pspec <- add.objective_v2(portfolio=pspec, type="risk", name="CVaR", multiplier=0, enabled=TRUE) # tmp1 <- set.portfolio.moments(R=ret, constraints=gen.constr) # tmp2 <- set.portfolio.moments_v2(R=ret, portfolio=pspec) # all.equal(tmp1, tmp2) -##### Simple test for DEoptim with optimize.portfolio_v2 ##### +##### Simple test for DEoptim method with optimize.portfolio_v2 ##### # generate an initial population with random_portfolios rp <- random_portfolios_v2(portfolio=pspec, permutations=40) set.seed(123) -opt_out <- optimize.portfolio(R=ret, gen.constr, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) +opt_out_de <- optimize.portfolio(R=ret, gen.constr, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) set.seed(123) -opt <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) +opt_de <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) -all.equal(opt_out$weights, opt$weights) -all.equal(opt_out$objective_measures, opt$objective_measures) +# The results should be the same using the same initial population and set.seed +all.equal(opt_out_de$weights, opt_de$weights) +all.equal(opt_out_de$objective_measures, opt_de$objective_measures) +##### Simple test for random method with optimize.portfolio_v2 ##### +set.seed(123) +opt_out_rp <- optimize.portfolio(R=ret, gen.constr, optimize_method="random", search_size=2000, trace=FALSE) + +set.seed(123) +opt_rp <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="random", search_size=2000, trace=FALSE) + +# The results should be the same +all.equal(opt_out_rp$weights, opt_rp$weights) +all.equal(opt_out_rp$objective_measures, opt_rp$objective_measures) + +##### Simple test for pso method with optimize.portfolio_v2 ##### + +set.seed(123) +opt_out_pso <- optimize.portfolio(R=ret, gen.constr, optimize_method="pso", search_size=2000, trace=FALSE) + +set.seed(123) +opt_pso <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="pso", search_size=2000, trace=FALSE) + +# The results should be the same +all.equal(opt_out_pso$weights, opt_pso$weights) +all.equal(opt_out_pso$objective_measures, opt_pso$objective_measures) + +##### Simple test for GenSA method with optimize.portfolio_v2 ##### + +set.seed(123) +opt_out_gensa <- optimize.portfolio(R=ret, gen.constr, optimize_method="GenSA", search_size=2000, trace=FALSE) + +set.seed(123) +opt_gensa <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="GenSA", search_size=2000, trace=FALSE) + +# The results should be the same +all.equal(opt_out_gensa$weights, opt_gensa$weights) +all.equal(opt_out_gensa$objective_measures, opt_gensa$objective_measures) + +##### Simple test for ROI method with optimize.portfolio_v2 ##### +# specify CVaR with old interface and ETL with new interface + +# Set up constraints and objectives using old interface +gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, + weight_seq = generatesequence(min=0, max=1, by=0.002)) +gen.constr <- add.objective(constraints=gen.constr, type="risk", name="CVaR", enabled=TRUE, multiplier=-1) + +# Set up constraints and objectives using new interface +pspec <- portfolio.spec(assets=funds, weight_seq = generatesequence(min=0, max=1, by=0.002)) +pspec <- add.constraint(portfolio=pspec, type="leverage", min_sum=0.99, max_sum=1.01, enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", multiplier=-1, enabled=TRUE) + +opt_out_roi <- optimize.portfolio(R=ret, gen.constr, optimize_method="ROI", search_size=2000, trace=FALSE) + +opt_roi <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="ROI", search_size=2000, trace=FALSE) + +# The results should be the same +all.equal(opt_out_roi$weights, opt_roi$weights) +all.equal(opt_out_roi$objective_measures, opt_roi$objective_measures) + ##### Test version of random_portfolios ##### tmp <- random_portfolios(gen.constr) tmp1 <- random_portfolios_v2(pspec) From noreply at r-forge.r-project.org Fri Jul 12 04:19:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 04:19:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2551 - pkg/PortfolioAnalytics/R Message-ID: <20130712021901.CCAC51856F2@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 04:19:01 +0200 (Fri, 12 Jul 2013) New Revision: 2551 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/R/random_portfolios.R Log: added fn_map to randomize_portfolio_v2 and fixed bug in rp_transform Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-12 01:06:45 UTC (rev 2550) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-12 02:19:01 UTC (rev 2551) @@ -381,7 +381,7 @@ # return w if all constraints are satisfied if((sum(w) >= min_sum & sum(w) <= max_sum) & (all(w >= tmp_min) & all(w <= max)) & - (all(!group_fail(weights, groups, cLO, cUP))) & + (all(!group_fail(w, groups, cLO, cUP))) & (sum(abs(w) > tolerance) <= max_pos)){ return(w) } Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-12 01:06:45 UTC (rev 2550) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-12 02:19:01 UTC (rev 2551) @@ -227,14 +227,15 @@ weight_seq <- as.vector(weight_seq) max <- constraints$max min <- constraints$min - portfolio <- as.vector(seed) - rownames(portfolio) <- NULL + # initial portfolio + iportfolio <- as.vector(seed) + rownames(iportfolio) <- NULL # initialize our loop permutations <- 1 # create a temporary portfolio so we don't return a non-feasible portfolio - tportfolio <- portfolio + tportfolio <- iportfolio # first randomly permute each element of the temporary portfolio random_index <- sample(1:length(tportfolio), length(tportfolio)) for (i in 1:length(tportfolio)) { @@ -286,14 +287,15 @@ } # end decrease loop } # end final walk towards the edges - portfolio <- tportfolio + # final portfolio + fportfolio <- fn_map(weights=tportfolio, portfolio=portfolio, relax=FALSE)$weights - colnames(portfolio) <- colnames(seed) - if (sum(portfolio) <= min_sum | sum(tportfolio) >= max_sum){ - portfolio <- seed + colnames(fportfolio) <- colnames(seed) + if (sum(fportfolio) <= min_sum | sum(fportfolio) >= max_sum){ + fportfolio <- seed warning("Infeasible portfolio created, defaulting to seed, perhaps increase max_permutations.") } - if(isTRUE(all.equal(seed,portfolio))) { + if(isTRUE(all.equal(seed, fportfolio))) { if (sum(seed) >= min_sum & sum(seed) <= max_sum) { warning("Unable to generate a feasible portfolio different from seed, perhaps adjust your parameters.") return(seed) @@ -302,7 +304,7 @@ return(NULL) } } - return(portfolio) + return(fportfolio) } #' version 2 generate an arbitary number of constrained random portfolios From noreply at r-forge.r-project.org Fri Jul 12 04:39:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 04:39:03 +0200 (CEST) Subject: [Returnanalytics-commits] r2552 - pkg/PortfolioAnalytics/R Message-ID: <20130712023903.E9FB6185B1B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 04:39:03 +0200 (Fri, 12 Jul 2013) New Revision: 2552 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: forcing normalize=FALSE in call to constrained_objective for optimize_method=random Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 02:19:01 UTC (rev 2551) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 02:39:03 UTC (rev 2552) @@ -699,11 +699,12 @@ } #' store matrix in out if trace=TRUE if (isTRUE(trace)) out$random_portfolios <- rp + # rp is already being generated with a call to fn_map so set normalize=FALSE in the call to constrained_objective #' write foreach loop to call constrained_objective() with each portfolio if ("package:foreach" %in% search() & !hasArg(parallel)){ - rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective_v2(w=rp[ii,], R, portfolio, trace=trace,...=dotargs) + rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective_v2(w=rp[ii,], R, portfolio, trace=trace,...=dotargs, normalize=FALSE) } else { - rp_objective_results <- apply(rp, 1, constrained_objective_v2, R=R, portfolio=portfolio, trace=trace, ...=dotargs) + rp_objective_results <- apply(rp, 1, constrained_objective_v2, R=R, portfolio=portfolio, trace=trace, ...=dotargs, normalize=FALSE) } #' if trace=TRUE , store results of foreach in out$random_results if(isTRUE(trace)) out$random_portfolio_objective_results <- rp_objective_results @@ -719,6 +720,7 @@ } # now find the weights that correspond to the minimum score from the constrained objective # and normalize_weights so that we meet our min_sum/max_sum constraints + # Is it necessary to normalize the weights at all with random portfolios? if (isTRUE(trace)) { min_objective_weights <- try(normalize_weights(rp_objective_results[[which.min(search)]]$weights)) } else { @@ -726,7 +728,7 @@ } #' re-call constrained_objective on the best portfolio, as above in DEoptim, with trace=TRUE to get results for out list out$weights <- min_objective_weights - out$objective_measures <- try(constrained_objective_v2(w=min_objective_weights, R=R, portfolio=portfolio,trace=TRUE)$objective_measures) + out$objective_measures <- try(constrained_objective_v2(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE)$objective_measures) out$call <- call #' construct out list to be as similar as possible to DEoptim list, within reason From noreply at r-forge.r-project.org Fri Jul 12 05:02:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 05:02:11 +0200 (CEST) Subject: [Returnanalytics-commits] r2553 - pkg/PortfolioAnalytics/R Message-ID: <20130712030211.8EA111842E0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 05:02:10 +0200 (Fri, 12 Jul 2013) New Revision: 2553 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R Log: added call to fn_map in constrained_objective and initial weights to store_output Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-12 02:39:03 UTC (rev 2552) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-12 03:02:10 UTC (rev 2553) @@ -397,6 +397,9 @@ verbose <- match.call(expand.dots=TRUE)$verbose else verbose <- FALSE + # initial weights + init_weights <- w + # get the constraints from the portfolio object constraints <- get_constraints(portfolio) @@ -418,28 +421,8 @@ # may be replaced by fn_map later if(isTRUE(normalize)){ - if(!is.null(constraints$min_sum) | !is.null(constraints$max_sum)){ - # the user has passed in either min_sum or max_sum constraints for the portfolio, or both. - # we'll normalize the weights passed in to whichever boundary condition has been violated - # NOTE: this means that the weights produced by a numeric optimization algorithm like DEoptim - # might violate your constraints, so you'd need to renormalize them after optimizing - # we'll create functions for that so the user is less likely to mess it up. - - #' NOTE: need to normalize in the optimization wrapper too before we return, since we've normalized in here - #' In Kris' original function, this was manifested as a full investment constraint - #' the normalization process produces much faster convergence, - #' and then we penalize parameters outside the constraints in the next block - if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { - max_sum <- constraints$max_sum - if(sum(w) > max_sum) { w <- (max_sum / sum(w)) * w } # normalize to max_sum - } - - if(!is.null(constraints$min_sum) & constraints$min_sum != -Inf ) { - min_sum <- constraints$min_sum - if(sum(w) < min_sum) { w <- (min_sum / sum(w)) * w } # normalize to min_sum - } - - } # end min_sum and max_sum normalization + w <- fn_map(weights=w, portfolio=portfolio)$weights + } # end fn_map transformation } else { # the user wants the optimization algorithm to figure it out if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { @@ -452,7 +435,7 @@ } } - #' penalize weights outside my constraints (can be caused by normalization) + # penalize weights outside min and max box constraints (can be caused by normalization) if (!is.null(constraints$max)){ max <- constraints$max out <- out + sum(w[which(w > max[1:N])] - constraints$max[which(w > max[1:N])]) * penalty @@ -461,6 +444,12 @@ min <- constraints$min out <- out + sum(constraints$min[which(w < min[1:N])] - w[which(w < min[1:N])]) * penalty } + +# TODO +# penalize weights that violate group constraints +# penalize weights that violate max_pos constraints +# penalize weights that violate diversification constraint +# penalize weights that violate turnover constraint nargs <- list(...) if(length(nargs)==0) nargs <- NULL @@ -650,7 +639,7 @@ #return if (isTRUE(storage)){ #add the new objective results - store_output[[length(store_output)+1]] <- list(out=as.numeric(out), weights=w, objective_measures=tmp_return) + store_output[[length(store_output)+1]] <- list(out=as.numeric(out), weights=w, init_weights=init_weights, objective_measures=tmp_return) # do the assign here assign('.objectivestorage', store_output, pos='.GlobalEnv') } From noreply at r-forge.r-project.org Fri Jul 12 05:12:18 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 05:12:18 +0200 (CEST) Subject: [Returnanalytics-commits] r2554 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130712031219.088E81842E0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 05:12:18 +0200 (Fri, 12 Jul 2013) New Revision: 2554 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/sandbox/testing_DEoptim_cardinality_constraint.R Log: modifying optimze.portfolio_v2 for method=DEoptim to pass fn_map to optional fnMap function and force normalize=FALSE in call to constrained_objective Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 03:02:10 UTC (rev 2553) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 03:12:18 UTC (rev 2554) @@ -667,8 +667,9 @@ } controlDE <- do.call(DEoptim.control, DEcformals) - # need to modify constrained_objective to accept a portfolio object - minw = try(DEoptim( constrained_objective_v2, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=...)) # add ,silent=TRUE here? + # We are passing fn_map to the optional fnMap function to do the + # transformation so we need to force normalize=FALSE in call to constrained_objective + minw = try(DEoptim( constrained_objective_v2, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=..., normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio))) # add ,silent=TRUE here? if(inherits(minw, "try-error")) { minw=NULL } if(is.null(minw)){ @@ -679,10 +680,11 @@ if(isTRUE(tmptrace)) trace <- tmptrace weights <- as.vector(minw$optim$bestmem) + # is it necessary to normalize the weights here? weights <- normalize_weights(weights) names(weights) <- colnames(R) - out <- list(weights=weights, objective_measures=constrained_objective_v2(w=weights, R=R, portfolio, trace=TRUE)$objective_measures, out=minw$optim$bestval, call=call) + out <- list(weights=weights, objective_measures=constrained_objective_v2(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=minw$optim$bestval, call=call) if (isTRUE(trace)){ out$DEoutput <- minw out$DEoptim_objective_results <- try(get('.objectivestorage',pos='.GlobalEnv'),silent=TRUE) Modified: pkg/PortfolioAnalytics/sandbox/testing_DEoptim_cardinality_constraint.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_DEoptim_cardinality_constraint.R 2013-07-12 03:02:10 UTC (rev 2553) +++ pkg/PortfolioAnalytics/sandbox/testing_DEoptim_cardinality_constraint.R 2013-07-12 03:12:18 UTC (rev 2554) @@ -58,7 +58,7 @@ # Implement a cardinality constraint for max positions with DEoptim # http://grokbase.com/t/r/r-help/126fsz99gh/r-deoptim-example-illustrating-use-of-fnmap-parameter-for-enforcement-of-cardinality-constraints -mappingFun <- function(x, max.pos=10) { +mappingFun <- function(x, max.pos) { N <- length(x) num <- N - max.pos # Two smallest weights are given a value of 0 @@ -66,7 +66,7 @@ x / sum(x) } -out2 <- DEoptim(fn = obj, lower=lower, upper=upper, control=controlDE, fnMap=mappingFun) +out2 <- DEoptim(fn = obj, lower=lower, upper=upper, control=controlDE, fnMap=function(x) mappingFun(x, max.pos=10)) weights2 <- out2$optim$bestmem weights2 <- weights2 / sum(weights2) out2$optim$bestval From noreply at r-forge.r-project.org Fri Jul 12 05:15:58 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 05:15:58 +0200 (CEST) Subject: [Returnanalytics-commits] r2555 - pkg/PortfolioAnalytics/R Message-ID: <20130712031558.C2FCB1842E0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 05:15:58 +0200 (Fri, 12 Jul 2013) New Revision: 2555 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R Log: fixed paren error in constrained_objective Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-12 03:12:18 UTC (rev 2554) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-12 03:15:58 UTC (rev 2555) @@ -422,7 +422,7 @@ # may be replaced by fn_map later if(isTRUE(normalize)){ w <- fn_map(weights=w, portfolio=portfolio)$weights - } # end fn_map transformation + # end fn_map transformation } else { # the user wants the optimization algorithm to figure it out if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { @@ -445,11 +445,11 @@ out <- out + sum(constraints$min[which(w < min[1:N])] - w[which(w < min[1:N])]) * penalty } -# TODO -# penalize weights that violate group constraints -# penalize weights that violate max_pos constraints -# penalize weights that violate diversification constraint -# penalize weights that violate turnover constraint + # TODO + # penalize weights that violate group constraints + # penalize weights that violate max_pos constraints + # penalize weights that violate diversification constraint + # penalize weights that violate turnover constraint nargs <- list(...) if(length(nargs)==0) nargs <- NULL From noreply at r-forge.r-project.org Fri Jul 12 05:27:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 05:27:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2556 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130712032733.2302F184FD7@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 05:27:32 +0200 (Fri, 12 Jul 2013) New Revision: 2556 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R Log: fixed call to fn_map to only return the weights and added comments in testing script Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 03:15:58 UTC (rev 2555) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-12 03:27:32 UTC (rev 2556) @@ -613,7 +613,7 @@ itermax <- round(search_size / NP) if(itermax < 50) itermax <- 50 #set minimum number of generations } - print(NP) + #check to see whether we need to disable foreach for parallel optimization, esp if called from inside foreach if(hasArg(parallel)) parallel <- match.call(expand.dots=TRUE)$parallel else parallel <- TRUE if(!isTRUE(parallel) && 'package:foreach' %in% search()){ @@ -669,7 +669,7 @@ # We are passing fn_map to the optional fnMap function to do the # transformation so we need to force normalize=FALSE in call to constrained_objective - minw = try(DEoptim( constrained_objective_v2, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=..., normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio))) # add ,silent=TRUE here? + minw = try(DEoptim( constrained_objective_v2, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=..., normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio)$weights)) # add ,silent=TRUE here? if(inherits(minw, "try-error")) { minw=NULL } if(is.null(minw)){ @@ -680,6 +680,7 @@ if(isTRUE(tmptrace)) trace <- tmptrace weights <- as.vector(minw$optim$bestmem) + print(weights) # is it necessary to normalize the weights here? weights <- normalize_weights(weights) names(weights) <- colnames(R) Modified: pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-12 03:15:58 UTC (rev 2555) +++ pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-12 03:27:32 UTC (rev 2556) @@ -35,6 +35,9 @@ all.equal(opt_out_de$weights, opt_de$weights) all.equal(opt_out_de$objective_measures, opt_de$objective_measures) +# Note that values are now different since I added fnMap=fn_map to DEoptim in optimize.portfolio_v2 +# This is likely due to how normalization/transformation is handled + ##### Simple test for random method with optimize.portfolio_v2 ##### set.seed(123) From noreply at r-forge.r-project.org Fri Jul 12 13:42:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 13:42:25 +0200 (CEST) Subject: [Returnanalytics-commits] r2557 - pkg/PortfolioAnalytics/R Message-ID: <20130712114225.6F78318033F@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 13:42:25 +0200 (Fri, 12 Jul 2013) New Revision: 2557 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R Log: added penalty terms to constrained_objective for group, position_limit, turnover, and diversification constraints Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-12 03:27:32 UTC (rev 2556) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-12 11:42:25 UTC (rev 2557) @@ -419,10 +419,10 @@ store_output <- try(get('.objectivestorage',pos='.GlobalEnv'), silent=TRUE) if(inherits(store_output,"try-error")) storage <- FALSE else storage <- TRUE - # may be replaced by fn_map later + # use fn_map to normalize the weights if(isTRUE(normalize)){ - w <- fn_map(weights=w, portfolio=portfolio)$weights - # end fn_map transformation + w <- fn_map(weights=w, portfolio=portfolio)$weights + # end fn_map transformation } else { # the user wants the optimization algorithm to figure it out if(!is.null(constraints$max_sum) & constraints$max_sum != Inf ) { @@ -438,19 +438,85 @@ # penalize weights outside min and max box constraints (can be caused by normalization) if (!is.null(constraints$max)){ max <- constraints$max - out <- out + sum(w[which(w > max[1:N])] - constraints$max[which(w > max[1:N])]) * penalty + # Only go to penalty term if any of the weights violate max + if(any(w > max)){ + out <- out + sum(w[which(w > max[1:N])] - constraints$max[which(w > max[1:N])]) * penalty + } } if (!is.null(constraints$min)){ min <- constraints$min - out <- out + sum(constraints$min[which(w < min[1:N])] - w[which(w < min[1:N])]) * penalty + # Only go to penalty term if any of the weights violate min + if(any(w < min)){ + out <- out + sum(constraints$min[which(w < min[1:N])] - w[which(w < min[1:N])]) * penalty + } } - # TODO # penalize weights that violate group constraints + if(!is.null(constraints$groups) & !is.null(constraints$cLO) & !is.null(constraints$cUP)){ + groups <- constraints$groups + cLO <- constraints$cLO + cUP <- constraints$cUP + # Only go to penalty term if group constraint is violated + if(any(group_fail(w, groups, cLO, cUP))){ + ngroups <- length(groups) + k <- 1 + l <- 0 + for(i in 1:ngroups){ + j <- groups[i] + tmp_w <- w[k:(l+j)] + # penalize weights for a given group that sum to less than specified group min + grp_min <- cLO[i] + if(sum(tmp_w) < grp_min) { + out <- out + penalty * (grp_min - sum(tmp_w)) + } + # penalize weights for a given group that sum to greater than specified group max + grp_max <- cUP[i] + if(sum(tmp_w) > grp_max) { + out <- out + penalty * (sum(tmp_w) - grp_max) + } + k <- k + j + l <- k - 1 + } + } + } # End group constraint penalty + # penalize weights that violate max_pos constraints + if(!is.null(constraints$max_pos)){ + max_pos <- constraints$max_pos + tolerance <- .Machine$double.eps^0.5 + mult <- 1 + # sum(abs(w) > tolerance) is the number of non-zero assets + nzassets <- sum(abs(w) > tolerance) + if(nzassets > max_pos){ + # Do we need a small multiplier term here since (nzassets - max_pos) + # will be an integer and much larger than the weight penalty terms + out <- out + penalty * mult * (nzassets - max_pos) + } + } # End position_limit constraint penalty + # penalize weights that violate diversification constraint + if(!is.null(constraints$div_target)){ + div_target <- constraints$div_target + div <- diversification(w) + mult <- 1 + # only penalize if not within +/- 5% of target + if((div < div_target * 0.95) | (div > div_target * 1.05)){ + out <- out + penalty * mult * abs(div - div_target) + } + } # End diversification constraint penalty + # penalize weights that violate turnover constraint - + if(!is.null(constraints$turnover_target)){ + turnover_target <- constraints$turnover_target + to <- turnover(w) + mult <- 1 + # only penalize if not within +/- 5% of target + if((to < turnover_target * 0.95) | (to > turnover_target * 1.05)){ + # print("transform or penalize to meet turnover target") + out = out + penalty * mult * abs(to - turnover_target) + } + } # End turnover constraint penalty + nargs <- list(...) if(length(nargs)==0) nargs <- NULL if (length('...')==0 | is.null('...')) { From noreply at r-forge.r-project.org Fri Jul 12 13:47:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 13:47:15 +0200 (CEST) Subject: [Returnanalytics-commits] r2558 - in pkg/PortfolioAnalytics: R man Message-ID: <20130712114715.4949A183D92@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-12 13:47:14 +0200 (Fri, 12 Jul 2013) New Revision: 2558 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/fn_map.Rd Log: modifying fn_map to remove penalty terms for diversification and turnover constraints because this is now being handled in constrained_objective and we are using fn_map to return a tansformed weights vector Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-12 11:42:25 UTC (rev 2557) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-12 11:47:14 UTC (rev 2558) @@ -30,7 +30,6 @@ #' \item{max: }{vector of max box constraints that may have been modified if relax=TRUE} #' \item{cLO: }{vector of lower bound group constraints that may have been modified if relax=TRUE} #' \item{cUP: }{vector of upper bound group constraints that may have been modified if relax=TRUE} -#' \item{out: }{penalty term} #' } #' @author Ross Bennett #' @export @@ -59,11 +58,7 @@ turnover_target <- constraints$turnover_target max_pos <- constraints$max_pos tolerance <- .Machine$double.eps^0.5 - if(!hasArg(penalty)) penalty <- 1e4 - if(!hasArg(multiplier)) multiplier <- 1 - out <- 0 - # We will modify the weights vector so create a temporary copy # modified for transformation or to relax constraints tmp_weights <- weights @@ -193,36 +188,14 @@ } # end try-error recovery } # end check for position limit constraint violation } # end check for NULL arguments - - # check diversification constraint - if(!is.null(div_target)){ - # penalize instead of transform? - div <- diversification(tmp_weights) - # only penalize if not within +/- 5% of target - if((div < div_target * .95) | (div > div_target * 1.05)){ - # print("transform or penalize to meet diversification target") - out = out + penalty * abs(multiplier) * abs(div - div_target) - } - } - - # check turnover constraint - if(!is.null(turnover_target)){ - # penalize instead of transform - to <- turnover(tmp_weights) - # only penalize if not within +/- 5% of target - if((to < turnover_target * 0.95) | (to > turnover_target * 1.05)){ - # print("transform or penalize to meet turnover target") - out = out + penalty * abs(multiplier) * abs(to - turnover_target) - } - } + names(tmp_weights) <- names(weights) return(list(weights=tmp_weights, min=tmp_min, max=tmp_max, cLO=tmp_cLO, cUP=tmp_cUP, - max_pos=tmp_max_pos, - out=out)) + max_pos=tmp_max_pos)) } #' Transform weights that violate min or max box constraints Modified: pkg/PortfolioAnalytics/man/fn_map.Rd =================================================================== --- pkg/PortfolioAnalytics/man/fn_map.Rd 2013-07-12 11:42:25 UTC (rev 2557) +++ pkg/PortfolioAnalytics/man/fn_map.Rd 2013-07-12 11:47:14 UTC (rev 2558) @@ -20,8 +20,7 @@ been modified if relax=TRUE} \item{cLO: }{vector of lower bound group constraints that may have been modified if relax=TRUE} \item{cUP: }{vector of upper bound group - constraints that may have been modified if relax=TRUE} - \item{out: }{penalty term} } + constraints that may have been modified if relax=TRUE} } } \description{ The purpose of the mapping function is to transform a From noreply at r-forge.r-project.org Fri Jul 12 21:20:14 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 21:20:14 +0200 (CEST) Subject: [Returnanalytics-commits] r2559 - in pkg/Meucci: . R data demo man Message-ID: <20130712192014.5EBE2185B54@r-forge.r-project.org> Author: xavierv Date: 2013-07-12 21:20:14 +0200 (Fri, 12 Jul 2013) New Revision: 2559 Added: pkg/Meucci/R/FitExpectationMaximization.R pkg/Meucci/R/QuantileMixture.R pkg/Meucci/data/highYieldIndices.Rda pkg/Meucci/demo/S_Estimator.R pkg/Meucci/demo/S_ExpectationMaximizationHighYield.R pkg/Meucci/man/FitExpectationMaximization.Rd pkg/Meucci/man/QuantileMixture.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE pkg/Meucci/demo/S_EigenvalueDispersion.R Log: -added a couple of demo scripts and functions Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-12 11:47:14 UTC (rev 2558) +++ pkg/Meucci/DESCRIPTION 2013-07-12 19:20:14 UTC (rev 2559) @@ -80,3 +80,5 @@ 'Cumul2Raw.R' 'Raw2Central.R' 'Raw2Cumul.R' + 'FitExpectationMaximization.R' + 'QuantileMixture.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-12 11:47:14 UTC (rev 2558) +++ pkg/Meucci/NAMESPACE 2013-07-12 19:20:14 UTC (rev 2559) @@ -10,6 +10,7 @@ export(Cumul2Raw) export(DetectOutliersViaMVE) export(EntropyProg) +export(FitExpectationMaximization) export(GenerateLogNormalDistribution) export(hermitePolynomial) export(integrateSubIntervals) @@ -27,6 +28,7 @@ export(PerformIidAnalysis) export(PlotDistributions) export(ProjectionStudentT) +export(QuantileMixture) export(Raw2Central) export(Raw2Cumul) export(RejectOutlier) Added: pkg/Meucci/R/FitExpectationMaximization.R =================================================================== --- pkg/Meucci/R/FitExpectationMaximization.R (rev 0) +++ pkg/Meucci/R/FitExpectationMaximization.R 2013-07-12 19:20:14 UTC (rev 2559) @@ -0,0 +1,74 @@ +#' Expectation-Maximization (EM) algorithm to recover missing observations in a time series , +#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005. +#' +#' @param X : [matrix] (T x N) of data +#' +#' @return E_EM : [vector] (N x 1) expectation +#' @return S_EM : [matrix] (N x N) covariance matrix +#' @return Y : [matrix] (T x N) updated data +#' @return CountLoop : [scalar] number of iterations of the algorithm +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "FitExpectationMaximization.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +FitExpectationMaximization = function(X) +{ + T = nrow(X); + N = ncol(X); + + # E-M initialization + idx = apply( !is.nan( X ), 1, all ); + X_Init = X[ idx, ]; + + M = matrix(apply( X_Init, 2, mean )); + + S = cov( X_Init ); + + Tolerance = 10 ^ ( -6 ) * mean(rbind( M, sqrt( matrix(diag( S ) ) ) ) ); + + # E-M loop + Convergence = 0; + CountLoop = 0; + Y = X; + while( !Convergence ) + { + CountLoop = CountLoop + 1; + + # Step 1: estimation + C = array( 0, dim = c( T, N, N) ); + for( t in 1 : T ) + { + Miss = is.nan( X[ t, ] ); + Obs = !Miss; + c = matrix(0, N, N ); + y = matrix( X[ t, ]); + if( any( Miss ) ) + { + y[ Miss ] = M[ Miss ] + S[ Miss, Obs] %*% ( solve(S[ Obs, Obs ]) %*% matrix (y[ Obs ] - M[ Obs ]) ); + c[ Miss, Miss ] = S[ Miss, Miss ] - S[ Miss, Obs ] %*% ( solve(S[ Obs, Obs ]) %*% S[ Obs, Miss ] ); + } + Y[ t, ] = y; + C[ t, , ] = c + (y - M) %*% t(y - M); + } + + # Step 2: update + M_new = matrix( apply( Y, 2, mean )); + S_new = drop( apply( C, c( 2, 3 ), mean ) ); + + D4 = rbind( ( M_new - M ) ^ 4, matrix(diag( (S_new - S) ^ 2 ) ) ); + Distance = mean( D4 ^ (1/4) ); + Convergence = ( Distance < Tolerance ); + + M = M_new; + S = S_new; + } + + E_EM = M; + S_EM = S; + + return( list( E_EM = E_EM, S_EM = S_EM, Recovered_Series = Y, CountLoop = CountLoop ) ); +} \ No newline at end of file Added: pkg/Meucci/R/QuantileMixture.R =================================================================== --- pkg/Meucci/R/QuantileMixture.R (rev 0) +++ pkg/Meucci/R/QuantileMixture.R 2013-07-12 19:20:14 UTC (rev 2559) @@ -0,0 +1,41 @@ + +#' Computes the quantile of a mixture distirbution by linear interpolation/extrapolation of the cdf.the confidence +#' level p can be vector. If this vector is uniformly distributed on [0,1] the sample Q is distributed as the mixture. +#' Described in A. Meucci "Risk and Asset Allocation", Springer, 2005 +#' +#' @param p : [scalar] in [0,1], probability +#' @param a : [scalar] in (0,1), mixing probability +#' @param m_Y : [scalar] mean of normal component +#' @param s_Y : [scalar] standard deviation of normal component +#' @param m_Z : [scalar] first parameters of the log-normal component +#' @param s_Z : [scalar] second parameter of the log-normal component +#' +#' @return Q : [scalar] quantile +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "QuantileMixture.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +QuantileMixture = function( p, a, m_Y, s_Y, m_Z, s_Z ) +{ + # compute first moment + m = a * m_Y + (1 - a) * exp( m_Z + 0.5 * s_Z * s_Z); + + # compute second moment + Ex2 = a * (m_Y^2 + s_Y^2) + (1 - a) * exp( 2 * m_Z + 2 * s_Z * s_Z); + s = sqrt( Ex2 - m * m ); + + # compute cdf on suitable range + X = m + 6 * s * seq( -1, 1, 0.001 ); + F = a * pnorm( X, m_Y, s_Y) + (1 - a) * plnorm(X, m_Z, s_Z); + X = X[!duplicated(F)]; + F = unique(F); + # compute quantile by interpolation + Q = interp1( F, X, p, method = "linear"); + + return( Q ); + +} \ No newline at end of file Added: pkg/Meucci/data/highYieldIndices.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/highYieldIndices.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Modified: pkg/Meucci/demo/S_EigenvalueDispersion.R =================================================================== --- pkg/Meucci/demo/S_EigenvalueDispersion.R 2013-07-12 11:47:14 UTC (rev 2558) +++ pkg/Meucci/demo/S_EigenvalueDispersion.R 2013-07-12 19:20:14 UTC (rev 2559) @@ -5,7 +5,7 @@ #' #' @references #' \url{http://symmys.com/node/170} -#' See Meucci's script for "S_EigenValueDispersion.R" +#' See Meucci's script for "S_EigenValueDispersion.m" #' #' @author Xavier Valls \email{flamejat@@gmail.com} Added: pkg/Meucci/demo/S_Estimator.R =================================================================== --- pkg/Meucci/demo/S_Estimator.R (rev 0) +++ pkg/Meucci/demo/S_Estimator.R 2013-07-12 19:20:14 UTC (rev 2559) @@ -0,0 +1,143 @@ +#'This script script familiarizes the user with the evaluation of an estimator replicability, loss, error, bias and inefficiency +#', as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EigenValueprintersion.R" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs +T = 52; # number of observations in time series +Mu = 0.1; +Sigma = 0.2; + +################################################################################################################## +### Plain vanilla estimation +# unknown functional of the distribution to be estimated, in this case the expected value +G_fX = exp( Mu + 0.5 * Sigma^2 ); +print( G_fX ); + +i_T = matrix( rlnorm( T, Mu, Sigma ), 1, T); # series generated by "nature": do not know the distribution + +G_Hat_1 = function(X) X[ , 1 ] * X[ ,3 ]; # estimator of unknown functional G_1=x(1)*x(3) +G_Hat_2 = function(X) apply( X, 1,mean); # estimator of unknown functional G_1=sample mean + +G1 = G_Hat_1( i_T ); +G2 = G_Hat_2( i_T ); +print( G1 ); +print( G2 ); + +################################################################################################################## +### Replicability vs. "luck" +# unknown functional of the distribution to be estimated, in this case the expected value +G_fX = exp( Mu + 0.5 * Sigma^2 ); + +nSim = 10000; +I_T = matrix( rlnorm( nSim * T, Mu, Sigma ), nSim, T); # randomize series generated by "nature" to check replicability + +G1 = G_Hat_1( I_T ); # estimator of unknown functional G_1=x(1)*x(3) +G2 = G_Hat_2( I_T ); # estimator of unknown functional G_2=sample mean + +Loss_G1 = (G1 - G_fX)^2; +Loss_G2 = (G2 - G_fX)^2; + +Err_G1 = sqrt(mean(Loss_G1)); +Err_G2 = sqrt(mean(Loss_G2)); + +Bias_G1 = abs(mean(G1) - G_fX); +Bias_G2 = abs(mean(G2) - G_fX); + +Ineff_G1 = sd( G1 ); +Ineff_G2 = sd( G2 ); + +################################################################################################################## +### printlay results +dev.new() +NumBins = round( 10 * log( nSim ) ); +par( mfrow = c(2,1) ); +hist(G1, NumBins); +points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); +#set(h, 'markersize', 20, 'col', 'r'); + +hist(G2, NumBins); +points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); +#set(h, 'markersize', 20, 'col', 'r'); + + +# loss +dev.new(); +par( mfrow = c(2,1) ); +hist(Loss_G1, NumBins, main = "estimator: x(1)*x(3)"); + +hist(Loss_G2, NumBins, main = "estimator: sample mean" ); + + +################################################################################################################## +### Stress test replicability +Mus = seq( 0, 0.7, 0.1 ); + +Err_G1sq = NULL; +Err_G2sq = NULL; +Bias_G1sq = NULL; +Bias_G2sq = NULL; +Ineff_G1sq = NULL; +Ineff_G2sq = NULL; + +for( j in 1 : length(Mus) ) +{ + Mu = Mus[ j ]; + + # unknown functional of the distribution to be estimated, in this case the expected value + G_fX = exp( Mu + 0.5 * Sigma^2); + I_T = matrix( rlnorm( nSim * T, Mu, Sigma ), nSim, T); # randomize series generated by "nature" to check replicability + + G1 = G_Hat_1(I_T); # estimator of unknown functional G_1=x(1)*x(3) + G2 = G_Hat_2(I_T); # estimator of unknown functional G_2=sample mean + + Loss_G1 = ( G1 - G_fX )^2; + Loss_G2 = ( G2 - G_fX )^2; + + Err_G1 = sqrt(mean(Loss_G1)); + Err_G2 = sqrt(mean(Loss_G2)); + Err_G1sq = cbind( Err_G1sq, Err_G1^2 ); ##ok<*AGROW> #store results + Err_G2sq = cbind( Err_G2sq, Err_G2^2 ); + + Bias_G1 = abs( mean( G1 )- G_fX ); + Bias_G2 = abs( mean( G2 )- G_fX ); + Bias_G1sq = cbind( Bias_G1sq, Bias_G1^2 ); #store results + Bias_G2sq = cbind( Bias_G2sq, Bias_G2^2 ); + + Ineff_G1 = sd(G1); + Ineff_G2 = sd(G2); + Ineff_G1sq = cbind(Ineff_G1sq, Ineff_G1^2); #store results + Ineff_G2sq = cbind(Ineff_G2sq, Ineff_G2^2); + + dev.new(); + NumBins = round(10*log(nSim)); + par( mfrow = c(2,1) ); + + hist(G1, NumBins); + points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); + + hist(G2, NumBins); + points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); + +} + +dev.new(); +par( mfrow = c(2,1) ); + +b = barplot(Bias_G1sq + Ineff_G1sq, col = "red", main = "stress-test of estimator: x(1)*x(3)"); +barplot( Ineff_G1sq, col="blue", add = TRUE); +lines( b, Err_G1sq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); + + +b=barplot( Bias_G2sq + Ineff_G2sq , col = "red", main = "stress-test of estimator sample mean"); +barplot( Ineff_G2sq, col="blue", add = TRUE); +lines(b, Err_G2sq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); Added: pkg/Meucci/demo/S_ExpectationMaximizationHighYield.R =================================================================== --- pkg/Meucci/demo/S_ExpectationMaximizationHighYield.R (rev 0) +++ pkg/Meucci/demo/S_ExpectationMaximizationHighYield.R 2013-07-12 19:20:14 UTC (rev 2559) @@ -0,0 +1,45 @@ +#' This script implements the Expectation-Maximization (EM) algoritm, which estimates the parameters of a +#' multivariate normal distribution when some observations are randomly missing, as described in A. Meucci, +#' "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ExpectationMaximizationHighYield.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Load data +load("../data/highYieldIndices.Rda"); + +################################################################################################################## +### Compute invariants and set NaN for large values +N = ncol(highYieldIndices$Data); +Series = log( highYieldIndices$Data[ -1, ] ) - log( highYieldIndices$Data[ -nrow(highYieldIndices$Data), ] ); +NANs_Index = which( abs( Series ) > (10 ^ 10) ); +Series[ NANs_Index ] = NaN; + +################################################################################################################## +### Run EM algorithm +FEM = FitExpectationMaximization(Series); + +################################################################################################################## +### Display results +dev.new(); +par( mfrow = c( N, 1 ) ) +for( n in 1 : N ) +{ + Drop = is.nan( Series[ , n ] ); + Bad_Dates = highYieldIndices$Dates[ Drop ]; + + Keep = !is.nan( Series[ , n ] ); + Good_Dates = highYieldIndices$Dates[ Keep ]; + + plot(Good_Dates[1:(length(Good_Dates)-1)], Series[ Keep, n ], xaxt = "n", xlab = "", ylab = ""); + points(Bad_Dates, FEM$Recovered_Series[ Drop, n ], pch = 21, bg = "red"); + #axis( 1, at = highYieldIndices$Dates, labels=format(highYieldIndices$Dates,"%m/%d/%y")) # Format x-axis + +} +legend( "bottom", 1.9, "EM-recovered data", pch = 21, col = "red" ,bg = "gray90" ); + + Added: pkg/Meucci/man/FitExpectationMaximization.Rd =================================================================== --- pkg/Meucci/man/FitExpectationMaximization.Rd (rev 0) +++ pkg/Meucci/man/FitExpectationMaximization.Rd 2013-07-12 19:20:14 UTC (rev 2559) @@ -0,0 +1,33 @@ +\name{FitExpectationMaximization} +\alias{FitExpectationMaximization} +\title{Expectation-Maximization (EM) algorithm to recover missing observations in a time series , +as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.} +\usage{ + FitExpectationMaximization(X) +} +\arguments{ + \item{X}{: [matrix] (T x N) of data} +} +\value{ + E_EM : [vector] (N x 1) expectation + + S_EM : [matrix] (N x N) covariance matrix + + Y : [matrix] (T x N) updated data + + CountLoop : [scalar] number of iterations of the + algorithm +} +\description{ + Expectation-Maximization (EM) algorithm to recover + missing observations in a time series , as described in + A. Meucci, "Risk and Asset Allocation", Springer, 2005. +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "FitExpectationMaximization.m" +} + Added: pkg/Meucci/man/QuantileMixture.Rd =================================================================== --- pkg/Meucci/man/QuantileMixture.Rd (rev 0) +++ pkg/Meucci/man/QuantileMixture.Rd 2013-07-12 19:20:14 UTC (rev 2559) @@ -0,0 +1,43 @@ +\name{QuantileMixture} +\alias{QuantileMixture} +\title{Computes the quantile of a mixture distirbution by linear interpolation/extrapolation of the cdf.the confidence +level p can be vector. If this vector is uniformly distributed on [0,1] the sample Q is distributed as the mixture. +Described in A. Meucci "Risk and Asset Allocation", Springer, 2005} +\usage{ + QuantileMixture(p, a, m_Y, s_Y, m_Z, s_Z) +} +\arguments{ + \item{p}{: [scalar] in [0,1], probability} + + \item{a}{: [scalar] in (0,1), mixing probability} + + \item{m_Y}{: [scalar] mean of normal component} + + \item{s_Y}{: [scalar] standard deviation of normal + component} + + \item{m_Z}{: [scalar] first parameters of the log-normal + component} + + \item{s_Z}{: [scalar] second parameter of the log-normal + component} +} +\value{ + Q : [scalar] quantile +} +\description{ + Computes the quantile of a mixture distirbution by linear + interpolation/extrapolation of the cdf.the confidence + level p can be vector. If this vector is uniformly + distributed on [0,1] the sample Q is distributed as the + mixture. Described in A. Meucci "Risk and Asset + Allocation", Springer, 2005 +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "QuantileMixture.m" +} + From noreply at r-forge.r-project.org Sat Jul 13 11:35:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 11:35:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2560 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: . Week1 Week2 Message-ID: <20130713093531.CB053185742@r-forge.r-project.org> Author: shubhanm Date: 2013-07-13 11:35:31 +0200 (Sat, 13 Jul 2013) New Revision: 2560 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpe.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/table.Return.GLM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R Removed: pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/GLMSmoothIndex.R pkg/PerformanceAnalytics/sandbox/Shubhankit/LoSharpeRatio.R pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R Log: Modified : GLMSmoothIndex.R : Modified the smoothing parameter and Literature LoSharpe.R : Modified the Function and checked it's consistency with results similar to published in Paper for edhec database Return.GLM.R : Modified The fucntion and checked it's consisteny with reduction in kurtosis and skewness for edhec database for most of the funds table.Return.GLM.R: Added Literature Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/EmaxDDGBM.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,194 +0,0 @@ -#' Expected Drawdown using Brownian Motion Assumptions -#' -#' Works on the model specified by Maddon-Ismail -#' -#' -#' -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns - -#' @author R -#' @keywords Expected Drawdown Using Brownian Motion Assumptions -#' -#' @export -table.EMaxDDGBM <- - function (R,digits =4) - {# @author - - # DESCRIPTION: - # Downside Risk Summary: Statistics and Stylized Facts - - # Inputs: - # R: a regular timeseries of returns (rather than prices) - # Output: Table of Estimated Drawdowns - - y = checkData(R, method = "xts") - columns = ncol(y) - rows = nrow(y) - columnnames = colnames(y) - rownames = rownames(y) - T= nyears(y); - - # for each column, do the following: - for(column in 1:columns) { - x = y[,column] - mu = Return.annualized(x, scale = NA, geometric = TRUE) - sig=StdDev(x) - gamma<-sqrt(pi/8) - - if(mu==0){ - - Ed<-2*gamma*sig*sqrt(T) - - } - - else{ - - alpha<-mu*sqrt(T/(2*sig^2)) - - x<-alpha^2 - - if(mu>0){ - - mQp<-matrix(c( - - 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, - - 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, - - 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900, - - 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000, - - 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690, - - 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171, - - 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162, - - 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999, - - 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992, - - 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457, - - 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985, - - 2.621743),ncol=2) - - - - if(x<0.0005){ - - Qp<-gamma*sqrt(2*x) - - } - - if(x>0.0005 & x<5000){ - - Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y - - } - - if(x>5000){ - - Qp<-0.25*log(x)+0.49088 - - } - - Ed<-(2*sig^2/mu)*Qp - - } - - if(mu<0){ - - mQn<-matrix(c( - - 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150, - - 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400, - - 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800, - - 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000, - - 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000, - - 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708, - - 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229, - - 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056, - - 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393, - - 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455, - - 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380, - - 4.990430, 5.498820),ncol=2) - - - - - - if(x<0.0005){ - - Qn<-gamma*sqrt(2*x) - - } - - if(x>0.0005 & x<5000){ - - Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y - - } - - if(x>5000){ - - Qn<-x+0.50 - - } - - Ed<-(2*sig^2/mu)*(-Qn) - - } - - } - - # return(Ed) - - z = c((mu*100), - (sig*100), - (Ed*100)) - znames = c( - "Annual Returns in %", - "Std Devetions in %", - "Expected Drawdown in %" - ) - if(column == 1) { - resultingtable = data.frame(Value = z, row.names = znames) - } - else { - nextcolumn = data.frame(Value = z, row.names = znames) - resultingtable = cbind(resultingtable, nextcolumn) - } - } - colnames(resultingtable) = columnnames - ans = base::round(resultingtable, digits) - ans - - - } - -############################################################################### -# R (http://r-project.org/) -# -# Copyright (c) 2004-2013 -# -# This R package is distributed under the terms of the GNU Public License (GPL) -# for full details see the file COPYING -# -# $Id: EMaxDDGBM -# -############################################################################### Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/GLMSmoothIndex.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/GLMSmoothIndex.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/GLMSmoothIndex.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,36 +0,0 @@ -GLMSmoothIndex<- - function(R = NULL, ...) - { - columns = 1 - columnnames = NULL - #Error handling if R is not NULL - if(!is.null(R)){ - x = checkData(R) - columns = ncol(x) - n = nrow(x) - count = q - x=edhec - columns = ncol(x) - columnnames = colnames(x) - - # Calculate AutoCorrelation Coefficient - for(column in 1:columns) { # for each asset passed in as R - y = checkData(edhec[,column], method="vector", na.rm = TRUE) - - acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] - values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) - - if(column == 1) { - result.df = data.frame(Value = values) - colnames(result.df) = columnnames[column] - } - else { - nextcol = data.frame(Value = values) - colnames(nextcol) = columnnames[column] - result.df = cbind(result.df, nextcol) - } - } - return(result.df) - - } - } \ No newline at end of file Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/LoSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/LoSharpeRatio.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/LoSharpeRatio.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,71 +0,0 @@ -LoSharpeRatio<- - function(R = NULL,Rf=0.,q = 0., ...) - { -columns = 1 -columnnames = NULL -#Error handling if R is not NULL -if(!is.null(R)){ - x = checkData(R) - columns = ncol(x) - n = nrow(x) - - if(q==0){ - stop("AutoCorrelation Coefficient Should be greater than 0") - - } - else{ - # A potfolio is constructed by applying the weights - - count = q - x=edhec - columns = ncol(x) - columnnames = colnames(x) - - # Calculate AutoCorrelation Coefficient - for(column in 1:columns) { # for each asset passed in as R - y = checkData(edhec[,column], method="vector", na.rm = TRUE) - - acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] - LjungBox = Box.test(y,type="Ljung-Box",lag=q) - values = c(acflag6, LjungBox$p.value) - # values = base::round(as.numeric(values),digits) - - if(column == 1) { - result.df = data.frame(Value = values) - colnames(result.df) = columnnames[column] - } - else { - nextcol = data.frame(Value = values) - colnames(nextcol) = columnnames[column] - result.df = cbind(result.df, nextcol) - } - } - # Calculate Neta's - for(column in 1:columns) { - sum = 0 - z = checkData(edhec[,column], method="vector", na.rm = TRUE) - for(q in 1:(q-1) ) - { - sum = sum + (count-q)*result.df[column,q] - - } - - netaq = count/(sqrt(count+2*sum)) - if(column == 1) { - netacol = data.frame(Value = netaq) - colnames(netacol) = columnnames[column] - } - else { - nextcol = data.frame(Value = netaq) - colnames(nextcol) = columnnames[column] - netacol = cbind(netacol, nextcol) - } - - } - shrp = SharpeRatio(x, Rf, FUN="VaR" , method="gaussian") - results = Shrp*netacol - colnames(results) = colnames(x) - return(results) - } - } -} \ No newline at end of file Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/UnsmoothReturn.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,36 +0,0 @@ -UnSmoothReturn<- - function(R = NULL,q, ...) - { - columns = 1 - columnnames = NULL - #Error handling if R is not NULL - if(!is.null(R)){ - x = checkData(R) - columns = ncol(x) - n = nrow(x) - count = q - x=edhec - columns = ncol(x) - columnnames = colnames(x) - - # Calculate AutoCorrelation Coefficient - for(column in 1:columns) { # for each asset passed in as R - y = checkData(edhec[,column], method="vector", na.rm = TRUE) - - acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] - values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) - - if(column == 1) { - result.df = data.frame(Value = values) - colnames(result.df) = columnnames[column] - } - else { - nextcol = data.frame(Value = values) - colnames(nextcol) = columnnames[column] - result.df = cbind(result.df, nextcol) - } - } - return(result.df[1:q,]*R) # Unsmooth Return - - } - } \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,3 +1,11 @@ +#This measure is well known in the +#industrial organization literature as the Herfindahl index, a measure of the +#concentration of firms in a given industry where yj represents the market share of +#firm j: Because yjA?0; 1 ; x is also confined to the unit interval, and is minimized when +#all the yj's are identical, which implies a value of 1=?k ? 1? for x; and is maximized +#when one coefficient is 1 and the rest are 0, in which case x ? 1: In the context of +##smoothed returns, a lower value of x implies more smoothing, and the upper bound +#of 1 implies no smoothing, hence we shall refer to x as a ''smoothingindex' '. GLMSmoothIndex<- function(R = NULL, ...) { @@ -15,11 +23,11 @@ # Calculate AutoCorrelation Coefficient for(column in 1:columns) { # for each asset passed in as R - y = checkData(edhec[,column], method="vector", na.rm = TRUE) + y = checkData(x[,column], method="vector", na.rm = TRUE) + sum = sum(abs(acf(y,plot=FALSE,lag.max=6)[[1]][2:7])); + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7]/sum; + values = sum(acflag6*acflag6) - acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] - values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) - if(column == 1) { result.df = data.frame(Value = values) colnames(result.df) = columnnames[column] @@ -33,4 +41,18 @@ return(result.df) } + + + ############################################################################### + # 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: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ + # + ############################################################################### + } \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpe.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpe.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpe.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -0,0 +1,110 @@ +#' calculate Geltner liquidity-adjusted return series +#' +#' David Geltner developed a method to remove estimating or liquidity bias in +#' real estate index returns. It has since been applied with success to other +#' return series that show autocorrelation or illiquidity effects. +#' +#' The theory is that by correcting for autocorrelation, you are uncovering a +#' "true" return from a series of observed returns that contain illiquidity or +#' manual pricing effects. +#' +#' The Geltner autocorrelation adjusted return series may be calculated via: +#' +#' \deqn{ }{Geltner.returns = [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) }\deqn{ +#' R_{G}=\frac{R_{t}-(R_{t-1}\cdot\rho_{1})}{1-\rho_{1}} }{Geltner.returns = +#' [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) } +#' +#' where \eqn{\rho_{1}}{acf(R(t-1))} is the first-order autocorrelation of the +#' return series \eqn{R_{a}}{Ra} and \eqn{R_{t}}{R(t)} is the return of +#' \eqn{R_{a}}{Ra} at time \eqn{t} and \eqn{R_{t-1}}{R(t-1)} is the one-period +#' lagged return. +#' +#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param \dots any other passthru parameters +#' @author Brian Peterson +#' @references "Edhec Funds of Hedge Funds Reporting Survey : A Return-Based +#' Approach to Funds of Hedge Funds Reporting",Edhec Risk and Asset Management +#' Research Centre, January 2005,p. 27 +#' +#' Geltner, David, 1991, Smoothing in Appraisal-Based Returns, Journal of Real +#' Estate Finance and Economics, Vol.4, p.327-345. +#' +#' Geltner, David, 1993, Estimating Market Values from Appraised Values without +#' Assuming an Efficient Market, Journal of Real Estate Research, Vol.8, +#' p.325-345. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' head(Return.Geltner(managers[,1:3]),n=20) +#' +#' @export +LoSharpe <- + function (Ra,Rf = 0,q = 0, ...) + { # @author Brian G. Peterson, Peter Carl + + # Description: + # Geltner Returns came from real estate where they are used to uncover a + # liquidity-adjusted return series. + + # Ra return vector + + # Function: + R = checkData(Ra, method="xts") + # Get dimensions and labels + columns.a = ncol(R) + columnnames.a = colnames(R) + Time= 252*nyears(edhec) + clean.lo <- function(column.R,q) { + # compute the lagged return series + gamma.k =matrix(0,q) + mu = sum(column.R)/(Time) + for(i in 1:q){ + lagR = lag(column.R, k=i) + # compute the Momentum Lagged Values + gamma.k[i]= (sum(((column.R-mu)*(lagR-mu)),na.rm=TRUE)) + } + return(gamma.k) + } + neta.lo <- function(pho.k,q) { + # compute the lagged return series + sumq = 0 + for(j in 1:q){ + sumq = sumq+ (q-j)*pho.k[j] + } + return(q/(sqrt(q+2*sumq))) + } + for(column.a in 1:columns.a) { # for each asset passed in as R + # clean the data and get rid of NAs + mu = sum(column.R)/(Time) + sig=sqrt(((column.R-mu)^2/(Time))) + pho.k = clean.lo(R[,column.a],q)/(as.numeric(sig[1])) + netaq=neta.lo(pho.k,q) + column.lo = (netaq*((mu-Rf)/as.numeric(sig[1]))) + + if(column.a == 1) { lo = column.lo } + else { lo = cbind (lo, column.lo) } + + } + colnames(lo) = columnnames.a + rownames(lo)= paste("Lo Sharpe Ratio") + return(lo) + + + # RESULTS: + # return(reclass(geltner,match.to=Ra)) + + } + +############################################################################### +# 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: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/table.Return.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/table.Return.GLM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/table.Return.GLM.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -0,0 +1 @@ +rff \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -0,0 +1,102 @@ +#' calculate Geltner liquidity-adjusted return series +#' +#' David Geltner developed a method to remove estimating or liquidity bias in +#' real estate index returns. It has since been applied with success to other +#' return series that show autocorrelation or illiquidity effects. +#' +#' The theory is that by correcting for autocorrelation, you are uncovering a +#' "true" return from a series of observed returns that contain illiquidity or +#' manual pricing effects. +#' +#' The Geltner autocorrelation adjusted return series may be calculated via: +#' +#' \deqn{ }{Geltner.returns = [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) }\deqn{ +#' R_{G}=\frac{R_{t}-(R_{t-1}\cdot\rho_{1})}{1-\rho_{1}} }{Geltner.returns = +#' [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) } +#' +#' where \eqn{\rho_{1}}{acf(R(t-1))} is the first-order autocorrelation of the +#' return series \eqn{R_{a}}{Ra} and \eqn{R_{t}}{R(t)} is the return of +#' \eqn{R_{a}}{Ra} at time \eqn{t} and \eqn{R_{t-1}}{R(t-1)} is the one-period +#' lagged return. +#' +#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param \dots any other passthru parameters +#' @author Brian Peterson +#' @references "Edhec Funds of Hedge Funds Reporting Survey : A Return-Based +#' Approach to Funds of Hedge Funds Reporting",Edhec Risk and Asset Management +#' Research Centre, January 2005,p. 27 +#' +#' Geltner, David, 1991, Smoothing in Appraisal-Based Returns, Journal of Real +#' Estate Finance and Economics, Vol.4, p.327-345. +#' +#' Geltner, David, 1993, Estimating Market Values from Appraised Values without +#' Assuming an Efficient Market, Journal of Real Estate Research, Vol.8, +#' p.325-345. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' head(Return.Geltner(managers[,1:3]),n=20) +#' +#' @export +Return.GLM <- + function (Ra,q=3) + { # @author Brian G. Peterson, Peter Carl + + # Description: + # Geltner Returns came from real estate where they are used to uncover a + # liquidity-adjusted return series. + + # Ra return vector + # q Lag Factors + # Function: + R = checkData(Ra, method="xts") + # Get dimensions and labels + columns.a = ncol(R) + columnnames.a = colnames(R) + + clean.GLM <- function(column.R,q=3) { + ma.coeff = as.numeric(arma(column.R, order = c(0,q))$coef) +# for( i in 1: q) + # { +# if(q == 1){column.glm = ma.coeff[i]*lag(column.R,i)} +#else{ column.glm = ma.coeff[i]*lag(column.R,i)+ column.glm} + # } + column.glm = ma.coeff[q]*lag(column.R,q) + # compute the lagged return series + #lagR = lag(column.R, k=1) + # compute the first order autocorrelation + #f_acf = as.numeric(acf(as.numeric(column.R), plot = FALSE)[1][[1]]) + # now calculate and return the Geltner series + #column.geltner = (column.R-(lagR*f_acf))/(1-f_acf) + return(column.glm) + } + + for(column.a in 1:columns.a) { # for each asset passed in as R + # clean the data and get rid of NAs + column.glma = na.skip(R[,column.a],clean.GLM) + + if(column.a == 1) { glm = column.glma } + else { glm = cbind (glm, column.glma) } + + } + + colnames(glm) = columnnames.a + + # RESULTS: + return(reclass(glm,match.to=Ra)) + + } + +############################################################################### +# 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: Return.GLM.R 2163 2012-07-16 00:30:19Z braverock $ +# +############################################################################### Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/chart.Autocorrelation.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,47 +0,0 @@ -#' Stacked Bar Plot of Autocorrelation Lag Coefficients -#' -#' A wrapper to create box and whiskers plot of comparitive inputs -#' -#' 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 Burghardt, Duncan and Liu(2013) -#' -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns -#' @return Stack Bar plot of lagged return coefficients -#' @author R -#' @seealso \code{\link[graphics]{boxplot}} -#' @references Burghardt, Duncan and Liu(2013) \emph{It's the autocorrelation, stupid}. AlternativeEdge Note November, 2012 } -#' @keywords Autocorrelation lag factors -#' @examples -#' -#' data(edhec) -#' chart.Autocorrelation(edhec) -#' -#' -#' @export -chart.Autocorrelation <- - function (R, ...) - { # @author R - - # DESCRIPTION: - # A wrapper to create box and whiskers plot, of autocorrelation lag coeffiecients - # of the First six factors - - R = checkData(R, method="xts") - -# Graph autos with adjacent bars using rainbow colors - -aa= table.Autocorrelation(R) -barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient", - , xlab = "Fund Type",beside=TRUE, col=rainbow(6)) - - # Place the legend at the top-left corner with no frame - # using rainbow colors - legend("topright", c("1","2","3","4","5","6"), cex=0.6, - bty="n", fill=rainbow(6)); - - - - -} \ No newline at end of file Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsmoothReturn.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,79 +0,0 @@ -#' Compenent Decomposition of Table of Unsmooth Returns -#' -#' Creates a table of estimates of moving averages for comparison across -#' multiple instruments or funds as well as their standard error and -#' smoothing index -#' -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns -#' @param ci confidence interval, defaults to 95\% -#' @param n number of series lags -#' @param p confidence level for calculation, default p=.99 -#' @param digits number of digits to round results to -#' @author R -#' @keywords ts smooth return models -#' -#' @export -table.UnsmoothReturn <- - function (R, n = 3, p= 0.95, digits = 4) - {# @author - - # DESCRIPTION: - # Downside Risk Summary: Statistics and Stylized Facts - - # Inputs: - # R: a regular timeseries of returns (rather than prices) - # n : Number of lags - # p = Confifence Level - # Output: - # A table of estimates of Moving Average - - y = checkData(R, method = "xts") - columns = ncol(y) - rows = nrow(y) - columnnames = colnames(y) - rownames = rownames(y) - - # for each column, do the following: - for(column in 1:columns) { - x = y[,column] - - z = c(arma(x,0,2)$theta[1], - arma(x,0,2)$se.theta[1], - arma(x,0,2)$theta[2], - arma(x,0,2)$se.theta[2], - arma(x,0,2)$se.theta[2]) - znames = c( - "Moving Average(1)", - "Std Error of MA(1)", - "Moving Average(2)", - "Std Error of MA(2)", - "Smoothing Invest" - - ) - if(column == 1) { - resultingtable = data.frame(Value = z, row.names = znames) - } - else { - nextcolumn = data.frame(Value = z, row.names = znames) - resultingtable = cbind(resultingtable, nextcolumn) - } - } - colnames(resultingtable) = columnnames - ans = base::round(resultingtable, digits) - ans - - -} - -############################################################################### -# R (http://r-project.org/) -# -# Copyright (c) 2004-2013 -# -# This R package is distributed under the terms of the GNU Public License (GPL) -# for full details see the file COPYING -# -# $Id: table.UnSmoothReturn.R -# -############################################################################### Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/table.UnsoothReturn.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,81 +0,0 @@ -#' Compenent Decomposition of Table of Unsmooth Returns -#' -#' Creates a table of estimates of moving averages for comparison across -#' multiple instruments or funds as well as their standard error and -#' smoothing index -#' -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns -#' @param ci confidence interval, defaults to 95\% -#' @param n number of series lags -#' @param p confidence level for calculation, default p=.99 -#' @param digits number of digits to round results to -#' @author R -#' @keywords ts smooth return models -#' -#' @export -table.UnsmoothReturn <- - function (R, n = 3, p= 0.95, digits = 4) - {# @author - - # DESCRIPTION: - # Downside Risk Summary: Statistics and Stylized Facts - - # Inputs: - # R: a regular timeseries of returns (rather than prices) - # n : Number of lags - # p = Confifence Level - # Output: - # A table of estimates of Moving Average - - y = checkData(R, method = "zoo") - columns = ncol(y) - rows = nrow(y) - columnnames = colnames(y) - rownames = rownames(y) - - # for each column, do the following: - for(column in 1:columns) { - x = na.omit(y[,column,drop=FALSE]) - - z = c( - arma(x,0,2)$theta[1], - arma(x,0,2)$se.theta[1], - arma(x,0,2)$theta[2], - arma(x,0,2)$se.theta[2], - (arma(x,0,2)$theta*arma(x,0,2)$theta) - ) - znames = c( - "Moving Average(1)", - "Std Error of MA(1)", - "Moving Average(2)", - "Std Error of MA(2)", - "Smoothing Invest" - - ) - if(column == 1) { - resultingtable = data.frame(Value = z, row.names = znames) - } - else { - nextcolumn = data.frame(Value = z, row.names = znames) - resultingtable = cbind(resultingtable, nextcolumn) - } - } - colnames(resultingtable) = columnnames - ans = base::round(resultingtable, digits) - ans - - -} - -############################################################################### -# R (http://r-project.org/) -# -# Copyright (c) 2004-2013 -# -# This R package is distributed under the terms of the GNU Public License (GPL) -# for full details see the file COPYING -# -# $Id: table.UnSmoothReturn.R -# -############################################################################### Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R 2013-07-12 19:20:14 UTC (rev 2559) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/table.normDD.R 2013-07-13 09:35:31 UTC (rev 2560) @@ -1,86 +0,0 @@ -#' Expected Drawdown using Brownian Motion Assumptions -#' -#' Works on the model specified by Maddon-Ismail -#' -#' -#' -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns - -#' @author R -#' @keywords Expected Drawdown Using Brownian Motion Assumptions -#' -#' @export -table.NormDD <- - function (R,digits =4) - {# @author - - # DESCRIPTION: - # Downside Risk Summary: Statistics and Stylized Facts - - # Inputs: - # R: a regular timeseries of returns (rather than prices) - # Output: Table of Estimated Drawdowns - - y = checkData(R, method = "xts") - columns = ncol(y) - rows = nrow(y) - columnnames = colnames(y) - rownames = rownames(y) - T= nyears(y); - n <- 1000 - dt <- 1/T; - r0 <- 100; - # for each column, do the following: - for(column in 1:columns) { - x = y[,column] - mu = Return.annualized(x, scale = NA, geometric = TRUE) - sig=StdDev.annualized(x) - r <- matrix(0,T+1,n) # matrix to hold short rate paths - r[1,] <- r0 - drawdown <- matrix(0,n) - # return(Ed) - - for(j in 1:n){ - for(i in 2:(T+1)){ - - dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) - r[i,j] <- r[i-1,j] + dr - } - drawdown[j] = maxDrawdown(r[,j]) - } - z = c((mu*100), - (sig*100), - ((mean(drawdown)*100))) - znames = c( - "Annual Returns in %", - "Std Devetions in %", - "Normalized Drawdown Drawdown in %" - ) - if(column == 1) { - resultingtable = data.frame(Value = z, row.names = znames) - } - else { - nextcolumn = data.frame(Value = z, row.names = znames) - resultingtable = cbind(resultingtable, nextcolumn) - } - } - colnames(resultingtable) = columnnames - ans = base::round(resultingtable, digits) - ans - t <- seq(0, T, dt) - matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") - - } - -############################################################################### -# R (http://r-project.org/) -# -# Copyright (c) 2004-2013 -# -# This R package is distributed under the terms of the GNU Public License (GPL) -# for full details see the file COPYING -# -# $Id: EMaxDDGBM -# -############################################################################### From noreply at r-forge.r-project.org Sat Jul 13 13:18:29 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 13:18:29 +0200 (CEST) Subject: [Returnanalytics-commits] r2561 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130713111829.AED8A180B3A@r-forge.r-project.org> Author: shubhanm Date: 2013-07-13 13:18:29 +0200 (Sat, 13 Jul 2013) New Revision: 2561 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R Log: Additional Method for Calmar Ratio (Normalized) : Reference Malik Magdon Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R 2013-07-13 11:18:29 UTC (rev 2561) @@ -0,0 +1,138 @@ +#' calculate a Calmar or Sterling reward/risk ratio +#' +#' Calmar and Sterling Ratios are yet another method of creating a +#' risk-adjusted measure for ranking investments similar to the +#' \code{\link{SharpeRatio}}. +#' +#' Both the Calmar and the Sterling ratio are the ratio of annualized return +#' over the absolute value of the maximum drawdown of an investment. The +#' Sterling ratio adds an excess risk measure to the maximum drawdown, +#' traditionally and defaulting to 10\%. +#' +#' It is also traditional to use a three year return series for these +#' calculations, although the functions included here make no effort to +#' determine the length of your series. If you want to use a subset of your +#' series, you'll need to truncate or subset the input data to the desired +#' length. +#' +#' Many other measures have been proposed to do similar reward to risk ranking. +#' It is the opinion of this author that newer measures such as Sortino's +#' \code{\link{UpsidePotentialRatio}} or Favre's modified +#' \code{\link{SharpeRatio}} are both \dQuote{better} measures, and +#' should be preferred to the Calmar or Sterling Ratio. +#' +#' @aliases CalmarRatio SterlingRatio +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param scale number of periods in a year (daily scale = 252, monthly scale = +#' 12, quarterly scale = 4) +#' @param excess for Sterling Ratio, excess amount to add to the max drawdown, +#' traditionally and default .1 (10\%) +#' @author Brian G. Peterson +#' @seealso +#' \code{\link{Return.annualized}}, \cr +#' \code{\link{maxDrawdown}}, \cr +#' \code{\link{SharpeRatio.modified}}, \cr +#' \code{\link{UpsidePotentialRatio}} +#' @references Bacon, Carl. \emph{Practical Portfolio Performance Measurement +#' and Attribution}. Wiley. 2004. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' CalmarRatio(managers[,1,drop=FALSE]) +#' CalmarRatio(managers[,1:6]) +#' SterlingRatio(managers[,1,drop=FALSE]) +#' SterlingRatio(managers[,1:6]) +#' +#' @export +#' @rdname CalmarRatio +#' QP function fo calculation of Sharpe Ratio +QP.Norm <- function (R, tau,scale = NA) +{ + Sharpe= as.numeric(SharpeRatio.annualized(edhec)) +return(.63519+(.5*log(tau))+log(Sharpe)) +} + +CalmarRatio.Normalized <- function (R, tau = 1,scale = NA) +{ # @author Brian G. Peterson + + # DESCRIPTION: + # Inputs: + # Ra: in this case, the function anticipates having a return stream as input, + # rather than prices. + # tau : scaled Time in Years + # scale: number of periods per year + # Outputs: + # This function returns a Calmar Ratio + + # FUNCTION: + + R = checkData(R) + if(is.na(scale)) { + 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} + ) + } + Time = nyears(R) + annualized_return = Return.annualized(R, scale=scale) + drawdown = abs(maxDrawdown(R)) + result = (annualized_return/drawdown)*(QP.Norm(R,Time)/QP.Norm(R,tau))*(tau/Time) + rownames(result) = "Calmar Ratio" + return(result) +} + +#' @export +#' @rdname CalmarRatio +SterlingRatio <- + function (R, scale=NA, excess=.1) + { # @author Brian G. Peterson + + # DESCRIPTION: + # Inputs: + # Ra: in this case, the function anticipates having a return stream as input, + # rather than prices. + # scale: number of periods per year + # Outputs: + # This function returns a Sterling Ratio + + # FUNCTION: + + R = checkData(R) + if(is.na(scale)) { + 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} + ) + } + annualized_return = Return.annualized(R, scale=scale) + drawdown = abs(maxDrawdown(R)+excess) + result = annualized_return/drawdown + rownames(result) = paste("Sterling Ratio (Excess = ", round(excess*100,0), "%)", sep="") + return(result) + } + +############################################################################### +# 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: CalmarRatio.R 1955 2012-05-23 16:38:16Z braverock $ +# +############################################################################### From noreply at r-forge.r-project.org Sat Jul 13 16:22:56 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 16:22:56 +0200 (CEST) Subject: [Returnanalytics-commits] r2562 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130713142256.D2464183B9C@r-forge.r-project.org> Author: shubhanm Date: 2013-07-13 16:22:56 +0200 (Sat, 13 Jul 2013) New Revision: 2562 Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R Log: Modified : Added Normalized Sterling Ratio and Documentation Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R 2013-07-13 11:18:29 UTC (rev 2561) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/CalmarRatio.Normalized.R 2013-07-13 14:22:56 UTC (rev 2562) @@ -1,10 +1,10 @@ -#' calculate a Calmar or Sterling reward/risk ratio +#' calculate a Normalized Calmar or Sterling reward/risk ratio #' -#' Calmar and Sterling Ratios are yet another method of creating a +#' Normalized Calmar and Sterling Ratios are yet another method of creating a #' risk-adjusted measure for ranking investments similar to the #' \code{\link{SharpeRatio}}. #' -#' Both the Calmar and the Sterling ratio are the ratio of annualized return +#' Both the Normalized Calmar and the Sterling ratio are the ratio of annualized return #' over the absolute value of the maximum drawdown of an investment. The #' Sterling ratio adds an excess risk measure to the maximum drawdown, #' traditionally and defaulting to 10\%. @@ -21,7 +21,7 @@ #' \code{\link{SharpeRatio}} are both \dQuote{better} measures, and #' should be preferred to the Calmar or Sterling Ratio. #' -#' @aliases CalmarRatio SterlingRatio +#' @aliases Normalized.CalmarRatio Normalized.SterlingRatio #' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns #' @param scale number of periods in a year (daily scale = 252, monthly scale = @@ -34,16 +34,15 @@ #' \code{\link{maxDrawdown}}, \cr #' \code{\link{SharpeRatio.modified}}, \cr #' \code{\link{UpsidePotentialRatio}} -#' @references Bacon, Carl. \emph{Practical Portfolio Performance Measurement -#' and Attribution}. Wiley. 2004. +#' @references Bacon, Carl. \emph{Magdon-Ismail, M. and Amir Atiya, Maximum drawdown. Risk Magazine, 01 Oct 2004. #' @keywords ts multivariate distribution models #' @examples #' #' data(managers) -#' CalmarRatio(managers[,1,drop=FALSE]) -#' CalmarRatio(managers[,1:6]) -#' SterlingRatio(managers[,1,drop=FALSE]) -#' SterlingRatio(managers[,1:6]) +#' Normalized.CalmarRatio(managers[,1,drop=FALSE]) +#' Normalized.CalmarRatio(managers[,1:6]) +#' Normalized.SterlingRatio(managers[,1,drop=FALSE]) +#' Normalized.SterlingRatio(managers[,1:6]) #' #' @export #' @rdname CalmarRatio @@ -85,14 +84,14 @@ annualized_return = Return.annualized(R, scale=scale) drawdown = abs(maxDrawdown(R)) result = (annualized_return/drawdown)*(QP.Norm(R,Time)/QP.Norm(R,tau))*(tau/Time) - rownames(result) = "Calmar Ratio" + rownames(result) = "Normalized Calmar Ratio" return(result) } #' @export #' @rdname CalmarRatio -SterlingRatio <- - function (R, scale=NA, excess=.1) +SterlingRatio.Normalized <- + function (R, tau=1,scale=NA, excess=.1) { # @author Brian G. Peterson # DESCRIPTION: @@ -104,7 +103,7 @@ # This function returns a Sterling Ratio # FUNCTION: - + Time = nyears(R) R = checkData(R) if(is.na(scale)) { freq = periodicity(R) @@ -120,15 +119,15 @@ } annualized_return = Return.annualized(R, scale=scale) drawdown = abs(maxDrawdown(R)+excess) - result = annualized_return/drawdown - rownames(result) = paste("Sterling Ratio (Excess = ", round(excess*100,0), "%)", sep="") + result = annualized_return/drawdown*(QP.Norm(R,Time)/QP.Norm(R,tau))*(tau/Time) + rownames(result) = paste("Normalized Sterling Ratio (Excess = ", round(excess*100,0), "%)", sep="") return(result) } ############################################################################### # R (http://r-project.org/) Econometrics for Performance and Risk Analysis # -# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson +# Copyright (c) 2004-2013 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 From noreply at r-forge.r-project.org Sat Jul 13 19:51:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 19:51:20 +0200 (CEST) Subject: [Returnanalytics-commits] r2563 - pkg/Meucci/demo Message-ID: <20130713175120.38D82184EBD@r-forge.r-project.org> Author: xavierv Date: 2013-07-13 19:51:19 +0200 (Sat, 13 Jul 2013) New Revision: 2563 Added: pkg/Meucci/demo/S_GenerateMixtureSample.R pkg/Meucci/demo/S_PasturMarchenko.R pkg/Meucci/demo/S_SemiCircular.R Log: -added three more demo files Added: pkg/Meucci/demo/S_GenerateMixtureSample.R =================================================================== --- pkg/Meucci/demo/S_GenerateMixtureSample.R (rev 0) +++ pkg/Meucci/demo/S_GenerateMixtureSample.R 2013-07-13 17:51:19 UTC (rev 2563) @@ -0,0 +1,26 @@ +#' This script generates draws from a univarite mixture, as described in A. Meucci, "Risk and Asset Allocation", +#' Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_GenerateMixtureSample.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com}### + +################################################################################################################## +### Inputs +a = 0.8; +m_Y = 0.1; +s_Y = 0.2; +m_Z = 0; +s_Z = 0.15; + +T = 52; + +################################################################################################################## +### Computations +P = runif(T); +Q = QuantileMixture( P, a, m_Y, s_Y, m_Z, s_Z ); + +dev.new(); +plot( Q ); \ No newline at end of file Added: pkg/Meucci/demo/S_PasturMarchenko.R =================================================================== --- pkg/Meucci/demo/S_PasturMarchenko.R (rev 0) +++ pkg/Meucci/demo/S_PasturMarchenko.R 2013-07-13 17:51:19 UTC (rev 2563) @@ -0,0 +1,45 @@ +#' This script illustrate the Marchenko-Pastur limit of runifom matrix theory, as described in A. Meucci, +#' "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_PasturMarchenko.m" +#' + +################################################################################################################## +### Inputs +T = 1500; +N = 900; + +################################################################################################################## +### Empirical eigenvalues + +#X = matrix( runif(T*N), T, N ) ; # normal +#X = (matrix( runif(T*N), T, N ) - 0.5) * sqrt(12); # uniform +X = log(matrix( runif( T*N ), T, N )) + 1; # exponential + +Y = ( t(X) %*% X ) / T; # symmetrize and rescale +E = t(eigen(Y)$values); + +NumBins = ceiling( 10 * log( length( E ))); +h = hist(E, NumBins, 1); +t_= h$mids; +b = h$counts; +D = t_[ 2 ] - t_[ 1 ]; +h = b / (D * N); + +################################################################################################################## +### Theoretical eigenvalues +q = N / T; +t_min = ( 1 - sqrt( q )) ^ 2; +t_max = ( 1 + sqrt( q )) ^ 2; +t = seq(t_[ 1 ], t_[length(t_)], (t_[ length(t_) ]- t_[ 1 ])/100 ); +a = pmax( t_max - t, 0); +b = pmax( t - t_min, 0); +y = 1 / ( q * 2 * pi * t) * sqrt(a * b); + +################################################################################################################## +### Plots +#barplot(t_,h); +plot(t_,h, type="h", lwd=5); +lines(t , y, col = 'red', lwd = 3); Added: pkg/Meucci/demo/S_SemiCircular.R =================================================================== --- pkg/Meucci/demo/S_SemiCircular.R (rev 0) +++ pkg/Meucci/demo/S_SemiCircular.R 2013-07-13 17:51:19 UTC (rev 2563) @@ -0,0 +1,40 @@ +#' This script illustrate the semi-circular law of random matrix theory, as described in A. Meucci, +#' "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_SemiCircular.m" +#' + +################################################################################################################## +### Inputs +N = 1000; # matrix size + +################################################################################################################## +### Empirical eigenvalues + +#X=rnorm(N); # normal +#X=( runif(N)-0.5 ) * sqrt(12); # uniform +X = log( matrix( runif(N^2), N, N )) + 1; # exponential + +Y = (X + t(X) ) / ( 2 * sqrt( 2 * N )); # symmetrize and rescale +E = t(eigen(Y)$values); + +################################################################################################################## +### Theoretical eigenvalues +t = seq( -1, 1, 0.01 ); +g = 2 / pi * sqrt(1 - t^2); + +NumBins = ceiling( 10 * log( length( E ))); +h = hist(E, NumBins, plot = FALSE); +t_= h$mids; +b = h$counts; +D = t_[ 2 ] - t_[ 1 ]; +h = b / (D * N); + +################################################################################################################## +### Plots +dev.new(); +#bar(t_, h); +plot(t_, h, type = "h", lwd = 5); +lines(t, g, col = "red", lwd = 3); From noreply at r-forge.r-project.org Sat Jul 13 20:02:30 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 20:02:30 +0200 (CEST) Subject: [Returnanalytics-commits] r2564 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130713180231.06172184EBD@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-13 20:02:30 +0200 (Sat, 13 Jul 2013) New Revision: 2564 Modified: pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R Log: adding examples with new portfolio interface to testing_ROI_Martin.R Modified: pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R 2013-07-13 17:51:19 UTC (rev 2563) +++ pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R 2013-07-13 18:02:30 UTC (rev 2564) @@ -7,7 +7,6 @@ rm(list=ls()) # Load packages -library(PerformanceAnalytics) library(PortfolioAnalytics) library(ROI) library(ROI.plugin.glpk) @@ -49,6 +48,20 @@ # Portfolio standard deviation sqrt(gmv.opt$out) +# GMV portfolio using new interface +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=-Inf, max=Inf, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio standard deviation +sqrt(opt$out) + ##### Example 1.2: Long Only GMV Portfolio ##### gmv.longonly.constr <- gen.constr @@ -69,6 +82,20 @@ # Portfolio standard deviation sqrt(gmv.longonly.opt$out) +# GMV long only portfolio using new interface +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio standard deviation +sqrt(opt$out) + ##### Example 1.3: GMV Box Constraints ##### gmv.box.constr <- gen.constr @@ -91,6 +118,20 @@ # Portfolio standard deviation sqrt(gmv.box.opt$out) +# GMV box constraints portfolio using new interface +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio standard deviation +sqrt(opt$out) + ##### Example 1.3a: GMV Box Constraints ##### gmv.box.constr <- gen.constr @@ -150,6 +191,42 @@ # Group weights gmv.lo.group.opt$weights[c(1, 3, 5, 7)] + gmv.lo.group.opt$weights[c(2, 4, 6, 8)] +# GMV group constraints portfolio using new interface +pspec <- portfolio.spec(assets=funds.cap) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="group", enabled=TRUE, + groups=c(2, 2, 2, 2), + group_min=c(0.1, 0.15, 0, 0), + group_max=c(0.25, .35, 0.35, 0.45), + group_labels=c("MICRO", "SMALL", "MID", "LARGE")) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns.cap, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Get the group weights +# This is something I will work to include in the summary.optimize.portfolio.ROI +groups <- pspec$constraints[[3]]$groups +group_labels <- pspec$constraints[[3]]$group_labels +group_weights <- rep(0, n.groups) +n.groups <- length(groups) +k <- 1 +l <- 0 +for(i in 1:n.groups){ + j <- groups[i] + group_weights[i] <- sum(opt$weights[k:(l+j)]) + k <- k + j + l <- k - 1 +} +names(group_weights) <- group_labels +group_weights + +# Portfolio standard deviation +sqrt(opt$out) + # In the previous examples, we were solving global minimum variance with optmize_method="ROI". # The solve.QP plugin is selected automatically by optimize.portfolio when "var" is the objective @@ -170,6 +247,20 @@ # Optimal weights maxret.opt$weights +# Maximize mean return with box constraints portfolio using new interface +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio standard deviation +sqrt(opt$out) + ##### Example 1.7 Maximize mean-return Long Only with Group Constraints ##### # Re-use lo.group.constr from Example 1.5 maxret.lo.group.constr <- lo.group.constr @@ -184,6 +275,42 @@ # Group weights maxret.lo.group.opt$weights[c(1, 3, 5, 7)] + maxret.lo.group.opt$weights[c(2, 4, 6, 8)] +# GMV group constraints portfolio using new interface +pspec <- portfolio.spec(assets=funds.cap) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="group", enabled=TRUE, + groups=c(2, 2, 2, 2), + group_min=c(0.1, 0.15, 0, 0), + group_max=c(0.25, .35, 0.35, 0.45), + group_labels=c("MICRO", "SMALL", "MID", "LARGE")) +pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns.cap, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Get the group weights +# This is something I will work to include in the summary.optimize.portfolio.ROI +groups <- pspec$constraints[[3]]$groups +group_labels <- pspec$constraints[[3]]$group_labels +group_weights <- rep(0, n.groups) +n.groups <- length(groups) +k <- 1 +l <- 0 +for(i in 1:n.groups){ + j <- groups[i] + group_weights[i] <- sum(opt$weights[k:(l+j)]) + k <- k + j + l <- k - 1 +} +names(group_weights) <- group_labels +group_weights + +# Portfolio standard deviation +sqrt(opt$out) + ##### Example 1.X: Maximize Quadratic Utility ##### # Quadratic utility maximize return penalizing variance qu.constr <- constraint(assets=funds, min=0, max=1, min_sum=1, max_sum=1) @@ -238,15 +365,115 @@ round(qu.opt$weights, 4) ##### Example X: Mean Variance Optimization (MVO) with target mean return constraint ##### -# TODO Add type="return" for constraint to solve the mean-return constrained mvo -# Will also need to modify optimize.portfolio for optimize_method="ROI" +# MVO with target mean return +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=-Inf, max=Inf, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio return +t(opt$weights) %*% colMeans(returns) + + ##### Example X: Mean Variance Optimization (MVO) with target mean return and long only constraints ##### -# TODO Add type="return" for constraint to solve the mean-return constrained mvo -# Will also need to modify optimize.portfolio for optimize_method="ROI" +# MVO with long only and target mean return +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio return +t(opt$weights) %*% colMeans(returns) + ##### Example X: Mean Variance Optimization (MVO) with target mean return and box constraints ##### -# TODO Add type="return" for constraint to solve the mean-return constrained mvo -# Will also need to modify optimize.portfolio for optimize_method="ROI" -# ROI only solves mean, var, or sample CVaR type business objectives \ No newline at end of file +# MVO with box constraints and target mean return +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) +pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Portfolio return +t(opt$weights) %*% colMeans(returns) + +##### Example X: ETL Long Only ##### + +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +# This can be specified with ETL, ES, or CVaR for name +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +##### Example X: ETL with box constraints ##### + +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) +# This can be specified with ETL, ES, or CVaR for name +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +##### Example X: ETL long only with group constraints ##### + +# GMV group constraints portfolio using new interface +pspec <- portfolio.spec(assets=funds.cap) +pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) +pspec <- add.constraint(portfolio=pspec, type="group", enabled=TRUE, + groups=c(2, 2, 2, 2), + group_min=c(0.1, 0.15, 0, 0), + group_max=c(0.25, .35, 0.35, 0.45), + group_labels=c("MICRO", "SMALL", "MID", "LARGE")) +pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) + +opt <- optimize.portfolio_v2(R=returns.cap, portfolio=pspec, optimize_method="ROI") + +# Optimal weights +round(opt$weights, 3) + +# Get the group weights +# This is something I will work to include in the summary.optimize.portfolio.ROI +groups <- pspec$constraints[[3]]$groups +group_labels <- pspec$constraints[[3]]$group_labels +group_weights <- rep(0, n.groups) +n.groups <- length(groups) +k <- 1 +l <- 0 +for(i in 1:n.groups){ + j <- groups[i] + group_weights[i] <- sum(opt$weights[k:(l+j)]) + k <- k + j + l <- k - 1 +} +names(group_weights) <- group_labels +group_weights + From noreply at r-forge.r-project.org Sat Jul 13 20:08:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 20:08:15 +0200 (CEST) Subject: [Returnanalytics-commits] r2565 - pkg/PerformanceAnalytics/sandbox/pulkit/week1/code Message-ID: <20130713180816.0D05C1841F3@r-forge.r-project.org> Author: pulkit Date: 2013-07-13 20:08:15 +0200 (Sat, 13 Jul 2013) New Revision: 2565 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSR.py Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R Log: PSR documentation and error handling Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-07-13 18:02:30 UTC (rev 2564) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-07-13 18:08:15 UTC (rev 2565) @@ -1,19 +1,31 @@ #'@title Minimum Track Record Length #' #'@description -#'?How long should a track record be in order to have statistical confidence -#'that its Sharpe ratio is above a given threshold? . if a track record is shorter#' than MinTRL, we do not have enough confidence that the observed ? is above the designated threshold +#'Minimum Track Record Length will tell us ?How long should a track record be in +#'order to have statistical confidence that its Sharpe ratio is above a given +#'threshold? ". If a track record is shorter than MinTRL, we do not have enough +#'confidence that the observed Sharpe Ratio is above the designated threshold. +#'The reference Sharpe Ratio should be less than the observed Sharpe Ratio and +#'the Values should be given in non-annualized terms, in the same periodicity as +#'the return series. The Minimum Track Record Length is also given in the same +#'Periodicity as the Return Series. #' +#'\deqn{MinTRL = n^\ast = 1+\biggl[1-\hat{\gamma_3}\hat{SR}+\frac{\hat{\gamma_4}}{4}\hat{SR^2}\biggr]\biggl(\frac{Z_\alpha}{\hat{SR}-SR^\ast}\biggr)^2} +#' +#'$\gamma{_3}$ and $\gamma{_4}$ are the skewness and kurtosis respectively. +#'It is important to note that MinTRL is expressed in terms of number of observations, +#'not annual or calendar terms. +#' #'@aliases MinTrackRecord #' -#'@param R the return series +#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset return #'@param Rf the risk free rate of return -#'@param refSR the reference Sharpe Ratio +#'@param refSR the reference Sharpe Ratio,in the same periodicity as the returns(non-annualized) #'@param p the confidence level #'@param weights the weights for the portfolio -#'@param sr Sharpe Ratio -#'@param sk Skewness -#'@param kr Kurtosis +#'@param sr Sharpe Ratio,in the same periodicity as the returns(non-annualized) +#'@param sk Skewness, in the same periodicity as the returns(non-annualized) +#'@param kr Kurtosis, in the same periodicity as the returns(non-annualized) #' #'@reference Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio #'Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter @@ -22,7 +34,7 @@ #'@examples #' #'data(edhec) -#'MinTrackRecord(edhec[,1],0.20) +#'MinTrackRecord(edhec[,1],refSR=0.20) MinTrackRecord<-function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,sr = NULL,sk = NULL, kr = NULL, ...){ @@ -66,8 +78,14 @@ # message("no weights passed,will calculate Minimum Track Record Length for each column") #} - if(!is.null(dim(Rf))) + if(!is.null(dim(Rf))){ Rf = checkData(Rf) + } + #If the refSR is greater than SR an error is displayed + if(refSR>sr){ + stop("The Reference Sharpe Ratio should be less than the Observed Sharpe Ratio") + } + result = 1 + (1 - sk*sr + ((kr-1)/4)*sr^2)*(qnorm(p)/(sr-refSR))^2 if(!is.null(dim(result))){ colnames(result) = columnnames Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSR.py =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSR.py (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSR.py 2013-07-13 18:08:15 UTC (rev 2565) @@ -0,0 +1,55 @@ +#!/usr/bin/env python +# PSR class for computing the Probabilistic Sharpe Ratio +# On 20120502 by MLdP + +from scipy.stats import norm +#------------------------------------------- +# PSR class +class PSR: + def __init__(self,stats,sr_ref,obs,prob): + self.PSR=0 + self.minTRL=0 + self.stats=stats + self.sr_ref=sr_ref + self.obs=obs + self.prob=prob +#------------------------------------------- + def set_PSR(self,moments): + stats=[0,0,0,3] + stats[:moments]=self.stats[:moments] + sr=self.stats[0]/self.stats[1] + self.PSR=norm.cdf((sr-self.sr_ref)*(self.obs-1)**0.5/(1-sr*stats[2]+sr**2*(stats[3]-1)/4.)**0.5) +#------------------------------------------- + def set_TRL(self,moments): + stats=[0,0,0,3] + stats[:moments]=self.stats[:moments] + sr=self.stats[0]/self.stats[1] + self.minTRL=1+(1-stats[2]*sr+(stats[3]-1)/4.*sr**2)*(norm.ppf(self.prob)/(sr-self.sr_ref))**2 +#------------------------------------------- + def get_PSR(self,moments): + self.set_PSR(moments) + return self.PSR +#------------------------------------------- + def get_TRL(self,moments): + self.set_TRL(moments) + return self.minTRL +#------------------------------------------- +#------------------------------------------- +# Main function +def main(): + #1) Inputs (stats on excess returns) + stats=[1.5,12**0.5,-0.72,5.78] + #non-annualized stats + sr_ref=1/(12**0.5) + #reference Sharpe ratio (non-annualized) + obs=59.895 + prob=0.95 + #2) Create class + psr=PSR(stats,sr_ref,obs,prob) + #3) Compute and report values + print 'PSR(2m,3m,4m):',[psr.get_PSR(i) for i in range(2,5,1)] + print 'minTRL(2m,3m,4m):',[psr.get_TRL(i) for i in range(2,5,1)] +#------------------------------------------- +# Boilerplate +if __name__=='__main__': main() + Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-07-13 18:02:30 UTC (rev 2564) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-07-13 18:08:15 UTC (rev 2565) @@ -1,33 +1,41 @@ -#'@title Probabilistic Sharpe Ratio +#' @title Probabilistic Sharpe Ratio #' -#'@description -#'Given a predefined benchmark Sharpe ratio ,the observed Sharpe Ratio -#'can be expressed in probabilistic terms known as the Probabilistic Sharpe Ratio -#'PSR takes higher moments into account and delivers a corrected, atemporal -#'measure of performance expressed in terms of probability of skill. +#' @description +#' Given a predefined benchmark Sharpe ratio ,the observed Sharpe Ratio +#' can be expressed in probabilistic terms known as the Probabilistic +#' Sharpe Ratio PSR takes higher moments into account and delivers a +#' corrected, atemporal measure of performance expressed in terms of +#' probability of skill. The reference Sharpe Ratio should be less than +#' the Observed Sharpe Ratio. +#' \deqn{\hat{PSR}(SR^\ast) = Z\biggl[\frac{(\hat{SR}-SR^\ast)\sqrt{n-1}}{\sqrt{1-\hat{\gamma_3}SR^\ast + \frac{\hat{\gamma_4}-1}{4}\hat{SR^2}}}\biggr]} + +#' Here $n$ is the track record length or the number of data points. It can be daily,weekly or yearly depending on the input given + +#' $\hat{\gamma{_3}}$ and $\hat{\gamma{_4}}$ are the skewness and kurtosis respectively. + #' -#'@aliases ProbSharpeRatio +#' @aliases ProbSharpeRatio #' -#'@param R the return series -#'@param Rf the risk free rate of return -#'@param refSR the reference Sharpe Ratio -#'@param the confidence level -#'@param weights the weights for the portfolio -#'@param sr Sharpe Ratio -#'@param sk Skewness -#'@param kr Kurtosis +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset return +#' @param Rf the risk free rate of return +#' @param refSR the reference Sharpe Ratio, in the same periodicity as the returns(non-annualized) +#' @param the confidence level +#' @param weights the weights for the portfolio +#' @param sr Sharpe Ratio, in the same periodicity as the returns(non-annualized) +#' @param sk Skewness, in the same periodicity as the returns(non-annualized) +#' @param kr Kurtosis, in the same periodicity as the returns(non-annualized) #' -#'@references Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio -#'Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter +#' @references Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio +#' Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter #' 2012/13 #' -#'@keywords ts multivariate distribution models +#' @keywords ts multivariate distribution models #' -#'@examples +#' @examples #' -#'data(edhec) -#'ProbSharpeRatio(edhec[,1],refSR = 0.28) -#'ProbSharpeRatio(edhec,reSR = 0.28,Rf = 0.06) +#' data(edhec) +#' ProbSharpeRatio(edhec[,1],refSR = 0.28) +#' ProbSharpeRatio(edhec,reSR = 0.28,Rf = 0.06) ProbSharpeRatio<- @@ -73,8 +81,13 @@ # message("no weights passed,will calculate Probability Sharpe Ratio for each column") # } - if(!is.null(dim(Rf))) + if(!is.null(dim(Rf))){ Rf = checkData(Rf) + } + #If the Reference Sharpe Ratio is greater than the Observred Sharpe Ratio an error is displayed + if(refSR>sr){ + stop("The Reference Sharpe Ratio should be less than the Observed Sharpe Ratio") + } result = pnorm(((sr - refSR)*(n-1)^(0.5))/(1-sr*sk+sr^2*(kr-1)/4)^(0.5)) if(!is.null(dim(result))){ colnames(result) = columnnames From noreply at r-forge.r-project.org Sat Jul 13 21:54:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 21:54:11 +0200 (CEST) Subject: [Returnanalytics-commits] r2566 - pkg/PerformanceAnalytics/sandbox/pulkit/week1/code Message-ID: <20130713195411.2E29B1854F1@r-forge.r-project.org> Author: pulkit Date: 2013-07-13 21:54:10 +0200 (Sat, 13 Jul 2013) New Revision: 2566 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R Log: Included the reference SR in the optimization Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-13 18:08:15 UTC (rev 2565) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-07-13 19:54:10 UTC (rev 2566) @@ -101,12 +101,15 @@ SR = get_SR(stats,n) meanSR = SR$meanSR sigmaSR = SR$sigmaSR + if(refSR>meanSR){ + stop("The Reference Sharpe Ratio should be less than the Observred Sharpe Ratio") + } for(i in 1:columns){ d1Z[i] = get_d1Z(stats,m,meanSR,sigmaSR,mean,weights,i) } - dZ = list("d1Z"=d1Z,"z"=meanSR/sigmaSR) + dZ = list("d1Z"=d1Z,"z"=(meanSR-refSR)/sigmaSR) return(dZ) } @@ -120,7 +123,7 @@ d1sigmaSR = (d1Kurt * meanSR^2+2*meanSR*d1meanSR*(stats[4]-1))/4 d1sigmaSR = d1sigmaSR-(d1Skew*meanSR+d1meanSR*stats[3]) d1sigmaSR = d1sigmaSR/(2*sigmaSR*(n-1)) - d1Z = (d1meanSR*sigmaSR-d1sigmaSR*meanSR)/sigmaSR^2 + d1Z = (d1meanSR*sigmaSR-d1sigmaSR*(meanSR-refSR))/sigmaSR^2 return(d1Z) } @@ -191,7 +194,6 @@ return(sum/n) } weights = optimize() - print(k) result = matrix(weights,nrow = columns) rownames(result) = columnnames colnames(result) = "weight" From noreply at r-forge.r-project.org Sat Jul 13 22:35:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 22:35:03 +0200 (CEST) Subject: [Returnanalytics-commits] r2567 - pkg/PerformanceAnalytics/sandbox/pulkit/week3/code Message-ID: <20130713203503.9FEF3184685@r-forge.r-project.org> Author: pulkit Date: 2013-07-13 22:35:03 +0200 (Sat, 13 Jul 2013) New Revision: 2567 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD2.py pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD3.py pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/data1.csv pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/run.py Log: Python code for Triple Penance Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD2.py =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD2.py (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD2.py 2013-07-13 20:35:03 UTC (rev 2567) @@ -0,0 +1,70 @@ +#!/usr/bin/env python +# On 20121230 +# Get maximum drawdown +# by MLdP +from scipy.stats import norm +#--------------------------------------------------------------- +def main(): + #1) Parameters + phi=.5 # AR(1) coefficient + mu=1 # unconditional mean + sigma=2 # Standard deviation of the random shock + dPi0=1 # Bet at origin (initialization of AR(1)) + confidence=.95 # Confidence level for quantile + #2) Compute MinQ + t,minQ=getMinQ(phi,mu,sigma,dPi0,confidence) + print 'MinQ = '+str(minQ) + print 'Time at MinQ = '+str(t) + print 'MaxDD = '+str(max(0,-minQ)) + return +#--------------------------------------------------------------- +def getMinQ(phi,mu,sigma,dPi0,confidence): + # Compute MinQ + q,bets=0,0 + #1) Determine extremes of search + while not q>0: + bets+=1 + q=getQ(bets,phi,mu,sigma,dPi0,confidence) + #2) Compute min of q + kargs={'args':(phi,mu,sigma,dPi0,confidence)} + t,minQ=goldenSection(getQ,0,bets,**kargs) + return t,minQ +#--------------------------------------------------------------- +def getQ(bets,phi,mu,sigma,dPi0,confidence): + # Compute analytical solution to quantile + #1) Mean + mean=(phi**(bets+1)-phi)/(1-phi)*(dPi0-mu)+mu*bets + #2) Variance + var=sigma**2/(phi-1)**2 + var*=(phi**(2*(bets+1))-1)/(phi**2-1)-2*(phi**(bets+1)-1)/(phi-1)+bets+1 + #3) Quantile + q=mean+norm.ppf(1-confidence,0,1)*var**.5 + return q +#--------------------------------------------------------------- +def goldenSection(obj,a,b,**kargs): + # Golden section method. Maximum if kargs['minimum']==False is passed + from math import log,ceil + tol,sign,args=1.0e-9,1,None + if 'minimum' in kargs and kargs['minimum']==False:sign=-1 + if 'args' in kargs:args=kargs['args'] + numIter=int(ceil(-2.078087*log(tol/abs(b-a)))) + r=0.618033989 + c=1.0-r + # Initialize + x1=r*a+c*b;x2=c*a+r*b + f1=sign*obj(x1,*args);f2=sign*obj(x2,*args) + # Loop + for i in range(numIter): + if f1>f2: + a=x1 + x1=x2;f1=f2 + x2=c*a+r*b;f2=sign*obj(x2,*args) + else: + b=x2 + x2=x1;f2=f1 + x1=r*a+c*b;f1=sign*obj(x1,*args) + if f1 +from scipy.stats import norm +#--------------------------------------------------------------- +def main(): + #1) Parameters + phi=.5 # AR(1) coefficient + mu=1 # unconditional mean + sigma=2 # Standard deviation of the random shock + dPi0=1 # Bet at origin (initialization of AR(1)) + confidence=.95 # Confidence level for quantile + #2) Compute TuW + tuw=getTuW(phi,mu,sigma,dPi0,confidence) + print 'MaxTuW = '+str(tuw) + return +#--------------------------------------------------------------- +def getTuW(phi,mu,sigma,dPi0,confidence): + # Compute TuW + q,bets=0,0 + #1) Determine extremes of search + while not q>0: + bets+=1 + q=getQ(bets,phi,mu,sigma,dPi0,confidence) + #2) Compute root of q polynomial + kargs={'args':(phi,mu,sigma,dPi0,confidence)} + tuw,q=goldenSection(diff,bets-1,bets,**kargs) + return tuw +#--------------------------------------------------------------- +def getQ(bets,phi,mu,sigma,dPi0,confidence): + # Compute analytical solution to quantile + #1) Mean + mean=(phi**(bets+1)-phi)/(1-phi)*(dPi0-mu)+mu*bets + #2) Variance + var=sigma**2/(phi-1)**2 + var*=(phi**(2*(bets+1))-1)/(phi**2-1)-2*(phi**(bets+1)-1)/(phi-1)+bets+1 + #3) Quantile + q=mean+norm.ppf(1-confidence,0,1)*var**.5 + return q +#--------------------------------------------------------------- +def diff(bets,phi,mu,sigma,dPi0,confidence): + return abs(getQ(bets,phi,mu,sigma,dPi0,confidence)) +#--------------------------------------------------------------- +def goldenSection(obj,a,b,**kargs): + # Golden section method. Maximum if kargs['minimum']==False is passed + from math import log,ceil + tol,sign,args=1.0e-9,1,None + if 'minimum' in kargs and kargs['minimum']==False:sign=-1 + if 'args' in kargs:args=kargs['args'] + numIter=int(ceil(-2.078087*log(tol/abs(b-a)))) + r=0.618033989 + c=1.0-r + # Initialize + x1=r*a+c*b;x2=c*a+r*b + f1=sign*obj(x1,*args);f2=sign*obj(x2,*args) + # Loop + for i in range(numIter): + if f1>f2: + a=x1 + x1=x2;f1=f2 + x2=c*a+r*b;f2=sign*obj(x2,*args) + else: + b=x2 + x2=x1;f2=f1 + x1=r*a+c*b;f1=sign*obj(x1,*args) + if f1 +import DD2,DD3 # These are the two modules in Appendices 9 and 10 +#--------------------------------------------------------------- +def isNumber(input): + # Determines whether input is a number + try: + float(input) + return True + except: + return False +#--------------------------------------------------------------- +def main(): + #1) Parameters + path='' + inFileName='data1.csv' + outFileName='Results1.csv' + fields=['Code','Mean','Phi','Sigma'] + confidence=.95 + dPi0=0 + #2) Read file + inFile=open(path+inFileName,'r') + outFile=open(path+outFileName,'w') + headers=inFile.readline().split(',') + indices=[headers.index(i) for i in fields] + for line in inFile: + #3) Get Input + params={} + line=line[:-1].split(',') + for i in indices: + if isNumber(line[i])==True: + params[headers[i]]=float(line[i]) + else: + params[headers[i]]=line[i] + #4) Compute MaxDD,MaxTuW + if params['Mean']>0 and params['Phi']>=0: + t,minQ=DD2.getMinQ(params['Phi'],params['Mean'],params['Sigma'],dPi0,confidence) + maxDD=max(0,-minQ) + maxTuW=DD3.getTuW(params['Phi'],params['Mean'],params['Sigma'],dPi0,confidence) + else: + maxDD,t,maxTuW='--','--','--' + #5) Store result + msg=params['Code']+','+str(maxDD)+','+str(t)+','+str(maxTuW) + outFile.writelines(msg+'\n') + print msg + return +#--------------------------------------------------------------- +# Boilerplate +if __name__=='__main__':main() From noreply at r-forge.r-project.org Sun Jul 14 14:57:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 14 Jul 2013 14:57:39 +0200 (CEST) Subject: [Returnanalytics-commits] r2568 - in pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1: . Code Tests Vignette Message-ID: <20130714125739.6815E1852BE@r-forge.r-project.org> Author: shubhanm Date: 2013-07-14 14:57:39 +0200 (Sun, 14 Jul 2013) New Revision: 2568 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpeRatio.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/table.Return.GLM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Tests/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Tests/test_LoSharpe.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.tex Log: Modified Function ,Added Tests and Documentation for Lo Sharpe Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1,58 @@ +#This measure is well known in the +#industrial organization literature as the Herfindahl index, a measure of the +#concentration of firms in a given industry where yj represents the market share of +#firm j: Because yjA?0; 1 ; x is also confined to the unit interval, and is minimized when +#all the yj's are identical, which implies a value of 1=?k ? 1? for x; and is maximized +#when one coefficient is 1 and the rest are 0, in which case x ? 1: In the context of +##smoothed returns, a lower value of x implies more smoothing, and the upper bound +#of 1 implies no smoothing, hence we shall refer to x as a ''smoothingindex' '. +GLMSmoothIndex<- + function(R = NULL, ...) + { + columns = 1 + columnnames = NULL + #Error handling if R is not NULL + if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + count = q + x=edhec + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(x[,column], method="vector", na.rm = TRUE) + sum = sum(abs(acf(y,plot=FALSE,lag.max=6)[[1]][2:7])); + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7]/sum; + values = sum(acflag6*acflag6) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + return(result.df) + + } + + + ############################################################################### + # 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: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ + # + ############################################################################### + + } \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1,110 @@ +#' calculate Geltner liquidity-adjusted return series +#' +#' David Geltner developed a method to remove estimating or liquidity bias in +#' real estate index returns. It has since been applied with success to other +#' return series that show autocorrelation or illiquidity effects. +#' +#' The theory is that by correcting for autocorrelation, you are uncovering a +#' "true" return from a series of observed returns that contain illiquidity or +#' manual pricing effects. +#' +#' The Geltner autocorrelation adjusted return series may be calculated via: +#' +#' \deqn{ }{Geltner.returns = [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) }\deqn{ +#' R_{G}=\frac{R_{t}-(R_{t-1}\cdot\rho_{1})}{1-\rho_{1}} }{Geltner.returns = +#' [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) } +#' +#' where \eqn{\rho_{1}}{acf(R(t-1))} is the first-order autocorrelation of the +#' return series \eqn{R_{a}}{Ra} and \eqn{R_{t}}{R(t)} is the return of +#' \eqn{R_{a}}{Ra} at time \eqn{t} and \eqn{R_{t-1}}{R(t-1)} is the one-period +#' lagged return. +#' +#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param \dots any other passthru parameters +#' @author Brian Peterson +#' @references "Edhec Funds of Hedge Funds Reporting Survey : A Return-Based +#' Approach to Funds of Hedge Funds Reporting",Edhec Risk and Asset Management +#' Research Centre, January 2005,p. 27 +#' +#' Geltner, David, 1991, Smoothing in Appraisal-Based Returns, Journal of Real +#' Estate Finance and Economics, Vol.4, p.327-345. +#' +#' Geltner, David, 1993, Estimating Market Values from Appraised Values without +#' Assuming an Efficient Market, Journal of Real Estate Research, Vol.8, +#' p.325-345. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' head(Return.Geltner(managers[,1:3]),n=20) +#' +#' @export +LoSharpe <- + function (Ra,Rf = 0,q = 0, ...) + { # @author Brian G. Peterson, Peter Carl + + # Description: + # Geltner Returns came from real estate where they are used to uncover a + # liquidity-adjusted return series. + + # Ra return vector + + # Function: + R = checkData(Ra, method="xts") + # Get dimensions and labels + columns.a = ncol(R) + columnnames.a = colnames(R) + Time= 252*nyears(edhec) + clean.lo <- function(column.R,q) { + # compute the lagged return series + gamma.k =matrix(0,q) + mu = sum(column.R)/(Time) + for(i in 1:q){ + lagR = lag(column.R, k=i) + # compute the Momentum Lagged Values + gamma.k[i]= (sum(((column.R-mu)*(lagR-mu)),na.rm=TRUE)) + } + return(gamma.k) + } + neta.lo <- function(pho.k,q) { + # compute the lagged return series + sumq = 0 + for(j in 1:q){ + sumq = sumq+ (q-j)*pho.k[j] + } + return(q/(sqrt(q+2*sumq))) + } + for(column.a in 1:columns.a) { # for each asset passed in as R + # clean the data and get rid of NAs + mu = sum(R[,column.a])/(Time) + sig=sqrt(((R[,column.a]-mu)^2/(Time))) + pho.k = clean.lo(R[,column.a],q)/(as.numeric(sig[1])) + netaq=neta.lo(pho.k,q) + column.lo = (netaq*((mu-Rf)/as.numeric(sig[1]))) + + if(column.a == 1) { lo = column.lo } + else { lo = cbind (lo, column.lo) } + + } + colnames(lo) = columnnames.a + rownames(lo)= paste("Lo Sharpe Ratio") + return(lo) + + + # RESULTS: + # return(reclass(geltner,match.to=Ra)) + + } + +############################################################################### +# 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: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpeRatio.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpeRatio.R 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1,70 @@ +LoSharpeRatio<- + function(R = NULL,Rf=0.,q = 0., ...) + { +columns = 1 +columnnames = NULL +#Error handling if R is not NULL +if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + + if(q==0){ + stop("AutoCorrelation Coefficient Should be greater than 0") + + } + else{ + # A potfolio is constructed by applying the weights + + count = q + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(edhec[,column], method="vector", na.rm = TRUE) + + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] + LjungBox = Box.test(y,type="Ljung-Box",lag=q) + values = c(acflag6, LjungBox$p.value) + # values = base::round(as.numeric(values),digits) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + # Calculate Neta's + for(column in 1:columns) { + sum = 0 + z = checkData(edhec[,column], method="vector", na.rm = TRUE) + for(q in 1:(q-1) ) + { + sum = sum + (count-q)*result.df[column,q] + + } + + netaq = count/(sqrt(count+2*sum)) + if(column == 1) { + netacol = data.frame(Value = netaq) + colnames(netacol) = columnnames[column] + } + else { + nextcol = data.frame(Value = netaq) + colnames(nextcol) = columnnames[column] + netacol = cbind(netacol, nextcol) + } + + } + shrp = SharpeRatio(x, Rf, FUN="VaR" , method="gaussian") + results = Shrp*netacol + colnames(results) = colnames(x) + return(results) + } + } +} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/table.Return.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/table.Return.GLM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/table.Return.GLM.R 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1 @@ +rff \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Tests/test_LoSharpe.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Tests/test_LoSharpe.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Tests/test_LoSharpe.R 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1,9 @@ +library(RUnit) +library(PerformanceAnalytics) +data(edhec) + +test_LoSharpe<-function(){ + + checkEqualsNumeric(LoSharpe(edhec,0,3)[1],0.1366338,tolerance = 1.0e-6) + +} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.Rnw 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1,46 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps = FALSE} +\begin{document} +\SweaveOpts{concordance=TRUE} + +\title{ Lo Sharpe Ratio } + +% \keywords{Lo Sharpe Ratio,GLM Smooth Index,GLM Return Table} + +\makeatletter +\makeatother +\maketitle + +\begin{abstract} + + This vignette gives an overview of the Lo Sharpe Ratio which have addressed the issue of IID in financial time series data. +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) + +\section{Lo Sharpe Ratio} + Given a predefined benchmark Sharpe ratio $SR^\ast$ , the observed Sharpe ratio $\hat{SR}$ can be expressed in terms of autocorrelated coefficients as + + \deqn{ \hat{SR} (q) - SR(q)= Normal Distribution(0,V_{GMM}(q)) } + +The estimator for the Sharpe ratio then follows directly: +\deqn{ \hat{SR} (q) = \hat{ \eta } (q) * Sharpe Ratio} +\deqn{ \hat{ \eta } (q)= q/\sqrt{q + \sum_k^n \rho } } + +<<>>= +data(edhec) +LoSharpe(edhec) +@ + +\end{document} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpe.tex 2013-07-14 12:57:39 UTC (rev 2568) @@ -0,0 +1,27 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +\usepackage{Rd} + +\usepackage{Sweave} + +\begin{document} +\input{LoSharpe-concordance} + +\title{ Lo Sharpe Ratio } + +% \keywords{Lo Sharpe Ratio,GLM Smooth Index,GLM Return Table} + +\makeatletter +\makeatother +\maketitle + +\begin{abstract} + + This vignette gives an overview of the Lo Sharpe Ratio, GLM Smoothing Index and Returns, which have addressed the issue of IID in financial time series data. +\end{abstract} + From noreply at r-forge.r-project.org Sun Jul 14 20:55:50 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 14 Jul 2013 20:55:50 +0200 (CEST) Subject: [Returnanalytics-commits] r2569 - in pkg/PerformanceAnalytics/sandbox/pulkit: . week1/vignette week3_4/code week5 Message-ID: <20130714185550.9B5C3184F83@r-forge.r-project.org> Author: pulkit Date: 2013-07-14 20:55:50 +0200 (Sun, 14 Jul 2013) New Revision: 2569 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD3.py pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/GoldenSection.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/data1.csv pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/run.py pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Removed: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenanceRule.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw Log: added files for Rolling economic Drawdown Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw 2013-07-14 12:57:39 UTC (rev 2568) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw 2013-07-14 18:55:50 UTC (rev 2569) @@ -58,7 +58,7 @@ $\hat{\gamma{_3}}$ and $\hat{\gamma{_4}}$ are the skewness and kurtosis respectively. It is not unusual to find strategies with irregular trading frequencies, such as weekly strategies that may not trade for a month. This poses a problem when computing an annualized Sharpe ratio, and there is no consensus as how skill should be measured in the context of irregular bets. Because PSR measures skill in probabilistic terms, it is invariant to calendar conventions. All calculations are done in the original frequency -of the data, and there is no annualization. +of the data, and there is no annualization. The Reference Sharpe Ratio is also given in the non-annualized form and should be greater than the Observed Sharpe Ratio. <<>>= data(edhec) @@ -73,7 +73,7 @@ \deqn{MinTRL = n^\ast = 1+\biggl[1-\hat{\gamma_3}\hat{SR}+\frac{\hat{\gamma_4}}{4}\hat{SR^2}\biggr]\biggl(\frac{Z_\alpha}{\hat{SR}-SR^\ast}\biggr)^2} -$\gamma{_3}$ and $\gamma{_4}$ are the skewness and kurtosis respectively. It is important to note that MinTRL is expressed in terms of number of observations, not annual or calendar terms. +$\gamma{_3}$ and $\gamma{_4}$ are the skewness and kurtosis respectively. It is important to note that MinTRL is expressed in terms of number of observations, not annual or calendar terms. All the values used in the above formula are non-annualized, in the same frequency as that of the returns. <<>>= data(edhec) Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py (from rev 2567, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD2.py) =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py 2013-07-14 18:55:50 UTC (rev 2569) @@ -0,0 +1,70 @@ +#!/usr/bin/env python +# On 20121230 +# Get maximum drawdown +# by MLdP +from scipy.stats import norm +#--------------------------------------------------------------- +def main(): + #1) Parameters + phi=.5 # AR(1) coefficient + mu=1 # unconditional mean + sigma=2 # Standard deviation of the random shock + dPi0=1 # Bet at origin (initialization of AR(1)) + confidence=.95 # Confidence level for quantile + #2) Compute MinQ + t,minQ=getMinQ(phi,mu,sigma,dPi0,confidence) + print 'MinQ = '+str(minQ) + print 'Time at MinQ = '+str(t) + print 'MaxDD = '+str(max(0,-minQ)) + return +#--------------------------------------------------------------- +def getMinQ(phi,mu,sigma,dPi0,confidence): + # Compute MinQ + q,bets=0,0 + #1) Determine extremes of search + while not q>0: + bets+=1 + q=getQ(bets,phi,mu,sigma,dPi0,confidence) + #2) Compute min of q + kargs={'args':(phi,mu,sigma,dPi0,confidence)} + t,minQ=goldenSection(getQ,0,bets,**kargs) + return t,minQ +#--------------------------------------------------------------- +def getQ(bets,phi,mu,sigma,dPi0,confidence): + # Compute analytical solution to quantile + #1) Mean + mean=(phi**(bets+1)-phi)/(1-phi)*(dPi0-mu)+mu*bets + #2) Variance + var=sigma**2/(phi-1)**2 + var*=(phi**(2*(bets+1))-1)/(phi**2-1)-2*(phi**(bets+1)-1)/(phi-1)+bets+1 + #3) Quantile + q=mean+norm.ppf(1-confidence,0,1)*var**.5 + return q +#--------------------------------------------------------------- +def goldenSection(obj,a,b,**kargs): + # Golden section method. Maximum if kargs['minimum']==False is passed + from math import log,ceil + tol,sign,args=1.0e-9,1,None + if 'minimum' in kargs and kargs['minimum']==False:sign=-1 + if 'args' in kargs:args=kargs['args'] + numIter=int(ceil(-2.078087*log(tol/abs(b-a)))) + r=0.618033989 + c=1.0-r + # Initialize + x1=r*a+c*b;x2=c*a+r*b + f1=sign*obj(x1,*args);f2=sign*obj(x2,*args) + # Loop + for i in range(numIter): + if f1>f2: + a=x1 + x1=x2;f1=f2 + x2=c*a+r*b;f2=sign*obj(x2,*args) + else: + b=x2 + x2=x1;f2=f1 + x1=r*a+c*b;f1=sign*obj(x1,*args) + if f1 +from scipy.stats import norm +#--------------------------------------------------------------- +def main(): + #1) Parameters + phi=.5 # AR(1) coefficient + mu=1 # unconditional mean + sigma=2 # Standard deviation of the random shock + dPi0=1 # Bet at origin (initialization of AR(1)) + confidence=.95 # Confidence level for quantile + #2) Compute TuW + tuw=getTuW(phi,mu,sigma,dPi0,confidence) + print 'MaxTuW = '+str(tuw) + return +#--------------------------------------------------------------- +def getTuW(phi,mu,sigma,dPi0,confidence): + # Compute TuW + q,bets=0,0 + #1) Determine extremes of search + while not q>0: + bets+=1 + q=getQ(bets,phi,mu,sigma,dPi0,confidence) + #2) Compute root of q polynomial + kargs={'args':(phi,mu,sigma,dPi0,confidence)} + tuw,q=goldenSection(diff,bets-1,bets,**kargs) + return tuw +#--------------------------------------------------------------- +def getQ(bets,phi,mu,sigma,dPi0,confidence): + # Compute analytical solution to quantile + #1) Mean + mean=(phi**(bets+1)-phi)/(1-phi)*(dPi0-mu)+mu*bets + #2) Variance + var=sigma**2/(phi-1)**2 + var*=(phi**(2*(bets+1))-1)/(phi**2-1)-2*(phi**(bets+1)-1)/(phi-1)+bets+1 + #3) Quantile + q=mean+norm.ppf(1-confidence,0,1)*var**.5 + return q +#--------------------------------------------------------------- +def diff(bets,phi,mu,sigma,dPi0,confidence): + return abs(getQ(bets,phi,mu,sigma,dPi0,confidence)) +#--------------------------------------------------------------- +def goldenSection(obj,a,b,**kargs): + # Golden section method. Maximum if kargs['minimum']==False is passed + from math import log,ceil + tol,sign,args=1.0e-9,1,None + if 'minimum' in kargs and kargs['minimum']==False:sign=-1 + if 'args' in kargs:args=kargs['args'] + numIter=int(ceil(-2.078087*log(tol/abs(b-a)))) + r=0.618033989 + c=1.0-r + # Initialize + x1=r*a+c*b;x2=c*a+r*b + f1=sign*obj(x1,*args);f2=sign*obj(x2,*args) + # Loop + for i in range(numIter): + if f1>f2: + a=x1 + x1=x2;f1=f2 + x2=c*a+r*b;f2=sign*obj(x2,*args) + else: + b=x2 + x2=x1;f2=f1 + x1=r*a+c*b;f1=sign*obj(x1,*args) + if f1f2){ + a = x1 + x1 = x2 + f1 = f2 + x2 = c*a+r*b + f2 = sign*FUN(x2,...) + } + else{ + b = x2 + x2 = x1 + f2 = f1 + x1 = r*a + c*b + f1 = sign*FUN(x1,...) + } + } + if(f1f2){ - a = x1 - x1 = x2 - f1 = f2 - x2 = c*a+r*b - f2 = sign*FUN(x2,phi,mu,sigma,dp0,confidence) - } - else{ - b = x2 - x2 = x1 - f2 = f1 - x1 = r*a + c*b - f1 = sign*FUN(x1,phi,mu,sigma,dp0,confidence) - } - } - if(f1 +import DD2,DD3 # These are the two modules in Appendices 9 and 10 +#--------------------------------------------------------------- +def isNumber(input): + # Determines whether input is a number + try: + float(input) + return True + except: + return False +#--------------------------------------------------------------- +def main(): + #1) Parameters + path='' + inFileName='data1.csv' + outFileName='Results1.csv' + fields=['Code','Mean','Phi','Sigma'] + confidence=.95 + dPi0=0 + #2) Read file + inFile=open(path+inFileName,'r') + outFile=open(path+outFileName,'w') + headers=inFile.readline().split(',') + indices=[headers.index(i) for i in fields] + for line in inFile: + #3) Get Input + params={} + line=line[:-1].split(',') + for i in indices: + if isNumber(line[i])==True: + params[headers[i]]=float(line[i]) + else: + params[headers[i]]=line[i] + #4) Compute MaxDD,MaxTuW + if params['Mean']>0 and params['Phi']>=0: + t,minQ=DD2.getMinQ(params['Phi'],params['Mean'],params['Sigma'],dPi0,confidence) + maxDD=max(0,-minQ) + maxTuW=DD3.getTuW(params['Phi'],params['Mean'],params['Sigma'],dPi0,confidence) + else: + maxDD,t,maxTuW='--','--','--' + #5) Store result + msg=params['Code']+','+str(maxDD)+','+str(t)+','+str(maxTuW) + outFile.writelines(msg+'\n') + print msg + return +#--------------------------------------------------------------- +# Boilerplate +if __name__=='__main__':main() Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R (from rev 2534, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R) =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R 2013-07-14 18:55:50 UTC (rev 2569) @@ -0,0 +1,45 @@ +#' @title +#' Table for displaying the Mximum Drawdown and the Time under Water +#' +#' @description +#' \code{table.Penance} Displays the table showing mean,Standard Deviation , phi, sigma , MaxDD,time at which MaxDD occurs, MaxTuW and the penance. +#' +#' @param R Returns +#' @param confidence the confidence interval +#' +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). + +table.Penance<-function(R,confidence){ + # DESCRIPTION: + # Maximum Drawdown and Time under Water considering first-order serial correlation + # + # Input: + # R log returns + # + # Output: + # Creates a Table showing mean stdDev phi sigma MaxDD t* MaxTuW and Penance + # + # Function: + x = checkData(R) + columns = ncol(x) + columnnames = colnames(x) + rownames = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance") + for(column in 1:columns){ + phi = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])])) + sigma_infinity = StdDev(x[,column]) + sigma = sigma_infinity*((1-phi^2)^0.5) + column_MinQ<-c(mean(x[,column]),sigma_infinity,phi,sigma) + column_MinQ <- c(column_MinQ,get_minq(x[,column],confidence)) + column_TuW = get_TuW(x[,column],confidence) + v = c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW) + if(column == 1){ + result = data.frame(Value = v, row.names = rownames) + } + else{ + nextcolumn = data.frame(Value = v,row.names = rownames) + result = cbind(result,nextcolumn) + } + } + colnames(result) = columnnames + result +} Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-14 18:55:50 UTC (rev 2569) @@ -0,0 +1,85 @@ +#'@title Calculate the Rolling Economic Drawdown +#' +#'@description +#'\code{rollDrawdown} calculates the Rolling Economic Drawdown(REDD) for +#' a return series.To calculate the rolling economic drawdown cumulative +#' return and rolling economic max is calculated for each point. The risk +#' free return(rf) and the lookback period(h) is taken as the input. +#' +#'@param R an xts, vector, matrix, data frame, timeseries, or zoo object of asset return. +#'@param weights portfolio weighting vector, default NULL +#'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining(FALSE) +#'to aggregate returns, default is TRUE +#'@param rf risk free rate can be vector such as government security rate of return +#'@param h lookback period +#'@param \dots any other passthru variable +#'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to +#'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012) +#' @export +rollDrawdown<-function(R,Rf,h, geometric = TRUE, weights = NULL,...) +{ + + # DESCRIPTION: + # calculates the Rolling Economic Drawdown(REDD) for + # a return series.To calculate the rolling economic drawdown cumulative + # return and rolling economic max is calculated for each point. The risk + # free return(rf) and the lookback period(h) is taken as the input. + + # FUNCTION: + x = checkData(R) + columns = ncol(x) + rowx = nrow(x) + columnnames = colnames(x) + rf = checkData(rf) + rowr = nrow(rf) + if(rowr != 1 ){ + if(rowr != rowx){ + warning("The number of rows of the returns and the risk free rate do not match") + } + } + REDD<-function(x,geometric){ + if(geometric) + Return.cumulative = cumprod(1+x) + else Return.cumulative = 1 + cumsum(x) + l = length(Return.cumulative) + REM = max(Return.cumulative*(1+rf)^(l-c(1:l))) + result = 1 - Return.cumulative[l]/REM + } + + for(column in 1:columns){ + column.drawdown <- apply.rolling(x[,column],width = h, FUN = REDD, geometric = geometric) + if(column == 1) + rolldrawdown = column.drawdown + else rolldrawdown = merge(rolldrawdown, column.drawdown) + } + colnames(rolldrawdown) = columnnames + rolldrawdown = reclass(rolldrawdown, x) + return(rolldrawdown) +} +chart.REDD<-function(R,rf,h, geometric = TRUE,legend.loc = NULL, colorset = (1:12),...) +{ +#DESCRIPTION: +#A function to create the chart for the rolling economic drawdown +# + # calculates the Rolling Economic Drawdown(REDD) for [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2569 From noreply at r-forge.r-project.org Sun Jul 14 21:16:36 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 14 Jul 2013 21:16:36 +0200 (CEST) Subject: [Returnanalytics-commits] r2570 - pkg/PerformanceAnalytics/sandbox/pulkit Message-ID: <20130714191636.D9215183DE7@r-forge.r-project.org> Author: pulkit Date: 2013-07-14 21:16:36 +0200 (Sun, 14 Jul 2013) New Revision: 2570 Removed: pkg/PerformanceAnalytics/sandbox/pulkit/week3/ Log: renamed folder From noreply at r-forge.r-project.org Sun Jul 14 22:27:53 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 14 Jul 2013 22:27:53 +0200 (CEST) Subject: [Returnanalytics-commits] r2571 - pkg/Meucci/demo Message-ID: <20130714202753.24396183D80@r-forge.r-project.org> Author: xavierv Date: 2013-07-14 22:27:52 +0200 (Sun, 14 Jul 2013) New Revision: 2571 Added: pkg/Meucci/demo/S_EstimateQuantileEvaluation.R pkg/Meucci/demo/S_ShrinkageEstimators.R Log: -added S_ShrinkageEstimators and S_EstimateQuantileEvaluation demo scripts Added: pkg/Meucci/demo/S_EstimateQuantileEvaluation.R =================================================================== --- pkg/Meucci/demo/S_EstimateQuantileEvaluation.R (rev 0) +++ pkg/Meucci/demo/S_EstimateQuantileEvaluation.R 2013-07-14 20:27:52 UTC (rev 2571) @@ -0,0 +1,150 @@ +#'This script familiarizes the user with the evaluation of an estimator:replicability, loss, error, +#'bias and inefficiency as described in A. Meucci,"Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EstimateQuantileEvaluation.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs + +T = 52; +a = 0.5; +m_Y = 0.1; +s_Y = 0.2; +m_Z = 0; +s_Z = 0.15; + +################################################################################################################## +### plain estimation + +# functional of the distribution to be estimated +G_fX = QuantileMixture( 0.5, a, m_Y, s_Y, m_Z, s_Z); +print( G_fX ); + +# series generated by "nature": do not know the distribution +P = runif( T ); +i_T = QuantileMixture( P, a, m_Y, s_Y, m_Z, s_Z ); + +G_Hat_e = function(X) apply( X, 1, median ); +G_Hat_b = function(X) apply( X, 1, mean ); + +Ge = G_Hat_e( t( as.matrix( i_T )) ); # tentative estimator of unknown functional +Gb = G_Hat_b( t( as.matrix( i_T )) ); # tentative estimator of unknown functional +print(Ge); +print(Gb); + +################################################################################################################## +### replicability vs. "luck" + +# functional of the distribution to be estimated +G_fX = QuantileMixture( 0.5, a, m_Y, s_Y, m_Z, s_Z); + +# randomize series generated by "nature" to check replicability +nSim = 10000; +I_T = c(); + +for( t in 1:T ) +{ + P = runif(nSim); + Simul = QuantileMixture(P,a,m_Y,s_Y,m_Z,s_Z); + I_T = cbind( I_T, Simul ); +} + +Ge = G_Hat_e( I_T ); # tentative estimator of unknown functional +Gb = G_Hat_b( I_T ); # tentative estimator of unknown functional + +Loss_Ge = ( Ge - G_fX ) ^ 2; +Loss_Gb = ( Gb - G_fX ) ^ 2; + +Err_Ge = sqrt( mean( Loss_Ge)); +Err_Gb = sqrt( mean( Loss_Gb)); + +Bias_Ge = abs(mean(Ge)-G_fX); +Bias_Gb = abs(mean(Gb)-G_fX); + +Ineff_Ge = sd(Ge); +Ineff_Gb = sd(Gb); + +################################################################################################################### +dev.new(); +NumBins = round( 10 * log( nSim )); +par( mfrow = c( 2, 1) ); +hist( Ge, NumBins, main = "estimator e" ); +points(G_fX, 0, pch = 21, bg = "red" ); + +hist(Gb, NumBins, main = "estimator b" ); +points(G_fX, 0, pch = 21, bg = "red" ); + +#loss +dev.new(); +par( mfrow = c( 2, 1) ); +hist(Loss_Ge, NumBins, main = "loss of estimator e" ); +hist(Loss_Gb, NumBins, main = "loss of estimator b" ); + +################################################################################################################### +### stress test replicability +m_s = seq( 0, 0.2, 0.02 ); + +Err_Gesq = NULL; Bias_Gesq = NULL; Ineff_Gesq = NULL; +Err_Gbsq = NULL; Bias_Gbsq = NULL; Ineff_Gbsq = NULL; + +for( j in 1 : length( m_s ) ) +{ + m_Y = m_s[ j ]; + # functional of the distribution to be estimated + G_fX = QuantileMixture( 0.5, a, m_Y, s_Y, m_Z, s_Z ); + + # randomize series generated by "nature" to check replicability + nSim = 10000; + I_T = NULL; + for( t in 1 : T ) + { + P = runif(nSim); + Simul = QuantileMixture(P, a, m_Y, s_Y, m_Z, s_Z); + I_T = cbind( I_T, Simul ); + } + + Ge = G_Hat_e( I_T ); # tentative estimator of unknown functional + Gb = G_Hat_b( I_T ); # tentative estimator of unknown functional + + Loss_Ge = ( Ge - G_fX ) ^ 2; + Loss_Gb = ( Gb - G_fX ) ^ 2; + + Err_Ge = sqrt( mean( Loss_Ge ) ); + Err_Gb = sqrt( mean( Loss_Gb ) ); + + Bias_Ge = abs( mean( Ge ) - G_fX ); + Bias_Gb = abs( mean( Gb ) - G_fX ); + + Ineff_Ge = std( Ge ); + Ineff_Gb = std( Gb ); + + #store results + Err_Gesq = cbind( Err_Gesq, Err_Ge ^ 2); ##ok<*AGROW> + Err_Gbsq = cbind(Err_Gbsq, Err_Gb^2); + + Bias_Gesq = cbind( Bias_Gesq, Bias_Ge^2 ); + Bias_Gbsq = cbind( Bias_Gbsq, Bias_Gb^2 ); + + Ineff_Gesq = cbind( Ineff_Gesq, Ineff_Ge ^ 2 ); + Ineff_Gbsq = cbind( Ineff_Gbsq, Ineff_Gb ^ 2 ); +} + +################################################################################################################### +### printlay results +dev.new(); +par( mfrow = c( 2, 1) ); +b = barplot(Bias_Gesq +Ineff_Gesq , col = "red", main = "stress-test of estimator e"); +barplot( Ineff_Gesq, col="blue", add = TRUE); +lines( b, Err_Gesq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); + + +b = barplot(Bias_Gbsq+Ineff_Gbsq, col = "red", main = "stress-test of estimator b"); +barplot( Ineff_Gbsq, col="blue", add = TRUE); +lines( b, Err_Gbsq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); \ No newline at end of file Added: pkg/Meucci/demo/S_ShrinkageEstimators.R =================================================================== --- pkg/Meucci/demo/S_ShrinkageEstimators.R (rev 0) +++ pkg/Meucci/demo/S_ShrinkageEstimators.R 2013-07-14 20:27:52 UTC (rev 2571) @@ -0,0 +1,70 @@ +library(mvtnorm); + +#' This script computes the multivariate shrinkage estimators of location and scatter under the normal assumption, +#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ShrinkageEstimators.m" +#' + +################################################################################################################## +### Inputs +N = 5; +T = 30; +Mu = runif(N); +A = matrix(runif( N* N), N, N) - 0.5; +Sigma = A %*% t(A); + +################################################################################################################# +### Generate normal sample +X = rmvnorm( T, Mu, Sigma ); + +# estimate sample parameters +Mu_hat = matrix( apply( X, 2, mean )); +Sigma_hat = cov( X ) * (T - 1) / T; + +################################################################################################################# +### Shrinkage of location parameter + +# target +b = matrix( 0, N, 1 ); + +# compute optimal weight +Lambda_hat = eigen( Sigma_hat )$values; +a = 1 / T * ( sum( Lambda_hat ) - 2 * max( Lambda_hat) ) / ( t( Mu_hat-b) %*% ( Mu_hat - b ) ); + +# restrict to sensible weight +a = max( 0, min( a, 1) ); + +# shrink +Mu_shr = ( 1 - a ) * Mu_hat + a * b; + +print(Mu_hat); +print(Mu_shr); + +################################################################################################################# +### Shrinkage of scatter parameter + +# target +C = mean(Lambda_hat) * diag( 1, N ); + +# compute optimal weight +Numerator = 0; +for( t in 1 : T ) +{ + Numerator = Numerator + 1 / T * sum(diag( (matrix(X[ t, ])%*%X[ t, ] - Sigma_hat ) ^ 2 )); +} + +Denominator = sum( diag( ( Sigma_hat - C ) ^ 2 )); +a = 1 / T * Numerator / Denominator; + +# restrict to sensible weight +a = max(0, min(a, 1)); + +# shrink +Sigma_shr = ( 1 - a ) * Sigma_hat + a * C; + +print(Sigma_hat); +print(Sigma_shr); + From noreply at r-forge.r-project.org Sun Jul 14 23:55:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 14 Jul 2013 23:55:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2572 - pkg/PortfolioAnalytics/R Message-ID: <20130714215559.3823E1856B0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-14 23:55:58 +0200 (Sun, 14 Jul 2013) New Revision: 2572 Added: pkg/PortfolioAnalytics/R/optFUN.R Log: adding optimization (sub)functions Added: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R (rev 0) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-07-14 21:55:58 UTC (rev 2572) @@ -0,0 +1,342 @@ + +##### GMV and QU QP Function ##### +gmv_opt <- function(R, constraints, moments, lambda, target){ + N <- ncol(R) + # Applying box constraints + bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), + upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) + + # set up initial A matrix for leverage constraints + Amat <- rbind(rep(1, N), rep(1, N)) + dir.vec <- c(">=","<=") + rhs.vec <- c(constraints$min_sum, constraints$max_sum) + + # check for a target return + if(!is.na(target)) { + Amat <- rbind(Amat, moments$mean) + dir.vec <- c(dir.vec, "==") + rhs.vec <- c(rhs.vec, target) + } + + # include group constraints + if(try(!is.null(constraints$groups), silent=TRUE)){ + n.groups <- length(constraints$groups) + Amat.group <- matrix(0, nrow=n.groups, ncol=N) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- constraints$groups[i] + Amat.group[i, k:(l+j)] <- 1 + k <- l + j + 1 + l <- k - 1 + } + if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) + if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) + Amat <- rbind(Amat, Amat.group, -Amat.group) + dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) + rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) + } + + # set up the quadratic objective + ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean) + + # set up the optimization problem and solve + opt.prob <- OP(objective=ROI_objective, + constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), + bounds=bnds) + roi.result <- ROI_solve(x=opt.prob, solver="quadprog") + + weights <- roi.result$solution[1:N] + names(weights) <- colnames(R) + out <- list() + out$weights <- weights + out$out <- roi.result$objval + # out$call <- call # need to get the call outside of the function + return(out) +} + +##### Maximize Return LP Function ##### +maxret_opt <- function(R, moments, constraints, target){ + N <- ncol(R) + # Applying box constraints + bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), + upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) + + # set up initial A matrix for leverage constraints + Amat <- rbind(rep(1, N), rep(1, N)) + dir.vec <- c(">=","<=") + rhs.vec <- c(constraints$min_sum, constraints$max_sum) + + # check for a target return + if(!is.na(target)) { + Amat <- rbind(Amat, moments$mean) + dir.vec <- c(dir.vec, "==") + rhs.vec <- c(rhs.vec, target) + } + + # include group constraints + if(try(!is.null(constraints$groups), silent=TRUE)){ + n.groups <- length(constraints$groups) + Amat.group <- matrix(0, nrow=n.groups, ncol=N) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- constraints$groups[i] + Amat.group[i, k:(l+j)] <- 1 + k <- l + j + 1 + l <- k - 1 + } + if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) + if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) + Amat <- rbind(Amat, Amat.group, -Amat.group) + dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) + rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) + } + + # set up the linear objective + ROI_objective <- L_objective(L=-moments$mean) + + # set up the optimization problem and solve + opt.prob <- OP(objective=ROI_objective, + constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), + bounds=bnds) + roi.result <- ROI_solve(x=opt.prob, solver="glpk") + + # The Rglpk solvers status returns an an integer with status information + # about the solution returned: 0 if the optimal solution was found, a + #non-zero value otherwise. + if(roi.result$status$code != 0) { + message(roi.result$status$msg$message) + return(NULL) + } + + weights <- roi.result$solution[1:N] + names(weights) <- colnames(R) + out <- list() + out$weights <- weights + out$out <- roi.result$objval + # out$call <- call # need to get the call outside of the function + return(out) +} + +##### Maximize Return MILP Function ##### +maxret_milp_opt <- function(R, constraints, moments, target){ + N <- ncol(R) + + max_pos <- constraints$max_pos + + LB <- as.numeric(constraints$min) + UB <- as.numeric(constraints$max) + + # Check for target return + if(!is.na(target)){ + # We have a target + targetcon <- rbind(c(moments$mean, rep(0, N)), + c(-moments$mean, rep(0, N))) + targetdir <- c("<=", "==") + targetrhs <- c(Inf, -target) + } else { + # No target specified, just maximize + targetcon <- NULL + targetdir <- NULL + targetrhs <- NULL + } + + Amat <- rbind(c(rep(1, N), rep(0, N)), + c(rep(1, N), rep(0, N))) + Amat <- rbind(Amat, targetcon) + Amat <- rbind(Amat, cbind(-diag(N), diag(LB))) + Amat <- rbind(Amat, cbind(diag(N), -diag(UB))) + Amat <- rbind(Amat, c(rep(0, N), rep(1, N))) + + dir <- c("<=", ">=", targetdir, rep("<=", 2*N), "==") + + rhs <- c(1, 1, targetrhs, rep(0, 2*N), max_pos) + + # include group constraints + if(try(!is.null(constraints$groups), silent=TRUE)){ + n.groups <- length(constraints$groups) + Amat.group <- matrix(0, nrow=n.groups, ncol=N) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- constraints$groups[i] + Amat.group[i, k:(l+j)] <- 1 + k <- l + j + 1 + l <- k - 1 + } + if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) + if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) + zeros <- matrix(data=0, nrow=nrow(Amat.group), ncol=ncol(Amat.group)) + Amat <- rbind(Amat, cbind(Amat.group, zeros), cbind(-Amat.group, zeros)) + dir <- c(dir, rep(">=", (n.groups + n.groups))) + rhs <- c(rhs, constraints$cLO, -constraints$cUP) + } + + objL <- c(-moments$mean, rep(0, N)) + + # Only seems to work if I do not specify bounds + # bounds = list( lower=list( ind=1L:(2*N), val=c(LB, rep(0, N)) ), + # upper=list( ind=1L:(2*N), val=c(UB, rep(1, N)) ) ) + bnds <- NULL + + # Set up the types vector with continuous and binary variables + types <- c(rep("C", N), rep("B", N)) + + # Solve directly with Rglpk... getting weird errors with ROI + result <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, types=types, bounds=bnds, max=FALSE) + + # The Rglpk solvers status returns an an integer with status information + # about the solution returned: 0 if the optimal solution was found, a + #non-zero value otherwise. + if(result$status != 0) { + message("Undefined Solution") + return(NULL) + } + + weights <- result$solution[1:N] + names(weights) <- colnames(R) + out <- list() + out$weights <- weights + out$out <- result$optimum + #out$call <- call # add this outside of here, this function doesn't have the call + return(out) +} + +##### Minimize ETL LP Function ##### +etl_opt <- function(R, constraints, moments, target, alpha){ + N <- ncol(R) + T <- nrow(R) + # Applying box constraints + bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), + upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) + + Rmin <- ifelse(is.na(target), 0, target) + + Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1))) + dir.vec <- c(">=","<=",">=",rep(">=",T)) + rhs.vec <- c(constraints$min_sum, constraints$max_sum, Rmin ,rep(0, T)) + + if(try(!is.null(constraints$groups), silent=TRUE)){ + n.groups <- length(constraints$groups) + Amat.group <- matrix(0, nrow=n.groups, ncol=N) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- constraints$groups[i] + Amat.group[i, k:(l+j)] <- 1 + k <- l + j + 1 + l <- k - 1 + } + if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) + if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) + zeros <- matrix(0, nrow=n.groups, ncol=(T+1)) + Amat <- rbind(Amat, cbind(Amat.group, zeros), cbind(-Amat.group, zeros)) + dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) + rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) + } + + ROI_objective <- L_objective(c(rep(0,N), rep(1/(alpha*T),T), 1)) + opt.prob <- OP(objective=ROI_objective, + constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), + bounds=bnds) + roi.result <- ROI_solve(x=opt.prob, solver="glpk") + weights <- roi.result$solution[1:N] + names(weights) <- colnames(R) + out <- list() + out$weights <- weights + out$out <- roi.result$objval + #out$call <- call # add this outside of here, this function doesn't have the call + return(out) +} + +##### Minimize ETL MILP Function ##### +etl_milp_opt <- function(R, constraints, moments, target, alpha){ + + # Number of rows + n <- nrow(R) + + # Number of columns + m <- ncol(R) + + max_sum <- constraints$max_sum + min_sum <- constraints$min_sum + LB <- constraints$min + UB <- constraints$max + max_pos <- constraints$max_pos + moments_mean <- as.numeric(moments$mean) + + # A benchmark can be specified in the parma package. + # Leave this in and set to 0 for now + benchmark <- 0 + + # Check for target return + if(!is.na(target)){ + # We have a target + targetcon <- c(moments_mean, rep(0, n+2)) + targetdir <- "==" + targetrhs <- target + } else { + # No target specified, just maximize + targetcon <- NULL + targetdir <- NULL + targetrhs <- NULL + } + + # Set up initial A matrix + tmpAmat <- cbind(-coredata(R), + matrix(-1, nrow=n, ncol=1), + -diag(n), + matrix(benchmark, nrow=n, ncol=1)) + + # Add leverage constraints to matrix + tmpAmat <- rbind(tmpAmat, rbind(c(rep(1, m), rep(0, n+2)), + c(rep(1, m), rep(0, n+2)))) + + # Add target return to matrix + tmpAmat <- rbind(tmpAmat, as.numeric(targetcon)) + + # This step just adds m rows to the matrix to accept box constraints in the next step + tmpAmat <- cbind(tmpAmat, matrix(0, ncol=m, nrow=dim(tmpAmat)[1])) + + # Add lower bound box constraints + tmpAmat <- rbind(tmpAmat, cbind(-diag(m), matrix(0, ncol=n+2, nrow=m), diag(LB))) + + # Add upper bound box constraints + tmpAmat <- rbind(tmpAmat, cbind(diag(m), matrix(0, ncol=n+2, nrow=m), diag(-UB))) + + # Add row for max_pos cardinality constraints + tmpAmat <- rbind(tmpAmat, cbind(matrix(0, ncol=m + n + 2, nrow=1), matrix(1, ncol=m, nrow=1))) + + # Set up the rhs vector + rhs <- c( rep(0, n), min_sum, max_sum, targetrhs, rep(0, 2*m), max_pos) + + # Set up the dir vector + dir <- c( rep("<=", n), ">=", "<=", targetdir, rep("<=", 2*m), "==") + + # Linear objective vector + objL <- c( rep(0, m), 1, rep(1/n, n) / alpha, 0, rep(0, m)) + + # Set up the types vector with continuous and binary variables + types <- c( rep("C", m), "C", rep("C", n), "C", rep("B", m)) + + bounds <- list( lower = list( ind = 1L:(m + n + 2 + m), val = c(LB, -1, rep(0, n), 1, rep(0, m)) ), + upper = list( ind = 1L:(m + n + 2 + m), val = c( UB, 1, rep(Inf, n), 1 , rep(1, m)) ) ) + + result <- Rglpk_solve_LP(obj=objL, mat=tmpAmat, dir=dir, rhs=rhs, types=types, bounds=bounds) + # The Rglpk solvers status returns an an integer with status information + # about the solution returned: 0 if the optimal solution was found, a + #non-zero value otherwise. + if(result$status != 0) { + message("Undefined Solution") + return(NULL) + } + + weights <- result$solution[1:m] + names(weights) <- colnames(R) + out <- list() + out$weights <- weights + out$out <- result$optimum + #out$call <- call # add this outside of here, this function doesn't have the call + return(out) +} From noreply at r-forge.r-project.org Mon Jul 15 00:07:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 00:07:22 +0200 (CEST) Subject: [Returnanalytics-commits] r2573 - pkg/PortfolioAnalytics/R Message-ID: <20130714220722.14C13184BE5@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-15 00:07:21 +0200 (Mon, 15 Jul 2013) New Revision: 2573 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: adding subfunctions for optimize_method=ROI Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-14 21:55:58 UTC (rev 2572) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-14 22:07:21 UTC (rev 2573) @@ -740,14 +740,12 @@ if(optimize_method == "ROI"){ # This takes in a regular portfolio object and extracts the desired business objectives # and converts them to matrix form to be inputed into a closed form solver - # Applying box constraints - bnds <- list(lower = list(ind = seq.int(1L, N), val = as.numeric(constraints$min)), - upper = list(ind = seq.int(1L, N), val = as.numeric(constraints$max))) # retrieve the objectives to minimize, these should either be "var" and/or "mean" # we can either miniminze variance or maximize quiadratic utility (we will be minimizing the neg. quad. utility) moments <- list(mean=rep(0, N)) alpha <- 0.05 target <- NA + lambda <- 1 for(objective in portfolio$objectives){ if(objective$enabled){ if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR", objective$name == "ES", objective$name == "ETL"))) @@ -755,63 +753,24 @@ moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) target <- ifelse(!is.null(objective$target), objective$target, target) alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha) - lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, 1) + lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, lambda) } } - plugin <- ifelse(any(names(moments)=="var"), "quadprog", "glpk") - if(plugin == "quadprog") ROI_objective <- ROI:::Q_objective(Q=2*lambda*moments$var, L=-moments$mean) - if(plugin == "glpk") ROI_objective <- ROI:::L_objective(L=-moments$mean) - Amat <- rbind(rep(1, N), rep(1, N)) - dir.vec <- c(">=","<=") - rhs.vec <- c(constraints$min_sum, constraints$max_sum) - if(!is.na(target)) { - Amat <- rbind(Amat, moments$mean) - dir.vec <- c(dir.vec, "==") - rhs.vec <- c(rhs.vec, target) + if("var" %in% names(moments)){ + # Then this is a QP problem + out <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target) + out$call <- call } - if(try(!is.null(constraints$groups), silent=TRUE)){ - if(sum(constraints$groups) != N) - stop("Number of assets in each group needs to sum to number of total assets.") - n.groups <- length(constraints$groups) - if(!all(c(length(constraints$cLO),length(constraints$cLO)) == n.groups) ) - stop("Number of group constraints exceeds number of groups.") - Amat.group <- matrix(0, nrow=n.groups, ncol=N) - k <- 1 - l <- 0 - for(i in 1:n.groups){ - j <- constraints$groups[i] - Amat.group[i, k:(l+j)] <- 1 - k <- l + j + 1 - l <- k - 1 - } - if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) - if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) - Amat <- rbind(Amat, Amat.group, -Amat.group) - dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) - rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) + if(names(moments) == "mean") { + # This is a maximize return problem if the only name in moments == mean + out <- maxret_opt(R=R, constraints=constraints, moments=moments, target=target) + out$call <- call } if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) { - Rmin <- ifelse(is.na(target), 0, target) - ROI_objective <- ROI:::L_objective(c(rep(0,N), rep(1/(alpha*T),T), 1)) - Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1))) - dir.vec <- c(">=","<=",">=",rep(">=",T)) - rhs.vec <- c(constraints$min_sum, constraints$max_sum, Rmin ,rep(0, T)) - if(try(!is.null(constraints$groups), silent=TRUE)){ - zeros <- matrix(0, nrow=n.groups, ncol=(T+1)) - Amat <- rbind(Amat, cbind(Amat.group, zeros), cbind(-Amat.group, zeros)) - dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) - rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) - } + # This is an ETL LP problem + out <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) + out$call <- call } - opt.prob <- ROI:::OP(objective=ROI_objective, - constraints=ROI:::L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), - bounds=bnds) - roi.result <- ROI:::ROI_solve(x=opt.prob, solver=plugin) - weights <- roi.result$solution[1:N] - names(weights) <- colnames(R) - out$weights <- weights - out$out <- roi.result$objval - out$call <- call } ## end case for ROI ## case if method=pso---particle swarm From noreply at r-forge.r-project.org Mon Jul 15 04:12:44 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 04:12:44 +0200 (CEST) Subject: [Returnanalytics-commits] r2574 - in pkg/PortfolioAnalytics: . R Message-ID: <20130715021244.E747F185147@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-15 04:12:43 +0200 (Mon, 15 Jul 2013) New Revision: 2574 Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: modified optimize_method=ROI call to subfunctions Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2013-07-14 22:07:21 UTC (rev 2573) +++ pkg/PortfolioAnalytics/DESCRIPTION 2013-07-15 02:12:43 UTC (rev 2574) @@ -45,3 +45,4 @@ 'portfolio.R' 'constraintsFUN.R' 'constraint_fn_map.R' + 'optFUN.R' Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-14 22:07:21 UTC (rev 2573) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-15 02:12:43 UTC (rev 2574) @@ -757,19 +757,34 @@ } } if("var" %in% names(moments)){ - # Then this is a QP problem + # Minimize variance if the only objective specified is variance + # Maximize Quadratic Utility if var and mean are specified as objectives out <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target) out$call <- call } - if(names(moments) == "mean") { - # This is a maximize return problem if the only name in moments == mean - out <- maxret_opt(R=R, constraints=constraints, moments=moments, target=target) - out$call <- call + if(length(names(moments)) == 1 & "mean" %in% names(moments)) { + # Maximize return if the only objective specified is mean + if(!is.null(constraints$max_pos)) { + # This is an MILP problem if max_pos is specified as a constraint + out <- maxret_milp_opt(R=R, constraints=constraints, moments=moments, target=target) + out$call <- call + } else { + # Maximize return LP problem + out <- maxret_opt(R=R, constraints=constraints, moments=moments, target=target) + out$call <- call + } } if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) { - # This is an ETL LP problem - out <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) - out$call <- call + # Minimize sample ETL/ES/CVaR if CVaR, ETL, or ES is specified as an objective + if(!is.null(constraints$max_pos)) { + # This is an MILP problem if max_pos is specified as a constraint + out <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) + out$call <- call + } else { + # Minimize sample ETL/ES/CVaR LP Problem + out <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) + out$call <- call + } } } ## end case for ROI From noreply at r-forge.r-project.org Mon Jul 15 04:18:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 04:18:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2575 - pkg/PortfolioAnalytics/R Message-ID: <20130715021801.8DEF61844CA@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-15 04:18:00 +0200 (Mon, 15 Jul 2013) New Revision: 2575 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: modified constraints so that the default is enabled=TRUE per Doug's comments Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-15 02:12:43 UTC (rev 2574) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-15 02:18:00 UTC (rev 2575) @@ -160,7 +160,7 @@ #' @param constrclass character to name the constraint class #' @author Ross Bennett #' @export -constraint_v2 <- function(type, enabled=FALSE, ..., constrclass="v2_constraint"){ +constraint_v2 <- function(type, enabled=TRUE, ..., constrclass="v2_constraint"){ if(!hasArg(type)) stop("you must specify a constraint type") if (hasArg(type)) if(is.null(type)) stop("you must specify a constraint type") @@ -189,7 +189,7 @@ #' @author Ross Bennett #' @seealso \code{\link{constraint_v2}}, \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}} #' @export -add.constraint <- function(portfolio, type, enabled=FALSE, ..., indexnum=NULL){ +add.constraint <- function(portfolio, type, enabled=TRUE, ..., indexnum=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")} @@ -287,7 +287,7 @@ #' # specify box constraints per asset #' 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)) #' @export -box_constraint <- function(type, assets, min, max, min_mult, max_mult, enabled=FALSE, ...){ +box_constraint <- function(type, assets, min, max, min_mult, max_mult, enabled=TRUE, ...){ # Based on the constraint function for object of class constraint_v1 that # included specifying box constraints. @@ -399,7 +399,7 @@ #' group_min=c(0.15, 0.25), #' group_max=c(0.65, 0.55)) #' @export -group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, enabled=FALSE, ...) { +group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, enabled=TRUE, ...) { nassets <- length(assets) ngroups <- length(groups) @@ -469,7 +469,7 @@ #' pspec <- add.constraint(pspec, type="dollar_neutral") #' pspec <- add.constraint(pspec, type="active") #' @export -weight_sum_constraint <- function(type, min_sum=0.99, max_sum=1.01, enabled=FALSE, ...){ +weight_sum_constraint <- function(type, min_sum=0.99, max_sum=1.01, enabled=TRUE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="weight_sum_constraint", ...) Constraint$min_sum <- min_sum Constraint$max_sum <- max_sum @@ -577,7 +577,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) #' @export -turnover_constraint <- function(type, turnover_target, enabled=FALSE, ...){ +turnover_constraint <- function(type, turnover_target, enabled=TRUE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="turnover_constraint", ...) Constraint$turnover_target <- turnover_target return(Constraint) @@ -600,7 +600,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) #' @export -diversification_constraint <- function(type, div_target, enabled=FALSE, ...){ +diversification_constraint <- function(type, div_target, enabled=TRUE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...) Constraint$div_target <- div_target return(Constraint) @@ -624,7 +624,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3) #' @export -position_limit_constraint <- function(type, max_pos, enabled=FALSE, ...){ +position_limit_constraint <- function(type, max_pos, enabled=TRUE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="position_limit_constraint", ...) Constraint$max_pos <- max_pos return(Constraint) From noreply at r-forge.r-project.org Mon Jul 15 04:21:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 04:21:25 +0200 (CEST) Subject: [Returnanalytics-commits] r2576 - pkg/PortfolioAnalytics/R Message-ID: <20130715022125.E3CCF1844CA@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-15 04:21:25 +0200 (Mon, 15 Jul 2013) New Revision: 2576 Modified: pkg/PortfolioAnalytics/R/objective.R Log: modified objectives so that the default is enabled=TRUE per Doug's comments Modified: pkg/PortfolioAnalytics/R/objective.R =================================================================== --- pkg/PortfolioAnalytics/R/objective.R 2013-07-15 02:18:00 UTC (rev 2575) +++ pkg/PortfolioAnalytics/R/objective.R 2013-07-15 02:21:25 UTC (rev 2576) @@ -21,7 +21,7 @@ #' @param objclass string class to apply, default 'objective' #' @author Brian G. Peterson #' @export -objective<-function(name , target=NULL , arguments, enabled=FALSE , ..., multiplier=1, objclass='objective'){ +objective<-function(name , target=NULL , arguments, enabled=TRUE , ..., multiplier=1, objclass='objective'){ if(!hasArg(name)) stop("you must specify an objective name") if (hasArg(name)) if(is.null(name)) stop("you must specify an objective name") if (!is.list(arguments)) stop("arguments must be passed as a named list") @@ -69,13 +69,13 @@ #' @seealso \code{\link{constraint}} #' #' @export -add.objective <- function(constraints, type, name, arguments=NULL, enabled=FALSE, ..., indexnum=NULL) +add.objective <- function(constraints, type, name, arguments=NULL, enabled=TRUE, ..., indexnum=NULL) { if (!is.constraint(constraints)) {stop("constraints passed in are not of class constraint")} if (!hasArg(name)) stop("you must supply a name for the objective") if (!hasArg(type)) stop("you must supply a type of objective to create") - if (!hasArg(enabled)) enabled=FALSE + if (!hasArg(enabled)) enabled=TRUE if (!hasArg(arguments) | is.null(arguments)) arguments<-list() if (!is.list(arguments)) stop("arguments must be passed as a named list") @@ -150,14 +150,14 @@ #' @seealso \code{\link{objective}} #' #' @export -add.objective_v2 <- function(portfolio, type, name, arguments=NULL, enabled=FALSE, ..., indexnum=NULL){ +add.objective_v2 <- function(portfolio, type, name, arguments=NULL, enabled=TRUE, ..., indexnum=NULL){ # This function is based on the original add.objective function, but modified # to add objectives to a portfolio object instead of a constraint object. if (!is.portfolio(portfolio)) {stop("portfolio passed in is not of class portfolio")} if (!hasArg(name)) stop("you must supply a name for the objective") if (!hasArg(type)) stop("you must supply a type of objective to create") - if (!hasArg(enabled)) enabled=FALSE + if (!hasArg(enabled)) enabled=TRUE if (!hasArg(arguments) | is.null(arguments)) arguments<-list() if (!is.list(arguments)) stop("arguments must be passed as a named list") @@ -241,7 +241,7 @@ #' @param \dots any other passthru parameters #' @author Brian G. Peterson #' @export -return_objective <- function(name, target=NULL, arguments=NULL, multiplier=-1, enabled=FALSE, ... ) +return_objective <- function(name, target=NULL, arguments=NULL, multiplier=-1, enabled=TRUE, ... ) { if(!hasArg(target)) target = NULL ##' if target is null, we'll try to maximize the return metric @@ -260,7 +260,7 @@ #' @param \dots any other passthru parameters #' @author Brian G. Peterson #' @export -portfolio_risk_objective <- function(name, target=NULL, arguments=NULL, multiplier=1, enabled=FALSE, ... ) +portfolio_risk_objective <- function(name, target=NULL, arguments=NULL, multiplier=1, enabled=TRUE, ... ) { if(is.null(arguments$portfolio_method)) arguments$portfolio_method="single" #use multivariate risk calcs return(objective(name=name,target=target, arguments=arguments, multiplier=multiplier,enabled=enabled, objclass=c("portfolio_risk_objective","objective"), ... )) @@ -281,7 +281,7 @@ #' @param min_difference TRUE/FALSE whether to minimize difference between concentration, default FALSE #' @author Brian G. Peterson #' @export -risk_budget_objective <- function(assets, name, target=NULL, arguments=NULL, multiplier=1, enabled=FALSE, ..., min_prisk, max_prisk, min_concentration=FALSE, min_difference=FALSE ) +risk_budget_objective <- function(assets, name, target=NULL, arguments=NULL, multiplier=1, enabled=TRUE, ..., min_prisk, max_prisk, min_concentration=FALSE, min_difference=FALSE ) { if(is.null(arguments$portfolio_method)) arguments$portfolio_method="component" @@ -336,7 +336,7 @@ #' @param \dots any other passthru parameters #' @author Ross Bennett #' @export -turnover_objective <- function(name, target=NULL, arguments=NULL, multiplier=1, enabled=FALSE, ... ) +turnover_objective <- function(name, target=NULL, arguments=NULL, multiplier=1, enabled=TRUE, ... ) { if(!hasArg(target)) target = NULL ##' if target is null, we'll try to minimize the turnover metric @@ -369,7 +369,7 @@ #' @param \dots any other passthru parameters #' @author Ross Bennett #' @export -minmax_objective <- function(name, target=NULL, arguments=NULL, multiplier=1, enabled=FALSE, ..., min, max ) +minmax_objective <- function(name, target=NULL, arguments=NULL, multiplier=1, enabled=TRUE, ..., min, max ) { if(!hasArg(target)) target = NULL ##' if target is null, we'll try to minimize the metric From noreply at r-forge.r-project.org Mon Jul 15 04:47:38 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 04:47:38 +0200 (CEST) Subject: [Returnanalytics-commits] r2577 - pkg/PortfolioAnalytics/R Message-ID: <20130715024738.2A9A5184ED8@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-15 04:47:37 +0200 (Mon, 15 Jul 2013) New Revision: 2577 Modified: pkg/PortfolioAnalytics/R/portfolio.R Log: adding support for category_labels to the portfolio object Modified: pkg/PortfolioAnalytics/R/portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/portfolio.R 2013-07-15 02:21:25 UTC (rev 2576) +++ pkg/PortfolioAnalytics/R/portfolio.R 2013-07-15 02:47:37 UTC (rev 2577) @@ -13,12 +13,13 @@ #' constructor for class portfolio #' #' @param assets number of assets, or optionally a named vector of assets specifying seed weights. If seed weights are not specified, an equal weight portfolio will be assumed. +#' @param category_labels character vector to categorize assets by sector, industry, geography, market-cap, currency, etc. #' @param weight_seq seed sequence of weights, see \code{\link{generatesequence}} #' @author Ross Bennett #' @examples #' pspec <- portfolio.spec(assets=10, weight_seq=generatesequence()) #' @export -portfolio.spec <- function(assets=NULL, weight_seq=NULL) { +portfolio.spec <- function(assets=NULL, category_labels=NULL, weight_seq=NULL) { # portfolio.spec is based on the v1_constraint object, but removes # constraint specification if (is.null(assets)) { @@ -55,10 +56,21 @@ # if assets is a named vector, we'll assume it is current weights } + # If category_labels is not null then the user has passed in category_labels + if(!is.null(category_labels)){ + if(!is.character(category_labels)){ + stop("category_labels must be a character vector") + } + if(length(category_labels) != length(assets)) { + stop("length(category_labels) must be equal to length(assets)") + } + } + ## now structure and return return(structure( list( assets = assets, + category_labels = category_labels, weight_seq = weight_seq, constraints = list(), objectives = list(), From noreply at r-forge.r-project.org Mon Jul 15 04:59:51 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 04:59:51 +0200 (CEST) Subject: [Returnanalytics-commits] r2578 - pkg/PortfolioAnalytics/man Message-ID: <20130715025951.21DB1184C72@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-15 04:59:49 +0200 (Mon, 15 Jul 2013) New Revision: 2578 Modified: pkg/PortfolioAnalytics/man/add.constraint.Rd pkg/PortfolioAnalytics/man/add.objective.Rd pkg/PortfolioAnalytics/man/add.objective_v2.Rd pkg/PortfolioAnalytics/man/box_constraint.Rd pkg/PortfolioAnalytics/man/constraint_v2.Rd pkg/PortfolioAnalytics/man/diversification_constraint.Rd pkg/PortfolioAnalytics/man/group_constraint.Rd pkg/PortfolioAnalytics/man/minmax_objective.Rd pkg/PortfolioAnalytics/man/objective.Rd pkg/PortfolioAnalytics/man/portfolio.spec.Rd pkg/PortfolioAnalytics/man/portfolio_risk_objective.Rd pkg/PortfolioAnalytics/man/position_limit_constraint.Rd pkg/PortfolioAnalytics/man/return_objective.Rd pkg/PortfolioAnalytics/man/risk_budget_objective.Rd pkg/PortfolioAnalytics/man/turnover_constraint.Rd pkg/PortfolioAnalytics/man/turnover_objective.Rd pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd Log: updating help files for constraints, objectives, and portfolio Modified: pkg/PortfolioAnalytics/man/add.constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/add.constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -2,7 +2,7 @@ \alias{add.constraint} \title{General interface for adding and/or updating optimization constraints.} \usage{ - add.constraint(portfolio, type, enabled = FALSE, ..., + add.constraint(portfolio, type, enabled = TRUE, ..., indexnum = NULL) } \arguments{ Modified: pkg/PortfolioAnalytics/man/add.objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/add.objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{General interface for adding optimization objectives, including risk, return, and risk budget} \usage{ add.objective(constraints, type, name, arguments = NULL, - enabled = FALSE, ..., indexnum = NULL) + enabled = TRUE, ..., indexnum = NULL) } \arguments{ \item{constraints}{an object of type "constraints" to add Modified: pkg/PortfolioAnalytics/man/add.objective_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.objective_v2.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/add.objective_v2.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{General interface for adding optimization objectives, including risk, return, and risk budget} \usage{ add.objective_v2(portfolio, type, name, arguments = NULL, - enabled = FALSE, ..., indexnum = NULL) + enabled = TRUE, ..., indexnum = NULL) } \arguments{ \item{portfolio}{an object of type 'portfolio' to add the Modified: pkg/PortfolioAnalytics/man/box_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/box_constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/box_constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for box_constraint.} \usage{ box_constraint(type, assets, min, max, min_mult, - max_mult, enabled = FALSE, ...) + max_mult, enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} Modified: pkg/PortfolioAnalytics/man/constraint_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constraint_v2.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/constraint_v2.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -2,7 +2,7 @@ \alias{constraint_v2} \title{constructor for class v2_constraint} \usage{ - constraint_v2(type, enabled = FALSE, ..., + constraint_v2(type, enabled = TRUE, ..., constrclass = "v2_constraint") } \arguments{ Modified: pkg/PortfolioAnalytics/man/diversification_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for diversification_constraint} \usage{ diversification_constraint(type, div_target, - enabled = FALSE, ...) + enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} Modified: pkg/PortfolioAnalytics/man/group_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -4,7 +4,7 @@ \usage{ group_constraint(type, assets, groups, group_labels = NULL, group_min, group_max, - enabled = FALSE, ...) + enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} Modified: pkg/PortfolioAnalytics/man/minmax_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/minmax_objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/minmax_objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for class tmp_minmax_objective} \usage{ minmax_objective(name, target = NULL, arguments = NULL, - multiplier = 1, enabled = FALSE, ..., min, max) + multiplier = 1, enabled = TRUE, ..., min, max) } \arguments{ \item{name}{name of the objective, should correspond to a Modified: pkg/PortfolioAnalytics/man/objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -2,9 +2,8 @@ \alias{objective} \title{constructor for class 'objective'} \usage{ - objective(name, target = NULL, arguments, - enabled = FALSE, ..., multiplier = 1, - objclass = "objective") + objective(name, target = NULL, arguments, enabled = TRUE, + ..., multiplier = 1, objclass = "objective") } \arguments{ \item{name}{name of the objective which will be used to Modified: pkg/PortfolioAnalytics/man/portfolio.spec.Rd =================================================================== --- pkg/PortfolioAnalytics/man/portfolio.spec.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/portfolio.spec.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -2,7 +2,8 @@ \alias{portfolio.spec} \title{constructor for class portfolio} \usage{ - portfolio.spec(assets = NULL, weight_seq = NULL) + portfolio.spec(assets = NULL, category_labels = NULL, + weight_seq = NULL) } \arguments{ \item{assets}{number of assets, or optionally a named @@ -10,6 +11,10 @@ are not specified, an equal weight portfolio will be assumed.} + \item{category_labels}{character vector to categorize + assets by sector, industry, geography, market-cap, + currency, etc.} + \item{weight_seq}{seed sequence of weights, see \code{\link{generatesequence}}} } Modified: pkg/PortfolioAnalytics/man/portfolio_risk_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/portfolio_risk_objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/portfolio_risk_objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for class portfolio_risk_objective} \usage{ portfolio_risk_objective(name, target = NULL, - arguments = NULL, multiplier = 1, enabled = FALSE, ...) + arguments = NULL, multiplier = 1, enabled = TRUE, ...) } \arguments{ \item{name}{name of the objective, should correspond to a Modified: pkg/PortfolioAnalytics/man/position_limit_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -2,7 +2,7 @@ \alias{position_limit_constraint} \title{constructor for position_limit_constraint} \usage{ - position_limit_constraint(type, max_pos, enabled = FALSE, + position_limit_constraint(type, max_pos, enabled = TRUE, ...) } \arguments{ Modified: pkg/PortfolioAnalytics/man/return_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/return_objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/return_objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for class return_objective} \usage{ return_objective(name, target = NULL, arguments = NULL, - multiplier = -1, enabled = FALSE, ...) + multiplier = -1, enabled = TRUE, ...) } \arguments{ \item{name}{name of the objective, should correspond to a Modified: pkg/PortfolioAnalytics/man/risk_budget_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/risk_budget_objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/risk_budget_objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for class risk_budget_objective} \usage{ risk_budget_objective(assets, name, target = NULL, - arguments = NULL, multiplier = 1, enabled = FALSE, ..., + arguments = NULL, multiplier = 1, enabled = TRUE, ..., min_prisk, max_prisk, min_concentration = FALSE, min_difference = FALSE) } Modified: pkg/PortfolioAnalytics/man/turnover_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for turnover_constraint} \usage{ turnover_constraint(type, turnover_target, - enabled = FALSE, ...) + enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} Modified: pkg/PortfolioAnalytics/man/turnover_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/turnover_objective.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/turnover_objective.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for class turnover_objective} \usage{ turnover_objective(name, target = NULL, arguments = NULL, - multiplier = 1, enabled = FALSE, ...) + multiplier = 1, enabled = TRUE, ...) } \arguments{ \item{name}{name of the objective, should correspond to a Modified: pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd 2013-07-15 02:47:37 UTC (rev 2577) +++ pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd 2013-07-15 02:59:49 UTC (rev 2578) @@ -3,7 +3,7 @@ \title{constructor for weight_sum_constraint} \usage{ weight_sum_constraint(type, min_sum = 0.99, - max_sum = 1.01, enabled = FALSE, ...) + max_sum = 1.01, enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} From noreply at r-forge.r-project.org Mon Jul 15 08:02:36 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 15 Jul 2013 08:02:36 +0200 (CEST) Subject: [Returnanalytics-commits] r2579 - pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2 Message-ID: <20130715060236.933D118477A@r-forge.r-project.org> Author: shubhanm Date: 2013-07-15 08:02:36 +0200 (Mon, 15 Jul 2013) New Revision: 2579 Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R Log: Added Literature and tests using edhec database Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R 2013-07-15 02:59:49 UTC (rev 2578) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Return.GLM.R 2013-07-15 06:02:36 UTC (rev 2579) @@ -1,43 +1,35 @@ -#' calculate Geltner liquidity-adjusted return series +#' True returns represent the flow of information that would determine the equilibrium +#' value of the fund's securities in a frictionless market. However, true economic +#' returns are not observed. Instead, Rot +#' denotes the reported or observed return in +#' period t, which is a weighted average of the fund's true returns over the most recent k ? 1 +#' periods, includingthe current period. +#' This averaging process captures the essence of smoothed returns in several +#' respects. From the perspective of illiquidity-driven smoothing, is consistent +#' with several models in the nonsynchronous tradingliterat ure. For example, Cohen +#' et al. (1 986, Chapter 6.1) propose a similar weighted-average model for observed +#' returns. #' -#' David Geltner developed a method to remove estimating or liquidity bias in -#' real estate index returns. It has since been applied with success to other -#' return series that show autocorrelation or illiquidity effects. -#' -#' The theory is that by correcting for autocorrelation, you are uncovering a -#' "true" return from a series of observed returns that contain illiquidity or -#' manual pricing effects. -#' #' The Geltner autocorrelation adjusted return series may be calculated via: #' -#' \deqn{ }{Geltner.returns = [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) }\deqn{ -#' R_{G}=\frac{R_{t}-(R_{t-1}\cdot\rho_{1})}{1-\rho_{1}} }{Geltner.returns = -#' [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) } -#' -#' where \eqn{\rho_{1}}{acf(R(t-1))} is the first-order autocorrelation of the -#' return series \eqn{R_{a}}{Ra} and \eqn{R_{t}}{R(t)} is the return of -#' \eqn{R_{a}}{Ra} at time \eqn{t} and \eqn{R_{t-1}}{R(t-1)} is the one-period -#' lagged return. -#' #' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns -#' @param \dots any other passthru parameters -#' @author Brian Peterson -#' @references "Edhec Funds of Hedge Funds Reporting Survey : A Return-Based -#' Approach to Funds of Hedge Funds Reporting",Edhec Risk and Asset Management -#' Research Centre, January 2005,p. 27 + +#' @param q order of autocorrelation coefficient +#' @author R +#' @references "An econometric model of serial correlation and +#' illiquidity in hedge fund returns +#' Mila Getmansky1, Andrew W. Lo*, Igor Makarov +#' MIT Sloan School of Management, 50 Memorial Drive, E52-432, Cambridge, MA 02142-1347, USA +#' Received 16 October 2002; received in revised form 7 March 2003; accepted 15 May 2003 +#' Available online 10 July 2004 #' -#' Geltner, David, 1991, Smoothing in Appraisal-Based Returns, Journal of Real -#' Estate Finance and Economics, Vol.4, p.327-345. -#' -#' Geltner, David, 1993, Estimating Market Values from Appraised Values without -#' Assuming an Efficient Market, Journal of Real Estate Research, Vol.8, -#' p.325-345. +#' #' @keywords ts multivariate distribution models #' @examples #' -#' data(managers) -#' head(Return.Geltner(managers[,1:3]),n=20) +#' data(edhec) +#' Return.GLM(edhec,4) #' #' @export Return.GLM <- @@ -45,9 +37,7 @@ { # @author Brian G. Peterson, Peter Carl # Description: - # Geltner Returns came from real estate where they are used to uncover a - # liquidity-adjusted return series. - + # Ra return vector # q Lag Factors # Function: @@ -57,19 +47,9 @@ columnnames.a = colnames(R) clean.GLM <- function(column.R,q=3) { - ma.coeff = as.numeric(arma(column.R, order = c(0,q))$coef) -# for( i in 1: q) - # { -# if(q == 1){column.glm = ma.coeff[i]*lag(column.R,i)} -#else{ column.glm = ma.coeff[i]*lag(column.R,i)+ column.glm} - # } - column.glm = ma.coeff[q]*lag(column.R,q) - # compute the lagged return series - #lagR = lag(column.R, k=1) - # compute the first order autocorrelation - #f_acf = as.numeric(acf(as.numeric(column.R), plot = FALSE)[1][[1]]) - # now calculate and return the Geltner series - #column.geltner = (column.R-(lagR*f_acf))/(1-f_acf) + ma.coeff = as.numeric(arma(edhec[,1],0,q)$theta) + column.glm = ma.coeff[q]*lag(column.R,q) + return(column.glm) } From noreply at r-forge.r-project.org Tue Jul 16 06:48:06 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 06:48:06 +0200 (CEST) Subject: [Returnanalytics-commits] r2580 - pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code Message-ID: <20130716044806.3E2941855BE@r-forge.r-project.org> Author: pulkit Date: 2013-07-16 06:48:05 +0200 (Tue, 16 Jul 2013) New Revision: 2580 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R Log: MaxDD and Time under water for normal distribution Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-15 06:02:36 UTC (rev 2579) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-16 04:48:05 UTC (rev 2580) @@ -10,12 +10,12 @@ #' #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). -MaxDD<-function(R,confidence,...) +MaxDD<-function(R,confidence,type=c("ar","normal"),...) { x = checkData(R) if(ncol(x)==1 || is.null(R) || is.vector(R)){ - + type = type[1] calcul = FALSE for(i in (1:length(x))){ if(!is.na(x[i])){ @@ -27,12 +27,22 @@ result = NA } else{ - result = get_minq(x,confidence) + if(type=="ar"){ + result = get_minq(x,confidence) + } + if(type=="normal"){ + result = dd_norm(x,confidence) + } } + return(result) } - - result = apply(x,MARGIN = 2,get_minq,confidence) + if(type=="ar"){ + result = apply(x,MARGIN = 2,get_minq,confidence) + } + if(type=="normal"){ + result = apply(x,MARGIN = 2,dd_norm,confidence) + } rownames(result) = c("MaxDD(in %)","t*") return(result) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R 2013-07-15 06:02:36 UTC (rev 2579) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R 2013-07-16 04:48:05 UTC (rev 2580) @@ -1,3 +1,38 @@ + + +dd_norm<-function(x,confidence){ + # DESCRIPTION: + # A function to return the maximum drawdown for a normal distribution + + # Inputs: + # R: The Return Series + # + # confidence: The confidence Level + sd = StdDev(x) + mu = mean(x, na.rm = TRUE) + dd = max(0,((qnorm(1-confidence)*sd)^2)/(4*mu)) + t = ((qnorm(1-confidence)*sd)/(2*mu))^2 + + return(c(dd*100,t)) +} + +tuw_norm<-function(x,confidence){ + # DESCRIPTION: + # A function to return the Time under water + + # Inputs: + # R: Return series + # confidence: The confidence level + sd = StdDev(x) + mu = mean(x,na.rm = TRUE) + tuw = ((qnorm(1-confidence)*sd)/mu)^2 + + return(tuw) +} + + + + get_minq<-function(R,confidence){ # DESCRIPTION: @@ -8,7 +43,7 @@ # Inputs: # R: The function takes Returns as the input # - # confidence: The confidence interval of the input. + # confidence: The confidence interval. x = checkData(R) mu = mean(x, na.rm = TRUE) sigma_infinity = StdDev(x) Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-15 06:02:36 UTC (rev 2579) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-16 04:48:05 UTC (rev 2580) @@ -10,11 +10,10 @@ #' #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). -TuW<-function(R,confidence,...){ +TuW<-function(R,confidence,type=c("ar","normal"),...){ x = checkData(R) - - if(ncol(x)==1 || is.null(R) || is.vector(R)){ - + type = type[1] + if(ncol(x)==1 || is.null(R) || is.vector(R)){ calcul = FALSE for(i in (1:length(x))){ if(!is.na(x[i])){ @@ -26,12 +25,23 @@ result = NA } else{ - result = get_TuW(x,confidence) + if(type=="ar"){ + result = get_TuW(x,confidence) + } + if(type=="normal"){ + result = tuw_norm(x,confidence) + } } return(result) } else{ - result=apply(x,MARGIN = 2, get_TuW,confidence) + if(type=="ar"){ + result=apply(x,MARGIN = 2, get_TuW,confidence) + } + if(type=="normal"){ + result=apply(x,MARGIN = 2, tuw_norm,confidence) + } + result<-as.data.frame(result) result<-t(result) rownames(result)=paste("Max Time Under Water") From noreply at r-forge.r-project.org Tue Jul 16 06:59:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 06:59:26 +0200 (CEST) Subject: [Returnanalytics-commits] r2581 - in pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3: . Code Test Message-ID: <20130716045926.5D0BF1855BE@r-forge.r-project.org> Author: shubhanm Date: 2013-07-16 06:59:26 +0200 (Tue, 16 Jul 2013) New Revision: 2581 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ Log: Added EmaxDDGBM.R along with the previous table, test on edhec, and literature Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R 2013-07-16 04:59:26 UTC (rev 2581) @@ -0,0 +1,194 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +table.EMaxDDGBM <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev(x) + gamma<-sqrt(pi/8) + + if(mu==0){ + + Ed<-2*gamma*sig*sqrt(T) + + } + + else{ + + alpha<-mu*sqrt(T/(2*sig^2)) + + x<-alpha^2 + + if(mu>0){ + + mQp<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, + + 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, + + 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900, + + 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000, + + 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690, + + 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171, + + 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162, + + 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999, + + 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992, + + 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457, + + 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985, + + 2.621743),ncol=2) + + + + if(x<0.0005){ + + Qp<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y + + } + + if(x>5000){ + + Qp<-0.25*log(x)+0.49088 + + } + + Ed<-(2*sig^2/mu)*Qp + + } + + if(mu<0){ + + mQn<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150, + + 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400, + + 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800, + + 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000, + + 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000, + + 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708, + + 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229, + + 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056, + + 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393, + + 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455, + + 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380, + + 4.990430, 5.498820),ncol=2) + + + + + + if(x<0.0005){ + + Qn<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y + + } + + if(x>5000){ + + Qn<-x+0.50 + + } + + Ed<-(2*sig^2/mu)*(-Qn) + + } + + } + + # return(Ed) + + z = c((mu*100), + (sig*100), + (Ed*100)) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Expected Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R 2013-07-16 04:59:26 UTC (rev 2581) @@ -0,0 +1,47 @@ +#' Stacked Bar Plot of Autocorrelation Lag Coefficients +#' +#' A wrapper to create box and whiskers plot of comparitive inputs +#' +#' 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 Burghardt, Duncan and Liu(2013) +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' an asset return +#' @return Stack Bar plot of lagged return coefficients +#' @author R +#' @seealso \code{\link[graphics]{boxplot}} +#' @references Burghardt, Duncan and Liu(2013) \emph{It's the autocorrelation, stupid}. AlternativeEdge Note November, 2012 } +#' @keywords Autocorrelation lag factors +#' @examples +#' +#' data(edhec[,1]) +#' chart.Autocorrelation(edhec[,1]) +#' +#' +#' @export +chart.Autocorrelation <- + function (R, ...) + { # @author R + + # DESCRIPTION: + # A wrapper to create box and whiskers plot, of autocorrelation lag coeffiecients + # of the First six factors + + R = checkData(R, method="xts") + +# Graph autos with adjacent bars using rainbow colors + +aa= table.Autocorrelation(R) +barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient", + , xlab = "Fund Type",beside=TRUE, col=rainbow(6)) + + # Place the legend at the top-left corner with no frame + # using rainbow colors + legend("topright", c("1","2","3","4","5","6"), cex=0.6, + bty="n", fill=rainbow(6)); + + + + +} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R 2013-07-16 04:59:26 UTC (rev 2581) @@ -0,0 +1,174 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +EMaxDDGBM <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev(x) + gamma<-sqrt(pi/8) + + if(mu==0){ + + Ed<-2*gamma*sig*sqrt(T) + + } + + else{ + + alpha<-mu*sqrt(T/(2*sig^2)) + + x<-alpha^2 + + if(mu>0){ + + mQp<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, + + 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, + + 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900, + + 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000, + + 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690, + + 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171, + + 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162, + + 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999, + + 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992, + + 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457, + + 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985, + + 2.621743),ncol=2) + + + + if(x<0.0005){ + + Qp<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y + + } + + if(x>5000){ + + Qp<-0.25*log(x)+0.49088 + + } + + Ed<-(2*sig^2/mu)*Qp + + } + + if(mu<0){ + + mQn<-matrix(c( + + 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150, + + 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400, + + 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800, + + 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000, + + 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000, + + 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708, + + 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229, + + 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056, + + 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393, + + 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455, + + 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380, + + 4.990430, 5.498820),ncol=2) + + + + + + if(x<0.0005){ + + Qn<-gamma*sqrt(2*x) + + } + + if(x>0.0005 & x<5000){ + + Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y + + } + + if(x>5000){ + + Qn<-x+0.50 + + } + + Ed<-(2*sig^2/mu)*(-Qn) + + } + + } + + return(Ed[1]*100) + + + } +} +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R 2013-07-16 04:59:26 UTC (rev 2581) @@ -0,0 +1,99 @@ +#' To simulate net asset value (NAV) series where skewness and kurtosis are zero, +#' we draw sample returns from a lognormal return distribution. To capture skewness +#' and kurtosis, we sample returns from a generalised lambda distribution.The values of +#' skewness and excess kurtosis used were roughly consistent with the range of values we +#' observed for commodity trading advisers in our database. The NAV series is constructed +#' from the return series. The simulated drawdowns are then derived and used to produce +#' the theoretical drawdown distributions. A typical run usually requires 10,000 +#' iterations to produce a smooth distribution. +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +table.NormDD <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + require("gld") + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= nyears(y); + n <- 1000 + dt <- 1/T; + r0 <- 0; + s0 <- 1; + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + mu = Return.annualized(x, scale = NA, geometric = TRUE) + sig=StdDev.annualized(x) + skew = skewness(x) + kurt = kurtosis(x) + r <- matrix(0,T+1,n) # matrix to hold short rate paths + s <- matrix(0,T+1,n) + r[1,] <- r0 + s[1,] <- s0 + drawdown <- matrix(0,n) + # return(Ed) + + for(j in 1:n){ + r[2:(T+1),j]= rgl(T,mu,sig,skew,kurt) + for(i in 2:(T+1)){ + + dr <- r[i,j]*dt + s[i,j] <- s[i-1,j] + (dr/100) + } + + + drawdown[j] = as.numeric(maxdrawdown(s[,j])[1]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + # t <- seq(0, T, dt) + # matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: EMaxDDGBM +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R 2013-07-16 04:59:26 UTC (rev 2581) @@ -0,0 +1,9 @@ +library(RUnit) +library(PerformanceAnalytics) +data(edhec[,1]) + +test_EMaxDDGBM<-function(){ + + checkEqualsNumeric(EMaxDDGBM(edhec[,1])[1],1.708261,tolerance = 1.0e-6) + +} \ No newline at end of file From noreply at r-forge.r-project.org Tue Jul 16 17:31:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 17:31:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2582 - in pkg/Meucci: . R demo man Message-ID: <20130716153133.7634F18514A@r-forge.r-project.org> Author: xavierv Date: 2013-07-16 17:31:33 +0200 (Tue, 16 Jul 2013) New Revision: 2582 Added: pkg/Meucci/R/GenerateUniformDrawsOnUnitSphere.R pkg/Meucci/demo/S_BuyNHold.R pkg/Meucci/demo/S_CPPI.R pkg/Meucci/demo/S_CornishFisher.R pkg/Meucci/demo/S_ESContributionFactors.R pkg/Meucci/demo/S_ESContributionsStudentT.R pkg/Meucci/demo/S_InvestorsObjective.R pkg/Meucci/demo/S_UtilityMax.R pkg/Meucci/demo/S_VaRContributionsUniform.R pkg/Meucci/man/GenerateUniformDrawsOnUnitSphere.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE Log: -added most of the demo scripts from chapter 5 and three from chapter 6 Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-16 04:59:26 UTC (rev 2581) +++ pkg/Meucci/DESCRIPTION 2013-07-16 15:31:33 UTC (rev 2582) @@ -82,3 +82,4 @@ 'Raw2Cumul.R' 'FitExpectationMaximization.R' 'QuantileMixture.R' + 'GenerateUniformDrawsOnUnitSphere.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-16 04:59:26 UTC (rev 2581) +++ pkg/Meucci/NAMESPACE 2013-07-16 15:31:33 UTC (rev 2582) @@ -12,6 +12,7 @@ export(EntropyProg) export(FitExpectationMaximization) export(GenerateLogNormalDistribution) +export(GenerateUniformDrawsOnUnitSphere) export(hermitePolynomial) export(integrateSubIntervals) export(InterExtrapolate) Added: pkg/Meucci/R/GenerateUniformDrawsOnUnitSphere.R =================================================================== --- pkg/Meucci/R/GenerateUniformDrawsOnUnitSphere.R (rev 0) +++ pkg/Meucci/R/GenerateUniformDrawsOnUnitSphere.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,39 @@ +#' Generate a uniform sample on the unit hypersphere, as described in A. Meucci, +#' "Risk and Asset Allocation", Springer, 2005. +#' +#' @param J : [scalar] number of draws +#' @param N : [scalar] dimension +#' +#' @return X : [matrix] (T x N) of draws +#' +#'@note +#' \item{ Initial script by Xiaoyu Wang - Dec 2006} +#' \item{ We decompose X=U*R, where U is a uniform distribution on unit sphere and +# R is a distribution on (0,1) proportional to r^(Dims-1), i.e. the area of surface of radius r } +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "GenerateUniformDrawsOnUnitSphere.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +GenerateUniformDrawsOnUnitSphere = function(J, N) +{ +l = matrix( 1, 1, N ); + +# 1. Generate U +Z = matrix( runif(J*N), J, N ); +normZ = sqrt( apply( Z * Z, 1, sum ) ); +U = Z / ( normZ %*% l ); + +# 2. Generate R +# the pdf of R is proportional to r^(N-1) therefore the cdf of R is r^N +# we use quantile function of R sample R from uniform simulations +Y = runif(J); +R = Y ^ ( 1/N ); + +# 3. Generate X +X = U * ( R %*% l ); + return( X ); +} \ No newline at end of file Added: pkg/Meucci/demo/S_BuyNHold.R =================================================================== --- pkg/Meucci/demo/S_BuyNHold.R (rev 0) +++ pkg/Meucci/demo/S_BuyNHold.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,99 @@ +#' This script illustrates the buy & hold dynamic strategy, as described in A. Meucci,"Risk and Asset Allocation", +#' Springer, 2005, Chapter 6. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_BuyNHold.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Input parameters +Initial_Investment = 1000; +Time_Horizon = 6 / 12; # in years +Time_Step = 1 / 252; # in years + +m = 0.2; # yearly expected return on the underlying +s = 0.40; # yearly expected percentage volatility on the stock index +r = 0.04; # risk-free (money market) interest rate + +NumSimul = 30000; + +################################################################################################################## +# proportion of underlying you want to hold in the beginning, e.g.: 50 +Prct = 50 ; + +################################################################################################################## +#### Initialize values +Underlying_Index = Initial_Investment; # value of the underlyting at starting time, normalzed to equal investment +Start = Underlying_Index; +Elapsed_Time = 0; +Portfolio_Value = Initial_Investment; + +Underlying_in_Portfolio_Percent = Prct / 100; + +Underlyings_in_Portfolio = Portfolio_Value * Underlying_in_Portfolio_Percent; +Cash_in_Portfolio = Portfolio_Value - Underlyings_in_Portfolio; + +################################################################################################################## +### Initialize parameters for the plot (no theory in this) + +Portfolio_Series = Portfolio_Value; +Market_Series = Underlying_Index; +Percentage_Series = Underlying_in_Portfolio_Percent; + +# asset evolution and portfolio rebalancing +while( Elapsed_Time < (Time_Horizon - 10^(-5)) ) # add this term to avoid errors +{ + # time elapses... + Elapsed_Time = Elapsed_Time + Time_Step; + + # ...asset prices evolve and portfolio takes on new value... + Multiplicator = exp( (m - s ^ 2 / 2) * Time_Step + s * sqrt( Time_Step ) * rnorm(NumSimul)); + Underlying_Index = Underlying_Index * Multiplicator; + Underlyings_in_Portfolio = Underlyings_in_Portfolio * Multiplicator; + Cash_in_Portfolio = Cash_in_Portfolio * exp(r * Time_Step); + Portfolio_Value = Underlyings_in_Portfolio + Cash_in_Portfolio; + + # ...and we rebalance our portfolio + Underlying_in_Portfolio_Percent = Underlyings_in_Portfolio / Portfolio_Value; + + # store one path for the movie (no theory in this) + Portfolio_Series = cbind( Portfolio_Series, Portfolio_Value[ 1 ] ); ##ok<*AGROW> + Market_Series = cbind( Market_Series, Underlying_Index[ 1 ] ); + Percentage_Series = cbind( Percentage_Series, Underlying_in_Portfolio_Percent[ 1 ] ); +} + +################################################################################################################## +### Play the movie for one path +Time = seq( 0, Time_Horizon, Time_Step); +y_max = max( cbind( Portfolio_Series, Market_Series) ) * 1.2; +dev.new(); +par( mfrow = c(2,1)) +for( i in 1 : length(Time) ) +{ + plot( Time[ 1:i ], Portfolio_Series[ 1:i ], type ="l", lwd = 2.5, col = "blue", ylab = "value", + xlim = c(0, Time_Horizon), ylim = c(0, y_max), main = "investment (blue) vs underlying (red) value"); + lines( Time[ 1:i ], Market_Series[ 1:i ], lwd = 2, col = "red" ); + #axis( 1, [0, Time_Horizon, 0, y_max]); + + plot(Time[ 1:i ], Percentage_Series[ 1:i ], type = "h", col = "red", xlab = "time", ylab = "#", + xlim = c(0, Time_Horizon), ylim =c(0,1), main = "percentage of underlying in portfolio"); +} + +################################################################################################################## +### Plots +# plot the scatterplot +dev.new(); + +# marginals +NumBins = round(10 * log(NumSimul)); +layout( matrix(c(1,2,2,2,1,2,2,2,1,2,2,2,0,3,3,3), 4, 4, byrow = TRUE)); +barplot( table( cut( Portfolio_Value, NumBins )), horiz=TRUE, yaxt="n") + +# joint scatter plot +plot(Underlying_Index, Portfolio_Value, xlab = "underlying at horizon (~ buy & hold )", ylab = "investment at horizon" ); +so = sort( Underlying_Index ); +lines( so, so, col = "red" ); + +barplot( table( cut( Underlying_Index, NumBins )), yaxt="n") Added: pkg/Meucci/demo/S_CPPI.R =================================================================== --- pkg/Meucci/demo/S_CPPI.R (rev 0) +++ pkg/Meucci/demo/S_CPPI.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,112 @@ +#' This script illustrates the CPPI (constant proportion portfolio insurance) dynamic strategy, as described in +#' A. Meucci,"Risk and Asset Allocation", Springer, 2005, Chapter 6. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_CPPI.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Input parameters +Initial_Investment = 1000; +Time_Horizon = 6 / 12; # in years +Time_Step = 1 / 252; # in years + +m = 0.2; # yearly expected return on the underlying +s = 0.40; # yearly expected percentage volatility on the stock index +r = 0.04; # risk-free (money market) interest rate + +nSim = 30000; + +################################################################################################################## +### Setup +# floor today (will evolve at the risk-free rate), e.g.: 950 +Floor = 980; +# leverage on the cushion between your money and the floor, e.g. 3 +Multiple_CPPI = 5; + +################################################################################################################## +### Initialize values +Underlying_Index = Initial_Investment; # value of the underlyting at starting time, normalzed to equal investment +Start = Underlying_Index; +Elapsed_Time = 0; +Portfolio_Value = Initial_Investment; + +Cushion = max( 0, Portfolio_Value - Floor ); +Underlyings_in_Portfolio = min(Portfolio_Value, max( 0, Multiple_CPPI * Cushion ) ); +#Cash_in_Portfolio = Portfolio_Value - Underlyings_in_Portfolio; +Underlying_in_Portfolio_Percent = Underlyings_in_Portfolio / Portfolio_Value; + +Underlyings_in_Portfolio = Portfolio_Value * Underlying_in_Portfolio_Percent; +Cash_in_Portfolio = Portfolio_Value - Underlyings_in_Portfolio; + +################################################################################################################## +### Initialize parameters for the plot (no theory in this) +Portfolio_Series = Portfolio_Value; +Market_Series = Underlying_Index; +Percentage_Series = Underlying_in_Portfolio_Percent; + +################################################################################################################## +### Asset evolution and portfolio rebalancing +while( Elapsed_Time < (Time_Horizon - 10^(-5)) ) # add this term to avoid errors +{ + # time elapses... + Elapsed_Time = Elapsed_Time + Time_Step; + + # ...asset prices evolve and portfolio takes on new value... + Multiplicator = exp( (m - s ^ 2 / 2) * Time_Step + s * sqrt( Time_Step ) * rnorm( NumSimul )); + Underlying_Index = Underlying_Index * Multiplicator; + Underlyings_in_Portfolio = Underlyings_in_Portfolio * Multiplicator; + Cash_in_Portfolio = Cash_in_Portfolio * exp(r * Time_Step); + Portfolio_Value = Underlyings_in_Portfolio + Cash_in_Portfolio; + + # ...and we rebalance our portfolio + Floor = Floor * exp( r * Time_Step ); + Cushion = pmax( 0, (Portfolio_Value - Floor) ); + Underlyings_in_Portfolio = pmin(Portfolio_Value, pmax( 0, Multiple_CPPI * Cushion) ); + Cash_in_Portfolio = Portfolio_Value - Underlyings_in_Portfolio; + Underlying_in_Portfolio_Percent = Underlyings_in_Portfolio / Portfolio_Value; + + # store one path for the movie (no theory in this) + Portfolio_Series = cbind( Portfolio_Series, Portfolio_Value[ 1 ] ); ##ok<*AGROW> + Market_Series = cbind( Market_Series, Underlying_Index[ 1 ] ); + Percentage_Series = cbind( Percentage_Series, Underlying_in_Portfolio_Percent[ 1 ] ); +} + +################################################################################################################## +### Play the movie for one path + +Time = seq( 0, Time_Horizon, Time_Step); +y_max = max( cbind( Portfolio_Series, Market_Series) ) * 1.2; +dev.new(); +par( mfrow = c(2,1)) +for( i in 1 : length(Time) ) +{ + plot( Time[ 1:i ], Portfolio_Series[ 1:i ], type ="l", lwd = 2.5, col = "blue", ylab = "value", + xlim = c(0, Time_Horizon), ylim = c(0, y_max), main = "investment (blue) vs underlying (red) value"); + lines( Time[ 1:i ], Market_Series[ 1:i ], lwd = 2, col = "red" ); + #axis( 1, [0, Time_Horizon, 0, y_max]); + + plot(Time[ 1:i ], Percentage_Series[ 1:i ], type = "h", col = "red", xlab = "time", ylab = "#", + xlim = c(0, Time_Horizon), ylim =c(0,1), main = "percentage of underlying in portfolio"); + +} + + +################################################################################################################## +### plot the scatterplot +dev.new(); + +# marginals +NumBins = round(10 * log(NumSimul)); +layout( matrix(c(1,2,2,2,1,2,2,2,1,2,2,2,0,3,3,3), 4, 4, byrow = TRUE)); +barplot( table( cut( Portfolio_Value, NumBins )), horiz=TRUE, yaxt="n"); + +# joint scatter plot +plot(Underlying_Index, Portfolio_Value, xlab = "underlying at horizon (~ buy & hold )", ylab = "investment at horizon" ); +so = sort( Underlying_Index ); +lines( so, so, col = "red" ); + +barplot( table( cut( Underlying_Index, NumBins )), yaxt="n"); + Added: pkg/Meucci/demo/S_CornishFisher.R =================================================================== --- pkg/Meucci/demo/S_CornishFisher.R (rev 0) +++ pkg/Meucci/demo/S_CornishFisher.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,39 @@ +#'This script compares the Cornish-Fisher estiamte of the VaR with the true analytical VaR under the lognormal +#'assumptions as described in A. Meucci,"Risk and Asset Allocation", Springer, 2005, Chapter 5. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_CornishFisher.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################### +### Inputs +mu = 0.05; +sig = 0.05; # NB: change here and see the impact of approximation + +################################################################################################################### +### Process data +E_X = exp( mu + sig ^ 2 / 2 ); +Sd_X = exp( mu + sig ^ 2 / 2 ) * sqrt( exp( sig ^ 2 ) - 1 ); +Sk_X = sqrt( exp( sig ^ 2 ) - 1 ) * ( exp( sig ^ 2 ) + 2 ); + +c = seq(0.001, 0.999, 0.001 ); +z = qnorm( c ); + +Q_CF = E_X + Sd_X * ( z + Sk_X / 6 * ( z ^ 2 - 1 ) ); +Q_true = qlnorm( c,mu,sig ); + +x = Q_true; +f = dlnorm( x, mu, sig ); + +################################################################################################################### +### Plots +dev.new(); +plot( x, f, type= "l", main = "pdf" ); + +dev.new(); +plot( c, Q_true, type = "l", col = "red", main = "quantile" ); +lines( c, Q_CF ); +legend( "topleft", 1.9, c( "true", "Cornish-Fisher approx" ), col = c( "black","red" ), + lty=1, bg = "gray90" ); Added: pkg/Meucci/demo/S_ESContributionFactors.R =================================================================== --- pkg/Meucci/demo/S_ESContributionFactors.R (rev 0) +++ pkg/Meucci/demo/S_ESContributionFactors.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,92 @@ +library(MASS); +library(Matrix); +#' This script computes the expected shortfall and the contributions to ES from each factor in simulations, using +#' the conditional expectation definition of the contributions as described in A. Meucci,"Risk and Asset Allocation", +#' Springer, 2005, Chapter 5. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ESContributionFactors.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################### +### Inputs + +N = 30; # number of securities +K = 10; # number of factors +a = runif(N); # allocation +c = 0.95; # ES confidence + +################################################################################################################### +### Generate market simulations +# factor loadings +B = matrix( runif( N*K ), N, K ); + +# student t parameters +nu = 10; +eps = 0.1; +g = 0.1; + +A = matrix( runif( K^2 ), K, K ) - 0.5; +C = A %*% t(A); +sigma_f = cov2cor(C); +sigma_u = diag( 1, N ); +for( n in 1:(N - 1) ) +{ + sigma_u = sigma_u + exp( -g * n ) *( rbind(cbind(matrix(0, N-n, n), diag(array( 1, N - n))), matrix(0,n,N)) + + rbind(matrix( 0, n, N ),cbind( diag( array( 1, N - n )), matrix( 0, N-n, n)) )); +} + +sigma = as.matrix(.bdiag(list( eps * sigma_f, eps^2 * sigma_u))) #block diagonal matrix +corr = cov2cor( sigma ); +diag_sigma = sqrt( diag( sigma ) ); +# scenarios +nSim = 10000; +l = matrix( 1, nSim); +X = rmvt( nSim/2, corr, nu ); +X = rbind( X, -X ); # symmetrize simulations +X = X %*% diag( diag_sigma ); +X = exp( X ); +F = X[ , 1:K ]; +U = X[ , (K+1):ncol(X) ]; +U = U - l %*% apply( U, 2, mean ); +M = F %*% t( B ) + U; + +################################################################################################################### +### Risk management +# compute the objective +Psi = M %*% a; + +# compute ES +th = ceiling((1-c) * nSim); # threshold +spc = matrix( 0, nSim, 1 ); +spc[ 1 : th ] = 1; +spc = spc / sum( spc ); + +Sort_Psi = sort( Psi ); +Index = order( Psi ); +ES_simul = t(Sort_Psi) %*% spc; + +# augment factor set to include residual +F_ = cbind( F, U%*%a ); +# compute portfolio-level loadings +b_ = cbind( t(a)%*%B, 1 ); + +# sort factors according to order induced by objective's realizations + +Sort_F_ = F_[Index, ]; +DES_simul = matrix( NaN, 1, K+1 ); +for( k in 1 : (K+1) ) +{ + # compute gradient as conditional expectation + DES_simul[ k ] = t(spc) %*% Sort_F_[ , k ]; +} +# compute contributions +ContrES_simul = b_ * DES_simul; + +################################################################################################################### +### Plots +dev.new(); +bar = barplot( ContrES_simul, main = "contributions to ES" ); +axis( 1 , at = bar, labels= 1:ncol(ContrES_simul)); Added: pkg/Meucci/demo/S_ESContributionsStudentT.R =================================================================== --- pkg/Meucci/demo/S_ESContributionsStudentT.R (rev 0) +++ pkg/Meucci/demo/S_ESContributionsStudentT.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,89 @@ +library(MASS); +library(Matrix); +#' This script computes the expected shortfall and the contributions to ES from each security: +#' - analytically, under the Student t assumption for the market +#' - in simulations, using the conditional expectation definition of the contributions +#' Described in A. Meucci,"Risk and Asset Allocation",Springer, 2005, Chapter 5. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ESContributionsStudentT.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs +# number of assets +N = 40; + +# market parameters (student t distribution) +Mu = runif(N); +A = matrix( runif( N^2 ), N, N )-.5; +Sigma = A %*% t(A); +nu = 7; + +# allocation +a = runif(N) - 0.5; + +# ES confidence +c = 0.95; + +nSim = 10000; + +################################################################################################################### +### Generate market scenarios +l = matrix( 1, nSim, 1); +diag_s = diag( sqrt( diag( Sigma ) ) ); +invdiag_s = diag( 1 / sqrt( diag( Sigma ) ) ); +C = invdiag_s * Sigma * invdiag_s; +X = rmvt( nSim / 2, C, nu); +X = rbind( X, -X ); # symmetrize simulations +M = l %*% t( Mu ) + X %*% diag_s; + +################################################################################################################### +### Simulations +# compute the objective +Psi = M %*% a; + +# compute cut-off spectrum (step function) for empirical ES estimation, see (5.218) +th = ceiling((1-c) * nSim); # threshold +spc = matrix( 0, nSim, 1 ); +spc[ 1 : th ] = 1; +spc = spc / sum( spc ); + +# compute ES +Sort_Psi = sort( Psi ); +Index = order( Psi ); +ES_simul = t(Sort_Psi) %*% spc; + +# sort market according to order induced by objective's realizations +Sort_M = M[ Index, ]; +DES_simul = matrix(NaN, 1, N); +for( n in 1 : N ) +{ + # compute gradient as conditional expectation + DES_simul[ n ] = t(spc) %*% Sort_M[ , n ]; +} + +# compute contributions +ContrES_simul = a * t( DES_simul); + +################################################################################################################### +### Analytical +# this does NOT depend on the allocation... +ES_standardized = 1 / ( 1 - c ) * integrate(qt, lower=10^(-8) ,upper=(1-c), df=7)$value; + +# ...the dependence on the allocation is analytical +ES_an = t( Mu ) %*% a + ES_standardized * sqrt(t(a) %*% Sigma %*% a); +DES_an = Mu + ES_standardized * Sigma %*% a / sqrt( t(a) %*% Sigma %*% a)[1]; +ContrES_an = a * DES_an; + +################################################################################################################### +### Plots +dev.new(); +par( mfrow = c( 2, 1 ) ); +bar = barplot(t(ContrES_an), main = "contributions to ES, analytical" ); +axis( 1 , at = bar, labels= 1:length(ContrES_an[,1])); + +bar = barplot(t(ContrES_simul), main = "contributions to ES, simulations" ); +axis( 1 , at = bar, labels= 1:length(ContrES_simul[,1])); \ No newline at end of file Added: pkg/Meucci/demo/S_InvestorsObjective.R =================================================================== --- pkg/Meucci/demo/S_InvestorsObjective.R (rev 0) +++ pkg/Meucci/demo/S_InvestorsObjective.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,79 @@ +library(mvtnorm); +#' This script familiarizes the users with the objectives of different investors in a highly +#' non-normal bi-variate market of securities, as described in A. Meucci,"Risk and Asset +#' Allocation",Springer, 2005, Chapter 5. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_InvestorsObjective.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Parameters of first marginal +nu_1 = 3; +s2_1 = 3; + +# parameters of second marginal +mu_2 = 0.1; +s2_2 = 0.2; + +# correlation in normal copula +r = 0.5; + +# number of simulations +J = 10000; + +# portfolio allocation +a = matrix(c( 1, 2 )); + +# benchmark allocation +b = matrix( c( 2, 1 )); + +################################################################################################################## +### Compute current prices +p_1 = nu_1 * s2_1; +p_2 = exp( mu_2 + 0.5 * s2_2 ^ 2 ); +p = matrix( c( p_1, p_2 )); + +################################################################################################################## +### Generate samnple of prices at the investment horizon +N = rmvnorm(J, cbind( 0, 0 ), rbind( c(1, r), c(r, 1))); +N_1 = N[ , 1 ]; +N_2 = N[ , 2 ]; + +U_1 = pnorm( N_1 ); +U_2 = pnorm( N_2 ); + +aa = nu_1 / 2; +bb = 2 * s2_1; +P_1 = qgamma( U_1, aa, scale = bb); +P_2 = qlnorm( U_2, mu_2, sqrt(s2_2)); + +P = cbind( P_1, P_2 ); + +# generate sample of final wealth +W = P %*% a; + +# generate sample of PnL +PnL = (P - matrix( 1, J, 1) %*% t( p )) %*% a; + +# generate sample of benchmark-relative wealth +K = diag(1, 2) - p %*% t(b) / (t(b) %*% p)[1]; +WRel = P %*% t(K) %*% a; + +################################################################################################################## +### Plots +NumBins = round(10 * log(J)); +dev.new(); +plot(P_1, P_2, xlab = "P_1", ylab = "P_2" ); + +dev.new() +hist(W, NumBins, main = "final wealth"); + +dev.new(); +hist(PnL, NumBins, main = "P&L"); + +dev.new(); +hist(WRel, NumBins, main = "benchmark-relative wealth" ); + Added: pkg/Meucci/demo/S_UtilityMax.R =================================================================== --- pkg/Meucci/demo/S_UtilityMax.R (rev 0) +++ pkg/Meucci/demo/S_UtilityMax.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,101 @@ +#' This script illustrates the constant weight dynamic strategy that maximizes power utility, as described in +#' A. Meucci,"Risk and Asset Allocation", Springer, 2005, Chapter 6. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_UtilityMax.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Input parameters +Initial_Investment = 1000; +Time_Horizon = 6/12; # in years +Time_Step = 1/252; # in years + +m = 0.2; # yearly expected return on the underlying +s = 0.40; # yearly expected percentage volatility on the stock index +r = 0.04; # risk-free (money market) interest rate + +nSim = 30000; + +# amount to be invested in the underlying? e.g.: 50 +Prct = 50 ; + +################################################################################################################## +### Initialize values +Underlying_Index = Initial_Investment; # value of the underlyting at starting time, normalzed to equal investment +Start = Underlying_Index; +Elapsed_Time = 0; +Portfolio_Value = Initial_Investment; + +Underlying_in_Portfolio_Percent = Prct / 100; + +Underlyings_in_Portfolio = Portfolio_Value * Underlying_in_Portfolio_Percent; +Cash_in_Portfolio = Portfolio_Value - Underlyings_in_Portfolio; + +################################################################################################################## +### Initialize parameters for the plot (no theory in this) +Portfolio_Series = Portfolio_Value; +Market_Series = Underlying_Index; +Percentage_Series = Underlying_in_Portfolio_Percent; + +# asset evolution and portfolio rebalancing +while( Elapsed_Time < (Time_Horizon - 10^(-5)) ) # add this term to avoid errors +{ + # time elapses... + Elapsed_Time = Elapsed_Time + Time_Step; + + # ...asset prices evolve and portfolio takes on new value... + Multiplicator = exp( (m - s ^ 2 / 2) * Time_Step + s * sqrt( Time_Step ) * rnorm( NumSimul )); + Underlying_Index = Underlying_Index * Multiplicator; + Underlyings_in_Portfolio = Underlyings_in_Portfolio * Multiplicator; + Cash_in_Portfolio = Cash_in_Portfolio * exp(r * Time_Step); + Portfolio_Value = Underlyings_in_Portfolio + Cash_in_Portfolio; + + # ...and we rebalance our portfolio + #Underlying_in_Portfolio_Percent = Underlying_in_Portfolio_Percent; + Underlyings_in_Portfolio = Portfolio_Value * Underlying_in_Portfolio_Percent; + Cash_in_Portfolio = Portfolio_Value - Underlyings_in_Portfolio; + + # store one path for the movie (no theory in this) + Portfolio_Series = cbind( Portfolio_Series, Portfolio_Value[ 1 ] ); ##ok<*AGROW> + Market_Series = cbind( Market_Series, Underlying_Index[ 1 ] ); + Percentage_Series = cbind( Percentage_Series, Underlying_in_Portfolio_Percent[ 1 ] ); +} + +################################################################################################################## +### Play the movie for one path + +Time = seq( 0, Time_Horizon, Time_Step); +y_max = max( cbind( Portfolio_Series, Market_Series) ) * 1.2; +dev.new(); +par( mfrow = c(2,1)) +for( i in 1 : length(Time) ) +{ + plot( Time[ 1:i ], Portfolio_Series[ 1:i ], type ="l", lwd = 2.5, col = "blue", ylab = "value", + xlim = c(0, Time_Horizon), ylim = c(0, y_max), main = "investment (blue) vs underlying (red) value"); + lines( Time[ 1:i ], Market_Series[ 1:i ], lwd = 2, col = "red" ); + #axis( 1, [0, Time_Horizon, 0, y_max]); + + plot(Time[ 1:i ], Percentage_Series[ 1:i ], type = "h", col = "red", xlab = "time", ylab = "#", + xlim = c(0, Time_Horizon), ylim =c(0,1), main = "percentage of underlying in portfolio"); + +} + +################################################################################################################## +### Plots +# plot the scatterplot +dev.new(); + +# marginals +NumBins = round(10 * log(NumSimul)); +layout( matrix(c(1,2,2,2,1,2,2,2,1,2,2,2,0,3,3,3), 4, 4, byrow = TRUE)); +barplot( table( cut( Portfolio_Value, NumBins )), horiz=TRUE, yaxt="n"); + +# joint scatter plot +plot(Underlying_Index, Portfolio_Value, xlab = "underlying at horizon (~ buy & hold )", ylab = "investment at horizon" ); +so = sort( Underlying_Index ); +lines( so, so, col = "red" ); + +barplot( table( cut( Underlying_Index, NumBins )), yaxt="n"); \ No newline at end of file Added: pkg/Meucci/demo/S_VaRContributionsUniform.R =================================================================== --- pkg/Meucci/demo/S_VaRContributionsUniform.R (rev 0) +++ pkg/Meucci/demo/S_VaRContributionsUniform.R 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,76 @@ + +#' This script computes the VaR and the contributions to VaR from each security +#' - analytically, under the elliptical-uniform assumption for the market +#' - in simulations, using the conditional expectation definition of the contributions +#' Described in A. Meucci,"Risk and Asset +#' Allocation",Springer, 2005, Chapter 5. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_VaRContributionsUniform.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################### +### Inputs +# number of assets +N = 10; + +# market parameters (uniform on ellipsoid) +Mu = matrix(runif(N)); +A = matrix( runif(N*N), N, N) - 0.5; +Sigma = A * t(A); + +# allocation +a = matrix( runif(N) ) - 0.5; + +# quantile level +c = 0.95; + +nSim = 10000; + +################################################################################################################### +### Generate market scenarios +X = GenerateUniformDrawsOnUnitSphere(nSim, N); # uniform on sphere +M = matrix( 1, nSim, 1) %*% t(Mu) + X %*% t(A); + +################################################################################################################### +### Compute contributions by simulations (brute-force approach) +# compute and sort the objective +Psi = M %*% a; +Q_sim = quantile( Psi, (1 - c) ); + +e = mean( abs( a )) / 100; # perturbation +DQ_simul = matrix( NaN, 1, N) ; +for( n in 1 : N ) +{ + # compute gradient + a_e = a; + a_e[ n ] = a[ n ] + e; + + Psi_e = M %*% a_e; + Q_sim_e = quantile(Psi_e, (1 - c) ); + DQ_simul[ n ] = ( Q_sim_e - Q_sim )/e; +} +# compute contributions +ContrQ_simul = a * t( DQ_simul ); + +################################################################################################################### +### Compute contributions analytically +# compute quantile of standardized marginal (1-dim generator) in simulations this does NOT depend on the allocation... +gc = quantile(X[ ,1 ], (1 - c)); + +# ...the dependence on the allocation is analytical +Q_an = t(Mu) %*% a + gc * sqrt( t(a) %*% Sigma %*% a ); +DQ_an = Mu + gc * Sigma %*% a / sqrt( t(a) %*% Sigma %*% a )[1]; +ContrQ_an = a * DQ_an; + +################################################################################################################### +# plots +dev.new(); +par( mfrow = c(2,1) ); +bar = barplot( t(ContrQ_an), xlim = c(0, N+1), main = "contributions to VaR, analytical" ); +axis( 1 , at = bar, labels= 1:(N+1)); + +bar = barplot( t(ContrQ_simul), xlim = c(0, N+1), main = "contributions to VaR, simulations" ); +axis( 1 , at = bar, labels= 1:(N+1)); Added: pkg/Meucci/man/GenerateUniformDrawsOnUnitSphere.Rd =================================================================== --- pkg/Meucci/man/GenerateUniformDrawsOnUnitSphere.Rd (rev 0) +++ pkg/Meucci/man/GenerateUniformDrawsOnUnitSphere.Rd 2013-07-16 15:31:33 UTC (rev 2582) @@ -0,0 +1,33 @@ +\name{GenerateUniformDrawsOnUnitSphere} +\alias{GenerateUniformDrawsOnUnitSphere} +\title{Generate a uniform sample on the unit hypersphere, as described in A. Meucci, + "Risk and Asset Allocation", Springer, 2005.} +\usage{ + GenerateUniformDrawsOnUnitSphere(J, N) +} +\arguments{ + \item{J}{: [scalar] number of draws} + + \item{N}{: [scalar] dimension} +} +\value{ + X : [matrix] (T x N) of draws +} +\description{ + Generate a uniform sample on the unit hypersphere, as + described in A. Meucci, "Risk and Asset Allocation", + Springer, 2005. +} +\note{ + \item{ Initial script by Xiaoyu Wang - Dec 2006} \item{ + We decompose X=U*R, where U is a uniform distribution on + unit sphere and +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "GenerateUniformDrawsOnUnitSphere.m" +} + From noreply at r-forge.r-project.org Wed Jul 17 03:37:23 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 03:37:23 +0200 (CEST) Subject: [Returnanalytics-commits] r2583 - in pkg/PortfolioAnalytics: R man Message-ID: <20130717013723.76A551851DC@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-17 03:37:21 +0200 (Wed, 17 Jul 2013) New Revision: 2583 Modified: pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/man/get_constraints.Rd Log: modifying get_constraints function to set appropriate defaults if leverage or box constraints are not specified. Default to min_sum=1 and min_sum=1 if leverage constraints are not specified. Default to min=-Inf and max=Inf if box constraints are not specified. Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-16 15:31:33 UTC (rev 2582) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-17 01:37:21 UTC (rev 2583) @@ -491,8 +491,10 @@ #' min_sum, max_sum, min, and max are either specified by the user or default #' values are assigned. These are required by other functions such as #' optimize.portfolio and constrained . This function will check that these -#' variables are in the portfolio object in the constraints list. This -#' function could be used at the beginning of optimize.portfolio or other +#' variables are in the portfolio object in the constraints list. We will +#' default to min_sum=1 and max_sum=1 if leverage constraints are not specified. +#' We will default to min=-Inf and max=Inf if box constraints are not specified. +#' This function is used at the beginning of optimize.portfolio and other #' functions to extract the constraints from the portfolio object. Uses the #' same naming as the v1_constraint object which may be useful when passed #' to other functions. @@ -544,12 +546,19 @@ # min_sum, max_sum, min, and max are required to be passed in and enabled if(is.na(out$min_sum) | is.na(out$max_sum)) { # return(NULL) - stop("Leverage constraint min_sum and max_sum are not enabled or passed in") + # stop("Leverage constraint min_sum and max_sum are not enabled or passed in") + # Default to full investment constraint + out$min_sum <- 1 + out$max_sum <- 1 } if(length(out$min) == 1 | length(out$max) == 1) { if(is.na(out$min) | is.na(out$max)){ # return(NULL) - stop("Box constraints min and max are not enabled or passed in") + # stop("Box constraints min and max are not enabled or passed in") + # Default to min=-Inf and max=Inf for unconstrained weights + nassets <- length(portfolio$assets) + out$min <- rep(-Inf, nassets) + out$max <- rep(Inf, nassets) } } # structure and return class of type constraint Modified: pkg/PortfolioAnalytics/man/get_constraints.Rd =================================================================== --- pkg/PortfolioAnalytics/man/get_constraints.Rd 2013-07-16 15:31:33 UTC (rev 2582) +++ pkg/PortfolioAnalytics/man/get_constraints.Rd 2013-07-17 01:37:21 UTC (rev 2583) @@ -18,8 +18,11 @@ assigned. These are required by other functions such as optimize.portfolio and constrained . This function will check that these variables are in the portfolio object in - the constraints list. This function could be used at the - beginning of optimize.portfolio or other functions to + the constraints list. We will default to min_sum=1 and + max_sum=1 if leverage constraints are not specified. We + will default to min=-Inf and max=Inf if box constraints + are not specified. This function is used at the + beginning of optimize.portfolio and other functions to extract the constraints from the portfolio object. Uses the same naming as the v1_constraint object which may be useful when passed to other functions. From noreply at r-forge.r-project.org Wed Jul 17 05:15:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 05:15:22 +0200 (CEST) Subject: [Returnanalytics-commits] r2584 - in pkg/PortfolioAnalytics: R man Message-ID: <20130717031522.A354118121A@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-17 05:15:21 +0200 (Wed, 17 Jul 2013) New Revision: 2584 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/group_fail.Rd Log: modifying group_fail to check for number of non-zero weights per group Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-17 01:37:21 UTC (rev 2583) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-17 03:15:21 UTC (rev 2584) @@ -465,13 +465,19 @@ #' @param groups vector specifying the groups of the assets #' @param cLO numeric or vector specifying minimum weight group constraints #' @param cUP numeric or vector specifying minimum weight group constraints +#' @param group_pos vector specifying the number of non-zero weights per group #' @return logical vector: TRUE if group constraints are violated for a given group #' @author Ross Bennett #' @export -group_fail <- function(weights, groups, cLO, cUP){ +group_fail <- function(weights, groups, cLO, cUP, group_pos=NULL){ # return FALSE if groups, cLO, or cUP is NULL if(is.null(groups) | is.null(cLO) | is.null(cUP)) return(FALSE) + # group_pos sets a limit on the number of non-zero weights by group + # Set equal to groups if NULL + if(is.null(group_pos)) group_pos <- groups + tolerance <- .Machine$double.eps^0.5 + n.groups <- length(groups) group_fail <- vector(mode="logical", length=n.groups) k <- 1 @@ -481,8 +487,9 @@ tmp.w <- weights[k:(l+j)] grp.min <- cLO[i] grp.max <- cUP[i] + grp.pos <- group_pos[i] # return TRUE if grp.min or grp.max is violated - group_fail[i] <- ( sum(tmp.w) < grp.min | sum(tmp.w) > grp.max ) + group_fail[i] <- ( sum(tmp.w) < grp.min | sum(tmp.w) > grp.max (sum(abs(tmp.w) > tolerance) > grp.pos)) k <- k + j l <- k - 1 } Modified: pkg/PortfolioAnalytics/man/group_fail.Rd =================================================================== --- pkg/PortfolioAnalytics/man/group_fail.Rd 2013-07-17 01:37:21 UTC (rev 2583) +++ pkg/PortfolioAnalytics/man/group_fail.Rd 2013-07-17 03:15:21 UTC (rev 2584) @@ -2,7 +2,7 @@ \alias{group_fail} \title{Test if group constraints have been violated} \usage{ - group_fail(weights, groups, cLO, cUP) + group_fail(weights, groups, cLO, cUP, group_pos = NULL) } \arguments{ \item{weights}{weights vector to test} @@ -14,6 +14,9 @@ \item{cUP}{numeric or vector specifying minimum weight group constraints} + + \item{group_pos}{vector specifying the number of non-zero + weights per group} } \value{ logical vector: TRUE if group constraints are violated From noreply at r-forge.r-project.org Wed Jul 17 05:31:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 05:31:11 +0200 (CEST) Subject: [Returnanalytics-commits] r2585 - in pkg/PortfolioAnalytics: R man Message-ID: <20130717033111.A12C018121A@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-17 05:31:11 +0200 (Wed, 17 Jul 2013) New Revision: 2585 Modified: pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/man/group_constraint.Rd Log: adding support for position limits per group to group_constraint constructor Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-17 03:15:21 UTC (rev 2584) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-17 03:31:11 UTC (rev 2585) @@ -382,6 +382,7 @@ #' @param group_labels character vector to label the groups (e.g. size, asset class, style, etc.) #' @param group_min numeric or vector specifying minimum weight group constraints #' @param group_max numeric or vector specifying minimum weight group constraints +#' @param group_pos vector specifying the number of non-zero weights per group #' @param enabled TRUE/FALSE #' @param \dots any other passthru parameters to specify group constraints #' @author Ross Bennett @@ -399,7 +400,7 @@ #' group_min=c(0.15, 0.25), #' group_max=c(0.65, 0.55)) #' @export -group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, enabled=TRUE, ...) { +group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, group_pos=NULL, enabled=TRUE, ...) { nassets <- length(assets) ngroups <- length(groups) @@ -428,11 +429,24 @@ if(length(group_labels) != length(groups)) stop("length of group_labels must be equal to the length of groups") + # Construct group_pos vector + if(!is.null(group_pos)){ + # Check the length of the group_pos vector + if(length(group_poss) != length(groups)) stop("length of group_pos must be equal to the length of groups") + # Check for negative values in group_pos + if(any(group_pos < 0)) stop("all elements of group_pos must be positive") + # Elements of group_pos cannot be greater than groups + if(any(group_pos > groups)){ + group_pos <- pmin(group_pos, groups) + } + } + Constraint <- constraint_v2(type, enabled=enabled, constrclass="group_constraint", ...) Constraint$groups <- groups Constraint$group_labels <- group_labels Constraint$cLO <- group_min Constraint$cUP <- group_max + Constraint$group_pos <- group_pos return(Constraint) } Modified: pkg/PortfolioAnalytics/man/group_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-17 03:15:21 UTC (rev 2584) +++ pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-17 03:31:11 UTC (rev 2585) @@ -4,7 +4,7 @@ \usage{ group_constraint(type, assets, groups, group_labels = NULL, group_min, group_max, - enabled = TRUE, ...) + group_pos = NULL, enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} @@ -23,6 +23,9 @@ \item{group_max}{numeric or vector specifying minimum weight group constraints} + \item{group_pos}{vector specifying the number of non-zero + weights per group} + \item{enabled}{TRUE/FALSE} \item{\dots}{any other passthru parameters to specify From noreply at r-forge.r-project.org Wed Jul 17 11:40:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 11:40:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2586 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: . Week5 Week5/Code Message-ID: <20130717094059.82F881848B1@r-forge.r-project.org> Author: shubhanm Date: 2013-07-17 11:40:59 +0200 (Wed, 17 Jul 2013) New Revision: 2586 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R Log: Alternative Conditional Drawdown at Risk (Chekhlov, Uryasev and Zabarankin (2003)) Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R 2013-07-17 09:40:59 UTC (rev 2586) @@ -0,0 +1,33 @@ +CDrawdown <- + function (R,p=0.95, ...) + { + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + for(column in 1:columns) { + x = y[,column] + drawdown = findDrawdowns(x) + threshold= ES(x,p)[1] + total = length(drawdown$return) + num = length(drawdown$return[drawdown$return>threshold]) + cva1= (((num/total)-p)/(1-p))*threshold + cva2=sum(drawdown$return)/((1-p)*total) + z = c((cva1+cva2)) + znames = c("Conditional Drawdown at Risk") + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + + } + colnames(resultingtable) = columnnames + #ans = base::round(resultingtable, digits) + #ans + resultingtable + } \ No newline at end of file From noreply at r-forge.r-project.org Wed Jul 17 13:49:19 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 13:49:19 +0200 (CEST) Subject: [Returnanalytics-commits] r2587 - in pkg/PortfolioAnalytics: R man Message-ID: <20130717114919.1E50518074F@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-17 13:49:18 +0200 (Wed, 17 Jul 2013) New Revision: 2587 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/rp_transform.Rd Log: modifying rp_transform and fn_map to take group_pos Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-17 09:40:59 UTC (rev 2586) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-17 11:49:18 UTC (rev 2587) @@ -54,6 +54,7 @@ groups <- constraints$groups cLO <- constraints$cLO cUP <- constraints$cUP + group_pos <- constraints$group_pos div_target <- constraints$div_target turnover_target <- constraints$turnover_target max_pos <- constraints$max_pos @@ -77,7 +78,7 @@ if(!is.null(min_sum) & !is.null(max_sum)){ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ # Try to transform only considering leverage and box constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -89,7 +90,7 @@ if(!is.null(tmp_min) & !is.null(tmp_max)){ if(!(all(tmp_weights >= tmp_min) & all(tmp_weights <= tmp_max))){ # Try to transform only considering leverage and box constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -111,7 +112,7 @@ } # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos, 500), silent=TRUE) # Default to original weights if this fails again if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 @@ -130,9 +131,9 @@ # check group constraints if(!is.null(groups) & !is.null(tmp_cLO) & !is.null(tmp_cUP)){ - if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))){ + if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP, group_pos))){ # Try to transform only considering leverage, box, and group constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -141,8 +142,8 @@ i <- 1 # loop while constraints are violated and relax constraints # Try to relax constraints up to 5 times - while(((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum) | (any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) | any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))) & i <= 5){ - if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP))){ + while(((sum(tmp_weights) < min_sum | sum(tmp_weights) > max_sum) | (any(tmp_weights < tmp_min) | any(tmp_weights > tmp_max)) | any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP, group_pos))) & i <= 5){ + if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP, group_pos))){ # I know which group failed, but not if it was cUP or cLO that was violated # Maybe I can modify group_fail to report back what was violated and only relax cLO or cUP, not both # This relaxes both cLO and cUP @@ -150,7 +151,7 @@ tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + runif(1, 0.01, 0.05) } # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -170,7 +171,7 @@ if(!is.null(tmp_max_pos)){ if(!(sum(abs(tmp_weights) > tolerance) <= tmp_max_pos)){ # Try to transform only considering leverage, box, group, and position_limit constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -180,7 +181,7 @@ # increment tmp_max_pos by 1 tmp_max_pos <- tmp_max_pos + 1 # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=TRUE) if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -321,11 +322,12 @@ #' @param cLO numeric or vector specifying minimum weight group constraints #' @param cUP numeric or vector specifying minimum weight group constraints #' @param max_pos maximum assets with non-zero weights +#' @param group_pos vector specifying maximum number assets with non-zero weights per group #' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200 #' @return named weighting vector #' @author Peter Carl, Brian G. Peterson, Ross Bennett (based on an idea by Pat Burns) #' @export -rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_pos=NULL, max_permutations=200){ +rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_pos=NULL, group_pos=NULL, max_permutations=200){ # Uses logic from randomize_portfolio to "normalize" a weights vector to # satisfy min_sum and max_sum while accounting for box and group constraints # Modified from randomize_portfolio to trigger the while loops if any weights @@ -336,6 +338,9 @@ tolerance=.Machine$double.eps^0.5 if(is.null(max_pos)) max_pos <- length(w) + if(!is.null(group_pos)) max_group_pos <- sum(group_pos) + max_assets <- min(max_pos, max_group_pos) + # Create a temporary min vector that will be modified, because a feasible # portfolio is rarely created if all(min > 0). This is due to the while # loop that checks any(tmp_w < min). @@ -354,7 +359,7 @@ # return w if all constraints are satisfied if((sum(w) >= min_sum & sum(w) <= max_sum) & (all(w >= tmp_min) & all(w <= max)) & - (all(!group_fail(w, groups, cLO, cUP))) & + (all(!group_fail(w, groups, cLO, cUP, group_pos))) & (sum(abs(w) > tolerance) <= max_pos)){ return(w) } @@ -362,7 +367,7 @@ # generate a sequence of weights based on min/max box constraints weight_seq <- generatesequence(min=min(min), max=max(max), by=0.005) # make sure there is a 0 in weight_seq - if(!is.null(max_pos) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq) + if((!is.null(max_pos) | !is.null(group_pos)) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq) # start the permutations counter permutations <- 1 @@ -371,7 +376,7 @@ tmp_w <- w # while portfolio is outside min_sum/max_sum or tmp_min/max or group or postion_limit constraints and we have not reached max_permutations - while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP)) | (sum(abs(tmp_w) > tolerance) > max_pos)) & permutations <= max_permutations) { + while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) | (sum(abs(tmp_w) > tolerance) > max_pos)) & permutations <= max_permutations) { permutations = permutations + 1 # check our box constraints on total portfolio weight # reduce(increase) total portfolio size till you get a match @@ -383,7 +388,7 @@ tmp_w <- w tmp_min <- min - random_index <- sample(1:length(tmp_w), max_pos) + random_index <- sample(1:length(tmp_w), max_assets) # Get the index values that are not in random_index and set them equal to 0 full_index <- 1:length(tmp_w) @@ -396,7 +401,7 @@ i = 1 # while sum of weights is less than min_sum or tmp_min/max box or group constraint is violated - while ((sum(tmp_w) <= min_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { + while ((sum(tmp_w) <= min_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos))) & i <= length(tmp_w)) { # randomly permute and increase a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -415,7 +420,7 @@ # group_fail does not test for direction of violation, just that group constraints were violated i = 1 # while sum of weights is greater than max_sum or tmp_min/max box or group constraint is violated - while ((sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP))) & i <= length(tmp_w)) { + while ((sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos))) & i <= length(tmp_w)) { # randomly permute and decrease a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -489,7 +494,7 @@ grp.max <- cUP[i] grp.pos <- group_pos[i] # return TRUE if grp.min or grp.max is violated - group_fail[i] <- ( sum(tmp.w) < grp.min | sum(tmp.w) > grp.max (sum(abs(tmp.w) > tolerance) > grp.pos)) + group_fail[i] <- ( sum(tmp.w) < grp.min | sum(tmp.w) > grp.max | (sum(abs(tmp.w) > tolerance) > grp.pos)) k <- k + j l <- k - 1 } Modified: pkg/PortfolioAnalytics/man/rp_transform.Rd =================================================================== --- pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-17 09:40:59 UTC (rev 2586) +++ pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-17 11:49:18 UTC (rev 2587) @@ -3,7 +3,7 @@ \title{Transform a weights vector to satisfy leverage, box, group, and position_limit constraints using logic from \code{randomize_portfolio}} \usage{ rp_transform(w, min_sum = 0.99, max_sum = 1.01, min, max, - groups, cLO, cUP, max_pos = NULL, + groups, cLO, cUP, max_pos = NULL, group_pos = NULL, max_permutations = 200) } \arguments{ @@ -31,6 +31,9 @@ \item{max_pos}{maximum assets with non-zero weights} + \item{group_pos}{vector specifying maximum number assets + with non-zero weights per group} + \item{max_permutations}{integer: maximum number of iterations to try for a valid portfolio, default 200} } From noreply at r-forge.r-project.org Wed Jul 17 14:18:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 14:18:00 +0200 (CEST) Subject: [Returnanalytics-commits] r2588 - in pkg/PortfolioAnalytics: R sandbox Message-ID: <20130717121800.56CF3184F3C@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-17 14:17:59 +0200 (Wed, 17 Jul 2013) New Revision: 2588 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R Log: added group_pos to testing and corrected bug in rp_transform Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-17 11:49:18 UTC (rev 2587) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-17 12:17:59 UTC (rev 2588) @@ -78,7 +78,7 @@ if(!is.null(min_sum) & !is.null(max_sum)){ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ # Try to transform only considering leverage and box constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -90,7 +90,7 @@ if(!is.null(tmp_min) & !is.null(tmp_max)){ if(!(all(tmp_weights >= tmp_min) & all(tmp_weights <= tmp_max))){ # Try to transform only considering leverage and box constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -112,7 +112,7 @@ } # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing # Default to original weights if this fails again if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 @@ -133,7 +133,7 @@ if(!is.null(groups) & !is.null(tmp_cLO) & !is.null(tmp_cUP)){ if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP, group_pos))){ # Try to transform only considering leverage, box, and group constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -151,7 +151,7 @@ tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + runif(1, 0.01, 0.05) } # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -171,7 +171,7 @@ if(!is.null(tmp_max_pos)){ if(!(sum(abs(tmp_weights) > tolerance) <= tmp_max_pos)){ # Try to transform only considering leverage, box, group, and position_limit constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -181,7 +181,7 @@ # increment tmp_max_pos by 1 tmp_max_pos <- tmp_max_pos + 1 # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=TRUE) + tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -338,7 +338,11 @@ tolerance=.Machine$double.eps^0.5 if(is.null(max_pos)) max_pos <- length(w) - if(!is.null(group_pos)) max_group_pos <- sum(group_pos) + if(!is.null(group_pos)) { + max_group_pos <- sum(group_pos) + } else { + max_group_pos <- length(w) + } max_assets <- min(max_pos, max_group_pos) # Create a temporary min vector that will be modified, because a feasible Modified: pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R 2013-07-17 11:49:18 UTC (rev 2587) +++ pkg/PortfolioAnalytics/sandbox/testing_rp_transform.R 2013-07-17 12:17:59 UTC (rev 2588) @@ -8,6 +8,7 @@ sum(weights) groups <- c(2, 1) +group_pos <- c(1, 1) cLO <- c(0.1, 0.10) cUP <- c(0.45, 0.8) min_sum <- 0.99 @@ -15,11 +16,11 @@ min <- rep(0.05, length(weights)) max <- rep(0.65, length(weights)) -group_fail(weights, groups, cLO, cUP) +group_fail(weights, groups, cLO, cUP, group_pos) -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 2, 200) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 2, group_pos, 200) w -group_fail(w, groups, cLO, cUP) +group_fail(w, groups, cLO, cUP, group_pos) ##### EX2 ##### # The assets are grouped into 3 groups of 2 @@ -32,6 +33,7 @@ sum(weights) groups <- c(2, 2, 2) +group_pos <- c(2, 2, 1) cLO <- c(0.05, 0.10, 0.05) cUP <- c(0.4, 0.45, 0.35) min_sum <- 0.99 @@ -40,17 +42,17 @@ max <- rep(0.65, length(weights)) -group_fail(weights, groups, cLO, cUP) +group_fail(weights, groups, cLO, cUP, group_pos) # groups and max_pos are NULL and box and leverage constraints are satisfied so this should # just return the original weights vector -w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, max_pos=NULL, 500) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups=NULL, cLO, cUP, max_pos=NULL, group_pos, 500) w # The first group exceeds cUP so the weights vector should be modified -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 4, 1000) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, max_pos=NULL, group_pos, 1000) w -group_fail(w, groups, cLO, cUP) +group_fail(w, groups, cLO, cUP, group_pos) ##### Ex3 ##### # The second group is below cLO and the third weight is below min @@ -58,6 +60,7 @@ sum(weights) groups <- c(2, 1, 3) +group_pos <- c(1, 1, 3) cLO <- c(0.05, 0.10, 0.05) cUP <- c(0.4, 0.45, 0.65) min_sum <- 0.99 @@ -66,11 +69,11 @@ max <- rep(0.65, length(weights)) -group_fail(weights, groups, cLO, cUP) +group_fail(weights, groups, cLO, cUP, group_pos) -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 5, 500) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 5, group_pos, 500) w -group_fail(w, groups, cLO, cUP) +group_fail(w, groups, cLO, cUP, group_pos) ##### Ex4 ##### # The second group is above cUP and the fourth group is below cLO @@ -82,6 +85,7 @@ sum(weights) groups <- c(2, 4, 3, 2) +group_pos <- c(2, 3, 2, 2) cLO <- c(0.05, 0.10, 0.05, 0.08) cUP <- c(0.4, 0.55, 0.65, 0.45) min_sum <- 0.99 @@ -89,9 +93,10 @@ min <- rep(0.05, length(weights)) max <- rep(0.65, length(weights)) -group_fail(weights, groups, cLO, cUP) +group_fail(weights, groups, cLO, cUP, group_pos) # Note that this was typically not working with max_permutations=200 # Relax constraints or increase max_permutations -w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 7, 1000) +w <- rp_transform(weights, min_sum, max_sum, min, max, groups, cLO, cUP, 7, group_pos, 500) w +group_fail(w, groups, cLO, cUP, group_pos) \ No newline at end of file From noreply at r-forge.r-project.org Wed Jul 17 20:30:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 17 Jul 2013 20:30:39 +0200 (CEST) Subject: [Returnanalytics-commits] r2589 - pkg/FactorAnalytics/R Message-ID: <20130717183040.0722718460E@r-forge.r-project.org> Author: chenyian Date: 2013-07-17 20:30:39 +0200 (Wed, 17 Jul 2013) New Revision: 2589 Modified: pkg/FactorAnalytics/R/factorModelCovariance.r pkg/FactorAnalytics/R/fitFundamentalFactorModel.R Log: 1. modify Rd. file of fitFundamentalFactorModel.R 2. add function that factorModelCovariance.r can take fitFundamentalFactorModel.R Modified: pkg/FactorAnalytics/R/factorModelCovariance.r =================================================================== --- pkg/FactorAnalytics/R/factorModelCovariance.r 2013-07-17 12:17:59 UTC (rev 2588) +++ pkg/FactorAnalytics/R/factorModelCovariance.r 2013-07-17 18:30:39 UTC (rev 2589) @@ -45,6 +45,30 @@ #' 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") +#' test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, +#' datevar = "DATE", returnsvar = "RETURN", +#' assetvar = "TICKER", wls = TRUE, +#' regression = "classic", +#' covariance = "classic", full.resid.cov = FALSE, +#' robust.scale = TRUE) +#' +#' # compute return covariance +#' # take beta as latest date input +#' beta.mat.fundm <- subset(data,DATE == "2003-12-31")[,exposure.names] +#' beta.mat.fundm <- cbind(rep(1,447),beta.mat.fundm) # add intercept +#' FM return covariance +#' ret.cov.fundm <- factorModelCovariance(beta.mat.fundm,test.fit$factor.cov$cov, +#' test.fit$resid.variance) +#' # the result is exactly the same +#' test.fit$returns.cov$cov == ret.cov.fundm +#' + factorModelCovariance <- function(beta.mat, factor.cov, residVars.vec) { Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-17 12:17:59 UTC (rev 2588) +++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-17 18:30:39 UTC (rev 2589) @@ -37,11 +37,12 @@ #' the data. #' @return an S3 object containing #' \itemize{ -#' \item cov.returns A "list" object contains covariance information for -#' asset returns, includes covariance, mean and eigenvalus. -#' \item cov.factor Anobject of class "cov" or "covRob" which +#' \item returns.cov A "list" object contains covariance information for +#' asset returns, includes covariance, mean and eigenvalus. Beta of taken as latest +#' date input. +#' \item factor.cov An object of class "cov" or "covRob" which #' contains the covariance matrix of the factor returns (including intercept). -#' \item cov.resids An object of class "cov" or "covRob" which contains +#' \item resids.cov An object of class "cov" or "covRob" which contains #' the covariance matrix of the residuals, if "full.resid.cov" is TRUE. NULL #' if "full.resid.cov" is FALSE. #' \item resid.variance A vector of variances estimated from the OLS @@ -72,10 +73,10 @@ #' robust.scale = TRUE) #' #' names(test.fit) -#' test.fit$cov.returns -#' test.fit$cov.resids +#' test.fit$returns.cov +#' test.fit$resids.cov #' names(test.fit$cov.factor) -#' test.fit$cov.factor$cov +#' test.fit$factor.cov$cov #' test.fit$factor #' test.fit$resid.variance #' test.fit$resids @@ -401,9 +402,9 @@ else { Cov.resids <- NULL } - output <- list(cov.returns = Cov.returns, - cov.factor = Cov.factors, - cov.resids = Cov.resids, + output <- list(returns.cov = Cov.returns, + factor.cov = Cov.factors, + resids.cov = Cov.resids, resid.variance = resid.vars, factors = f.hat, residuals = resids, @@ -412,5 +413,4 @@ data = data) class(output) <- "FundamentalFactorModel" return(output) -} - +} \ No newline at end of file From noreply at r-forge.r-project.org Thu Jul 18 02:23:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 18 Jul 2013 02:23:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2590 - pkg/PortfolioAnalytics/R Message-ID: <20130718002359.986EA180FC5@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-18 02:23:59 +0200 (Thu, 18 Jul 2013) New Revision: 2590 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: modifying constraints to support additional cardinality constraints Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-17 18:30:39 UTC (rev 2589) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-18 00:23:59 UTC (rev 2590) @@ -243,7 +243,8 @@ ...=...) }, # Position limit constraint - position_limit = {tmp_constraint <- position_limit_constraint(type=type, + position_limit = {tmp_constraint <- position_limit_constraint(assets=assets, + type=type, enabled=enabled, ...=...) }, @@ -544,6 +545,7 @@ out$group_labels <- constraint$group_labels out$cLO <- constraint$cLO out$cUP <- constraint$cUP + out$group_pos <- constraint$group_pos } if(inherits(constraint, "turnover_constraint")){ out$turnover_target <- constraint$turnover_target @@ -553,6 +555,8 @@ } if(inherits(constraint, "position_limit_constraint")){ out$max_pos <- constraint$max_pos + out$max_pos_long <- constraint$max_pos_long + out$max_pos_short <- constraint$max_pos_short } } } @@ -635,9 +639,11 @@ #' Allows the user to specify the maximum number of positions (i.e. number of assets with non-zero weights) #' #' @param type character type of the constraint -#' @param max_pos maximum number of positions +#' @param max_pos maximum number of assets with non-zero weights +#' @param max_pos_long maximum number of assets with long (i.e. buy) positions +#' @param max_pos_short maximum number of assets with short (i.e. sell) positions #' @param enabled TRUE/FALSE -#' @param \dots any other passthru parameters to specify box and/or group constraints +#' @param \dots any other passthru parameters to specify position limit constraints #' @author Ross Bennett #' #' @examples #' data(edhec) @@ -647,9 +653,49 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3) #' @export -position_limit_constraint <- function(type, max_pos, enabled=TRUE, ...){ +position_limit_constraint <- function(type, assets, max_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, enabled=TRUE, ...){ + # Get the length of the assets vector + nassets <- length(assets) + + # Checks for max_pos + if(!is.null(max_pos)){ + if(length(max_pos != 1)) stop("max_pos must be a scalar value of length 1") + if(max_pos < 0) stop("max_pos must be a positive value") + if(max_pos > nassets){ + message("max_pos must be less than or equal to the number of assets") + max_pos <- nassets + } + # coerce to integer + max_pos <- as.integer(max_pos) + } + + # Checks for max_pos_long + if(!is.null(max_pos_long)){ + if(length(max_pos_long != 1)) stop("max_pos_long must be a scalar value of length 1") + if(max_pos_long < 0) stop("max_pos_long must be a positive value") + if(max_pos_long > nassets){ + message("max_pos_long must be less than or equal to the number of assets") + max_pos_long <- nassets + } + # coerce to integer + max_pos_long <- as.integer(max_pos_long) + } + + # Checks for max_pos_short + if(!is.null(max_pos_short)){ + if(length(max_pos_short != 1)) stop("max_pos_short must be a scalar value of length 1") + if(max_pos_short < 0) stop("max_pos_short must be a positive value") + if(max_pos_short > nassets){ + message("max_pos_short must be less than or equal to the number of assets") + max_pos_short <- nassets + } + # coerce to integer + max_pos_short <- as.integer(max_pos_short) + } Constraint <- constraint_v2(type, enabled=enabled, constrclass="position_limit_constraint", ...) Constraint$max_pos <- max_pos + Constraint$max_pos_long <- max_pos_long + Constraint$max_pos_short <- max_pos_short return(Constraint) } From noreply at r-forge.r-project.org Thu Jul 18 03:45:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 18 Jul 2013 03:45:03 +0200 (CEST) Subject: [Returnanalytics-commits] r2591 - pkg/PortfolioAnalytics/R Message-ID: <20130718014503.5B44218487B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-18 03:45:02 +0200 (Thu, 18 Jul 2013) New Revision: 2591 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: adding pos_limit_fail function to check for violation of position limit constraints Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-18 00:23:59 UTC (rev 2590) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-18 01:45:02 UTC (rev 2591) @@ -506,6 +506,46 @@ return(group_fail) } +#' function to check for violation of position limits constraints +#' +#' This is used as a helper function for \code{\link{rp_transform}} to check +#' for violation of position limit constraints. The position limit constraints +#' checked are max_pos, max_pos_long, and max_pos_short. +#' +#' @param weights vector of weights to test +#' @param max_pos maximum number of assets with non-zero weights +#' @param max_pos_long maximum number of assets with long (i.e. buy) positions +#' @param max_pos_short maximum number of assets with short (i.e. sell) positions +#' @return TRUE if any position_limit is violated. FALSE if all position limits are satisfied +#' @export +pos_limit_fail <- function(weights, max_pos, max_pos_long, max_pos_short){ + # tolerance for "non-zero" definition + tolerance <- .Machine$double.eps^0.5 + + # Check if max_pos is violated + if(!is.null(max_pos)){ + if(sum(abs(weights) > tolerance) > max_pos){ + return(TRUE) + } + } + + # Check if max_pos_long is violated + if(!is.null(max_pos_long)){ + if(sum(weights > tolerance) > max_pos_long){ + return(TRUE) + } + } + + # Check if max_pos_short is violated + if(!is.null(max_pos_short)){ + if(sum(weights < -tolerance) > max_pos_short){ + return(TRUE) + } + } + # Return FALSE if nothing is violated + return(FALSE) +} + # test # w <- c(0.1, 0.25, 0.3, 0.15, 0.05, 0.15) # min <- rep(0.1, length(w)) From noreply at r-forge.r-project.org Thu Jul 18 05:37:21 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 18 Jul 2013 05:37:21 +0200 (CEST) Subject: [Returnanalytics-commits] r2592 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130718033721.BC778184EB5@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-18 05:37:21 +0200 (Thu, 18 Jul 2013) New Revision: 2592 Added: pkg/PortfolioAnalytics/man/pos_limit_fail.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/man/position_limit_constraint.Rd pkg/PortfolioAnalytics/man/rp_transform.Rd Log: modifying rp_transform to support additional position limit constraints Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-18 01:45:02 UTC (rev 2591) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-18 03:37:21 UTC (rev 2592) @@ -43,6 +43,7 @@ export(plot.optimize.portfolio) export(portfolio_risk_objective) export(portfolio.spec) +export(pos_limit_fail) export(position_limit_constraint) export(print.constraint) export(random_portfolios_v2) Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-18 01:45:02 UTC (rev 2591) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-18 03:37:21 UTC (rev 2592) @@ -323,11 +323,13 @@ #' @param cUP numeric or vector specifying minimum weight group constraints #' @param max_pos maximum assets with non-zero weights #' @param group_pos vector specifying maximum number assets with non-zero weights per group +#' @param max_pos_long maximum number of assets with long (i.e. buy) positions +#' @param max_pos_short maximum number of assets with short (i.e. sell) positions #' @param max_permutations integer: maximum number of iterations to try for a valid portfolio, default 200 #' @return named weighting vector #' @author Peter Carl, Brian G. Peterson, Ross Bennett (based on an idea by Pat Burns) #' @export -rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_pos=NULL, group_pos=NULL, max_permutations=200){ +rp_transform <- function(w, min_sum=0.99, max_sum=1.01, min, max, groups, cLO, cUP, max_pos=NULL, group_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, max_permutations=200){ # Uses logic from randomize_portfolio to "normalize" a weights vector to # satisfy min_sum and max_sum while accounting for box and group constraints # Modified from randomize_portfolio to trigger the while loops if any weights @@ -364,14 +366,14 @@ if((sum(w) >= min_sum & sum(w) <= max_sum) & (all(w >= tmp_min) & all(w <= max)) & (all(!group_fail(w, groups, cLO, cUP, group_pos))) & - (sum(abs(w) > tolerance) <= max_pos)){ + !pos_limit_fail(w, max_pos, max_pos_long, max_pos_short)){ return(w) } # generate a sequence of weights based on min/max box constraints - weight_seq <- generatesequence(min=min(min), max=max(max), by=0.005) + weight_seq <- generatesequence(min=min(min), max=max(max), by=0.002) # make sure there is a 0 in weight_seq - if((!is.null(max_pos) | !is.null(group_pos)) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq) + if((!is.null(max_pos) | !is.null(group_pos) | !is.null(max_pos_long) | !is.null(max_pos_short)) & !is.element(0, weight_seq)) weight_seq <- c(0, weight_seq) # start the permutations counter permutations <- 1 @@ -380,7 +382,7 @@ tmp_w <- w # while portfolio is outside min_sum/max_sum or tmp_min/max or group or postion_limit constraints and we have not reached max_permutations - while ((sum(tmp_w) <= min_sum | sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) | (sum(abs(tmp_w) > tolerance) > max_pos)) & permutations <= max_permutations) { + while ((sum(tmp_w) < min_sum | sum(tmp_w) > max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) | (pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short))) & permutations <= max_permutations) { permutations = permutations + 1 # check our box constraints on total portfolio weight # reduce(increase) total portfolio size till you get a match @@ -405,7 +407,7 @@ i = 1 # while sum of weights is less than min_sum or tmp_min/max box or group constraint is violated - while ((sum(tmp_w) <= min_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos))) & i <= length(tmp_w)) { + while ((sum(tmp_w) < min_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) | (pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short))) & i <= length(tmp_w)) { # randomly permute and increase a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -424,7 +426,7 @@ # group_fail does not test for direction of violation, just that group constraints were violated i = 1 # while sum of weights is greater than max_sum or tmp_min/max box or group constraint is violated - while ((sum(tmp_w) >= max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos))) & i <= length(tmp_w)) { + while ((sum(tmp_w) > max_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) | (pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short))) & i <= length(tmp_w)) { # randomly permute and decrease a random portfolio element cur_index <- random_index[i] cur_val <- tmp_w[cur_index] @@ -449,7 +451,7 @@ # This will be useful in fn_map so that we can catch the error and take # action (try again with more permutations, relax constraints, different # method to normalize, etc.) - if (sum(portfolio)<=min_sum | sum(portfolio)>=max_sum){ + if (sum(portfolio) < min_sum | sum(portfolio) > max_sum){ portfolio <- w stop("Infeasible portfolio created, perhaps increase max_permutations and/or adjust your parameters.") } Added: pkg/PortfolioAnalytics/man/pos_limit_fail.Rd =================================================================== --- pkg/PortfolioAnalytics/man/pos_limit_fail.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/pos_limit_fail.Rd 2013-07-18 03:37:21 UTC (rev 2592) @@ -0,0 +1,31 @@ +\name{pos_limit_fail} +\alias{pos_limit_fail} +\title{function to check for violation of position limits constraints} +\usage{ + pos_limit_fail(weights, max_pos, max_pos_long, + max_pos_short) +} +\arguments{ + \item{weights}{vector of weights to test} + + \item{max_pos}{maximum number of assets with non-zero + weights} + + \item{max_pos_long}{maximum number of assets with long + (i.e. buy) positions} + + \item{max_pos_short}{maximum number of assets with short + (i.e. sell) positions} +} +\value{ + TRUE if any position_limit is violated. FALSE if all + position limits are satisfied +} +\description{ + This is used as a helper function for + \code{\link{rp_transform}} to check for violation of + position limit constraints. The position limit + constraints checked are max_pos, max_pos_long, and + max_pos_short. +} + Modified: pkg/PortfolioAnalytics/man/position_limit_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-18 01:45:02 UTC (rev 2591) +++ pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-18 03:37:21 UTC (rev 2592) @@ -2,18 +2,26 @@ \alias{position_limit_constraint} \title{constructor for position_limit_constraint} \usage{ - position_limit_constraint(type, max_pos, enabled = TRUE, - ...) + position_limit_constraint(type, assets, max_pos = NULL, + max_pos_long = NULL, max_pos_short = NULL, + enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} - \item{max_pos}{maximum number of positions} + \item{max_pos}{maximum number of assets with non-zero + weights} + \item{max_pos_long}{maximum number of assets with long + (i.e. buy) positions} + + \item{max_pos_short}{maximum number of assets with short + (i.e. sell) positions} + \item{enabled}{TRUE/FALSE} - \item{\dots}{any other passthru parameters to specify box - and/or group constraints} + \item{\dots}{any other passthru parameters to specify + position limit constraints} } \description{ This function is called by add.constraint when Modified: pkg/PortfolioAnalytics/man/rp_transform.Rd =================================================================== --- pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-18 01:45:02 UTC (rev 2591) +++ pkg/PortfolioAnalytics/man/rp_transform.Rd 2013-07-18 03:37:21 UTC (rev 2592) @@ -4,6 +4,7 @@ \usage{ rp_transform(w, min_sum = 0.99, max_sum = 1.01, min, max, groups, cLO, cUP, max_pos = NULL, group_pos = NULL, + max_pos_long = NULL, max_pos_short = NULL, max_permutations = 200) } \arguments{ @@ -34,6 +35,12 @@ \item{group_pos}{vector specifying maximum number assets with non-zero weights per group} + \item{max_pos_long}{maximum number of assets with long + (i.e. buy) positions} + + \item{max_pos_short}{maximum number of assets with short + (i.e. sell) positions} + \item{max_permutations}{integer: maximum number of iterations to try for a valid portfolio, default 200} } From noreply at r-forge.r-project.org Thu Jul 18 13:36:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 18 Jul 2013 13:36:57 +0200 (CEST) Subject: [Returnanalytics-commits] r2593 - pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette Message-ID: <20130718113657.D13BA184695@r-forge.r-project.org> Author: pulkit Date: 2013-07-18 13:36:57 +0200 (Thu, 18 Jul 2013) New Revision: 2593 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw Log: Documentation for Triple Penance Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw 2013-07-18 11:36:57 UTC (rev 2593) @@ -0,0 +1,108 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps = FALSE} +%\VignetteIndexEntry{Triple Penance Rule} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{Triple Penance Rule,Maximum Drawdown,Time under water,risk,portfolio} +%\VignettePackage{PerformanceAnalytics} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\title{ Triple Penance Rule } + +% \keywords{Triple Penance Rule,Maximum Drawdown,Time Under Water,risk,portfolio} + +\makeatletter +\makeatother +\maketitle + +\begin{abstract} + +Drawdown based stopouts is a framework for informing the decision of stopping a portfolio manager or investment strategy once it has reached the drawdown or time under water limit associated with a certain confidence limit. + +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) +@ + +<>= +source("../code/MaxDD.R") +@ + +<>= +source("../code/TriplePenance.R") +@ + +<>= +source("../code/GoldenSection.R") +@ + + +\section{ Maximum Drawdown } +Maximum Drawdown tells us Up to how much could a particular strategy lose with a given confidence level ?. This function calculated Maximum Drawdown for two underlying processes normal and autoregressive. For a normal process Maximum Drawdown is given by the formula + +When the distibution is normal + +\deqn{MaxDD_{\alpha}=max\left\{0,\frac{(z_{\alpha}\sigma)^2}{4\mu}\right\}} + +The time at which the Maximum Drawdown occurs is given by + +\deqn{t^\ast=\biggl(\frac{Z_{\alpha}\sigma}{2\mu}\biggr)^2} + +Here $Z_{\alpha}$ is the critical value of the Standard Normal Distribution associated with a probability $\alpha$.$\sigma$ and $\mu$ are the Standard Distribution and the mean respectively. + +When the distribution is non-normal and time dependent, Autoregressive process. + + +\deqn{Q_{\alpha,t}=\frac{\phi^{(t+1)}-\phi}{\phi-1}(\triangle\pi_0-\mu)+{\mu}t+Z_{\alpha}\frac{\sigma}{|\phi-1|}\biggl(\frac{\phi^{2(t+1)}-1}{\phi^2-1}-2\frac{\phi^(t+1)-1}{\phi-1}+t+1\biggr)^{1/2}} + +$\phi$ is estimated as + +\deqn{\hat{\phi} = Cov_0[\triangle\pi_\tau,\triangle\pi_{\tau-1}](Cov_0[\triangle\pi_{\tau-1},\triangle\pi_{\tau-1}])^{-1}} + + +and the Maximum Drawdown is given by. + +\deqn{MaxDD_{\alpha}=max\left\{0,-MinQ_\alpha\right\}} + +Golden Section Algorithm is used to calculate the Minimum of the function Q. + + +\subsection{Usage of the function} + +The Return Series ,confidence level and the type of distribution is taken as the input. The Return Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns. +<<>>= +data(edhec) +MaxDD(edhec,0.95,type="ar") +@ + + +The $t^\ast$ in the output is the time at which Maximum Drawdown occurs. + +\section{ Maximum Time Under Water } + +For a particular sequence $\left\{\pi_t\right\}$, the time under water $(TuW)$ is the minimum number of observations, $t>0$, such that $\pi_{t-1}<0$ and $\pi_t>0$. + +For a normal distribution Maximum Time Under Water is given by the following expression. + +\deqn{MaxTuW_\alpha=\biggl(\frac{Z_\alpha{\sigma}}{\mu}\biggr)^2} + +For a Autoregressive process the Time under water is found using the golden section algorithm. + +\subsection{Usage} + + + +\end{document} + From noreply at r-forge.r-project.org Thu Jul 18 15:53:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 18 Jul 2013 15:53:49 +0200 (CEST) Subject: [Returnanalytics-commits] r2594 - in pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4: . Code Vignette Message-ID: <20130718135349.A95A4183C48@r-forge.r-project.org> Author: shubhanm Date: 2013-07-18 15:53:49 +0200 (Thu, 18 Jul 2013) New Revision: 2594 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarJames.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarNumberofObservations.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.tex Log: Week4 : Added : Acar & Shane Maximum LossSimulation ( Stage : Development) Added: Vignette (Acar & Shane) : (Stage : Development) Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R 2013-07-18 13:53:49 UTC (rev 2594) @@ -0,0 +1,40 @@ +#To get some insight on the relationships between maximum drawdown per unit of volatility +#and mean return divided by volatility, we have proceeded to Monte-Carlo simulations. +# We have simulated cash flows over a period of 36 monthly returns and measured maximum +#drawdown for varied levels of annualised return divided by volatility varying from minus +# two to two by step of 0.1. The process has been repeated six thousand times. +AcarSim <- + function () +{ +mu=mean(Return.annualized(edhec)) +monthly=(1+mu)^(1/12)-1 +sig=StdDev.annualized(edhec[,1])[1]; +T= 36 +j=1 +dt=1/T +nsim=10; +r=matrix(0,nsim,T+1) + +r[,1]=monthly; +# Sigma 'monthly volatiltiy' will be the varying term +ratio= seq(-2, 2, by=.1); +len = length(ratio) +ddown=matrix(0,nsim,len) +Z <- array(0, c(len)) +for(i in 1:len) +{ + monthly = sig*ratio[i]; + + for(j in 1:nsim) +{ + dz=rnorm(T) + + + r[j,2:37]=monthly+sig*dz + + ddown[j,i]= ES((r[j,]))/monthly +} +} +plot(ddown[1,]) + +} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarJames.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarJames.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarJames.R 2013-07-18 13:53:49 UTC (rev 2594) @@ -0,0 +1,90 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +chart.ArcarJames <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= 36; + n <- 1000 + #tlength <- 36 + musig.ratio=seq(-2,2,by=.1) + dt <- 1/T; + s0 <- 100; + # for each column, do the following: + for(ratio in 1:length(musig.ratio)) + { + for(column in 1:columns) { + x = y[,column] + mu = musig.ratio[ratio] *.01 + sig= .01 + r <- matrix(0,T+1,n) # matrix to hold Asset Path + r[1,] <- s0 + drawdown <- matrix(0,length(musig.ratio),n) + + for(j in 1:n){ + for(i in 2:(T+1)){ + + dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) + r[i,j] <- r[i-1,j] + dr + } + drawdown[ratio,j] = maxDrawdown(r[ratio,j]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)*100))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + t <- seq(0, T, dt) + matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: chart.ArcarJames +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarNumberofObservations.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarNumberofObservations.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/chart.ArcarNumberofObservations.R 2013-07-18 13:53:49 UTC (rev 2594) @@ -0,0 +1,114 @@ +#' Expected Drawdown using Brownian Motion Assumptions +#' +#' Works on the model specified by Maddon-Ismail +#' +#' +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @author R +#' @keywords Expected Drawdown Using Brownian Motion Assumptions +#' +#' @export +chart.ArcarJames <- + function (R,digits =4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # Output: Table of Estimated Drawdowns + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + T= 36; + n <- 1000 + #tlength <- 36 + musig.ratio=seq(-2,2,by=.1) + dt <- 1/T; + s0 <- 100; + for(column in 1:columns) { + x = y[,column] + mu = musig.ratio[ratio] *.01 + sig= .01 + r <- matrix(0,T+1,n) # matrix to hold Asset Path + r[1,] <- s0 + drawdown <- matrix(0,length(musig.ratio),n) + # Generate k random walks across time {0, 1, ... , T} + T <- 100 + k <- 250 + initial.value <- 100 + GetRandomWalk <- function() { + # Add a standard normal at each step + initial.value + c(0, cumsum(rnorm(T))) + + } + # Matrix of random walks + values <- replicate(k, GetRandomWalk()) + # Create an empty plot + dev.new(height=8, width=12) + plot(0:T, rep(NA, T + 1), main=sprintf("%s Random Walks", k), + xlab="time", ylab="value", + ylim=100 + 4.5 * c(-1, 1) * sqrt(T)) + mtext(sprintf("%s%s} with initial value of %s", + "Across time {0, 1, ... , ", T, initial.value)) + for (i in 1:k) { + lines(0:T, values[ , i], lwd=0.25) + } + for (sign in c(-1, 1)) { + curve(initial.value + sign * 1.96 * sqrt(x), from=0, to=T, + n=2*T, col="darkred", lty=2, lwd=1.5, add=TRUE) + } + legend("topright", "1.96 * sqrt(t)", + bty="n", lwd=1.5, lty=2, col="darkred") + + for(j in 1:n){ + for(i in 2:(T+1)){ + + dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1) + r[i,j] <- r[i-1,j] + dr + } + drawdown[ratio,j] = maxDrawdown(r[ratio,j]) + } + z = c((mu*100), + (sig*100), + ((mean(drawdown)*100))) + znames = c( + "Annual Returns in %", + "Std Devetions in %", + "Normalized Drawdown Drawdown in %" + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + t <- seq(0, T, dt) + matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt") + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: chart.ArcarNumberofObservations +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.Rnw 2013-07-18 13:53:49 UTC (rev 2594) @@ -0,0 +1,56 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps = FALSE} +%\VignetteIndexEntry{Triple Penance Rule} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{Triple Penance Rule,Maximum Drawdown,Time under water,risk,portfolio} +%\VignettePackage{PerformanceAnalytics} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\title{ Maximum Loss and Maximum Drawdown in Financial +Markets} + +% \keywords{Triple Penance Rule,Maximum Drawdown,Time Under Water,risk,portfolio} + +\makeatletter +\makeatother +\maketitle + +\begin{abstract} + +The main concern of this paper is the study of alternative risk measures: namely maximum loss and maximum drawdown. Both statistics have received little attention from academics despite their extensive use by proprietary traders and derivative fund managers. + +Firstly, this paper recalls from previously published research the expected maximum loss under the normal random walk with drift assumption. In that case, we see that exact analytical formulae can be established. The expected maximum loss can be derived as a function of the mean and standard deviation of the asset. For the maximum drawdown, exact formulae seems more difficult to establish. + +Therefore Monte-Carlo simulations have to be used. + +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) + +\section{ Maximum Drawdown } + +Unfortunately, there is no analytical formulae to establish the maximum drawdown properties under the random walk assumption. We should note first that due to its definition, the maximum drawdown divided by volatility is an only function of the ratio mean divided by volatility. + +When the distibution is normal + +\deqn{MD_{\sigma}=min\left\{0,\frac{({\X}\sigma)}} + + + + + + +\end{document} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/MaximumLoss.tex 2013-07-18 13:53:49 UTC (rev 2594) @@ -0,0 +1,35 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +\usepackage{Rd} + +\usepackage{Sweave} + +%\VignetteIndexEntry{Triple Penance Rule} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{Triple Penance Rule,Maximum Drawdown,Time under water,risk,portfolio} +%\VignettePackage{PerformanceAnalytics} + +\begin{document} +\input{MaximumLoss-concordance} + +\title{ Maximum Loss and Maximum Drawdown in Financial +Markets} + +% \keywords{Triple Penance Rule,Maximum Drawdown,Time Under Water,risk,portfolio} + +\makeatletter +\makeatother +\maketitle + +\begin{abstract} + +Drawdown based stopouts is a framework for informing the decision of stopping a portfolio manager or investment strategy once it has reached the drawdown or time under water limit associated with a certain confidence limit. + +\end{abstract} + + From noreply at r-forge.r-project.org Thu Jul 18 23:32:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 18 Jul 2013 23:32:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2595 - pkg/FactorAnalytics/R Message-ID: <20130718213232.22568180603@r-forge.r-project.org> Author: chenyian Date: 2013-07-18 23:32:31 +0200 (Thu, 18 Jul 2013) New Revision: 2595 Modified: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r Log: modify plot.TimeSeriesFactorModel.r so that it can adopt new change in fitTimeSeriesFactorModel.R Modified: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-07-18 13:53:49 UTC (rev 2594) +++ pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-07-18 21:32:31 UTC (rev 2595) @@ -33,7 +33,7 @@ #' @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. See detail. +#' true rist or "cv" 10 folds cross-validation. Default is "Cp". See detail. #' @return an S3 object containing #' \itemize{ #' \item{asset.fit}{Fit objects for each asset. This is the class "lm" for @@ -54,11 +54,9 @@ #' \dontrun{ #' # load data from the database #' data(managers.df) -#' ret.assets = managers.df[,(1:6)] -#' factors = managers.df[,(7:9)] -#' # fit the factor model with OLS -#' fit <- fitTimeseriesFactorModel(ret.assets,factors,fit.method="OLS", -#' variable.selection="all subsets") +#' 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 @@ -74,7 +72,7 @@ variable.selection="none", decay.factor = 0.95,nvmax=8,force.in=NULL, subsets.method = c("exhaustive", "backward", "forward", "seqrep"), - lars.criteria = c("Cp","cv")) { + lars.criteria = "Cp") { require(PerformanceAnalytics) require(leaps) @@ -369,7 +367,9 @@ resid.variance = ResidVars, call = this.call, data = data, - factors.names = factors.names) + factors.names = factors.names, + variable.selection = variable.selection, + assets.names = assets.names) class(ans) = "TimeSeriesFactorModel" return(ans) } Modified: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-07-18 13:53:49 UTC (rev 2594) +++ pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-07-18 21:32:31 UTC (rev 2595) @@ -31,11 +31,9 @@ #' \dontrun{ #' # load data from the database #' data(managers.df) -#' ret.assets = managers.df[,(1:6)] -#' factors = managers.df[,(7:9)] -#' # fit the factor model with OLS -#' fit <- fitTimeSeriesFactorModel(ret.assets,factors,fit.method="OLS", -#' variable.selection="all subsets") +#' 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 @@ -50,6 +48,7 @@ require(zoo) require(PerformanceAnalytics) require(strucchange) + require(ellipse) if (plot.single==TRUE) { ## inputs: @@ -223,17 +222,18 @@ "Factor Contributions to VaR"), title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n") + variable.selection = fit.macro$variable.selection - manager.names = colnames(fit.macro$ret.assets) - factor.names = colnames(fit.macro$factors) - managers.df = cbind(fit.macro$ret.assets,fit.macro$factors) - cov.factors = var(fit.macro$factors) - n <- length(manager.names) + asset.names = fit.macro$assets.names + factor.names = fit.macro$factors.names + plot.data = fit.macro$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) { + if (n > max.show) { cat(paste("numbers of assets are greater than",max.show,", show only first", max.show,"assets",sep=" ")) n <- max.show @@ -241,33 +241,33 @@ par(mfrow=c(n/2,2)) if (variable.selection == "lar" || variable.selection == "lasso") { for (i in 1:n) { - alpha = fit.macro$alpha.vec[i] - beta = as.matrix(fit.macro$beta.mat[i,]) - fitted = alpha+as.matrix(fit.macro$factors)%*%beta - dataToPlot = cbind(fitted, na.omit(fit.macro$ret.assets[,i])) + alpha = fit.macro$alpha[i] + beta = as.matrix(fit.macro$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",manager.names[i],seq="") + 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(fit.macro$asset.fit[[i]]), na.omit(fit.macro$ret.assets[,i])) + dataToPlot = cbind(fitted(fit.macro$asset.fit[[i]]), na.omit(plot.data[,i])) colnames(dataToPlot) = c("Fitted","Actual") - main = paste("Factor Model fit for",manager.names[i],seq="") + 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(fit.macro$r2.vec) + barplot(fit.macro$r2) }, "3L" = { - barplot(fit.macro$residVars.vec) + barplot(fit.macro$resid.variance) }, "4L" = { - cov.fm<- factorModelCovariance(fit.macro$beta.mat,var(fit.macro$factors),fit.macro$residVars.vec) + cov.fm<- factorModelCovariance(fit.macro$beta,cov.factors,fit.macro$resid.variance) cor.fm = cov2cor(cov.fm) rownames(cor.fm) = colnames(cor.fm) ord <- order(cor.fm[1,]) @@ -276,10 +276,10 @@ }, "5L" = { factor.sd.decomp.list = list() - for (i in manager.names) { + for (i in asset.names) { factor.sd.decomp.list[[i]] = - factorModelSdDecomposition(fit.macro$beta.mat[i,], - cov.factors, fit.macro$residVars.vec[i]) + factorModelSdDecomposition(fit.macro$beta[i,], + cov.factors, fit.macro$resid.variance[i]) } # function to extract contribution to sd from list getCSD = function(x) { @@ -298,33 +298,33 @@ factor.es.decomp.list = list() if (variable.selection == "lar" || variable.selection == "lasso") { - for (i in manager.names) { - idx = which(!is.na(managers.df[,i])) - alpha = fit.macro$alpha.vec[i] - beta = as.matrix(fit.macro$beta.mat[i,]) - fitted = alpha+as.matrix(fit.macro$factors)%*%beta - residual = fit.macro$ret.assets[,i]-fitted - tmpData = cbind(managers.df[idx,i], managers.df[idx,factor.names], - (residual[idx,]/sqrt(fit.macro$residVars.vec[i])) ) + for (i in asset.names) { + idx = which(!is.na(plot.data[,i])) + alpha = fit.macro$alpha[i] + beta = as.matrix(fit.macro$beta[i,]) + fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta + residual = plot.data[,i]-fitted + tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names], + (residual[idx,]/sqrt(fit.macro$resid.variance[i])) ) colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") factor.es.decomp.list[[i]] = factorModelEsDecomposition(tmpData, - fit.macro$beta.mat[i,], - fit.macro$residVars.vec[i], tail.prob=0.05) + fit.macro$beta[i,], + fit.macro$resid.variance[i], tail.prob=0.05) } } else { - for (i in manager.names) { + for (i in asset.names) { # check for missing values in fund data - idx = which(!is.na(managers.df[,i])) - tmpData = cbind(managers.df[idx,i], managers.df[idx,factor.names], - residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$residVars.vec[i])) + idx = which(!is.na(plot.data[,i])) + tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names], + residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$resid.variance[i])) colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") factor.es.decomp.list[[i]] = factorModelEsDecomposition(tmpData, - fit.macro$beta.mat[i,], - fit.macro$residVars.vec[i], tail.prob=0.05) + fit.macro$beta[i,], + fit.macro$resid.variance[i], tail.prob=0.05) } } @@ -345,32 +345,32 @@ if (variable.selection == "lar" || variable.selection == "lasso") { - for (i in manager.names) { - idx = which(!is.na(managers.df[,i])) - alpha = fit.macro$alpha.vec[i] - beta = as.matrix(fit.macro$beta.mat[i,]) - fitted = alpha+as.matrix(fit.macro$factors)%*%beta - residual = fit.macro$ret.assets[,i]-fitted - tmpData = cbind(managers.df[idx,i], managers.df[idx,factor.names], - (residual[idx,]/sqrt(fit.macro$residVars.vec[i])) ) + for (i in asset.names) { + idx = which(!is.na(plot.data[,i])) + alpha = fit.macro$alpha[i] + beta = as.matrix(fit.macro$beta[i,]) + fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta + residual = plot.data[,i]-fitted + tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names], + (residual[idx,]/sqrt(fit.macro$resid.variance[i])) ) colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") factor.VaR.decomp.list[[i]] = factorModelVaRDecomposition(tmpData, - fit.macro$beta.mat[i,], - fit.macro$residVars.vec[i], tail.prob=0.05) + fit.macro$beta[i,], + fit.macro$resid.variance[i], tail.prob=0.05) } } else { - for (i in manager.names) { + for (i in asset.names) { # check for missing values in fund data - idx = which(!is.na(managers.df[,i])) - tmpData = cbind(managers.df[idx,i], managers.df[idx,factor.names], - residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$residVars.vec[i])) + idx = which(!is.na(plot.data[,i])) + tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names], + residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$resid.variance[i])) colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual") factor.VaR.decomp.list[[i]] = factorModelVaRDecomposition(tmpData, - fit.macro$beta.mat[i,], - fit.macro$residVars.vec[i], tail.prob=0.05, + fit.macro$beta[i,], + fit.macro$resid.variance[i], tail.prob=0.05, VaR.method="HS") } } From noreply at r-forge.r-project.org Fri Jul 19 00:07:06 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 00:07:06 +0200 (CEST) Subject: [Returnanalytics-commits] r2596 - in pkg/FactorAnalytics: R man Message-ID: <20130718220706.C262218569F@r-forge.r-project.org> Author: chenyian Date: 2013-07-19 00:07:06 +0200 (Fri, 19 Jul 2013) New Revision: 2596 Modified: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r pkg/FactorAnalytics/man/factorModelCovariance.Rd pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd Log: modify Rd. file Modified: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-07-18 21:32:31 UTC (rev 2595) +++ pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-07-18 22:07:06 UTC (rev 2596) @@ -14,7 +14,7 @@ #' 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 FALSE. -#' @param fundName Name of the asset to be plotted. +#' @param asset.name Name of the asset to be plotted. #' @param which.plot.single integer indicating which plot to create: "none" #' will create a menu to choose. Defualt is none. 1 = time series plot of #' actual and fitted values 2 = time series plot of residuals with standard @@ -37,13 +37,13 @@ #' # 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, fundName="HAM1") +#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1") #' } #' plot.TimeSeriesFactorModel <- function(fit.macro,colorset=c(1:12),legend.loc=NULL, which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6, - plot.single=FALSE, fundName,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", + plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L", "7L","8L","9L","10L","11L","12L","13L")) { require(zoo) require(PerformanceAnalytics) @@ -55,7 +55,7 @@ ## 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. - ## fundName charater. The name of the single asset to be ploted. + ## 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 @@ -71,7 +71,10 @@ ## 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] - fit.lm = fit.macro$asset.fit[[fundName]] + if (missing(asset.name) == TRUE) { + stop("Neet to specify an asset to plot if plot.single is TRUE.") + } + fit.lm = fit.macro$asset.fit[[asset.name]] if (!(class(fit.lm) == "lm")) stop("Must pass a valid lm object") @@ -79,7 +82,7 @@ ## extract information from lm object factorNames = colnames(fit.lm$model)[-1] - fit.formula = as.formula(paste(fundName,"~", paste(factorNames, collapse="+"), sep=" ")) + 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))) @@ -104,7 +107,7 @@ switch(which.plot.single, "1L" = { ## time series plot of actual and fitted values - plot(actual.z, main=fundName, ylab="Monthly performance", lwd=2, col="black") + 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")) @@ -112,7 +115,7 @@ "2L" = { ## time series plot of residuals with standard error bands - plot(residuals.z, main=fundName, ylab="Monthly performance", lwd=2, col="black") + 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") @@ -121,41 +124,41 @@ }, "3L" = { ## time series plot of squared residuals - plot(residuals.z^2, main=fundName, ylab="Squared residual", lwd=2, col="black") + 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=fundName, ylab="Absolute residual", lwd=2, col="black") + 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: ", fundName, sep="")) + 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: ", fundName, sep="")) + 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|: ", fundName, sep="")) + 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: ", fundName, sep="")) + 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: ", fundName, sep="")) + chart.QQPlot(residuals.z, envelope=0.95, main=paste("Residuals: ", asset.name, sep="")) }, "10L"= { ## CUSUM plot of recursive residuals if (as.character(fit.macro$call["fit.method"]) == "OLS") { cusum.rec = efp(fit.formula, type="Rec-CUSUM", data=fit.lm$model) - plot(cusum.rec, sub=fundName) + plot(cusum.rec, sub=asset.name) } else stop("CUMSUM applies only on OLS method") }, @@ -163,7 +166,7 @@ ## CUSUM plot of OLS residuals if (as.character(fit.macro$call["fit.method"]) == "OLS") { cusum.ols = efp(fit.formula, type="OLS-CUSUM", data=fit.lm$model) - plot(cusum.ols, sub=fundName) + plot(cusum.ols, sub=asset.name) } else stop("CUMSUM applies only on OLS method") }, @@ -171,7 +174,7 @@ ## CUSUM plot of recursive estimates relative to full sample estimates if (as.character(fit.macro$call["fit.method"]) == "OLS") { cusum.est = efp(fit.formula, type="fluctuation", data=fit.lm$model) - plot(cusum.est, functional=NULL, sub=fundName) + plot(cusum.est, functional=NULL, sub=asset.name) } else stop("CUMSUM applies only on OLS method") }, @@ -184,7 +187,7 @@ 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:", fundName, sep=" ")) + plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" ")) } else if (as.character(fit.macro$call["fit.method"]) == "DLS") { decay.factor <- as.numeric(as.character(fit.macro$call["decay.factor"])) t.length <- 24 @@ -198,10 +201,10 @@ } 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(fundName,"~", paste(factorNames, collapse="+"), sep=" ")) + fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" ")) rollReg.z = rollapply(reg.z, FUN=rollReg, fit.formula,w, width=24, by.column = FALSE, align="right") - plot(rollReg.z, main=paste("24-month rolling regression estimates:", fundName, sep=" ")) + plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" ")) } }, invisible() Modified: pkg/FactorAnalytics/man/factorModelCovariance.Rd =================================================================== --- pkg/FactorAnalytics/man/factorModelCovariance.Rd 2013-07-18 21:32:31 UTC (rev 2595) +++ pkg/FactorAnalytics/man/factorModelCovariance.Rd 2013-07-18 22:07:06 UTC (rev 2596) @@ -59,6 +59,29 @@ 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") +test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, + datevar = "DATE", returnsvar = "RETURN", + assetvar = "TICKER", wls = TRUE, + regression = "classic", + covariance = "classic", full.resid.cov = FALSE, + robust.scale = TRUE) + + # compute return covariance + # take beta as latest date input + beta.mat.fundm <- subset(data,DATE == "2003-12-31")[,exposure.names] + beta.mat.fundm <- cbind(rep(1,447),beta.mat.fundm) # add intercept +FM return covariance +ret.cov.fundm <- factorModelCovariance(beta.mat.fundm,test.fit$factor.cov$cov, + test.fit$resid.variance) + # the result is exactly the same +test.fit$returns.cov$cov == ret.cov.fundm } \author{ Eric Zivot and Yi-An Chen. Modified: pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd 2013-07-18 21:32:31 UTC (rev 2595) +++ pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd 2013-07-18 22:07:06 UTC (rev 2596) @@ -5,7 +5,7 @@ fitFundamentalFactorModel(data, exposure.names, datevar, returnsvar, assetvar, wls = TRUE, regression = "classic", covariance = "classic", - full.resid.cov = TRUE, robust.scale = FALSE) + full.resid.cov = FALSE, robust.scale = FALSE) } \arguments{ \item{data}{data.frame, data must have \emph{assetvar}, @@ -44,26 +44,26 @@ asset variable in the data.} } \value{ - an S3 object containing \itemize{ \item cov.returns A + an S3 object containing \itemize{ \item returns.cov A "list" object contains covariance information for asset - returns, includes covariance, mean and eigenvalus. \item - cov.factor Anobject of class "cov" or "covRob" which - contains the covariance matrix of the factor returns - (including intercept). \item cov.resids An object of - class "cov" or "covRob" which contains the covariance - matrix of the residuals, if "full.resid.cov" is TRUE. - NULL if "full.resid.cov" is FALSE. \item resid.variance A - vector of variances estimated from the OLS residuals for - each asset. If "wls" is TRUE, these are the weights used - in the weighted least squares regressions. If "cov = - robust" these values are computed with "scale.tau". - Otherwise they are computed with "var". \item factors A - "xts" object containing the times series of estimated - factor returns and intercepts. \item residuals A "xts" - object containing the time series of residuals for each - asset. \item tstats A "xts" object containing the time - series of t-statistics for each exposure. \item call - function call } + returns, includes covariance, mean and eigenvalus. Beta + of taken as latest date input. \item factor.cov An object + of class "cov" or "covRob" which contains the covariance + matrix of the factor returns (including intercept). \item + resids.cov An object of class "cov" or "covRob" which + contains the covariance matrix of the residuals, if + "full.resid.cov" is TRUE. NULL if "full.resid.cov" is + FALSE. \item resid.variance A vector of variances + estimated from the OLS residuals for each asset. If "wls" + is TRUE, these are the weights used in the weighted least + squares regressions. If "cov = robust" these values are + computed with "scale.tau". Otherwise they are computed + with "var". \item factors A "xts" object containing the + times series of estimated factor returns and intercepts. + \item residuals A "xts" object containing the time series + of residuals for each asset. \item tstats A "xts" object + containing the time series of t-statistics for each + exposure. \item call function call } } \description{ fit fundamental factor model or cross-sectional time @@ -98,10 +98,10 @@ robust.scale = TRUE) names(test.fit) -test.fit$cov.returns -test.fit$cov.resids +test.fit$returns.cov +test.fit$resids.cov names(test.fit$cov.factor) -test.fit$cov.factor$cov +test.fit$factor.cov$cov test.fit$factor test.fit$resid.variance test.fit$resids Modified: pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd 2013-07-18 21:32:31 UTC (rev 2595) +++ pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd 2013-07-18 22:07:06 UTC (rev 2596) @@ -8,7 +8,7 @@ variable.selection = "none", decay.factor = 0.95, nvmax = 8, force.in = NULL, subsets.method = c("exhaustive", "backward", "forward", "seqrep"), - lars.criteria = c("Cp", "cv")) + lars.criteria = "Cp") } \arguments{ \item{assets.names}{names of assets returns.} @@ -57,7 +57,7 @@ \item{lars.criteria}{either choose minimum "Cp": unbiased estimator of the true rist or "cv" 10 folds - cross-validation. See detail.} + cross-validation. Default is "Cp". See detail.} } \value{ an S3 object containing \itemize{ \item{asset.fit}{Fit @@ -83,11 +83,9 @@ \dontrun{ # load data from the database data(managers.df) -ret.assets = managers.df[,(1:6)] -factors = managers.df[,(7:9)] -# fit the factor model with OLS -fit <- fitTimeseriesFactorModel(ret.assets,factors,fit.method="OLS", - variable.selection="all subsets") +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 Modified: pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2013-07-18 21:32:31 UTC (rev 2595) +++ pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd 2013-07-18 22:07:06 UTC (rev 2596) @@ -5,7 +5,7 @@ plot.TimeSeriesFactorModel(fit.macro, colorset = c(1:12), legend.loc = NULL, which.plot = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L"), - max.show = 6, plot.single = FALSE, fundName, + 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")) } \arguments{ @@ -29,7 +29,7 @@ \item{plot.single}{Plot a single asset of lm class. Defualt is FALSE.} - \item{fundName}{Name of the asset to be plotted.} + \item{asset.name}{Name of the asset to be plotted.} \item{which.plot.single}{integer indicating which plot to create: "none" will create a menu to choose. Defualt is @@ -54,15 +54,13 @@ \dontrun{ # load data from the database data(managers.df) -ret.assets = managers.df[,(1:6)] -factors = managers.df[,(7:9)] -# fit the factor model with OLS -fit <- fitTimeSeriesFactorModel(ret.assets,factors,fit.method="OLS", - variable.selection="all subsets") +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, fundName="HAM1") +plot(fit.macro, plot.single=TRUE, asset.name="HAM1") } } \author{ From noreply at r-forge.r-project.org Fri Jul 19 03:58:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 03:58:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2597 - pkg/PortfolioAnalytics/R Message-ID: <20130719015832.2AAB5185730@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-19 03:58:31 +0200 (Fri, 19 Jul 2013) New Revision: 2597 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: modified rp_transform to better handle max_pos_long and max_pos_short cardinality constraints Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-18 22:07:06 UTC (rev 2596) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-19 01:58:31 UTC (rev 2597) @@ -337,14 +337,20 @@ # in randomize_portfolio if min_sum and max_sum were satisfied, but the # min/max constraints were violated. + # Set the tolerance to determine non-zero weights tolerance=.Machine$double.eps^0.5 + + # Set value for max_pos if it is not specified if(is.null(max_pos)) max_pos <- length(w) + # Determine maximum number of non-zero weights if(!is.null(group_pos)) { max_group_pos <- sum(group_pos) } else { max_group_pos <- length(w) } + + # Set maximum number of assets based on max_pos and group_pos max_assets <- min(max_pos, max_group_pos) # Create a temporary min vector that will be modified, because a feasible @@ -405,6 +411,45 @@ # violation of any(tmp_w < tmp_min) tmp_min[not_index] <- 0 + # Transform weights to satisfy max_pos_long and max_pos_short before being + # passed into the main loops + # Both max_pos_long and max_pos_short should be specified + if(!is.null(max_pos_long) & !is.null(max_pos_short)){ + pos_idx <- which(tmp_w > 0) + neg_idx <- which(tmp_w < 0) + + # Check if number of positive weights exceeds max_pos_long + if(length(pos_idx) > max_pos_long){ + # Randomly sample positive weights that cause violation of max_pos_long + # and replace with randomly sampled negative weights from weight_seq + make_neg_idx <- sample(pos_idx, length(pos_idx) - max_pos_long) + for(i in make_neg_idx){ + tmp_idx <- weight_seq[weight_seq < 0 & weight_seq >= min[i]] + if(length(tmp_idx) > 0){ + tmp_w[i] <- sample(tmp_idx, 1) + } else { + # This should never happen if the correct weight_seq and min is specified + tmp_w[i] <- -tmp_w[i] + } + } + } + # Check if number of negative weights exceeds max_pos_short + if(length(neg_idx) > max_pos_short){ + # Randomly sample negative weights that cause violation of max_pos_short + # and replace with randomly sampled positive weights from weight_seq + make_pos_idx <- sample(neg_idx, length(neg_idx) - max_pos_short) + for(i in make_pos_idx){ + tmp_seq <- weight_seq[weight_seq > 0 & weight_seq <= max[i]] + if(length(tmp_seq) > 0){ + tmp_w[i] <- sample(tmp_seq, 1) + } else { + # This should never happen if the correct weight_seq and max is specified + tmp_w[i] <- -tmp_w[i] + } + } + } + } + i = 1 # while sum of weights is less than min_sum or tmp_min/max box or group constraint is violated while ((sum(tmp_w) < min_sum | any(tmp_w < tmp_min) | any(tmp_w > max) | any(group_fail(tmp_w, groups, cLO, cUP, group_pos)) | (pos_limit_fail(tmp_w, max_pos, max_pos_long, max_pos_short))) & i <= length(tmp_w)) { From noreply at r-forge.r-project.org Fri Jul 19 04:23:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 04:23:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2598 - pkg/PortfolioAnalytics/R Message-ID: <20130719022333.72A1C185394@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-19 04:23:32 +0200 (Fri, 19 Jul 2013) New Revision: 2598 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: modified for individual checks NULL for max_pos_long or max_pos_short Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-19 01:58:31 UTC (rev 2597) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-19 02:23:32 UTC (rev 2598) @@ -408,13 +408,16 @@ tmp_w[not_index] <- 0 # set some tmp_min values equal to zero so the while loops do not see a - # violation of any(tmp_w < tmp_min) - tmp_min[not_index] <- 0 + # violation of any(tmp_w < tmp_min). This tends to force weights to 0 and + # works well for long only, but we may want to allow negative weights. + # tmp_min[not_index] <- 0 + # Only set values of tmp_min that are greater than 0 to 0 + tmp_min[not_index[which(tmp_min[not_index] > 0)]] <- 0 # Transform weights to satisfy max_pos_long and max_pos_short before being # passed into the main loops # Both max_pos_long and max_pos_short should be specified - if(!is.null(max_pos_long) & !is.null(max_pos_short)){ + if(!is.null(max_pos_long)){ pos_idx <- which(tmp_w > 0) neg_idx <- which(tmp_w < 0) @@ -433,6 +436,8 @@ } } } + } + if(!is.null(max_pos_short)){ # Check if number of negative weights exceeds max_pos_short if(length(neg_idx) > max_pos_short){ # Randomly sample negative weights that cause violation of max_pos_short From noreply at r-forge.r-project.org Fri Jul 19 04:33:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 04:33:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2599 - pkg/PortfolioAnalytics/R Message-ID: <20130719023333.D8E9B185394@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-19 04:33:33 +0200 (Fri, 19 Jul 2013) New Revision: 2599 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: fixing error with parens in position_limit_constraint Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-19 02:23:32 UTC (rev 2598) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-19 02:33:33 UTC (rev 2599) @@ -659,7 +659,7 @@ # Checks for max_pos if(!is.null(max_pos)){ - if(length(max_pos != 1)) stop("max_pos must be a scalar value of length 1") + if(length(max_pos) != 1) stop("max_pos must be a scalar value of length 1") if(max_pos < 0) stop("max_pos must be a positive value") if(max_pos > nassets){ message("max_pos must be less than or equal to the number of assets") @@ -671,7 +671,7 @@ # Checks for max_pos_long if(!is.null(max_pos_long)){ - if(length(max_pos_long != 1)) stop("max_pos_long must be a scalar value of length 1") + if(length(max_pos_long) != 1) stop("max_pos_long must be a scalar value of length 1") if(max_pos_long < 0) stop("max_pos_long must be a positive value") if(max_pos_long > nassets){ message("max_pos_long must be less than or equal to the number of assets") @@ -683,7 +683,7 @@ # Checks for max_pos_short if(!is.null(max_pos_short)){ - if(length(max_pos_short != 1)) stop("max_pos_short must be a scalar value of length 1") + if(length(max_pos_short) != 1) stop("max_pos_short must be a scalar value of length 1") if(max_pos_short < 0) stop("max_pos_short must be a positive value") if(max_pos_short > nassets){ message("max_pos_short must be less than or equal to the number of assets") From noreply at r-forge.r-project.org Fri Jul 19 13:40:27 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 13:40:27 +0200 (CEST) Subject: [Returnanalytics-commits] r2600 - pkg/PortfolioAnalytics/R Message-ID: <20130719114027.2E150185A07@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-19 13:40:26 +0200 (Fri, 19 Jul 2013) New Revision: 2600 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: modifying fn_map to support additional position limit constraints Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-19 02:33:33 UTC (rev 2599) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-19 11:40:26 UTC (rev 2600) @@ -58,6 +58,8 @@ div_target <- constraints$div_target turnover_target <- constraints$turnover_target max_pos <- constraints$max_pos + max_pos_long <- constraints$max_pos_long + max_pos_short <- constraints$max_pos_short tolerance <- .Machine$double.eps^0.5 # We will modify the weights vector so create a temporary copy @@ -68,6 +70,8 @@ tmp_cLO <- cLO tmp_cUP <- cUP tmp_max_pos <- max_pos + tmp_max_pos_long <- max_pos_long + tmp_max_pos_short <- max_pos_short # step 2: check that the vector of weights satisfies the constraints, # transform weights if constraint is violated @@ -78,7 +82,13 @@ if(!is.null(min_sum) & !is.null(max_sum)){ if(!(sum(tmp_weights) >= min_sum & sum(tmp_weights) <= max_sum)){ # Try to transform only considering leverage and box constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, min, max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=NULL, cLO=NULL, cUP=NULL, + max_pos=NULL, group_pos=NULL, + max_pos_long=NULL, max_pos_short=NULL, + max_permutations=500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -90,7 +100,13 @@ if(!is.null(tmp_min) & !is.null(tmp_max)){ if(!(all(tmp_weights >= tmp_min) & all(tmp_weights <= tmp_max))){ # Try to transform only considering leverage and box constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=NULL, cLO=NULL, cUP=NULL, + max_pos=NULL, group_pos=NULL, + max_pos_long=NULL, max_pos_short=NULL, + max_permutations=500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -112,7 +128,13 @@ } # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=NULL, cLO=NULL, cUP=NULL, + max_pos=NULL, group_pos=NULL, + max_pos_long=NULL, max_pos_short=NULL, + max_permutations=500), silent=FALSE) # FALSE for testing # Default to original weights if this fails again if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 @@ -133,7 +155,13 @@ if(!is.null(groups) & !is.null(tmp_cLO) & !is.null(tmp_cUP)){ if(any(group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP, group_pos))){ # Try to transform only considering leverage, box, and group constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, + max_pos=NULL, group_pos=group_pos, + max_pos_long=NULL, max_pos_short=NULL, + max_permutations=500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -151,7 +179,13 @@ tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] <- tmp_cUP[group_fail(tmp_weights, groups, tmp_cLO, tmp_cUP)] + runif(1, 0.01, 0.05) } # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, max_pos=NULL, group_pos, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, + max_pos=NULL, group_pos=group_pos, + max_pos_long=NULL, max_pos_short=NULL, + max_permutations=500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -168,20 +202,34 @@ } # end check for NULL arguments # check position_limit constraints - if(!is.null(tmp_max_pos)){ - if(!(sum(abs(tmp_weights) > tolerance) <= tmp_max_pos)){ + if(!is.null(tmp_max_pos) | !is.null(tmp_max_pos_long) | !is.null(tmp_max_pos_short)){ + if(pos_limit_fail(tmp_weights, tmp_max_pos, tmp_max_pos_long, tmp_max_pos_short)){ # Try to transform only considering leverage, box, group, and position_limit constraints - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, + max_pos=tmp_max_pos, group_pos=group_pos, + max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short, + max_permutations=500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights if(relax){ i <- 1 - while((sum(abs(tmp_weights) > tolerance) > tmp_max_pos) & (tmp_max_pos <= nassets) & (i <= 5)){ + while(pos_limit_fail(tmp_weights, tmp_max_pos, tmp_max_pos_long, tmp_max_pos_short) & (i <= 5)){ # increment tmp_max_pos by 1 - tmp_max_pos <- tmp_max_pos + 1 + if(!is.null(tmp_max_pos)) tmp_max_pos <- min(nassets, tmp_max_pos + 1) + if(!is.null(tmp_max_pos_long)) tmp_max_pos_long <- min(nassets, tmp_max_pos_long + 1) + if(!is.null(tmp_max_pos_short)) tmp_max_pos_short <- min(nassets, tmp_max_pos_short + 1) # Now try the transformation again - tmp_weights <- try(rp_transform(tmp_weights, min_sum, max_sum, tmp_min, tmp_max, groups, tmp_cLO, tmp_cUP, tmp_max_pos, group_pos, 500), silent=FALSE) # FALSE for testing + tmp_weights <- try(rp_transform(w=tmp_weights, + min_sum=min_sum, max_sum=max_sum, + min=tmp_min, max=tmp_max, + groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, + max_pos=tmp_max_pos, group_pos=group_pos, + max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short, + max_permutations=500), silent=FALSE) # FALSE for testing if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -196,7 +244,9 @@ max=tmp_max, cLO=tmp_cLO, cUP=tmp_cUP, - max_pos=tmp_max_pos)) + max_pos=tmp_max_pos, + max_pos_long=tmp_max_pos_long, + max_pos_short=tmp_max_pos_short)) } #' Transform weights that violate min or max box constraints From noreply at r-forge.r-project.org Fri Jul 19 15:34:23 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 15:34:23 +0200 (CEST) Subject: [Returnanalytics-commits] r2601 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130719133423.6F36C184EDC@r-forge.r-project.org> Author: pulkit Date: 2013-07-19 15:34:23 +0200 (Fri, 19 Jul 2013) New Revision: 2601 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/chart.REDD.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Log: REDD Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/chart.REDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/chart.REDD.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/chart.REDD.R 2013-07-19 13:34:23 UTC (rev 2601) @@ -0,0 +1,16 @@ +chart.REDD<-function(R,rf,h, geometric = TRUE,legend.loc = NULL, colorset = (1:12),...) +{ +#DESCRIPTION: +#A function to create the chart for the rolling economic drawdown +# + # calculates the Rolling Economic Drawdown(REDD) for + # a return series.To calculate the rolling economic drawdown cumulative + # return and rolling economic max is calculated for each point. The risk + # free return(rf) and the lookback period(h) is taken as the input. + + + rolldrawdown = rollDrawdown(R,geometric = TRUE,weights = NULL,rf,h) + chart.TimeSeries(rolldrawdown, colorset = colorset, legend.loc = legend.loc, ...) +} + + Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-19 11:40:26 UTC (rev 2600) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-19 13:34:23 UTC (rev 2601) @@ -32,11 +32,10 @@ columnnames = colnames(x) rf = checkData(rf) rowr = nrow(rf) - if(rowr != 1 ){ - if(rowr != rowx){ + if(rowr != 1 && rowr != rowx ){ warning("The number of rows of the returns and the risk free rate do not match") } - } + REDD<-function(x,geometric){ if(geometric) Return.cumulative = cumprod(1+x) @@ -56,20 +55,7 @@ rolldrawdown = reclass(rolldrawdown, x) return(rolldrawdown) } -chart.REDD<-function(R,rf,h, geometric = TRUE,legend.loc = NULL, colorset = (1:12),...) -{ -#DESCRIPTION: -#A function to create the chart for the rolling economic drawdown -# - # calculates the Rolling Economic Drawdown(REDD) for - # a return series.To calculate the rolling economic drawdown cumulative - # return and rolling economic max is calculated for each point. The risk - # free return(rf) and the lookback period(h) is taken as the input. - - rolldrawdown = rollDrawdown(R,geometric = TRUE,weights = NULL,rf,h) - chart.TimeSeries(rolldrawdown, colorset = colorset, legend.loc = legend.loc, ...) -} @@ -78,8 +64,6 @@ - - From noreply at r-forge.r-project.org Fri Jul 19 20:10:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 20:10:54 +0200 (CEST) Subject: [Returnanalytics-commits] r2602 - in pkg/FactorAnalytics: R data man Message-ID: <20130719181054.5DEBC184D89@r-forge.r-project.org> Author: chenyian Date: 2013-07-19 20:10:54 +0200 (Fri, 19 Jul 2013) New Revision: 2602 Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R pkg/FactorAnalytics/R/plot.StatFactorModel.r pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r pkg/FactorAnalytics/data/stat.fm.data.RData pkg/FactorAnalytics/man/plot.StatFactorModel.Rd Log: 1. support lar and larsso variable selection in plot.TimeSeriesFactorModel.r 2. support apca method for plot.StatFactorModel.r 3. edit their Rd. file 4. modify data so that zoo/xts can be applied Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-07-19 13:34:23 UTC (rev 2601) +++ pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-07-19 18:10:54 UTC (rev 2602) @@ -392,6 +392,7 @@ ans$mimic <- mimic ans$resid.variance <- apply(ans$residuals,2,var) ans$call <- call + ans$data <- data class(ans) <- "StatFactorModel" return(ans) } Modified: pkg/FactorAnalytics/R/plot.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-07-19 13:34:23 UTC (rev 2601) +++ pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-07-19 18:10:54 UTC (rev 2602) @@ -1,456 +1,463 @@ -#' plot StatFactorModel object. -#' -#' Generic function of plot method for fitStatisticFactorModel. Either plot all -#' fit models or choose a single asset to plot. -#' -#' PCA works well. APCA is underconstruction. -#' -#' @param fit.stat fit object created by fitStatisticalFactorModel. -#' @param variables Optional. an integer vector telling which variables are to -#' be plotted. The default is to plot all the variables, or the number of -#' variables explaining 90 percent of the variance, whichever is bigger. -#' @param cumulative a logical flag: if TRUE, the cumulative fraction of the -#' variance is printed above each bar in the plot. -#' @param style Charater. bar or lines can be chosen. -#' @param which.plot integer indicating which plot to create: "none" will -#' create a menu to choose. Defualt is none. 1 = "Screeplot of Eigenvalues", 2 -#' = "Factor returns", 3 = "FM Correlation", 4 = "R square", 5 = "Variance of -#' Residuals", 6 = "Factor Contributions to SD", 7 = "Factor Contributions to -#' ES", 8 = "Factor Contributions to VaR" -#' @param hgrid Logic. Whether to plot horizontal grid or not. Defualt is -#' FALSE. -#' @param vgrid Logic. Whether to plot vertical grid or not. Defualt is FALSE. -#' @param plot.single Plot a single asset of lm class. Defualt is FALSE. -#' @param fundName Name of the asset to be plotted. -#' @param which.plot.single integer indicating which plot to create: "none" -#' will create a menu to choose. Defualt is none. 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 -#' @param ... other variables for barplot method. -#' @author Eric Zivot and Yi-An Chen. -#' @examples -#' -#' \dontrun{ -#' # load data for fitStatisticalFactorModel.r -#' # data from finmetric berndt.dat and folio.dat -#' -#' data(stat.fm.data) -#' # pca -#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) -#' args(plot.StatFactorModel) -#' # plot all -#' plot(sfm.pca.fit) -#' # plot single asset -#' plot(sfm.pca.fit,plot.single=TRUE,fundName="CITCRP") -#' } -#' -plot.StatFactorModel <- -function(fit.stat, variables, cumulative = TRUE, style = "bar", - which.plot = c("none","1L","2L","3L","4L","5L","6L","7L","8L"), - hgrid = FALSE, vgrid = FALSE,plot.single=FALSE, fundName, - which.plot.single=c("none","1L","2L","3L","4L","5L","6L", - "7L","8L","9L","10L","11L","12L","13L"), ...) -{ - require(strucchange) - # - # beginning of funciton screenplot - # - screeplot<- - function(mf, variables, cumulative = TRUE, style = "bar", main = "", ...) - { - vars <- mf$eigen - n90 <- which(cumsum(vars)/sum(vars) > 0.9)[1] - if(missing(variables)) { - variables <- 1:max(mf$k, min(10, n90)) - } - istyle <- charmatch(style, c("bar", "lines"), nomatch = NA) - if(is.na(istyle) || istyle <= 1) - style <- "bar" - else { - style <- "lines" - } - if(style == "bar") { - loc <- barplot(vars[variables], names = paste("F", variables, - sep = "."), main = main, ylab = "Variances", ...) - } - else { - loc <- 1:length(variables) - plot(loc, vars[variables], type = "b", axes = F, main = main, - ylab = "Variances", xlab = "") - axis(2) - axis(1, at = loc, labels = paste("F", variables, sep = ".")) - } - if(cumulative) { - cumv <- (cumsum(vars)/sum(vars))[variables] - text(loc, vars[variables] + par("cxy")[2], as.character(signif( - cumv, 3))) - } - invisible(loc) - } - # - # end of screenplot - # - - if (plot.single==TRUE) { - ## inputs: - ## x 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. - ## fundName 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 (which.plot.single=="none") - - - # pca method - - if ( dim(fit$asset.ret)[1] > dim(fit$asset.ret)[2] ) { - - - fit.lm = fit.stat$asset.fit[[fundName]] - - if (!(class(fit.lm) == "lm")) - stop("Must pass a valid lm object") - - ## exact information from lm object - - factorNames = colnames(fit.lm$model)[-1] - fit.formula = as.formula(paste(fundName,"~", 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) - - 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=fundName, 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=fundName, 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=fundName, 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=fundName, 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: ", fundName, sep="")) - }, - "6L" = { - ## SACF and PACF of squared residuals - chart.ACFplus(residuals.z^2, main=paste("Residuals^2: ", fundName, sep="")) - }, - "7L" = { - ## SACF and PACF of absolute residuals - chart.ACFplus(abs(residuals.z), main=paste("|Residuals|: ", fundName, sep="")) - }, - "8L" = { - ## histogram of residuals with normal curve overlayed - chart.Histogram(residuals.z, methods="add.normal", main=paste("Residuals: ", fundName, sep="")) - }, - "9L" = { - ## normal qq-plot of residuals - chart.QQPlot(residuals.z, envelope=0.95, main=paste("Residuals: ", fundName, sep="")) - }, - "10L"= { - ## CUSUM plot of recursive residuals - - cusum.rec = efp(fit.formula, type="Rec-CUSUM", data=fit.lm$model) - plot(cusum.rec, sub=fundName) - - }, - "11L"= { - ## CUSUM plot of OLS residuals - - cusum.ols = efp(fit.formula, type="OLS-CUSUM", data=fit.lm$model) - - }, - "12L"= { - ## CUSUM plot of recursive estimates relative to full sample estimates - - cusum.est = efp(fit.formula, type="fluctuation", data=fit.lm$model) - plot(cusum.est, functional=NULL, sub=fundName) - - }, - "13L"= { - ## rolling regression over 24 month window - - 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:", fundName, sep=" ")) - - }, - invisible() - ) - } else { - dates <- rownames(fit$factors) - actual.z <- zoo(fit$asset.ret,as.Date(dates)) - residuals.z <- zoo(fit$residuals,as.Date(dates)) - fitted.z <- actual.z - residuals.z - t <- length(dates) - k <- fit$k - - 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[,fundName], main=fundName, ylab="Monthly performance", lwd=2, col="black") - lines(fitted.z[,fundName], 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[,fundName], main=fundName, ylab="Monthly performance", lwd=2, col="black") - abline(h=0) - sigma = (sum(residuals.z[,fundName]^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[,fundName]^2, main=fundName, 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[,fundName]), main=fundName, 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[,fundName], main=paste("Residuals: ", fundName, sep="")) - }, - "6L" = { - ## SACF and PACF of squared residuals - chart.ACFplus(residuals.z[,fundName]^2, main=paste("Residuals^2: ", fundName, sep="")) - }, - "7L" = { - ## SACF and PACF of absolute residuals - chart.ACFplus(abs(residuals.z[,fundName]), main=paste("|Residuals|: ", fundName, sep="")) - }, - "8L" = { - ## histogram of residuals with normal curve overlayed - chart.Histogram(residuals.z[,fundName], methods="add.normal", main=paste("Residuals: ", fundName, sep="")) - }, - "9L" = { - ## normal qq-plot of residuals - chart.QQPlot(residuals.z[,fundName], envelope=0.95, main=paste("Residuals: ", fundName, sep="")) - }, - invisible() ) - } - - - } else { - which.plot<-which.plot[1] - - - ## - ## 2. Plot selected choices. - ## - - - which.plot <- menu(c("Screeplot of Eigenvalues", - "Factor Returns", - "FM Correlation", - "R square", - "Variance of Residuals", - "Factor Contributions to SD", - "Factor Contributions to ES", - "Factor Contributions to VaR"), title = - "\nMake a plot selection (or 0 to exit):\n") - - switch(which.plot, - "1L" = { - ## - ## 1. screeplot. - ## - if(missing(variables)) { - vars <- fit.stat$eigen - n90 <- which(cumsum(vars)/ - sum(vars) > 0.9)[1] - variables <- 1:max(fit.stat$k, min(10, n90)) - } - screeplot(fit.stat, variables, cumulative, - style, "Screeplot") - }, - "2L" = { - ## - ## 2. factor returns - ## - if(missing(variables)) { - f.ret <- fit.stat$factors - } - plot.ts(f.ret) - -} , - "3L" = { - cov.fm<- factorModelCovariance(t(fit.stat$loadings),var(fit.stat$factors),fit.stat$residVars.vec) - 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]) - }, - "4L" ={ - barplot(fit.stat$r2) - }, - "5L" = { - barplot(fit.stat$residVars.vec) - }, - "6L" = { - cov.factors = var(fit.stat$factors) - names = colnames(fit.stat$asset.ret) - factor.sd.decomp.list = list() - for (i in names) { - factor.sd.decomp.list[[i]] = - factorModelSdDecomposition(fit.stat$loadings[,i], - cov.factors, fit.stat$residVars.vec[i]) - } - # function to efit.stattract contribution to sd from list - getCSD = function(x) { - x$cr.fm - } - # extract contributions to SD from list - cr.sd = sapply(factor.sd.decomp.list, getCSD) - rownames(cr.sd) = c(colnames(fit.stat$factors), "residual") - # create stacked barchart - barplot(cr.sd, main="Factor Contributions to SD", - legend.text=T, args.legend=list(x="topleft"), - col=c(1:50) ) - } , - "7L" ={ - factor.es.decomp.list = list() - names = colnames(fit.stat$asset.ret) - for (i in names) { - # check for missing values in fund data - idx = which(!is.na(fit.stat$asset.ret[,i])) - tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, - fit.stat$residuals[,i]/sqrt(fit.stat$residVars.vec[i])) - colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") - factor.es.decomp.list[[i]] = - factorModelEsDecomposition(tmpData, - fit.stat$loadings[,i], - fit.stat$residVars.vec[i], tail.prob=0.05) - } - - - # stacked bar charts of percent contributions to ES - getCETL = function(x) { - x$cES - } - # report as positive number - cr.etl = sapply(factor.es.decomp.list, getCETL) - rownames(cr.etl) = c(colnames(fit.stat$factors), "residual") - barplot(cr.etl, main="Factor Contributions to ES", - legend.text=T, args.legend=list(x="topleft"), - col=c(1:50) ) - }, - "8L" = { - factor.VaR.decomp.list = list() - names = colnames(fit.stat$asset.ret) - for (i in names) { - # check for missing values in fund data - idx = which(!is.na(fit.stat$asset.ret[,i])) - tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, - fit.stat$residuals[,i]/sqrt(fit.stat$residVars.vec[i])) - colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") - factor.VaR.decomp.list[[i]] = - factorModelVaRDecomposition(tmpData, - fit.stat$loadings[,i], - fit.stat$residVars.vec[i], tail.prob=0.05) - } - - - # stacked bar charts of percent contributions to VaR - getCVaR = function(x) { - x$cVaR.fm - } - # report as positive number - cr.var = sapply(factor.VaR.decomp.list, getCVaR) - rownames(cr.var) = c(colnames(fit.stat$factors), "residual") - barplot(cr.var, main="Factor Contributions to VaR", - legend.text=T, args.legend=list(x="topleft"), - col=c(1:50) ) - }, invisible() - - ) - -} -} +#' plot StatFactorModel object. +#' +#' Generic function of plot method for fitStatisticFactorModel. Either plot all +#' fit models or choose a single asset to plot. +#' +#' PCA works well. APCA is underconstruction. +#' +#' @param fit.stat fit object created by fitStatisticalFactorModel. +#' @param variables Optional. an integer vector telling which variables are to +#' be plotted. The default is to plot all the variables, or the number of +#' variables explaining 90 percent of the variance, whichever is bigger. +#' @param cumulative a logical flag: if TRUE, the cumulative fraction of the +#' variance is printed above each bar in the plot. +#' @param style Charater. bar or lines can be chosen. +#' @param which.plot integer indicating which plot to create: "none" will +#' create a menu to choose. Defualt is none. 1 = "Screeplot of Eigenvalues", 2 +#' = "Factor returns", 3 = "FM Correlation", 4 = "R square", 5 = "Variance of +#' Residuals", 6 = "Factor Contributions to SD", 7 = "Factor Contributions to +#' ES", 8 = "Factor Contributions to VaR" +#' @param hgrid Logic. Whether to plot horizontal grid or not. Defualt is +#' FALSE. +#' @param vgrid Logic. Whether to plot vertical grid or not. Defualt is FALSE. +#' @param plot.single Plot a single asset of lm class. Defualt is FALSE. +#' @param asset.name Name of the asset to be plotted. +#' @param which.plot.single integer indicating which plot to create: "none" +#' will create a menu to choose. Defualt is none. 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 +#' @param max.show Maximum assets to plot. Default is 6. +#' @param ... other variables for barplot method. +#' @author Eric Zivot and Yi-An Chen. +#' @examples +#' +#' \dontrun{ +#' # load data for fitStatisticalFactorModel.r +#' # data from finmetric berndt.dat and folio.dat +#' +#' data(stat.fm.data) +#' # pca +#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) +#' args(plot.StatFactorModel) +#' # plot all +#' plot(sfm.pca.fit) +#' # plot single asset +#' plot(sfm.pca.fit,plot.single=TRUE,asset.name="CITCRP") +#' } +#' +plot.StatFactorModel <- +function(fit.stat, variables, cumulative = TRUE, style = "bar", + which.plot = c("none","1L","2L","3L","4L","5L","6L","7L","8L"), + hgrid = FALSE, vgrid = FALSE,plot.single=FALSE, asset.name, + which.plot.single=c("none","1L","2L","3L","4L","5L","6L", + "7L","8L","9L","10L","11L","12L","13L"), + max.show=6, ...) +{ + require(strucchange) + require(ellipse) + # + # beginning of funciton screenplot + # + screeplot<- + function(mf, variables, cumulative = TRUE, style = "bar", main = "", ...) + { + vars <- mf$eigen + n90 <- which(cumsum(vars)/sum(vars) > 0.9)[1] + if(missing(variables)) { + variables <- 1:max(mf$k, min(10, n90)) + } + istyle <- charmatch(style, c("bar", "lines"), nomatch = NA) + if(is.na(istyle) || istyle <= 1) + style <- "bar" + else { + style <- "lines" + } + if(style == "bar") { + loc <- barplot(vars[variables], names = paste("F", variables, + sep = "."), main = main, ylab = "Variances", ...) + } + else { + loc <- 1:length(variables) + plot(loc, vars[variables], type = "b", axes = F, main = main, + ylab = "Variances", xlab = "") + axis(2) + axis(1, at = loc, labels = paste("F", variables, sep = ".")) + } + if(cumulative) { + cumv <- (cumsum(vars)/sum(vars))[variables] + text(loc, vars[variables] + par("cxy")[2], as.character(signif( + cumv, 3))) + } + invisible(loc) + } + # + # end of screenplot + # + + if (plot.single==TRUE) { + ## inputs: + ## x 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 (which.plot.single=="none") + + + # pca method + + if ( dim(fit.stat$asset.ret)[1] > dim(fit.stat$asset.ret)[2] ) { + + + fit.lm = fit.stat$asset.fit[[asset.name]] + + if (!(class(fit.lm) == "lm")) + stop("Must pass a valid lm object") + + ## exact information from lm object + + factorNames = colnames(fit.lm$model)[-1] + fit.formula = as.formula(paste(asset.name,"~", paste(factorNames, collapse="+"), sep=" ")) + #Date = try(as.Date(names(residuals(fit.lm)))) + #Date = try(as.yearmon(names(residuals(fit.lm)),"%b %Y")) + 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) + + 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 + + cusum.rec = efp(fit.formula, type="Rec-CUSUM", data=fit.lm$model) + plot(cusum.rec, sub=asset.name) + + }, + "11L"= { + ## CUSUM plot of OLS residuals + + cusum.ols = efp(fit.formula, type="OLS-CUSUM", data=fit.lm$model) + + }, + "12L"= { + ## CUSUM plot of recursive estimates relative to full sample estimates + + cusum.est = efp(fit.formula, type="fluctuation", data=fit.lm$model) + plot(cusum.est, functional=NULL, sub=asset.name) + + }, + "13L"= { + ## rolling regression over 24 month window + + 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=" ")) + + }, + invisible() + ) + } else { #apca method + + dates <- rownames(fit.stat$factors) + actual.z <- zoo(fit.stat$asset.ret,as.Date(dates)) + residuals.z <- zoo(fit.stat$residuals,as.Date(dates)) + fitted.z <- actual.z - residuals.z + t <- length(dates) + k <- fit.stat$k + + 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") [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2602 From noreply at r-forge.r-project.org Fri Jul 19 22:54:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 19 Jul 2013 22:54:26 +0200 (CEST) Subject: [Returnanalytics-commits] r2603 - pkg/FactorAnalytics/R Message-ID: <20130719205427.00CBB183E14@r-forge.r-project.org> Author: chenyian Date: 2013-07-19 22:54:26 +0200 (Fri, 19 Jul 2013) New Revision: 2603 Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r Log: add SD decomposition plot Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-19 18:10:54 UTC (rev 2602) +++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-19 20:54:26 UTC (rev 2603) @@ -383,6 +383,8 @@ # should we let user choose which beta to use ? B.final[, numeric.columns] <- as.matrix(data[ (as.numeric(data[[datevar]]) == timedates[numTimePoints]), exposures.numeric]) + rownames(B.final) = assets + colnames(B.final) = colnames(f.hat) if (length(exposures.factor)) { B.final[, grep(exposures.factor, x = colnames)][cbind(seq(numAssets), as.numeric(data[data[[datevar]] == timedates[numTimePoints], @@ -410,7 +412,9 @@ residuals = resids, tstats = tstats, call = this.call, - data = data) + data = data, + asset.names = assets, + beta = B.final) class(output) <- "FundamentalFactorModel" return(output) } \ No newline at end of file Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-19 18:10:54 UTC (rev 2602) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-19 20:54:26 UTC (rev 2603) @@ -1,82 +1,173 @@ -# plot.FundamentalFactorModel.r -# Yi-An Chen -# 7/16/2012 - - - -#' plot FundamentalFactorModel object. -#' -#' Generic function of plot method for fitFundamentalFactorModel. -#' -#' -#' @param fund.fit fit object created by fitFundamentalFactorModel. -#' @param which.plot integer indicating which plot to create: "none" will -#' create a menu to choose. Defualt is none. 1 = "factor returns", 2 = "R -#' square", 3 = "Variance of Residuals", 4 = "FM Correlation", -#' @param max.show Maximum assets to plot. Default is 12. -#' @author Eric Zivot and Yi-An Chen. -#' @examples -#' -#' \dontrun{ -#' # BARRA type factor model -#' # there are 447 assets -#' data(stock) -#' assets = unique(fulldata[,"PERMNO"]) -#' timedates = as.Date(unique(fulldata[,"DATE"])) -#' exposures <- exposures.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -#' fund.fit <- fitFundamentalFactorModel(fulldata=fulldata, timedates=timedates, exposures=exposures,covariance="classic", assets=assets,full.resid.cov=TRUE, -#' regression="classic",wls=TRUE) -#' -#' plot(fund.fit) -#' } -#' -plot.FundamentalFactorModel <- -function(fund.fit,which.plot=c("none","1L","2L","3L","4L"),max.show=12) - { -require(ellipse) - - - which.plot<-which.plot[1] - - if(which.plot=='none') - which.plot<-menu(c("Factor returns", - "Residual plots", - "Variance of Residuals", - "Factor Model Correlation"), - title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n") - - - n <- length(fund.fit$asset) - if (n >= max.show) { - cat(paste("numbers of assets are greater than",max.show,", show only first", - max.show,"assets",sep=" ")) - n <- max.show - } - switch(which.plot, - - "1L" = { - plot(fund.fit$factor.rets,main="Factor Returns") - - }, - "2L" ={ - plot(fund.fit$resids[,c(1:n)],main="Residuals") - }, - "3L" = { - barplot(fund.fit$resid.vars[c(1:n)]) - }, - - "4L" = { - cor.fm = cov2cor(fund.fit$cov.returns$cov) - rownames(cor.fm) = colnames(cor.fm) - ord <- order(cor.fm[1,]) - ordered.cor.fm <- cor.fm[ord, ord] - plotcorr(ordered.cor.fm[c(1:n),c(1:n)], col=cm.colors(11)[5*ordered.cor.fm + 6]) - }, - - invisible() - ) - - - -} - +# plot.FundamentalFactorModel.r +# Yi-An Chen +# 7/16/2012 + + + +#' plot FundamentalFactorModel object. +#' +#' Generic function of plot method for fitFundamentalFactorModel. +#' +#' +#' @param fit.fund fit object created by fitFundamentalFactorModel. +#' @param which.plot integer indicating which plot to create: "none" will +#' create a menu to choose. Defualt is none. 1 = "factor returns", 2 = "R +#' square", 3 = "Variance of Residuals", 4 = "FM Correlation", +#' @param max.show Maximum assets to plot. Default is 12. +#' @author Eric Zivot and Yi-An Chen. +#' @examples +#' +#' \dontrun{ +#' # BARRA type factor model +#' # there are 447 assets +#' data(stock) +#' # BARRA type factor model +#' data(stock) +#' # there are 447 assets +#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' fit.fund <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, +#' datevar = "DATE", returnsvar = "RETURN", +#' assetvar = "TICKER", wls = TRUE, +#' regression = "classic", +#' covariance = "classic", full.resid.cov = TRUE, +#' robust.scale = TRUE) +#' +#' plot(fit.fund) +#' } +#' +plot.FundamentalFactorModel <- +function(fit.fund,which.plot=c("none","1L","2L","3L","4L"),max.show=10) + { +require(ellipse) +require(PerformanceAnalytics) + + which.plot<-which.plot[1] + + if(which.plot=='none') + which.plot<-menu(c("Factor returns", + "Residual plots", + "Variance of Residuals", + "Factor Model 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") + + n <- length(fit.fund$asset.names) + if (n >= max.show) { + cat(paste("numbers of assets are greater than",max.show,", show only first", + max.show,"assets",sep=" ")) + n <- max.show + } + switch(which.plot, + + "1L" = { + factor.names <- colnames(fit.fund$factors) + nn <- length(factor.names) + par(mfrow=c(nn,1)) + for (i in factor.names) { + plot(fit.fund$factors[,i],main=paste(i," Factor Returns",sep="") ) + } + par(mfrow=c(1,1)) + }, + "2L" ={ + par(mfrow=c(n/2,2)) + names <- colnames(fit.fund$residuals[,1:n]) + for (i in names) { + plot(fit.fund$residuals[,i],main=paste(i," Residuals", sep="")) + } + par(mfrow=c(1,1)) + }, + "3L" = { + barplot(fit.fund$resid.variance[c(1:n)]) + }, + + "4L" = { + cor.fm = cov2cor(fit.fund$returns.cov$cov) + rownames(cor.fm) = colnames(cor.fm) + ord <- order(cor.fm[1,]) + ordered.cor.fm <- cor.fm[ord, ord] + plotcorr(ordered.cor.fm[c(1:n),c(1:n)], col=cm.colors(11)[5*ordered.cor.fm + 6]) + }, + "5L" = { + cov.factors = var(fit.fund$factors) + names = fit.fund$asset.names + factor.sd.decomp.list = list() + for (i in names) { + factor.sd.decomp.list[[i]] = + factorModelSdDecomposition(fit.fund$beta[i,], + cov.factors, fit.fund$resid.variance[i]) + } + # function to efit.stattract contribution to sd from list + getCSD = function(x) { + x$cr.fm + } + # extract contributions to SD from list + cr.sd = sapply(factor.sd.decomp.list, getCSD) + rownames(cr.sd) = c(colnames(fit.fund$factors), "residual") + # create stacked barchart + barplot(cr.sd[,(1:max.show)], main="Factor Contributions to SD", + legend.text=T, args.legend=list(x="topleft"), + col=c(1:50) ) + } , +# "6L" = { +# factor.es.decomp.list = list() +# names = fit.fund$asset.names +# for (i in names) { +# # check for missing values in fund data +# idx = which(!is.na(fit.fund$data[,i])) +# tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, +# fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i])) +# colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") +# factor.es.decomp.list[[i]] = +# factorModelEsDecomposition(tmpData, +# fit.stat$loadings[,i], +# fit.stat$resid.variance[i], tail.prob=0.05) +# } +# +# +# # stacked bar charts of percent contributions to ES +# getCETL = function(x) { +# x$cES +# } +# # report as positive number +# cr.etl = sapply(factor.es.decomp.list, getCETL) +# rownames(cr.etl) = c(colnames(fit.stat$factors), "residual") +# barplot(cr.etl[,(1:max.show)], main="Factor Contributions to ES", +# legend.text=T, args.legend=list(x="topleft"), +# col=c(1:50) ) +# }, +# "7L" = { +# factor.VaR.decomp.list = list() +# names = colnames(fit.stat$asset.ret) +# for (i in names) { +# # check for missing values in fund data +# idx = which(!is.na(fit.stat$asset.ret[,i])) +# tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, +# fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i])) +# colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") +# factor.VaR.decomp.list[[i]] = +# factorModelVaRDecomposition(tmpData, +# fit.stat$loadings[,i], +# fit.stat$resid.variance[i], tail.prob=0.05) +# } +# +# +# # stacked bar charts of percent contributions to VaR +# getCVaR = function(x) { +# x$cVaR.fm +# } +# # report as positive number +# cr.var = sapply(factor.VaR.decomp.list, getCVaR) +# rownames(cr.var) = c(colnames(fit.stat$factors), "residual") +# barplot(cr.var[,(1:max.show)], main="Factor Contributions to VaR", +# legend.text=T, args.legend=list(x="topleft"), +# col=c(1:50) ) +# }, + invisible() + ) + + + +} + From noreply at r-forge.r-project.org Sat Jul 20 12:26:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 20 Jul 2013 12:26:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2604 - in pkg/PerformanceAnalytics/sandbox/pulkit: week1/code week2/code week3_4/code week5 Message-ID: <20130720102632.CFDC81802F0@r-forge.r-project.org> Author: pulkit Date: 2013-07-20 12:26:32 +0200 (Sat, 20 Jul 2013) New Revision: 2604 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Log: taking refSR as a vector input and some documentation changes Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-07-19 20:54:26 UTC (rev 2603) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-07-20 10:26:32 UTC (rev 2604) @@ -1,7 +1,7 @@ #'@title Minimum Track Record Length #' #'@description -#'Minimum Track Record Length will tell us ?How long should a track record be in +#'Minimum Track Record Length tells us ?How long should a track record be in #'order to have statistical confidence that its Sharpe ratio is above a given #'threshold? ". If a track record is shorter than MinTRL, we do not have enough #'confidence that the observed Sharpe Ratio is above the designated threshold. @@ -16,16 +16,27 @@ #'It is important to note that MinTRL is expressed in terms of number of observations, #'not annual or calendar terms. #' +#'The sharpe ratio , skewness and kurtosis can be directly given if the return series +#'is not available using the input parameters sr,sk and kr. If the return series +#'is available these parameters can be left. +#' +#'weights will be needed to be entered if a portfolio's MinTRL is to be calculated +#'else weight can be left as NULL. +#' #'@aliases MinTrackRecord #' #'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset return #'@param Rf the risk free rate of return -#'@param refSR the reference Sharpe Ratio,in the same periodicity as the returns(non-annualized) +#'@param refSR the reference Sharpe Ratio, can be a single value or a vector for a multicolumn +#' return series.Should be non-annualized , in the same periodicity as the returns. #'@param p the confidence level #'@param weights the weights for the portfolio -#'@param sr Sharpe Ratio,in the same periodicity as the returns(non-annualized) -#'@param sk Skewness, in the same periodicity as the returns(non-annualized) -#'@param kr Kurtosis, in the same periodicity as the returns(non-annualized) +#'@param sr Sharpe Ratio,in the same periodicity as the returns(non-annualized). +#'To be given in case the return series is not given. +#'@param sk Skewness, in the same periodicity as the returns(non-annualized). +#'To be given in case the return series is not given. +#'@param kr Kurtosis, in the same periodicity as the returns(non-annualized). +#'To be given in case the return series is not given. #' #'@reference Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio #'Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter @@ -34,9 +45,10 @@ #'@examples #' #'data(edhec) -#'MinTrackRecord(edhec[,1],refSR=0.20) - - +#'MinTrackRecord(edhec[,1],refSR=0.1,Rf = 0.04/12) +#'MinTrackRecord(refSR = 1/12^0.5,Rf = 0,p=0.95,sr = 2/12^0.5,sk=-0.72,kr=5.78) +#'MinTrackRecord(edhec[,1:2],refSR = c(0.28,0.24)) +#'@export MinTrackRecord<-function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,sr = NULL,sk = NULL, kr = NULL, ...){ columns = 1 columnnames = NULL @@ -65,7 +77,12 @@ } columnnames = colnames(x) - + if(length(refSR)==1){ + refSR = rep(refSR,columns) + } + if(length(refSR)!=columns){ + stop("Reference Sharpe Ratio should be given for each series") + } } # If R is passed as null checking for sharpe ratio , skewness and kurtosis else{ @@ -73,23 +90,19 @@ stop("You must either pass R or the Sharpe ratio, Skewness, Kurtosis,n etc") } } - #If weights are not taken into account a message is displayed - #if(is.null(weights)){ - # message("no weights passed,will calculate Minimum Track Record Length for each column") - #} - + if(!is.null(dim(Rf))){ Rf = checkData(Rf) } #If the refSR is greater than SR an error is displayed - if(refSR>sr){ + if(length(which(refSR>sr))!=0){ stop("The Reference Sharpe Ratio should be less than the Observed Sharpe Ratio") } result = 1 + (1 - sk*sr + ((kr-1)/4)*sr^2)*(qnorm(p)/(sr-refSR))^2 if(!is.null(dim(result))){ - colnames(result) = columnnames - rownames(result) = paste("Minimum Track Record Length(p=",round(p*100,1),"%):") + colnames(result) = paste(columnnames,"(SR >",refSR,")") + rownames(result) = paste("Probabilistic Sharpe Ratio(p=",round(p*100,1),"%):") } return(result) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-07-19 20:54:26 UTC (rev 2603) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-07-20 10:26:32 UTC (rev 2604) @@ -7,23 +7,29 @@ #' corrected, atemporal measure of performance expressed in terms of #' probability of skill. The reference Sharpe Ratio should be less than #' the Observed Sharpe Ratio. +#' #' \deqn{\hat{PSR}(SR^\ast) = Z\biggl[\frac{(\hat{SR}-SR^\ast)\sqrt{n-1}}{\sqrt{1-\hat{\gamma_3}SR^\ast + \frac{\hat{\gamma_4}-1}{4}\hat{SR^2}}}\biggr]} #' Here $n$ is the track record length or the number of data points. It can be daily,weekly or yearly depending on the input given #' $\hat{\gamma{_3}}$ and $\hat{\gamma{_4}}$ are the skewness and kurtosis respectively. - #' +#' #' @aliases ProbSharpeRatio #' #' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset return #' @param Rf the risk free rate of return -#' @param refSR the reference Sharpe Ratio, in the same periodicity as the returns(non-annualized) -#' @param the confidence level +#' @param refSR the reference Sharpe Ratio, can be a single value or a vector for a multicolumn +#' return series.Should be non-annualized , in the same periodicity as the returns. +#' @param p the confidence level #' @param weights the weights for the portfolio -#' @param sr Sharpe Ratio, in the same periodicity as the returns(non-annualized) -#' @param sk Skewness, in the same periodicity as the returns(non-annualized) -#' @param kr Kurtosis, in the same periodicity as the returns(non-annualized) +#' @param sr Sharpe Ratio, in the same periodicity as the returns(non-annualized). +#' To be given in case the return series is not given. +#' @param sk Skewness, in the same periodicity as the returns(non-annualized). +#' To be given in case the return series is not given. +#' @param kr Kurtosis, in the same periodicity as the returns(non-annualized). +#' To be given in case the return series is not given. +#' @param n track record length. To be given in case the return series is not given. #' #' @references Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio #' Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter @@ -34,10 +40,10 @@ #' @examples #' #' data(edhec) -#' ProbSharpeRatio(edhec[,1],refSR = 0.28) -#' ProbSharpeRatio(edhec,reSR = 0.28,Rf = 0.06) +#' ProbSharpeRatio(edhec[,1],refSR = 0.23) +#' ProbSharpeRatio(refSR = 1/12^0.5,Rf = 0,p=0.95,sr = 2/12^0.5,sk=-0.72,kr=5.78,n=59) +#' ProbSharpeRatio(edhec[,1:2],refSR = c(0.28,0.24)) - ProbSharpeRatio<- function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,n = NULL,sr = NULL,sk = NULL, kr = NULL, ...){ columns = 1 @@ -67,6 +73,13 @@ } columnnames = colnames(x) + if(length(refSR)==1){ + refSR = rep(refSR,columns) + } + if(length(refSR)!=columns){ + stop("Reference Sharpe Ratio should be given for each series") + } + } # If R is passed as null checking for sharpe ratio , skewness and kurtosis @@ -76,21 +89,17 @@ stop("You must either pass R or the Sharpe ratio, Skewness, Kurtosis,n etc") } } - #If weights are not taken into account a message is displayed -# if(is.null(weights)){ - # message("no weights passed,will calculate Probability Sharpe Ratio for each column") - # } if(!is.null(dim(Rf))){ Rf = checkData(Rf) } #If the Reference Sharpe Ratio is greater than the Observred Sharpe Ratio an error is displayed - if(refSR>sr){ + if(length(which(refSR>sr))!=0){ stop("The Reference Sharpe Ratio should be less than the Observed Sharpe Ratio") } result = pnorm(((sr - refSR)*(n-1)^(0.5))/(1-sr*sk+sr^2*(kr-1)/4)^(0.5)) if(!is.null(dim(result))){ - colnames(result) = columnnames + colnames(result) = paste(columnnames,"(SR >",refSR,")") rownames(result) = paste("Probabilistic Sharpe Ratio(p=",round(p*100,1),"%):") } return(result) Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-19 20:54:26 UTC (rev 2603) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-20 10:26:32 UTC (rev 2604) @@ -44,4 +44,4 @@ corr_avg = corr_avg*2/(columns*(columns-1)) SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg[1,1])) return(SR_Benchmark) -} \ No newline at end of file +} Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R 2013-07-19 20:54:26 UTC (rev 2603) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R 2013-07-20 10:26:32 UTC (rev 2604) @@ -58,7 +58,7 @@ if(is.null(xlab)){ xlab = "Candidate's Strategy's Sharpe Ratio" } - #plot(SR_i,corr_range,type="l",xlab = xlab,ylab = ylab,main="Sharpe Ratio Indifference Curve") + plot(SR_i,corr_range,type="l",xlab = xlab,ylab = ylab,main="Sharpe Ratio Indifference Curve") #OR we can use ggplot2 for much better plots - qplot(SR_i,corr_range,geom="line",xlab=xlab,ylab=ylab,main="Sharpe Ratio IndifferenceCurve",margins=TRUE,facet="grid")+stat_summary() -} \ No newline at end of file + #qplot(SR_i,corr_range,geom="line",xlab=xlab,ylab=ylab,main="Sharpe Ratio IndifferenceCurve",margins=TRUE,facet="grid")+stat_summary() +} Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R 2013-07-19 20:54:26 UTC (rev 2603) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R 2013-07-20 10:26:32 UTC (rev 2604) @@ -19,8 +19,8 @@ phi[column] = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])])) penance[column]<-get_minq(x[,column],confidence)[1]/get_TuW(x[,column],confidence) } - plot(x=phi,y=penance,xlab="Phi",ylab = "Penance",main="Penance vs Phi") - text(phi,penance,columnnames,pos = 4) + plot(x=phi,y=penance,xlab="Phi",ylab = "Penance",main="Penance vs Phi",pch=2) + text(phi,penance,columnnames,pos = 4,col=c(1:columns)) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-19 20:54:26 UTC (rev 2603) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-20 10:26:32 UTC (rev 2604) @@ -30,18 +30,24 @@ columns = ncol(x) rowx = nrow(x) columnnames = colnames(x) - rf = checkData(rf) - rowr = nrow(rf) + rf = checkData(Rf) + rowr = length(Rf) if(rowr != 1 && rowr != rowx ){ - warning("The number of rows of the returns and the risk free rate do not match") - } + stop("The number of rows of the returns and the risk free rate do not match") + } REDD<-function(x,geometric){ if(geometric) Return.cumulative = cumprod(1+x) else Return.cumulative = 1 + cumsum(x) l = length(Return.cumulative) - REM = max(Return.cumulative*(1+rf)^(l-c(1:l))) + if(rowr == 1){ + REM = max(Return.cumulative*(1+rf)^(l-c(1:l))) + } + else{ + prodRf = prod(1+rf) + REM = max(Return.cumulative*prodRf) + } result = 1 - Return.cumulative[l]/REM } From noreply at r-forge.r-project.org Sat Jul 20 15:31:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 20 Jul 2013 15:31:25 +0200 (CEST) Subject: [Returnanalytics-commits] r2605 - in pkg/PerformanceAnalytics/sandbox/pulkit: week1/code week5 Message-ID: <20130720133125.909901806EB@r-forge.r-project.org> Author: pulkit Date: 2013-07-20 15:31:25 +0200 (Sat, 20 Jul 2013) New Revision: 2605 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Log: Added Rolling economic Max Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-07-20 10:26:32 UTC (rev 2604) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-07-20 13:31:25 UTC (rev 2605) @@ -49,6 +49,7 @@ #'MinTrackRecord(refSR = 1/12^0.5,Rf = 0,p=0.95,sr = 2/12^0.5,sk=-0.72,kr=5.78) #'MinTrackRecord(edhec[,1:2],refSR = c(0.28,0.24)) #'@export +#' MinTrackRecord<-function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,sr = NULL,sk = NULL, kr = NULL, ...){ columns = 1 columnnames = NULL @@ -107,3 +108,14 @@ return(result) } +############################################################################### +# 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: MinTRL.R $ +# +############################################################################## \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-07-20 10:26:32 UTC (rev 2604) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-07-20 13:31:25 UTC (rev 2605) @@ -105,3 +105,14 @@ return(result) } +############################################################################### +# 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: ProbSharpeRatio.R $ +# +############################################################################## Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R 2013-07-20 13:31:25 UTC (rev 2605) @@ -0,0 +1,83 @@ +#'@title +#'Rolling Economic Max +#' +#'@description +#'Rolling Economic Max at time t, looking back at portfolio Wealth history +#'for a rolling window of length H is given by: +#' +#'\deqn{REM(t,h)=\max_{t-H \leq s}\[(1+r_f)^{t-s}W_s\]} +#' +#'Here rf is the average realized risk free rate over a period of length t-s. If the risk free rate is changing. This is used to compound. +#' +#'\deqn{ \prod_{i=s}^{t}(1+r_{i}.{\triangle}t)} +#' +#'here \eqn{r_i} denotes the risk free interest rate during \eqn{i^{th}} discrete +#'time interval \eqn{{\triangle}t}. + +#' +#'@param R R an xts, vector, matrix, data frame, timeseries, or zoo object of asset return. +#'@param Rf risk free rate can be vector such as government security rate of return. +#'@param h Look back period +#'@param geomtric geometric utilize geometric chaining (TRUE) or simple/arithmetic #'chaining(FALSE) to aggregate returns, default is TRUE. +#'@param ... any other variable +#'@examples +#'rollEconomicMax(edhec,0.08,100) +#'@export +#' +rollEconomicMax<-function(R,Rf,h,geometric = TRUE,...){ + + + # DESCRIPTION: + # calculates the Rolling Economic Max(REDD) for a return series. + # The risk free return(rf) and the lookback period(h) is taken as the input. + + # FUNCTION: + x = checkData(R) + columns = ncol(x) + n = nrow(x) + columnnames = colnames(x) + rf = checkData(Rf) + nr = length(Rf) + if(nr != 1 && nr != n ){ + stop("The number of rows of the returns and the risk free rate do not match") + } + + REM<-function(x,geometric){ + if(geometric) + Return.cumulative = cumprod(1+x) + else Return.cumulative = 1 + cumsum(x) + l = length(Return.cumulative) + if(nr == 1){ + REM = max(Return.cumulative*(1+rf)^(l-c(1:l))) + } + else{ + prodRf = prod(1+rf) + REM = max(Return.cumulative*prodRf) + } + result = REM + } + + for(column in 1:columns){ + column.drawdown <- apply.rolling(x[,column],width = h, FUN = REM, geometric = geometric) + if(column == 1) + rolldrawdown = column.drawdown + else rolldrawdown = merge(rolldrawdown, column.drawdown) + } + colnames(rolldrawdown) = columnnames + rolldrawdown = reclass(rolldrawdown, x) + return(rolldrawdown) +} + +############################################################################### +# 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: REM.R $ +# +############################################################################## + + Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-20 10:26:32 UTC (rev 2604) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-20 13:31:25 UTC (rev 2605) @@ -2,21 +2,31 @@ #' #'@description #'\code{rollDrawdown} calculates the Rolling Economic Drawdown(REDD) for -#' a return series.To calculate the rolling economic drawdown cumulative -#' return and rolling economic max is calculated for each point. The risk -#' free return(rf) and the lookback period(h) is taken as the input. +#'a return series.To calculate the rolling economic drawdown cumulative +#'return and rolling economic max is calculated for each point. The risk +#'free return(rf) and the lookback period(h) is taken as the input. #' +#'Rolling Economic Drawdown is given by the equation +#' +#'\deqn{REDD(t,h)=1-\frac{W_t}/{REM(t,H)}} +#' +#'Here REM stands for Rolling Economic Max and is the code \code{\link{rollEconomicMax}} +#' +#' #'@param R an xts, vector, matrix, data frame, timeseries, or zoo object of asset return. #'@param weights portfolio weighting vector, default NULL -#'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining(FALSE) +#'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining(FALSE) #'to aggregate returns, default is TRUE #'@param rf risk free rate can be vector such as government security rate of return #'@param h lookback period -#'@param \dots any other passthru variable +#'@param \dots any other variable #'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to #'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012) +#'@examples +#'rollDrawdown(edhec,0.08,100) +#' #' @export -rollDrawdown<-function(R,Rf,h, geometric = TRUE, weights = NULL,...) +rollDrawdown<-function(R,Rf,h, geometric = TRUE,...) { # DESCRIPTION: @@ -28,11 +38,11 @@ # FUNCTION: x = checkData(R) columns = ncol(x) - rowx = nrow(x) + n = nrow(x) columnnames = colnames(x) rf = checkData(Rf) - rowr = length(Rf) - if(rowr != 1 && rowr != rowx ){ + nr = length(Rf) + if(nr != 1 && nr != n ){ stop("The number of rows of the returns and the risk free rate do not match") } @@ -41,7 +51,7 @@ Return.cumulative = cumprod(1+x) else Return.cumulative = 1 + cumsum(x) l = length(Return.cumulative) - if(rowr == 1){ + if(nr == 1){ REM = max(Return.cumulative*(1+rf)^(l-c(1:l))) } else{ @@ -62,14 +72,23 @@ return(rolldrawdown) } +############################################################################### +# 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: redd.R $ +# +############################################################################## - - From noreply at r-forge.r-project.org Sat Jul 20 21:09:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 20 Jul 2013 21:09:16 +0200 (CEST) Subject: [Returnanalytics-commits] r2606 - pkg/PortfolioAnalytics/R Message-ID: <20130720190916.7AC411851E2@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-20 21:09:16 +0200 (Sat, 20 Jul 2013) New Revision: 2606 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/R/random_portfolios.R Log: correct weight_seq and relax min_sum and max_sum in randomize portfolio. Changed to silent=TRUE for try expresseions in fn_map Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-20 13:31:25 UTC (rev 2605) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-20 19:09:16 UTC (rev 2606) @@ -88,7 +88,7 @@ groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -106,7 +106,7 @@ groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -134,7 +134,7 @@ groups=NULL, cLO=NULL, cUP=NULL, max_pos=NULL, group_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing # Default to original weights if this fails again if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 @@ -161,7 +161,7 @@ groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, max_pos=NULL, group_pos=group_pos, max_pos_long=NULL, max_pos_short=NULL, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -185,7 +185,7 @@ groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, max_pos=NULL, group_pos=group_pos, max_pos_long=NULL, max_pos_short=NULL, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } @@ -211,7 +211,7 @@ groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, max_pos=tmp_max_pos, group_pos=group_pos, max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing if(inherits(tmp_weights, "try-error")){ # Default to initial weights tmp_weights <- weights @@ -229,7 +229,7 @@ groups=groups, cLO=tmp_cLO, cUP=tmp_cUP, max_pos=tmp_max_pos, group_pos=group_pos, max_pos_long=tmp_max_pos_long, max_pos_short=tmp_max_pos_short, - max_permutations=500), silent=FALSE) # FALSE for testing + max_permutations=500), silent=TRUE) # FALSE for testing if(inherits(tmp_weights, "try-error")) tmp_weights <- weights i <- i + 1 } Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-20 13:31:25 UTC (rev 2605) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-20 19:09:16 UTC (rev 2606) @@ -220,7 +220,13 @@ if(is.null(max_mult)) max_mult <- rep(Inf,nassets) min_sum <- constraints$min_sum max_sum <- constraints$max_sum - weight_seq <- constraints$weight_seq + # randomize_portfolio will rarely find a feasible portfolio if there is not some + # 'wiggle room' between min_sum and max_sum + if((max_sum - min_sum) < 0.02){ + min_sum <- min_sum - 0.01 + max_sum <- max_sum + 0.01 + } + weight_seq <- portfolio$weight_seq if(is.null(weight_seq)){ weight_seq <- generatesequence(min=min(constraints$min), max=max(constraints$max), by=0.002) } From noreply at r-forge.r-project.org Sat Jul 20 21:31:08 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 20 Jul 2013 21:31:08 +0200 (CEST) Subject: [Returnanalytics-commits] r2607 - pkg/PortfolioAnalytics/R Message-ID: <20130720193108.A6025185329@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-20 21:31:08 +0200 (Sat, 20 Jul 2013) New Revision: 2607 Modified: pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/R/portfolio.R Log: added message argument to suppress the messages displayed with portfolio.spec, add.constraint, and optimize.portfolio_v2 Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-20 19:09:16 UTC (rev 2606) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-20 19:31:08 UTC (rev 2607) @@ -184,12 +184,13 @@ #' @param portfolio an object of class 'portfolio' to add the constraint to, specifying the constraints for the optimization, see \code{\link{portfolio.spec}} #' @param type character type of the constraint to add or update, currently 'weight_sum', 'box', 'group', 'turnover', 'diversification', or 'position_limit' #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify constraints #' @param indexnum if you are updating a specific constraint, the index number in the $objectives list to update #' @author Ross Bennett #' @seealso \code{\link{constraint_v2}}, \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}} #' @export -add.constraint <- function(portfolio, type, enabled=TRUE, ..., indexnum=NULL){ +add.constraint <- function(portfolio, type, enabled=TRUE, message=FALSE, ..., indexnum=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")} @@ -205,17 +206,20 @@ box = {tmp_constraint <- box_constraint(assets=assets, type=type, enabled=enabled, + message=message, ...=...) }, # Group constraints group = {tmp_constraint <- group_constraint(assets=assets, type=type, enabled=enabled, + message=message, ...=...) }, # Sum of weights constraints weight=, leverage=, weight_sum = {tmp_constraint <- weight_sum_constraint(type=type, enabled=enabled, + message=message, ...=...) }, # Special case of weight_sum constraint for full investment @@ -223,6 +227,7 @@ min_sum=1, max_sum=1, enabled=enabled, + message=message, ...=...) }, # Special case of weight_sum constraint for dollar neutral or active @@ -230,22 +235,26 @@ min_sum=0, max_sum=0, enabled=enabled, + message=message, ...=...) }, # Turnover constraint turnover = {tmp_constraint <- turnover_constraint(type=type, enabled=enabled, + message=message, ...=...) }, # Diversification constraint diversification = {tmp_constraint <- diversification_constraint(type=type, enabled=enabled, + message=message, ...=...) }, # Position limit constraint position_limit = {tmp_constraint <- position_limit_constraint(assets=assets, type=type, enabled=enabled, + message=message, ...=...) }, # Do nothing and return the portfolio object if type is NULL @@ -270,6 +279,7 @@ #' @param min_mult numeric or named vector specifying minimum multiplier box constraint from seed weight in \code{assets} #' @param max_mult numeric or named vector specifying maximum multiplier box constraint from seed weight in \code{assets} #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify box constraints #' @author Ross Bennett #' @seealso \code{\link{add.constraint}} @@ -288,7 +298,7 @@ #' # specify box constraints per asset #' 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)) #' @export -box_constraint <- function(type, assets, min, max, min_mult, max_mult, enabled=TRUE, ...){ +box_constraint <- function(type, assets, min, max, min_mult, max_mult, enabled=TRUE, message=FALSE, ...){ # Based on the constraint function for object of class constraint_v1 that # included specifying box constraints. @@ -303,21 +313,21 @@ # If the user passes in a scalar for min, then create a min vector if (length(min) == 1) { - message("min not passed in as vector, replicating min to length of length(assets)") + if(message) message("min not passed in as vector, replicating min to length of length(assets)") min <- rep(min, nassets) } if (length(min) != nassets) stop(paste("length of min must be equal to 1 or the number of assets:", nassets)) # If the user passes in a scalar for max, then create a max vector if (length(max) == 1) { - message("max not passed in as vector, replicating max to length of length(assets)") + if(message) message("max not passed in as vector, replicating max to length of length(assets)") max <- rep(max, nassets) } if (length(max) != nassets) stop(paste("length of max must be equal to 1 or the number of assets:", nassets)) } else { # Default to min=0 and max=1 if min or max are not passed in - message("no min or max passed in, assuming 0 and 1") + if(message) message("no min or max passed in, assuming 0 and 1") min <- rep(0, nassets) max <- rep(1, nassets) } @@ -331,7 +341,7 @@ if (length(min_mult) > 1 & length(max_mult) > 1){ if (length(min_mult) != length(max_mult) ) { stop("length of min_mult and max_mult must be the same") } } else { - message("min_mult and max_mult not passed in as vectors, replicating min_mult and max_mult to length of assets vector") + if(message) message("min_mult and max_mult not passed in as vectors, replicating min_mult and max_mult to length of assets vector") min_mult = rep(min_mult, nassets) max_mult = rep(max_mult, nassets) } @@ -385,6 +395,7 @@ #' @param group_max numeric or vector specifying minimum weight group constraints #' @param group_pos vector specifying the number of non-zero weights per group #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify group constraints #' @author Ross Bennett #' @seealso \code{\link{add.constraint}} @@ -401,7 +412,7 @@ #' group_min=c(0.15, 0.25), #' group_max=c(0.65, 0.55)) #' @export -group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, group_pos=NULL, enabled=TRUE, ...) { +group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, group_pos=NULL, enabled=TRUE, message=FALSE, ...) { nassets <- length(assets) ngroups <- length(groups) @@ -411,14 +422,14 @@ # Checks for group_min if (length(group_min) == 1) { - message("group_min not passed in as vector, replicating group_min to length of groups") + if(message) message("group_min not passed in as vector, replicating group_min to length of groups") group_min <- rep(group_min, ngroups) } if (length(group_min) != ngroups) stop(paste("length of group_min must be equal to 1 or the length of groups:", ngroups)) # Checks for group_max if (length(group_max) == 1) { - message("group_max not passed in as vector, replicating group_max to length of groups") + if(message) message("group_max not passed in as vector, replicating group_max to length of groups") group_max <- rep(group_max, ngroups) } if (length(group_max) != ngroups) stop(paste("length of group_max must be equal to 1 or the length of groups:", ngroups)) @@ -466,6 +477,7 @@ #' @param min_sum minimum sum of all asset weights, default 0.99 #' @param max_sum maximum sum of all asset weights, default 1.01 #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify weight_sum constraints #' @author Ross Bennett #' @examples @@ -594,6 +606,7 @@ #' @param type character type of the constraint #' @param turnover_target target turnover value #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify box and/or group constraints #' @author Ross Bennett #' @examples @@ -604,7 +617,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) #' @export -turnover_constraint <- function(type, turnover_target, enabled=TRUE, ...){ +turnover_constraint <- function(type, turnover_target, enabled=TRUE, message=FALSE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="turnover_constraint", ...) Constraint$turnover_target <- turnover_target return(Constraint) @@ -617,6 +630,7 @@ #' @param type character type of the constraint #' @param div_target diversification target value #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify box and/or group constraints #' @author Ross Bennett #' @examples @@ -627,7 +641,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) #' @export -diversification_constraint <- function(type, div_target, enabled=TRUE, ...){ +diversification_constraint <- function(type, div_target, enabled=TRUE, message=FALSE, ...){ Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...) Constraint$div_target <- div_target return(Constraint) @@ -643,6 +657,7 @@ #' @param max_pos_long maximum number of assets with long (i.e. buy) positions #' @param max_pos_short maximum number of assets with short (i.e. sell) positions #' @param enabled TRUE/FALSE +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @param \dots any other passthru parameters to specify position limit constraints #' @author Ross Bennett #' #' @examples @@ -653,7 +668,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3) #' @export -position_limit_constraint <- function(type, assets, max_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, enabled=TRUE, ...){ +position_limit_constraint <- function(type, assets, max_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, enabled=TRUE, message=FALSE, ...){ # Get the length of the assets vector nassets <- length(assets) @@ -662,7 +677,7 @@ if(length(max_pos) != 1) stop("max_pos must be a scalar value of length 1") if(max_pos < 0) stop("max_pos must be a positive value") if(max_pos > nassets){ - message("max_pos must be less than or equal to the number of assets") + warning("max_pos must be less than or equal to the number of assets") max_pos <- nassets } # coerce to integer @@ -674,7 +689,7 @@ if(length(max_pos_long) != 1) stop("max_pos_long must be a scalar value of length 1") if(max_pos_long < 0) stop("max_pos_long must be a positive value") if(max_pos_long > nassets){ - message("max_pos_long must be less than or equal to the number of assets") + warning("max_pos_long must be less than or equal to the number of assets") max_pos_long <- nassets } # coerce to integer @@ -686,7 +701,7 @@ if(length(max_pos_short) != 1) stop("max_pos_short must be a scalar value of length 1") if(max_pos_short < 0) stop("max_pos_short must be a positive value") if(max_pos_short > nassets){ - message("max_pos_short must be less than or equal to the number of assets") + warning("max_pos_short must be less than or equal to the number of assets") max_pos_short <- nassets } # coerce to integer Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-20 19:09:16 UTC (rev 2606) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-20 19:31:08 UTC (rev 2607) @@ -517,6 +517,7 @@ #' @param \dots any other passthru parameters #' @param rp matrix of random portfolio weights, default NULL, mostly for automated use by rebalancing optimization or repeated tests on same portfolios #' @param momentFUN the name of a function to call to set portfolio moments, default \code{\link{set.portfolio.moments_v2}} +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' #' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information #' @author Kris Boudt, Peter Carl, Brian G. Peterson @@ -528,7 +529,8 @@ search_size=20000, trace=FALSE, ..., rp=NULL, - momentFUN='set.portfolio.moments_v2' + momentFUN='set.portfolio.moments_v2', + message=FALSE ) { optimize_method <- optimize_method[1] @@ -882,7 +884,7 @@ # Prepare for final object to return end_t <- Sys.time() # print(c("elapsed time:",round(end_t-start_t,2),":diff:",round(diff,2), ":stats: ", round(out$stats,4), ":targets:",out$targets)) - message(c("elapsed time:", end_t-start_t)) + if(message) message(c("elapsed time:", end_t-start_t)) out$portfolio <- portfolio out$data_summary <- list(first=first(R), last=last(R)) out$elapsed_time <- end_t - start_t Modified: pkg/PortfolioAnalytics/R/portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/portfolio.R 2013-07-20 19:09:16 UTC (rev 2606) +++ pkg/PortfolioAnalytics/R/portfolio.R 2013-07-20 19:31:08 UTC (rev 2607) @@ -15,11 +15,12 @@ #' @param assets number of assets, or optionally a named vector of assets specifying seed weights. If seed weights are not specified, an equal weight portfolio will be assumed. #' @param category_labels character vector to categorize assets by sector, industry, geography, market-cap, currency, etc. #' @param weight_seq seed sequence of weights, see \code{\link{generatesequence}} +#' @param message TRUE/FALSE. The default is message=FALSE. Display messages if TRUE. #' @author Ross Bennett #' @examples #' pspec <- portfolio.spec(assets=10, weight_seq=generatesequence()) #' @export -portfolio.spec <- function(assets=NULL, category_labels=NULL, weight_seq=NULL) { +portfolio.spec <- function(assets=NULL, category_labels=NULL, weight_seq=NULL, message=FALSE) { # portfolio.spec is based on the v1_constraint object, but removes # constraint specification if (is.null(assets)) { @@ -32,7 +33,7 @@ if (length(assets) == 1) { nassets = assets # we passed in a number of assets, so we need to create the vector - message("assuming equal weighted seed portfolio") + if(message) message("assuming equal weighted seed portfolio") assets <- rep(1 / nassets, nassets) } else { nassets = length(assets) @@ -47,7 +48,7 @@ if(is.character(assets)){ nassets = length(assets) assetnames = assets - message("assuming equal weighted seed portfolio") + if(message) message("assuming equal weighted seed portfolio") assets <- rep(1 / nassets, nassets) names(assets) <- assetnames # set names, so that other code can access it, # and doesn't have to know about the character vector From noreply at r-forge.r-project.org Sat Jul 20 21:37:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 20 Jul 2013 21:37:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2608 - pkg/PortfolioAnalytics/R Message-ID: <20130720193745.D5D37185180@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-20 21:37:45 +0200 (Sat, 20 Jul 2013) New Revision: 2608 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: allow user to specify long only constraints by specifying type=long_only Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-20 19:31:08 UTC (rev 2607) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-20 19:37:45 UTC (rev 2608) @@ -209,6 +209,15 @@ message=message, ...=...) }, + # special case of box constraints for long_only + long_only = {tmp_constraint <- box_constraint(assets=assets, + type=type, + enabled=enabled, + message=message, + min=0, + max=1, + ...=...) + }, # Group constraints group = {tmp_constraint <- group_constraint(assets=assets, type=type, From noreply at r-forge.r-project.org Sun Jul 21 05:53:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 21 Jul 2013 05:53:16 +0200 (CEST) Subject: [Returnanalytics-commits] r2609 - pkg/PortfolioAnalytics/R Message-ID: <20130721035316.3A878185606@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-21 05:53:14 +0200 (Sun, 21 Jul 2013) New Revision: 2609 Modified: pkg/PortfolioAnalytics/R/generics.R Log: adding print methods for objects created by call to optimize.portfolio Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-07-20 19:37:45 UTC (rev 2608) +++ pkg/PortfolioAnalytics/R/generics.R 2013-07-21 03:53:14 UTC (rev 2609) @@ -113,3 +113,151 @@ print.constraint <- function(obj){ print.default(obj) } + +#' Printing Output of optimize.portfolio +#' +#' print method for optimize.portfolio.ROI +#' +#' @param object an object of class "optimize.portfolio.ROI" resulting from a call to optimize.portfolio +#' @param digits the number of significant digits to use when printing. +#' @param ... any other passthru parameters +#' @export +print.optimize.portfolio.ROI <- function(object, digits = max(3, getOption("digits") - 3), ...){ + cat(rep("*", 35) ,"\n", sep="") + cat("PortfolioAnalytics Optimization\n") + cat(rep("*", 35) ,"\n", sep="") + + cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), + "\n\n", sep = "") + + # get optimal weights + cat("Optimal Weights:\n") + print.default(object$weights, digits=digits) + cat("\n") + + # get objective measure + cat("Objective Measure:\n") + print.default(object$out, digits=digits) + cat("\n") +} + +#' Printing Output of optimize.portfolio +#' +#' print method for optimize.portfolio.random +#' +#' @param object an object of class "optimize.portfolio.random" resulting from a call to optimize.portfolio +#' @param digits the number of significant digits to use when printing. +#' @param ... any other passthru parameters +#' @export +print.optimize.portfolio.random <- function(object, digits=max(3, getOption("digits")-3), ...){ + cat(rep("*", 35) ,"\n", sep="") + cat("PortfolioAnalytics Optimization\n") + cat(rep("*", 35) ,"\n", sep="") + + cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), + "\n\n", sep = "") + + # get optimal weights + cat("Optimal Weights:\n") + print.default(object$weights, digits=digits) + cat("\n") + + # get objective measure + cat("Objective Measures:\n") + for(obj in object$objective_measures){ + print.default(obj, digits=digits) + cat("\n") + } + cat("\n") +} + +#' Printing Output of optimize.portfolio +#' +#' print method for optimize.portfolio.DEoptim +#' +#' @param object an object of class "optimize.portfolio.DEoptim" resulting from a call to optimize.portfolio +#' @param digits the number of significant digits to use when printing. +#' @param ... any other passthru parameters +#' @export +print.optimize.portfolio.DEoptim <- function(object, digits=max(3, getOption("digits")-3), ...){ + cat(rep("*", 35) ,"\n", sep="") + cat("PortfolioAnalytics Optimization\n") + cat(rep("*", 35) ,"\n", sep="") + + cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), + "\n\n", sep = "") + + # get optimal weights + cat("Optimal Weights:\n") + print.default(object$weights, digits=digits) + cat("\n") + + # get objective measure + cat("Objective Measures:\n") + for(obj in object$objective_measures){ + print.default(obj, digits=digits) + cat("\n") + } + cat("\n") +} + +#' Printing Output of optimize.portfolio +#' +#' print method for optimize.portfolio.GenSA +#' +#' @param object an object of class "optimize.portfolio.GenSA" resulting from a call to optimize.portfolio +#' @param digits the number of significant digits to use when printing +#' @param ... any other passthru parameters +#' @export +print.optimize.portfolio.GenSA <- function(object, digits=max(3, getOption("digits")-3), ...){ + cat(rep("*", 35) ,"\n", sep="") + cat("PortfolioAnalytics Optimization\n") + cat(rep("*", 35) ,"\n", sep="") + + cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), + "\n\n", sep = "") + + # get optimal weights + cat("Optimal Weights:\n") + print.default(object$weights, digits=digits) + cat("\n") + + # get objective measure + cat("Objective Measures:\n") + for(obj in object$objective_measures){ + print.default(obj, digits=digits) + cat("\n") + } + cat("\n") +} + +#' Printing Output of optimize.portfolio +#' +#' print method for optimize.portfolio.pso +#' +#' @param object an object of class "optimize.portfolio.pso" resulting from a call to optimize.portfolio +#' @param digits the number of significant digits to use when printing. +#' @param ... any other passthru parameters +#' @export +print.optimize.portfolio.pso <- function(object, digits=max(3, getOption("digits")-3), ...){ + cat(rep("*", 35) ,"\n", sep="") + cat("PortfolioAnalytics Optimization\n") + cat(rep("*", 35) ,"\n", sep="") + + cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), + "\n\n", sep = "") + + # get optimal weights + cat("Optimal Weights:\n") + print.default(object$weights, digits=digits) + cat("\n") + + # get objective measure + cat("Objective Measures:\n") + for(obj in object$objective_measures){ + print.default(obj, digits=digits) + cat("\n") + } + cat("\n") +} + From noreply at r-forge.r-project.org Sun Jul 21 12:18:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 21 Jul 2013 12:18:49 +0200 (CEST) Subject: [Returnanalytics-commits] r2610 - in pkg/PerformanceAnalytics/sandbox/pulkit: week2/code week3_4/vignette Message-ID: <20130721101849.3C5B0184E52@r-forge.r-project.org> Author: pulkit Date: 2013-07-21 12:18:48 +0200 (Sun, 21 Jul 2013) New Revision: 2610 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw Log: changes in SR indifferent curves Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-21 03:53:14 UTC (rev 2609) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-21 10:18:48 UTC (rev 2610) @@ -1,6 +1,56 @@ -BenchmarkSRPlots<-function(R=NULL,ylab = NULL,xlab = NULL,lwd = 2,pch = 1,cex = 1,avgSR = NULL,columns = NULL,...){ +#'@title Benchmark Sharpe Ratio Plots +#' +#'@description +#'Benchmark Sharpe Ratio Plots are used to give the relation ship between the +#'Benchmark Sharpe Ratio and average correlation,average sharpe ratio or the number of #'strategies keeping other parameters constant. Here average Sharpe ratio , average #'correlation stand for the average of all the strategies in the portfolio. The original +#'point of the return series is also shown on the plots. +#' +#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#'@param ylab set the y-axis label, as in \code{\link{plot}} +#'@param xlab set the x-axis label, as in \code{\link{plot}} +#'@param main set the chart title, as in \code{\link{plot}} +#'@param element.color set the element.color value as in \code{\link{plot}} +#'@param lwd set the width of the line, as in \code{\link{plot}} +#'@param pch set the pch value, as in \code{\link{plot}} +#'@param cex set the cex value, as in \code{\link{plot}} +#'@param cex.axis set the cex.axis value, as in \code{\link{plot}} +#'@param cex.main set the cex.main value, as in \code{\link{plot}} +#'@param vs The values against which benchmark SR has to be plotted. can be +#'"sharpe","correlation" or "strategies" +#'@param ylim set the ylim value, as in \code{\link{plot}} +#'@param xlim set the xlim value, as in \code{\link{plot}} + +#'@references +#'Bailey, David H. and Lopez de Prado, Marcos, The Strategy Approval Decision: +#'A Sharpe Ratio Indifference Curve Approach (January 2013). Algorithmic Finance, +#'Vol. 2, No. 1 (2013). +#' +#'@seealso \code{\link{plot}} +#'@keywords ts multivariate distribution models hplot +#'@examples +#' +#'chart.BenchmarkSR(edhec,vs="strategies") +#'chart.BenchmarkSR(edhec,vs="sharpe") +#'@export + +chart.BenchmarkSR<-function(R=NULL,main=NULL,ylab = NULL,xlab = NULL,element.color="darkgrey",lwd = 2,pch = 1,cex = 1,cex.axis=0.8,cex.lab = 1,cex.main = 1,vs=c("sharpe","correlation","strategies"),xlim = NULL,ylim = NULL,...){ + # DESCRIPTION: + # Draws Benchmark SR vs various variables such as average sharpe , + # average correlation and the number of strategies + # INPUT: + # The Return Series of the portfolio is taken as the input. The Return + # Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of + # asset returns. + + # All other inputs are the same as "plot" and are principally included + # so that some sensible defaults could be set. + + # vs parameter takes the value against which benchmark sr has to be plotted + + # FUNCTION: if(!is.null(R)){ x = checkData(R) columns = ncol(x) @@ -20,10 +70,67 @@ } } corr_avg = corr_avg*2/(columns*(columns-1)) - - rho = seq(0,1,length.out=30) - SR_B = avgSR*sqrt(columns/(1+(columns-1)*rho)) - plot(rho,SR_B,type="l",xlab="Correlation",ylab="Benchmark Sharpe Ratio",main="Benchmark Sharpe Ratio vs Correlation") - points(corr_avg[1,1],BenchmarkSR(R),col="blue",pch=10) - text(corr_avg[1,1],BenchmarkSR(R),"Original Point",pos=4) -} \ No newline at end of file + if(vs=="sharpe"){ + if(is.null(ylab)){ + ylab = "Benchmark Sharpe Ratio" + } + if(is.null(xlab)){ + xlab = "Average Sharpe Ratio" + } + if(is.null(main)){ + main = "Benchmark Sharpe Ratio vs Average Sharpe Ratio" + } + sr = seq(0,1,length.out=30) + SR_B = sr*sqrt(columns/(1+(columns-1)*corr_avg[1,1])) + plot(sr,SR_B,type="l",xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab) + points(avgSR,BenchmarkSR(R),col="blue",pch=10) + text(avgSR,BenchmarkSR(R),"Return Series ",pos=4) + } + if(vs=="correlation"){ + + if(is.null(ylab)){ + ylab = "Benchmark Sharpe Ratio" + } + if(is.null(xlab)){ + xlab = "Average Correlation" + } + if(is.null(main)){ + main = "Benchmark Sharpe Ratio vs Correlation" + } + rho = seq(0,1,length.out=30) + SR_B = avgSR*sqrt(columns/(1+(columns-1)*rho)) + plot(rho,SR_B,type="l",xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab) + points(corr_avg[1,1],BenchmarkSR(R),col="blue",pch=10) + text(corr_avg[1,1],BenchmarkSR(R),"Return Series ",pos=4) + } + if(vs=="strategies"){ + + if(is.null(ylab)){ + ylab = "Benchmark Sharpe Ratio" + } + if(is.null(xlab)){ + xlab = "Number of Strategies" + } + if(is.null(main)){ + main = "Benchmark Sharpe Ratio vs Number of Strategies" + } + n = seq(2,100,length.out=20) + SR_B = avgSR*sqrt(n/(1+(n-1)*corr_avg[1,1])) + plot(n,SR_B,type="l",xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab) + points(columns,BenchmarkSR(R),col="blue",pch=10) + text(columns,BenchmarkSR(R),"Return Series ",pos=4) + } + +} + +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2013 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: BenchmarkSRPlots.R $ +# +############################################################################### \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-21 03:53:14 UTC (rev 2609) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-21 10:18:48 UTC (rev 2610) @@ -11,6 +11,9 @@ #'@aliases BenchmarkSR #'\deqn{SR_B = \bar{SR}\sqrt{\frac{S}{1+(S-1)\bar{\rho}}}} #' +#'Here \eqn{\bar{SR}} is the average SR of the portfolio and \eqn{\bar{\rho}} +#'is the average correlation across off-diagonal elements +#' #'@param R a vector, matrix, data frame,timeseries or zoo object of asset returns #' #'@references @@ -21,11 +24,20 @@ #'@examples #' #'data(edhec) -#'BenchmarkSR(edhec) #expected 0.2019308 +#'BenchmarkSR(edhec) #expected 0.393797 #' #'@export #' BenchmarkSR<-function(R){ + # DESCRIPTION: + # Returns the Value of the Benchmark Sharpe Ratio. + + # INPUT: + # The return series of all the series in the portfolio is taken as the input + # The return series can be a vector, matrix, data frame,timeseries or zoo + # object of asset returns. + + # FUNCTION: x = checkData(R) columns = ncol(x) #TODO : What to do if the number of columns is only one ? @@ -45,3 +57,14 @@ SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg[1,1])) return(SR_Benchmark) } +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2013 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: BenchmarkSR.R $ +# +############################################################################### \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R 2013-07-21 03:53:14 UTC (rev 2609) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R 2013-07-21 10:18:48 UTC (rev 2610) @@ -3,32 +3,69 @@ #' #'@description #'The trade-off between a candidate?s SR and its correlation -#' to the existing set of strategies, is given by the Sharpe -#' ratio indifference curve. It is a plot between the candidate's -#' Sharpe Ratio and candidate's average correlation for a given -#' portfolio Sharpe Ratio. +#'to the existing set of strategies, is given by the Sharpe +#'ratio indifference curve. It is a plot between the candidate's +#'Sharpe Ratio and candidate's average correlation for a given +#'portfolio Sharpe Ratio.Portfolio's sharpe Ratio remains constant +#'if any strategy from the Sharpe Ratio Indifference Curve is added. #' #'The equation for the candidate's average autocorrelation for a given #'sharpe Ratio is given by #' #'\deqn{\bar{\rho{_s+1}}=\frac{1}{2}\biggl[\frac{\bar{SR}.S+SR_{s+1}^2}{S.SR_B^2}-\frac{S+1}{S}-\bar{rho}{S-1}\biggr]} #' +#'This is the correlation that the candidate's strategy should have with the portfolio +#'for the Sharpe Ratio of the portfolio to remain constant if this strategy is added. +#' #'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns +#'@param reference.grid if true, draws a grid aligned with the points on the x +#'and y axes #'@param ylab set the y-axis label, as in \code{\link{plot}} #'@param xlab set the x-axis label, as in \code{\link{plot}} +#'@param main set the chart title, as in \code{\link{plot}} +#'@param element.color set the element.color value as in \code{\link{plot}} #'@param lwd set the width of the line, as in \code{\link{plot}} #'@param pch set the pch value, as in \code{\link{plot}} #'@param cex set the cex value, as in \code{\link{plot}} +#'@param cex.axis set the cex.axis value, as in \code{\link{plot}} +#'@param cex.main set the cex.main value, as in \code{\link{plot}} +#'@param ylim set the ylim value, as in \code{\link{plot}} +#'@param xlim set the xlim value, as in \code{\link{plot}} #' #'@references #'Bailey, David H. and Lopez de Prado, Marcos, The Strategy Approval Decision: #'A Sharpe Ratio Indifference Curve Approach (January 2013). Algorithmic Finance, #'Vol. 2, No. 1 (2013). #' -#' -SRIndifference<-function(R, ylab = NULL,xlab = NULL,lwd = 2,pch = 1,cex = 1,...){ +#'@seealso \code{\link{plot}} +#'@keywords ts multivariate distribution models hplot +#'@examples +#' +#'data(edhec) +#'chart.SRIndifference(edhec) +#' +#'@export + +chart.SRIndifference<-function(R,reference.grid = TRUE, ylab = NULL,xlab = NULL,main = "Sharpe Ratio Indifference Curve",element.color = "darkgrey",lwd = 2,pch = 1,cex = 1,cex.axis = 0.8,cex.lab = 1,cex.main = 1,ylim = NULL,xlim = NULL,...){ + # DESCRIPTION: + # Draws the Sharpe Ratio Indifference curve, which gives us pairs + # of correlation and sharpe ratio of strategies which when added + # to the portfolio do not effect the portfolio's Sharpe Ratio. + + # INPUT: + # The Return Series of the portfolio is taken as the input. The Return + # Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of + # asset returns. + + # All other inputs are the same as "plot" and are principally included + # so that some sensible defaults could be set. + + # Output: + # Draws the Sharpe Ratio Indifference Curve with some sensible defaults. + + # FUNCTION: x = checkData(R) columns = ncol(x) #TODO: What to do when the number of columns is 1 ? @@ -45,7 +82,7 @@ } } corr_avg = corr_avg*2/(columns*(columns-1)) - SR_B = BenchmanrkSR(R) + SR_B = BenchmarkSR(R) corr_range = seq(-1,1,length.out = 30) SR_i = NULL for(i in corr_range){ @@ -58,7 +95,23 @@ if(is.null(xlab)){ xlab = "Candidate's Strategy's Sharpe Ratio" } - plot(SR_i,corr_range,type="l",xlab = xlab,ylab = ylab,main="Sharpe Ratio Indifference Curve") - #OR we can use ggplot2 for much better plots - #qplot(SR_i,corr_range,geom="line",xlab=xlab,ylab=ylab,main="Sharpe Ratio IndifferenceCurve",margins=TRUE,facet="grid")+stat_summary() + plot(corr_range~SR_i,type="l",xlab = '',ylab = '',main=main,cex =cex,xlim = xlim,ylim = ylim,pch = pch,lwd = lwd) + title(ylab = ylab,cex.lab = cex.lab) + title(xlab = xlab,cex.lab = cex.lab) + if(reference.grid) { + grid(col = element.color) + abline(h = 0, col = element.color) + abline(v = 0, col = element.color) + } } +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2013 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.SRIndifferenceCurve.R $ +# +############################################################################### \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw 2013-07-21 03:53:14 UTC (rev 2609) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw 2013-07-21 10:18:48 UTC (rev 2610) @@ -49,6 +49,9 @@ @ +<>= +source("../code/TuW.R") +@ \section{ Maximum Drawdown } Maximum Drawdown tells us Up to how much could a particular strategy lose with a given confidence level ?. This function calculated Maximum Drawdown for two underlying processes normal and autoregressive. For a normal process Maximum Drawdown is given by the formula @@ -101,8 +104,17 @@ For a Autoregressive process the Time under water is found using the golden section algorithm. \subsection{Usage} +<<>>= +data(edhec) +TuW(edhec,0.95,type="ar") +@ +The Return Series ,confidence level and the type of distribution is taken as the input. The Return Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns. +The out is given in the same periodicity as the input series. +\section{ Golden Section Algorithm } + + \end{document} From noreply at r-forge.r-project.org Sun Jul 21 18:34:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 21 Jul 2013 18:34:54 +0200 (CEST) Subject: [Returnanalytics-commits] r2611 - in pkg/Meucci: . R demo man Message-ID: <20130721163454.35E2B1857DD@r-forge.r-project.org> Author: xavierv Date: 2013-07-21 18:34:53 +0200 (Sun, 21 Jul 2013) New Revision: 2611 Added: pkg/Meucci/R/PlotMarginalsNormalInverseWishart.R pkg/Meucci/R/RandNormalInverseWishart.R pkg/Meucci/demo/S_AnalyzeNormalInverseWishart.R pkg/Meucci/demo/S_CorrelationPriorUniform.R pkg/Meucci/demo/S_EvaluationGeneric.R pkg/Meucci/demo/S_MarkovChainMonteCarlo.R pkg/Meucci/man/PlotMarginalsNormalInverseWishart.Rd pkg/Meucci/man/RandNormalInverseWishart.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE Log: - added all the scripts from chapters 7 and 8 and its associated functions Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-21 10:18:48 UTC (rev 2610) +++ pkg/Meucci/DESCRIPTION 2013-07-21 16:34:53 UTC (rev 2611) @@ -30,10 +30,11 @@ xts (>= 0.8), matlab, pracma, - R.utils + R.utils, + mvtnorm, + dlm Suggests: quadprog, - mvtnorm, limSolve, Matrix, MASS, @@ -83,3 +84,5 @@ 'FitExpectationMaximization.R' 'QuantileMixture.R' 'GenerateUniformDrawsOnUnitSphere.R' + 'PlotMarginalsNormalInverseWishart.R' + 'RandNormalInverseWishart.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-21 10:18:48 UTC (rev 2610) +++ pkg/Meucci/NAMESPACE 2013-07-21 16:34:53 UTC (rev 2611) @@ -28,8 +28,10 @@ export(PartialConfidencePosterior) export(PerformIidAnalysis) export(PlotDistributions) +export(PlotMarginalsNormalInverseWishart) export(ProjectionStudentT) export(QuantileMixture) +export(RandNormalInverseWishart) export(Raw2Central) export(Raw2Cumul) export(RejectOutlier) Added: pkg/Meucci/R/PlotMarginalsNormalInverseWishart.R =================================================================== --- pkg/Meucci/R/PlotMarginalsNormalInverseWishart.R (rev 0) +++ pkg/Meucci/R/PlotMarginalsNormalInverseWishart.R 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,77 @@ +#' Plot the marginals of the normal-inverse-Whishart model. +#' Described in A. Meucci "Risk and Asset Allocation", Springer, 2005 +#' +#' @param Mu_Simul : [] +#' @param InvSigma_Simul : [] +#' @param Mu_0 : [] +#' @param T_0 : [] +#' @param Sigma_0 : [] +#' @param Nu_0 : [] +#' @param Legend : [] +#' +#' @note Numerically and analytically the marginal pdf of +#' - the first entry of the random vector Mu +#' - the (1,1)-entry of the random matrix inv(Sigma) +#' when Mu and Sigma are jointly normal-inverse-Wishart: Mu ~ St(Mu_0,Sigma/T_0) +#' inv(Sigma) ~ W(Nu_0,inv(Sigma_0)/Nu_0) +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "QuantileMixture.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +PlotMarginalsNormalInverseWishart = function(Mu_Simul, InvSigma_Simul, Mu_0, T_0, Sigma_0, Nu_0, Legend) +{ + NumSimulations = nrow( Mu_Simul ); + NumBins = round( 10 * log( NumSimulations )); + + dev.new(); + + ################################################################################################################# + ### Mu + # plot empirical pdf (histogram) + par( mfrow = c(2,1) ); + h = hist(Mu_Simul[ , 1 ], NumBins, plot= FALSE); + D = h$mids[ 2 ] - h$mids[ 1 ]; + n= h$counts /( D * NumSimulations ); + plot( h$mids, n, type = "h", main = bquote(paste( .(Legend)," ", mu)) ); + #barplot( n ); + + # superimpose analytical expectation + points( Mu_0[ 1 ], 0, pch = 21, bg = "red" ); + + + # superimpose analytical pdf + x_lo = min(Mu_Simul[ ,1 ]); + x_hi = max(Mu_Simul[ ,1 ]); + x_grid = seq( x_lo, x_hi, (x_hi-x_lo)/100 ); + m = Mu_0[ 1 ]; + s = sqrt(Sigma_0[ 1, 1] / T_0 ); + f = 1 / s * dt( (x_grid - m )/s, Nu_0 ); + lines(x_grid, f ,col = "red" ); + + ################################################################################################################# + ### Sigma + # plot empirical pdf (histogram) + h = hist(InvSigma_Simul[ ,1 ], NumBins, plot= FALSE ); + D = h$mids[ 2 ] - h$mids[ 1 ]; + n= h$counts /( D * NumSimulations ); + plot( h$mids, n, type = "h", main = bquote(paste( .(Legend), " inv(Sigma)")) ); + + # superimpose analytical expectation + InvSigma_0=solve(Sigma_0); + points(InvSigma_0[ 1, 1 ],0, pch = 21, bg = "red" ); + + + # superimpose analytical pdf + x_lo = min(InvSigma_Simul[ ,1 ]); + x_hi = max(InvSigma_Simul[ ,1 ]); + x_grid = seq( x_lo, x_hi, (x_hi-x_lo)/100 ); + sigma_square = InvSigma_0[ 1, 1] / Nu_0; + A = Nu_0 / 2; + B = 2 * sigma_square; + f = dgamma(x_grid, shape = A, scale = B); + lines(x_grid, f, col = "red" ); +} \ No newline at end of file Added: pkg/Meucci/R/RandNormalInverseWishart.R =================================================================== --- pkg/Meucci/R/RandNormalInverseWishart.R (rev 0) +++ pkg/Meucci/R/RandNormalInverseWishart.R 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,56 @@ + +#' Generates a multivariate i.i.d. sample of lenght J from the normal-inverse-Wishart distribution, as described in +#' A. Meucci "Risk and Asset Allocation", Springer, 2005. +#' +#' @param Mu_0 : [vector] +#' @param T_0 : [scalar] +#' @param Sigma_0 : [matrix] +#' @param nu_0 : [scalar] +#' @param J : [scalar] +#' +#' @return Mu : [vector] +#' @return Sigma : [matrix] +#' @return InvSigma : [matrix] +#' +#' @note +#' Mu|Sigma ~ N(Mu_0,Sigma/T_0) +#' inv(Sigma) ~ W(Nu_0,inv(Sigma_0)/Nu_0) +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "RandNormalInverseWishart.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +RandNormalInverseWishart = function(Mu_0, T_0, Sigma_0, nu_0, J) +{ + N = length( Mu_0 ); + VecIndex = NULL; + for( n in 1 : N ) + { + VecIndex[ n ] = cbind( VecIndex, ( n-1 ) * N +( n:N ) ); ##ok + } + + invSigma_0 = solve(Sigma_0) %*% diag( 1, dim( Sigma_0 )); + Phi = invSigma_0 / nu_0; + + Mu = NULL; + Sigma = NULL; + InvSigma = NULL; + + for( j in 1 : J ) + { + Inv_Sigma = rwishart( df = nu_0, Sigma = Phi ); + InvSigma = rbind( InvSigma, Inv_Sigma[ VecIndex ] ); + + S = solve(Inv_Sigma) %*% diag( 1, dim( Inv_Sigma ) ); + Sigma = rbind( Sigma, S[VecIndex] ); + + M = rmvnorm( nrow(Mu_0) * nrow(S/T_0), Mu_0, S/T_0); + Mu = rbind( Mu, M ); + } + + return( list( Mu = Mu, Sigma = Sigma , InvSigma = InvSigma ) ) +} + Added: pkg/Meucci/demo/S_AnalyzeNormalInverseWishart.R =================================================================== --- pkg/Meucci/demo/S_AnalyzeNormalInverseWishart.R (rev 0) +++ pkg/Meucci/demo/S_AnalyzeNormalInverseWishart.R 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,86 @@ +#' This script familiarizes the users with multivariate Bayesian estimation. +#' A normal time series is generated a normal-inverse-Wishart prior is set. +#' The ensuing normal-inverse-Wishart posterior is computed and analyzed numerically and analytically. +#' Described in A. Meucci,"Risk and Asset Allocation",Springer, 2005, Chapter 7. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_AnalyzeNormalInverseWishart.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################### +### Inputs +N = 1; # market dimension +nSim = 2000; + +################################################################################################################### +### History : X_t ~ N(M,S), t=1,...,T +# set parameters +M = 1 * array( 1, N ); +s = 1 * array( 1, N ); +r = 0.7; +C = (1 - r) * diag( 1, N ) + r * matrix( 1, N, N); +S = diag( s, N ) %*% C %*% diag( s, N ); +T = 520; + +# generate time series +X = rmvnorm( T, M, S); +Mu_Hat = apply(X, 2, mean); +Sigma_Hat = cov(X); + +################################################################################################################### +### Prior : Mu|Sigma ~ N(Mu_0,Sigma/T_0) +### Omega == inv(Sigma) ~ W(Nu_0,inv(Sigma_0)/Nu_0) +# set parameters +Mu_0 = 2 * array( 1, N ); +T_0 = 520; +s_0 = 2 * array( 1, N ); +r = 0.3; +C = ( 1 - r ) * diag( 1, N ) + r * matrix( 1, N, N ); +Sigma_0 = diag( s_0, N ) %*% C %*% diag( s_0, N ); +Nu_0 = 520; + +# generate simulations +RNIWPrior= RandNormalInverseWishart(Mu_0, T_0, Sigma_0, Nu_0, nSim); + +# plot results +PlotMarginalsNormalInverseWishart( RNIWPrior$Mu , RNIWPrior$InvSigma, Mu_0, T_0, Sigma_0, Nu_0, "prior" ); + +################################################################################################################### +### Posterior : Mu|Sigma ~ N(Mu_1,Sigma/T_1) +### Omega == inv(Sigma) ~ W(Nu_1,inv(Sigma_1)/Nu_1) + +# set parameters +T_1 = T_0 + T; +Mu_1 = ( T_0 %*% Mu_0 + T %*% Mu_Hat) / T_1; +Nu_1 = Nu_0 + T; +Sigma_1 = ( Nu_0 %*% Sigma_0 + T %*% Sigma_Hat + ( T %*% T_0 / (T + T_0)) %*% (Mu_0 - Mu_Hat) %*% t(Mu_0 - Mu_Hat) ) / Nu_1; + +# generate simulations +RNIWPost = RandNormalInverseWishart(Mu_1, T_1, Sigma_1, Nu_1, nSim); + +# plot results +PlotMarginalsNormalInverseWishart( RNIWPost$Mu, RNIWPost$InvSigma, Mu_1, T_1, Sigma_1, Nu_1, "posterior" ); + +################################################################################################################### +### Compute statistics +Mu_CE_Num = apply( RNIWPost$Mu, 2, mean); +Mu_CE_Anal = t( Mu_1 ); +Mu_Hat = t( Mu_Hat ); +Mu_0 = t( Mu_0 ); + +Mu_Scatter_Num = cov( RNIWPost$Mu ); +Mu_Scatter_Anal = Nu_1 / ( Nu_1 - 2 ) * Sigma_1 / T_1; + +Sigma_CE_Num = apply(RNIWPost$Sigma,2, mean); +Sigma_CE_Anal = Sigma_1; +print(Sigma_Hat); +print(Sigma_0); + +Sigma_Scatter_Num = cov(RNIWPost$Sigma); + +InvSigma_CE_Num = apply(RNIWPost$InvSigma, 2, mean); +S = solve( Sigma_1 ); +InvSigma_CE_Anal = S; + Added: pkg/Meucci/demo/S_CorrelationPriorUniform.R =================================================================== --- pkg/Meucci/demo/S_CorrelationPriorUniform.R (rev 0) +++ pkg/Meucci/demo/S_CorrelationPriorUniform.R 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,78 @@ +#' This script shows how a jointly uniform prior on the correlations implies that the marginal distribution of +#' each correlation is peaked around zero , as described in A. Meucci,"Risk and Asset Allocation",Springer, 2005, +#' Chapter 7. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_CorrelationPriorUniform.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs +N = 3; # dimensionality of the problem +K = N * (N - 1) / 2; +J = 10000; # number of simulations + +################################################################################################################## +### Compute correlations in all scenarios +CorrsAsTensor = array(0, dim = c(J,N,N) ); +Eigs = NULL; +j = 1; + +while( j < J ) +{ + C = 2 * matrix( runif(K), 1, K ) - 1; + Corr = diag( 1, N ); + k = 0; + for( n in 1 : ( N - 1 ) ) + { + for( m in ( n + 1 ) : N ) + { + k = k + 1; + Corr[ n, m ] = C[ k ]; + Corr[ m, n ] = Corr[ n, m ]; + } + } + E = eigen(Corr)$values; + if( min(E) > 0 ) + { + CorrsAsTensor[ j, , ] = Corr; + j = j + 1; + } + Eigs = rbind(Eigs, t(E) ); +} + +##################################################################################################################### +### Reassemble results in an entry-wise structure that runs on the upper triangular portion of the correlation +CorrsAsEntries = NULL; +for( n in 1 : (N-1) ) +{ + for( m in (n + 1) : N ) + { + el = list( Values = CorrsAsTensor[ , n, m ], Names = paste("{", n, m,"}")); + # CorrsAsEntries[ k ]$Names = ["\theta_{") num2str(n) num2str(m) "}"]; + CorrsAsEntries = rbind( CorrsAsEntries, el ) + } +} +##################################################################################################################### +### Plots +# univariate marginals +K = nrow( CorrsAsEntries ); +Nbins = round( 5 * log( J ) ); +for( k in 1 : K ) +{ + dev.new(); + hist(CorrsAsEntries[ k, ]$Values, Nbins, xlab = "", ylab = "", main = bquote( paste("histogram of ", theta, .(CorrsAsEntries[k,]$Names)))); +} + +# bivariate marginals +for( k in 1 : (K-1) ) +{ + for( j in (k + 1) : K ) + { + dev.new(); + plot(CorrsAsEntries[k, ]$Values,CorrsAsEntries[j, ]$Values, xlab = "", ylab = "", + main = paste( CorrsAsEntries[ k ]$Names, ' - ', CorrsAsEntries[ j ]$Names )); + } +} Added: pkg/Meucci/demo/S_EvaluationGeneric.R =================================================================== --- pkg/Meucci/demo/S_EvaluationGeneric.R (rev 0) +++ pkg/Meucci/demo/S_EvaluationGeneric.R 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,217 @@ +#' Determine the optimal allocation, as described in A. Meucci "Risk and Asset Allocation", Springer, 2005 +#' +#' @param Market : [struct] market parameters +#' @param InvestorProfile : [struct] investor's parameters +#' +#' @return Allocation : [vector] (N x 1) +#' +#' @note +#' compute optimal allocation, only possible if hidden parameters were known: thus it is not a "decision", we call it a "choice" +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for " EvaluationChoiceOptimal.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + +EvaluationChoiceOptimal = function( Market, InvestorProfile ) +{ + Exp_Prices = diag( Market$CurrentPrices, length(Market$CurrentPrices) ) %*% ( 1 + Market$LinRets_EV ); + Cov_Prices = diag( Market$CurrentPrices, length(Market$CurrentPrices) ) %*% Market$LinRets_Cov %*% diag( Market$CurrentPrices, length(Market$CurrentPrices) ); + + S = solve( Cov_Prices ) %*% diag( 1, dim(Cov_Prices) ); + A = (t( Market$CurrentPrices ) %*% S %*% Market$CurrentPrices)[ 1 ]; + B = (t( Market$CurrentPrices ) %*% S %*% Exp_Prices)[1]; + + Gamma = (( InvestorProfile$Budget - InvestorProfile$RiskPropensity * B) / A )[1]; + Allocation = InvestorProfile$RiskPropensity * S %*% Exp_Prices + Gamma[ 1 ] * S %*% Market$CurrentPrices; + + return( Allocation ); +} + +#' Compute the certainty-equivalent statisfaction index , as described in A. Meucci "Risk and Asset Allocation", +#' Springer, 2005. +#' +#' @param Allocation : [vector] (N x 1) +#' @param Market : [struct] market parameters +#' @param InvestorProfile : [struct] investor s parameters +#' +#' @return CertaintyEquivalent : [scalar] +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for " EvaluationSatisfaction.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + +EvaluationSatisfaction = function( Allocation, Market, InvestorProfile ) +{ + CertaintyEquivalent = t(Allocation) %*% diag( Market$CurrentPrices, length( Market$CurrentPrices ) ) %*% (1 + Market$LinRets_EV) - 1 / (2 * InvestorProfile$RiskPropensity) * t( Allocation ) %*% diag( Market$CurrentPrices, length( Market$CurrentPrices )) %*% Market$LinRets_Cov %*% diag( Market$CurrentPrices, length( Market$CurrentPrices )) %*% Allocation ; + + return( CertaintyEquivalent[1] ) +} + + +#' Determine the allocation of the best performer, as described in A. Meucci "Risk and Asset Allocation", +#' Springer, 2005. +#' +#' @param Market : [struct] market parameters +#' @param InvestorProfile : [struct] investors parameters +#' +#' @return Allocation : [vector] (N x 1) +#' +#' @note +#' scenario-dependent decision that tries to pick the optimal allocation +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "EvaluationDecisionBestPerformer.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +EvaluationDecisionBestPerformer = function( Market, InvestorProfile ) +{ + # find index of best performer + B = which.max( Market$LinRetsSeries[ nrow(Market$LinRetsSeries) , ] ); ##ok + + # invest in that asset + I = diag( 1, length(Market$CurrentPrices) ); + Allocation = InvestorProfile$Budget * I[ , B ] / Market$CurrentPrices[ B ]; + + return( Allocation ); +} + + +#' Determine the cost of allocation, as described in A. Meucci "Risk and Asset Allocation", Springer, 2005. +#' +#' @param Allocation : [vector] (N x 1) +#' @param Market : [struct] market parameters +#' @param InvestorProfile : [struct] investor's parameters +#' +#' @return C_Plus : [scalar] cost +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "EvaluationDecisionBestPerformer.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +EvaluationCost = function( Allocation, Market, InvestorProfile ) +{ + aXi = t(Allocation) %*% diag( Market$CurrentPrices, length( Market$CurrentPrices ) ) %*% (1 + Market$LinRets_EV); + aPhia = t(Allocation) %*% diag( Market$CurrentPrices, length( Market$CurrentPrices ) ) %*% Market$LinRets_Cov %*% diag( Market$CurrentPrices, length( Market$CurrentPrices ) ) %*% Allocation; + + C = ( 1 - InvestorProfile$BaR ) * InvestorProfile$Budget - aXi + sqrt(2 %*% aPhia) * erfinv( 2 * InvestorProfile$Confidence - 1); + C_Plus = max(C, 0); + return( C_Plus ); + +} + + +#' This script evaluates a generic allocation decision (in this case the "best performer" strategy, which fully +#' invest the budget in the last period's best performer). +#' It displays the distribution of satisfaction, cost of constraint violation and opportunity cost for each value +#' of the market stress-test parameters (in this case the correlation). +#' Described in A. Meucci "Risk and Asset Allocation", Springer, 2005, Chapter 8. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EvaluationGeneric.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Inputs +NumScenarios = 1000; +NumCorrelations = 5; +Bottom_Correlation = 0; +Top_Correlation = 0.99; + +################################################################################################################## +### Input investor's parameters +InvestorProfile = NULL; +InvestorProfile$Budget = 10000; +InvestorProfile$RiskPropensity = 30; +InvestorProfile$Confidence = 0.9; +InvestorProfile$BaR = 0.2; + +################################################################################################################## +### Input market parameters +NumAssets = 10; +a = 0.5; # effect of correlation on expected values and volatility (hidden) +Bottom = 0.06; +Top = 0.36; +Step = (Top - Bottom) / (NumAssets - 1); +v = seq( Bottom, Top, Step ) ; # volatility vector +Market = NULL; +Market$T = 20; # not hidden +Market$CurrentPrices = 10 * array( 1, NumAssets); # not hidden + +################################################################################################################## +Step = (Top_Correlation - Bottom_Correlation) / (NumCorrelations - 1); +Overall_Correlations = seq( Bottom_Correlation, Top_Correlation, Step ); + +Suboptimal = NULL; +Suboptimal$StrsTst_Satisfaction = NULL; +Suboptimal$StrsTst_CostConstraints = NULL; +Suboptimal$StrsTst_OppCost = NULL; +Optimal = NULL; +Optimal$StrsTst_Satisfaction = NULL; + +for( t in 1 : length(Overall_Correlations) ) +{ + # input the (hidden) market parameters (only correlations, we assume standard deviations and expected values fixed and known) + Market$St_Devations = ( 1 + a * Overall_Correlations[ t ]) * v; # hidden + Market$LinRets_EV = 0.5 * Market$St_Devations; # hidden + + Correlation = ( 1 - Overall_Correlations[ t ] ) * diag( 1, NumAssets) + Overall_Correlations[ t ] * matrix( 1, NumAssets, NumAssets); + Market$LinRets_Cov = diag( Market$St_Devations, length(Market$St_Devations) ) %*% Correlation %*% diag( Market$St_Devations, length(Market$St_Devations) ) + + + ################################################################################################################## + # compute optimal allocation, only possible if hidden parameters were known: thus it is not a "decision", we call it a "choice" + Allocation = EvaluationChoiceOptimal( Market, InvestorProfile ); + Satisfaction_Optimal = EvaluationSatisfaction( Allocation, Market, InvestorProfile ); + + ################################################################################################################## + # choose allocation based on available information + StrsTst_TrueSatisfaction = NULL; + StrsTst_CostConstraints = NULL; + + for( s in 1 : NumScenarios ) + { + # generate scenarios i_T of information I_T + Market$LinRetsSeries = rmvnorm( Market$T, Market$LinRets_EV, Market$LinRets_Cov ); + + # scenario-dependent decision that tries to pick the optimal allocation + Allocation = EvaluationDecisionBestPerformer( Market, InvestorProfile ); + TrueSatisfaction = EvaluationSatisfaction( Allocation, Market, InvestorProfile ); + CostConstraints = EvaluationCost( Allocation, Market, InvestorProfile ); + + StrsTst_TrueSatisfaction = cbind( StrsTst_TrueSatisfaction, TrueSatisfaction ); ##ok<*AGROW> + StrsTst_CostConstraints = cbind( StrsTst_CostConstraints, CostConstraints ); + } + + Suboptimal$StrsTst_CostConstraints = rbind( Suboptimal$StrsTst_CostConstraints, StrsTst_CostConstraints ); + Suboptimal$StrsTst_Satisfaction = rbind( Suboptimal$StrsTst_Satisfaction, StrsTst_TrueSatisfaction ); + Suboptimal$StrsTst_OppCost = rbind( Suboptimal$StrsTst_OppCost, Satisfaction_Optimal - StrsTst_TrueSatisfaction + StrsTst_CostConstraints ); + Optimal$StrsTst_Satisfaction = rbind( Optimal$StrsTst_Satisfaction, Satisfaction_Optimal ); +} + +################################################################################################################## +### Display +NumVBins = round(10 * log(NumScenarios)); + +# optimal allocation vs. allocation decision +for( t in 1 : length(Overall_Correlations) ) +{ + dev.new(); + par( mfrow = c( 3, 1) ) + hist(Suboptimal$StrsTst_Satisfaction[ t, ], NumVBins, main = "satisfaction", xlab ="", ylab = "" ); + + hist(Suboptimal$StrsTst_CostConstraints[ t, ], NumVBins, main = "constraint violation cost", xlab ="", ylab = ""); + + hist(Suboptimal$StrsTst_OppCost[ t, ], NumVBins, main = "opportunity cost", xlab ="", ylab = ""); +} \ No newline at end of file Added: pkg/Meucci/demo/S_MarkovChainMonteCarlo.R =================================================================== --- pkg/Meucci/demo/S_MarkovChainMonteCarlo.R (rev 0) +++ pkg/Meucci/demo/S_MarkovChainMonteCarlo.R 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,52 @@ +#' This script illustrates the Metropolis-Hastings algorithm, as described in A. Meucci,"Risk and Asset Allocation", +#' Springer, 2005, Chapter 7. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_MarkovChainMonteCarlo.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Set-up target and candidate +# kernel of the target distribution +kernel = function(x) dnorm( x, 1, 0.5 ); + +# parameters of the normal candidate distribution +mu = 0; +sig = 5; + +################################################################################################################## +### Set up MH algorithm +nSim = 10000; +xt = matrix( NaN, nSim, 1); +xt[ 1 ] = 0; +nacc = 0; +for( i in 2 : nSim ) +{ + # normal candidate + r = mu + sig * rnorm(1); + # kernel at candidate + f1 = kernel( r ); + # kernel at past + f2 = kernel( xt[ i-1 ] ); + prob = f1 / f2; + xt[ i ] = xt[ i-1 ]; + if( prob > 1 || runif(1) > (1 - prob) ) + { + xt[ i ] = r; + nacc = nacc + 1; + } +} +################################################################################################################## +### Post-process output +# acceptance rate +print( nacc / nSim ); + +# display MCMC over time +dev.new(); +plot( xt, type = "l" ); + +# distribution +dev.new(); +hist( xt, log(10*nSim) ); Added: pkg/Meucci/man/PlotMarginalsNormalInverseWishart.Rd =================================================================== --- pkg/Meucci/man/PlotMarginalsNormalInverseWishart.Rd (rev 0) +++ pkg/Meucci/man/PlotMarginalsNormalInverseWishart.Rd 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,43 @@ +\name{PlotMarginalsNormalInverseWishart} +\alias{PlotMarginalsNormalInverseWishart} +\title{Plot the marginals of the normal-inverse-Whishart model. +Described in A. Meucci "Risk and Asset Allocation", Springer, 2005} +\usage{ + PlotMarginalsNormalInverseWishart(Mu_Simul, + InvSigma_Simul, Mu_0, T_0, Sigma_0, Nu_0, Legend) +} +\arguments{ + \item{Mu_Simul}{: []} + + \item{InvSigma_Simul}{: []} + + \item{Mu_0}{: []} + + \item{T_0}{: []} + + \item{Sigma_0}{: []} + + \item{Nu_0}{: []} + + \item{Legend}{: []} +} +\description{ + Plot the marginals of the normal-inverse-Whishart model. + Described in A. Meucci "Risk and Asset Allocation", + Springer, 2005 +} +\note{ + Numerically and analytically the marginal pdf of - the + first entry of the random vector Mu - the (1,1)-entry of + the random matrix inv(Sigma) when Mu and Sigma are + jointly normal-inverse-Wishart: Mu ~ St(Mu_0,Sigma/T_0) + inv(Sigma) ~ W(Nu_0,inv(Sigma_0)/Nu_0) +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "QuantileMixture.m" +} + Added: pkg/Meucci/man/RandNormalInverseWishart.Rd =================================================================== --- pkg/Meucci/man/RandNormalInverseWishart.Rd (rev 0) +++ pkg/Meucci/man/RandNormalInverseWishart.Rd 2013-07-21 16:34:53 UTC (rev 2611) @@ -0,0 +1,42 @@ +\name{RandNormalInverseWishart} +\alias{RandNormalInverseWishart} +\title{Generates a multivariate i.i.d. sample of lenght J from the normal-inverse-Wishart distribution, as described in +A. Meucci "Risk and Asset Allocation", Springer, 2005.} +\usage{ + RandNormalInverseWishart(Mu_0, T_0, Sigma_0, nu_0, J) +} +\arguments{ + \item{Mu_0}{: [vector]} + + \item{T_0}{: [scalar]} + + \item{Sigma_0}{: [matrix]} + + \item{nu_0}{: [scalar]} + + \item{J}{: [scalar]} +} +\value{ + Mu : [vector] + + Sigma : [matrix] + + InvSigma : [matrix] +} +\description{ + Generates a multivariate i.i.d. sample of lenght J from + the normal-inverse-Wishart distribution, as described in + A. Meucci "Risk and Asset Allocation", Springer, 2005. +} +\note{ + Mu|Sigma ~ N(Mu_0,Sigma/T_0) inv(Sigma) ~ + W(Nu_0,inv(Sigma_0)/Nu_0) +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://symmys.com/node/170} See Meucci's script for + "RandNormalInverseWishart.m" +} + From noreply at r-forge.r-project.org Sun Jul 21 18:44:55 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 21 Jul 2013 18:44:55 +0200 (CEST) Subject: [Returnanalytics-commits] r2612 - pkg/Meucci/data Message-ID: <20130721164455.44B06184F6E@r-forge.r-project.org> Author: xavierv Date: 2013-07-21 18:44:54 +0200 (Sun, 21 Jul 2013) New Revision: 2612 Added: pkg/Meucci/data/stockSeries.Rda Log: - added data file for chapter 7 scripts Added: pkg/Meucci/data/stockSeries.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/stockSeries.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Sun Jul 21 22:23:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 21 Jul 2013 22:23:26 +0200 (CEST) Subject: [Returnanalytics-commits] r2613 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130721202327.0ED0B18548B@r-forge.r-project.org> Author: pulkit Date: 2013-07-21 22:23:26 +0200 (Sun, 21 Jul 2013) New Revision: 2613 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Log: REDD-COPS in progress Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-21 20:23:26 UTC (rev 2613) @@ -0,0 +1,91 @@ +#'@title +#'Rolling Economic Drawdown Controlled Optimal Portfolio Strategy +#' +#'@description +#'The Rolling Economic Drawdown Controlled Optimal Portfolio Strategy(REDD-COPS) has +#'the portfolio fraction allocated to single risky asset as: +#' +#' \deqn{x_t = Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} +#' +#' The risk free asset accounts for the rest of the portfolio allocation \eqn{x_f = 1 - x_t}. +#' +#' For two risky assets in REDD-COPS,dynamic asset allocation weights are : +#' +#' \deqn{\left[{\begin{array}{c} x_1 \\ +#' x_2 +#' \end{array}}\right] = \frac{1}{1-{\rho}^2}\left[\begin{array{c} (\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) \\ +#'(\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) +#'\end{array}}\right].Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} +#' +#'The portion of the risk free asset is \eqn{x_f = 1 - x_1 - x_2}. +#' +#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#'@param delta Drawdown limit +#'@param sharpe If you want to use a constant Sharpe Ratio please specify here +#'else the return series will be used +#'@param Rf risk free rate can be vector such as government security rate of return. +#'@param h Look back period +#'@param geomtric geometric utilize geometric chaining (TRUE) or simple/arithmetic #'chaining(FALSE) to aggregate returns, default is TRUE. +#'@param ... any other variable +#' +#'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to +#'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012) +#' +#' +#'@examples +#'REDDCOPS(edhec,delta = 0.1,Rf = 0,h = 40) +#' +#'@export +#' + +REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,sharpe=NULL,...){ + # DESCRIPTION + # Calculates the dynamic weights for single and double risky asset portfolios + # using Rolling Economic Drawdown + + # INPUT: + # The Return series ,drawdown limit, risk free rate and the lookback period are + # given as the input + + # FUNCTION: + x = checkData(R) + columns = ncol(x) + n = nrow(x) + columnnames = colnames(x) + rf = checkData(Rf) + nr = length(Rf) + + if(is.null(sharpe)){ + sharpe = SharpeRatio(R,FUN="StdDev",Rf ,p=0.95) + } + dynamicPort<-function(x){ + sd = StdDev(R) + factor = (as.vector(sharpe)/as.vector(sd)+0.5)/(1-delta^2) + redd = rollDrawdown(R,Rf,h,geometric) + redd = na.omit(redd) + xt = max(0,(delta-redd)/(1-redd)) + return(xt) + } + for(column in 1:columns){ + column.xt <- na.skip(x[,column],FUN = dynamicPort) + if(column == 1) + xt = column.xt + else xt = merge(xt, column.xt) + } + colnames(xt) = columnnames + xt = reclass(xt, x) + return(xt) + +} +############################################################################### +# 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: REDDCOPS.R $ +# +############################################################################## Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-21 16:44:54 UTC (rev 2612) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-21 20:23:26 UTC (rev 2613) @@ -14,11 +14,10 @@ #' #' #'@param R an xts, vector, matrix, data frame, timeseries, or zoo object of asset return. -#'@param weights portfolio weighting vector, default NULL +#'@param Rf risk free rate can be vector such as government security rate of return +#'@param h lookback period #'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining(FALSE) #'to aggregate returns, default is TRUE -#'@param rf risk free rate can be vector such as government security rate of return -#'@param h lookback period #'@param \dots any other variable #'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to #'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012) From noreply at r-forge.r-project.org Mon Jul 22 00:40:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 00:40:04 +0200 (CEST) Subject: [Returnanalytics-commits] r2614 - in pkg/PortfolioAnalytics: . man Message-ID: <20130721224004.5A6FC18568C@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-22 00:40:03 +0200 (Mon, 22 Jul 2013) New Revision: 2614 Added: pkg/PortfolioAnalytics/man/print.optimize.portfolio.DEoptim.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.GenSA.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.ROI.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.pso.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.random.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/man/add.constraint.Rd pkg/PortfolioAnalytics/man/box_constraint.Rd pkg/PortfolioAnalytics/man/diversification_constraint.Rd pkg/PortfolioAnalytics/man/group_constraint.Rd pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd pkg/PortfolioAnalytics/man/portfolio.spec.Rd pkg/PortfolioAnalytics/man/position_limit_constraint.Rd pkg/PortfolioAnalytics/man/turnover_constraint.Rd pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd Log: updating documentation and NAMESPACE Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-21 22:40:03 UTC (rev 2614) @@ -46,6 +46,11 @@ export(pos_limit_fail) export(position_limit_constraint) export(print.constraint) +export(print.optimize.portfolio.DEoptim) +export(print.optimize.portfolio.GenSA) +export(print.optimize.portfolio.pso) +export(print.optimize.portfolio.random) +export(print.optimize.portfolio.ROI) export(random_portfolios_v2) export(random_portfolios) export(random_walk_portfolios) Modified: pkg/PortfolioAnalytics/man/add.constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/add.constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -2,8 +2,8 @@ \alias{add.constraint} \title{General interface for adding and/or updating optimization constraints.} \usage{ - add.constraint(portfolio, type, enabled = TRUE, ..., - indexnum = NULL) + add.constraint(portfolio, type, enabled = TRUE, + message = FALSE, ..., indexnum = NULL) } \arguments{ \item{portfolio}{an object of class 'portfolio' to add @@ -16,6 +16,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify constraints} Modified: pkg/PortfolioAnalytics/man/box_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/box_constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/box_constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -3,7 +3,7 @@ \title{constructor for box_constraint.} \usage{ box_constraint(type, assets, min, max, min_mult, - max_mult, enabled = TRUE, ...) + max_mult, enabled = TRUE, message = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} @@ -27,6 +27,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify box constraints} } Modified: pkg/PortfolioAnalytics/man/diversification_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -3,7 +3,7 @@ \title{constructor for diversification_constraint} \usage{ diversification_constraint(type, div_target, - enabled = TRUE, ...) + enabled = TRUE, message = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} @@ -12,6 +12,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify box and/or group constraints} } Modified: pkg/PortfolioAnalytics/man/group_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -4,7 +4,7 @@ \usage{ group_constraint(type, assets, groups, group_labels = NULL, group_min, group_max, - group_pos = NULL, enabled = TRUE, ...) + group_pos = NULL, enabled = TRUE, message = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} @@ -28,6 +28,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify group constraints} } Modified: pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/optimize.portfolio_v2.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -5,7 +5,8 @@ optimize.portfolio_v2(R, portfolio, optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), search_size = 20000, trace = FALSE, ..., rp = NULL, - momentFUN = "set.portfolio.moments_v2") + momentFUN = "set.portfolio.moments_v2", + message = FALSE) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries @@ -40,6 +41,9 @@ \item{momentFUN}{the name of a function to call to set portfolio moments, default \code{\link{set.portfolio.moments_v2}}} + + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} } \value{ a list containing the optimal weights, some summary Modified: pkg/PortfolioAnalytics/man/portfolio.spec.Rd =================================================================== --- pkg/PortfolioAnalytics/man/portfolio.spec.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/portfolio.spec.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -3,7 +3,7 @@ \title{constructor for class portfolio} \usage{ portfolio.spec(assets = NULL, category_labels = NULL, - weight_seq = NULL) + weight_seq = NULL, message = FALSE) } \arguments{ \item{assets}{number of assets, or optionally a named @@ -17,6 +17,9 @@ \item{weight_seq}{seed sequence of weights, see \code{\link{generatesequence}}} + + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} } \description{ constructor for class portfolio Modified: pkg/PortfolioAnalytics/man/position_limit_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -4,7 +4,7 @@ \usage{ position_limit_constraint(type, assets, max_pos = NULL, max_pos_long = NULL, max_pos_short = NULL, - enabled = TRUE, ...) + enabled = TRUE, message = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} @@ -20,6 +20,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify position limit constraints} } Added: pkg/PortfolioAnalytics/man/print.optimize.portfolio.DEoptim.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.optimize.portfolio.DEoptim.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.optimize.portfolio.DEoptim.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -0,0 +1,21 @@ +\name{print.optimize.portfolio.DEoptim} +\alias{print.optimize.portfolio.DEoptim} +\title{Printing Output of optimize.portfolio} +\usage{ + print.optimize.portfolio.DEoptim(object, + digits = max(3, getOption("digits") - 3), ...) +} +\arguments{ + \item{object}{an object of class + "optimize.portfolio.DEoptim" resulting from a call to + optimize.portfolio} + + \item{digits}{the number of significant digits to use + when printing.} + + \item{...}{any other passthru parameters} +} +\description{ + print method for optimize.portfolio.DEoptim +} + Added: pkg/PortfolioAnalytics/man/print.optimize.portfolio.GenSA.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.optimize.portfolio.GenSA.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.optimize.portfolio.GenSA.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -0,0 +1,21 @@ +\name{print.optimize.portfolio.GenSA} +\alias{print.optimize.portfolio.GenSA} +\title{Printing Output of optimize.portfolio} +\usage{ + print.optimize.portfolio.GenSA(object, + digits = max(3, getOption("digits") - 3), ...) +} +\arguments{ + \item{object}{an object of class + "optimize.portfolio.GenSA" resulting from a call to + optimize.portfolio} + + \item{digits}{the number of significant digits to use + when printing} + + \item{...}{any other passthru parameters} +} +\description{ + print method for optimize.portfolio.GenSA +} + Added: pkg/PortfolioAnalytics/man/print.optimize.portfolio.ROI.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.optimize.portfolio.ROI.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.optimize.portfolio.ROI.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -0,0 +1,20 @@ +\name{print.optimize.portfolio.ROI} +\alias{print.optimize.portfolio.ROI} +\title{Printing Output of optimize.portfolio} +\usage{ + print.optimize.portfolio.ROI(object, + digits = max(3, getOption("digits") - 3), ...) +} +\arguments{ + \item{object}{an object of class "optimize.portfolio.ROI" + resulting from a call to optimize.portfolio} + + \item{digits}{the number of significant digits to use + when printing.} + + \item{...}{any other passthru parameters} +} +\description{ + print method for optimize.portfolio.ROI +} + Added: pkg/PortfolioAnalytics/man/print.optimize.portfolio.pso.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.optimize.portfolio.pso.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.optimize.portfolio.pso.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -0,0 +1,20 @@ +\name{print.optimize.portfolio.pso} +\alias{print.optimize.portfolio.pso} +\title{Printing Output of optimize.portfolio} +\usage{ + print.optimize.portfolio.pso(object, + digits = max(3, getOption("digits") - 3), ...) +} +\arguments{ + \item{object}{an object of class "optimize.portfolio.pso" + resulting from a call to optimize.portfolio} + + \item{digits}{the number of significant digits to use + when printing.} + + \item{...}{any other passthru parameters} +} +\description{ + print method for optimize.portfolio.pso +} + Added: pkg/PortfolioAnalytics/man/print.optimize.portfolio.random.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.optimize.portfolio.random.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.optimize.portfolio.random.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -0,0 +1,21 @@ +\name{print.optimize.portfolio.random} +\alias{print.optimize.portfolio.random} +\title{Printing Output of optimize.portfolio} +\usage{ + print.optimize.portfolio.random(object, + digits = max(3, getOption("digits") - 3), ...) +} +\arguments{ + \item{object}{an object of class + "optimize.portfolio.random" resulting from a call to + optimize.portfolio} + + \item{digits}{the number of significant digits to use + when printing.} + + \item{...}{any other passthru parameters} +} +\description{ + print method for optimize.portfolio.random +} + Modified: pkg/PortfolioAnalytics/man/turnover_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -3,7 +3,7 @@ \title{constructor for turnover_constraint} \usage{ turnover_constraint(type, turnover_target, - enabled = TRUE, ...) + enabled = TRUE, message = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} @@ -12,6 +12,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify box and/or group constraints} } Modified: pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd 2013-07-21 20:23:26 UTC (rev 2613) +++ pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd 2013-07-21 22:40:03 UTC (rev 2614) @@ -16,6 +16,9 @@ \item{enabled}{TRUE/FALSE} + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} + \item{\dots}{any other passthru parameters to specify weight_sum constraints} } From noreply at r-forge.r-project.org Mon Jul 22 01:22:05 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 01:22:05 +0200 (CEST) Subject: [Returnanalytics-commits] r2615 - pkg/PortfolioAnalytics/R Message-ID: <20130721232205.C3E89184BF4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-22 01:22:05 +0200 (Mon, 22 Jul 2013) New Revision: 2615 Modified: pkg/PortfolioAnalytics/R/random_portfolios.R Log: correcting check for feasible portfolio in randomize_portfolio_v2 Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-21 22:40:03 UTC (rev 2614) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-21 23:22:05 UTC (rev 2615) @@ -297,7 +297,7 @@ fportfolio <- fn_map(weights=tportfolio, portfolio=portfolio, relax=FALSE)$weights colnames(fportfolio) <- colnames(seed) - if (sum(fportfolio) <= min_sum | sum(fportfolio) >= max_sum){ + if (sum(fportfolio) < min_sum | sum(fportfolio) > max_sum){ fportfolio <- seed warning("Infeasible portfolio created, defaulting to seed, perhaps increase max_permutations.") } From noreply at r-forge.r-project.org Mon Jul 22 02:32:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 02:32:00 +0200 (CEST) Subject: [Returnanalytics-commits] r2616 - in pkg/FactorAnalytics: R data Message-ID: <20130722003200.418321852B5@r-forge.r-project.org> Author: chenyian Date: 2013-07-22 02:31:59 +0200 (Mon, 22 Jul 2013) New Revision: 2616 Added: pkg/FactorAnalytics/data/CommomFactors.RData Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r Log: Add new commom factor data Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-21 23:22:05 UTC (rev 2615) +++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-22 00:31:59 UTC (rev 2616) @@ -404,6 +404,7 @@ else { Cov.resids <- NULL } + output <- list(returns.cov = Cov.returns, factor.cov = Cov.factors, resids.cov = Cov.resids, @@ -414,7 +415,10 @@ call = this.call, data = data, asset.names = assets, - beta = B.final) + beta = B.final, + datevar = datevar, + returnsvar = returnsvar, + assetvar = assetvar) class(output) <- "FundamentalFactorModel" return(output) } \ No newline at end of file Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-21 23:22:05 UTC (rev 2615) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-22 00:31:59 UTC (rev 2616) @@ -115,6 +115,13 @@ # names = fit.fund$asset.names # for (i in names) { # # check for missing values in fund data +# asset.n = which( colnames(fit.fund$data) == as.name(fit.fund$assetvar)) +# as.symbol(fit.fund$assetvar) +# subset(fit.fund$data,fit.fund$assetvar == "STI") +# +# subset(fit.fund$data,TICKER == "STI")[[fit.fund$returnsvar]] +# +# [,fit.fund$returnsvar] # idx = which(!is.na(fit.fund$data[,i])) # tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, # fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i])) Added: pkg/FactorAnalytics/data/CommomFactors.RData =================================================================== (Binary files differ) Property changes on: pkg/FactorAnalytics/data/CommomFactors.RData ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Mon Jul 22 03:18:35 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 03:18:35 +0200 (CEST) Subject: [Returnanalytics-commits] r2617 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130722011835.95B8D183C75@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-22 03:18:35 +0200 (Mon, 22 Jul 2013) New Revision: 2617 Added: pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/generics.R Log: modifying print and summary methods for objective measures Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 00:31:59 UTC (rev 2616) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 01:18:35 UTC (rev 2617) @@ -62,6 +62,7 @@ export(set.portfolio.moments_v2) export(set.portfolio.moments) export(summary.optimize.portfolio.rebalancing) +export(summary.optimize.portfolio) export(summary.portfolio) export(trailingFUN) export(turnover_constraint) Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-07-22 00:31:59 UTC (rev 2616) +++ pkg/PortfolioAnalytics/R/generics.R 2013-07-22 01:18:35 UTC (rev 2617) @@ -137,7 +137,7 @@ # get objective measure cat("Objective Measure:\n") - print.default(object$out, digits=digits) + print(as.numeric(object$out), digits=digits) cat("\n") } @@ -163,9 +163,12 @@ cat("\n") # get objective measure + objective_measures <- object$objective_measures + tmp_obj <- as.numeric(unlist(objective_measures)) + names(tmp_obj) <- names(objective_measures) cat("Objective Measures:\n") - for(obj in object$objective_measures){ - print.default(obj, digits=digits) + for(i in 1:length(tmp_obj)){ + print(tmp_obj[i], digits=digits) cat("\n") } cat("\n") @@ -193,9 +196,12 @@ cat("\n") # get objective measure + objective_measures <- object$objective_measures + tmp_obj <- as.numeric(unlist(objective_measures)) + names(tmp_obj) <- names(objective_measures) cat("Objective Measures:\n") - for(obj in object$objective_measures){ - print.default(obj, digits=digits) + for(i in 1:length(tmp_obj)){ + print(tmp_obj[i], digits=digits) cat("\n") } cat("\n") @@ -223,9 +229,12 @@ cat("\n") # get objective measure + objective_measures <- object$objective_measures + tmp_obj <- as.numeric(unlist(objective_measures)) + names(tmp_obj) <- names(objective_measures) cat("Objective Measures:\n") - for(obj in object$objective_measures){ - print.default(obj, digits=digits) + for(i in 1:length(tmp_obj)){ + print(tmp_obj[i], digits=digits) cat("\n") } cat("\n") @@ -253,11 +262,183 @@ cat("\n") # get objective measure + # get objective measure + objective_measures <- object$objective_measures + tmp_obj <- as.numeric(unlist(objective_measures)) + names(tmp_obj) <- names(objective_measures) cat("Objective Measures:\n") - for(obj in object$objective_measures){ - print.default(obj, digits=digits) + for(i in 1:length(tmp_obj)){ + print(tmp_obj[i], digits=digits) cat("\n") } cat("\n") } +#' Summarizing Output of optimize.portfolio +#' +#' summary method for class "optimize.portfolio" +#' +#' @param object an object of class "optimize.portfolio.pso" resulting from a call to optimize.portfolio +#' @param ... any other passthru parameters. Currently not used. +#' @export +summary.optimize.portfolio <- function(object, ...){ + + cat(rep("*", 50) ,"\n", sep="") + cat("PortfolioAnalytics Optimization Summary", "\n") + cat(rep("*", 50) ,"\n", sep="") + + # show the call to optimize.portfolio + cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), + "\n\n", sep = "") + + # get optimal weights + cat("Optimal Weights:\n") + print.default(object$weights) + cat("\n") + + # objective measures + # The objective measure is object$out for ROI + cat("Objective Measures:\n") + if(!is.null(object$objective_measures)){ + # get objective measure + objective_measures <- object$objective_measures + tmp_obj <- as.numeric(unlist(objective_measures)) + names(tmp_obj) <- names(objective_measures) + for(i in 1:length(tmp_obj)){ + print(tmp_obj[i]) + cat("\n") + } + } else { + print(as.numeric(object$out)) + } + cat("\n") + + # get seed portfolio + cat("Portfolio Assets and Seed Weights:\n") + print.default(object$portfolio$assets) + cat("\n") + + # summary of the portfolio object + summary(object$portfolio) + + # Constraints + cat(rep("*", 40), "\n", sep="") + cat("Constraints\n") + cat(rep("*", 40), "\n", sep="") + + # get the constraints + constraints <- get_constraints(object$portfolio) + + # leverage constraints + cat("Leverage Constraint:\n") + if(!is.null(constraints$min_sum) & !is.null(constraints$max_sum)){ + cat("min_sum = ", constraints$min_sum, "\n", sep="") + cat("max_sum = ", constraints$max_sum, "\n", sep="") + cat("\n") + } + + # box constraints + cat("Box Constraints:\n") + if(!is.null(constraints$min) & !is.null(constraints$max)){ + cat("min:\n") + print(constraints$min) + cat("max:\n") + print(constraints$max) + cat("\n") + } + + # group constraints + cat("Group Constraints:\n") + if(!is.null(constraints$groups) & !is.null(constraints$cLO) & !is.null(constraints$cUP)){ + cat("Groups:\n") + groups <- constraints$groups + group_labels <- constraints$group_labels + names(groups) <- group_labels + print(groups) + cat("\n") + cat("Lower bound on group weights, group_min:\n") + cLO <- constraints$cLO + names(cLO) <- group_labels + print(cLO) + cat("\n") + cat("Upper bound on group weights, group_max:\n") + cUP <- constraints$cUP + names(cUP) <- group_labels + print(cUP) + cat("\n") + cat("Group position limits, group_pos:\n") + group_pos <- constraints$group_pos + if(!is.null(group_pos)) names(group_pos) <- group_labels + print(group_pos) + cat("\n") + + cat("Group Weights:\n") + n.groups <- length(groups) + group_weights <- rep(0, n.groups) + k <- 1 + l <- 0 + for(i in 1:n.groups){ + j <- groups[i] + group_weights[i] <- sum(object$weights[k:(l+j)]) + k <- k + j + l <- k - 1 + } + names(group_weights) <- group_labels + print(group_weights) + cat("\n") + } + tolerance <- .Machine$double.eps^0.5 + + # position limit constraints + cat("Position Limit Constraints:\n") + cat("Maximum number of non-zero weights, max_pos:\n") + print(constraints$max_pos) + cat("Realized number of non-zero weights (i.e. positions):\n") + print(sum(abs(object$weights) > tolerance)) + cat("\n") + + cat("Maximum number of long positions, max_pos_long:\n") + print(constraints$max_pos_long) + cat("Realized number of long positions:\n") + print(sum(object$weights > tolerance)) + cat("\n") + + cat("Maximum number of short positions, max_pos_short:\n") + print(constraints$max_pos_short) + cat("Realized number of short positions:\n") + print(sum(object$weights < -tolerance)) + cat("\n\n") + + # diversification + cat("Diversification Target Constraint:\n") + print(constraints$div_target) + cat("\n") + cat("Realized diversification:\n") + print(diversification(object$weights)) + cat("\n") + + # turnover + cat("Turnover Target Constraint:\n") + print(constraints$turnover_target) + cat("\n") + cat("Realized turnover:\n") + print(turnover(object$weights, wts.init=object$portfolio$assets)) + cat("\n") + + # Objectives + cat(rep("*", 40), "\n", sep="") + cat("Objectives\n") + cat(rep("*", 40), "\n\n", sep="") + + for(obj in object$portfolio$objectives){ + cat("Objective:", class(obj)[1], "\n") + print(obj) + cat("\n", rep("*", 40), "\n", sep="") + } + cat("\n") + + # show the elapsed time for the optimization + cat("Elapsed Time:\n") + print(object$elapsed_time) + cat("\n") +} Added: pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd 2013-07-22 01:18:35 UTC (rev 2617) @@ -0,0 +1,17 @@ +\name{summary.optimize.portfolio} +\alias{summary.optimize.portfolio} +\title{Summarizing Output of optimize.portfolio} +\usage{ + summary.optimize.portfolio(object, ...) +} +\arguments{ + \item{object}{an object of class "optimize.portfolio.pso" + resulting from a call to optimize.portfolio} + + \item{...}{any other passthru parameters. Currently not + used.} +} +\description{ + summary method for class "optimize.portfolio" +} + From noreply at r-forge.r-project.org Mon Jul 22 12:38:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 12:38:54 +0200 (CEST) Subject: [Returnanalytics-commits] r2618 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: Week1/Code Week4/Code Message-ID: <20130722103854.A2A1C184CDF@r-forge.r-project.org> Author: shubhanm Date: 2013-07-22 12:38:54 +0200 (Mon, 22 Jul 2013) New Revision: 2618 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.ModGeltner.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Rplots.pdf Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R Log: Added Geltner Return Function ( Test and Implement + Literature) Modified : Week 4 Acar Sim, GLM Smooth + Lo Sharpe (Added Literature, improved code readability and minor modification for speeding up computation) Vignette for Week 1: Status : Complemeting for all the now completed Functions Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R 2013-07-22 01:18:35 UTC (rev 2617) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/GLMSmoothIndex.R 2013-07-22 10:38:54 UTC (rev 2618) @@ -1,11 +1,26 @@ -#This measure is well known in the -#industrial organization literature as the Herfindahl index, a measure of the -#concentration of firms in a given industry where yj represents the market share of -#firm j: Because yjA?0; 1 ; x is also confined to the unit interval, and is minimized when -#all the yj's are identical, which implies a value of 1=?k ? 1? for x; and is maximized -#when one coefficient is 1 and the rest are 0, in which case x ? 1: In the context of -##smoothed returns, a lower value of x implies more smoothing, and the upper bound -#of 1 implies no smoothing, hence we shall refer to x as a ''smoothingindex' '. +#'@title Getmansky Lo Markov Smoothing Index Parameter +#'@description +#A useful summary statistic for measuring the concentration of weights is +# a sum of square of Moving Average lag coefficient. +# This measure is well known in the industrial organization literature as the +# Herfindahl index, a measure of the concentration of firms in a given industry. +# The index is maximized when one coefficient is 1 and the rest are 0, in which case x ? 1: In the context of +#smoothed returns, a lower value of x implies more smoothing, and the upper bound +#of 1 implies no smoothing, hence x is reffered as a ''smoothingindex' '. +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @author R +#' @references "An econometric model of serial correlation and illiquidity in +#' hedge fund returns" Mila Getmansky1, Andrew W. Lo*, Igor Makarov +#' +#' @keywords ts multivariate distribution models non-iid +#' @examples +#' +#' data(edhec) +#' head(GLMSmoothIndex(edhec) +#' +#' @export GLMSmoothIndex<- function(R = NULL, ...) { @@ -38,21 +53,21 @@ result.df = cbind(result.df, nextcol) } } + rownames(result.df)= paste("GLM Smooth Index") + return(result.df) } - - - ############################################################################### - # 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: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ - # - ############################################################################### - - } \ No newline at end of file + } + +############################################################################### +# 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: GLMSmoothIndex.R 2163 2012-07-16 00:30:19Z braverock $ +# +############################################################################### Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R 2013-07-22 01:18:35 UTC (rev 2617) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R 2013-07-22 10:38:54 UTC (rev 2618) @@ -1,65 +1,48 @@ -#' calculate Geltner liquidity-adjusted return series +#'@title Andrew Lo Sharpe Ratio +#'@description +#' Although the Sharpe ratio has become part of the canon of modern financial +#' analysis, its applications typically do not account for the fact that it is an +#' estimated quantity, subject to estimation errors that can be substantial in +#' some cases. #' -#' David Geltner developed a method to remove estimating or liquidity bias in -#' real estate index returns. It has since been applied with success to other -#' return series that show autocorrelation or illiquidity effects. +#' Many studies have documented various violations of the assumption of +#' IID returns for financial securities. #' -#' The theory is that by correcting for autocorrelation, you are uncovering a -#' "true" return from a series of observed returns that contain illiquidity or -#' manual pricing effects. -#' -#' The Geltner autocorrelation adjusted return series may be calculated via: -#' -#' \deqn{ }{Geltner.returns = [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) }\deqn{ -#' R_{G}=\frac{R_{t}-(R_{t-1}\cdot\rho_{1})}{1-\rho_{1}} }{Geltner.returns = -#' [R(t) - R(t-1)*acf(R(t-1))]/1-acf(R(t-1)) } -#' -#' where \eqn{\rho_{1}}{acf(R(t-1))} is the first-order autocorrelation of the -#' return series \eqn{R_{a}}{Ra} and \eqn{R_{t}}{R(t)} is the return of -#' \eqn{R_{a}}{Ra} at time \eqn{t} and \eqn{R_{t-1}}{R(t-1)} is the one-period -#' lagged return. -#' +#' Under the assumption of stationarity,a version of the Central Limit Theorem can +#' still be applied to the estimator . #' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns +#' daily asset returns +#' @param Rf an xts, vector, matrix, data frame, timeSeries or zoo object of +#' annualized Risk Free Rate +#' @param q Number of autocorrelated lag periods. Taken as 3 (Default) #' @param \dots any other passthru parameters -#' @author Brian Peterson -#' @references "Edhec Funds of Hedge Funds Reporting Survey : A Return-Based -#' Approach to Funds of Hedge Funds Reporting",Edhec Risk and Asset Management -#' Research Centre, January 2005,p. 27 +#' @author R +#' @references "The Statistics of Sharpe Ratios" Andrew. W. Lo #' -#' Geltner, David, 1991, Smoothing in Appraisal-Based Returns, Journal of Real -#' Estate Finance and Economics, Vol.4, p.327-345. -#' -#' Geltner, David, 1993, Estimating Market Values from Appraised Values without -#' Assuming an Efficient Market, Journal of Real Estate Research, Vol.8, -#' p.325-345. -#' @keywords ts multivariate distribution models +#' @keywords ts multivariate distribution models non-iid #' @examples #' -#' data(managers) -#' head(Return.Geltner(managers[,1:3]),n=20) +#' data(edhec) +#' head(LoSharpe(edhec,0,3) #' #' @export LoSharpe <- - function (Ra,Rf = 0,q = 0, ...) + function (Ra,Rf = 0,q = 3, ...) { # @author Brian G. Peterson, Peter Carl + - # Description: - # Geltner Returns came from real estate where they are used to uncover a - # liquidity-adjusted return series. - - # Ra return vector - # Function: R = checkData(Ra, method="xts") # Get dimensions and labels columns.a = ncol(R) columnnames.a = colnames(R) + # Time used for daily Return manipulations Time= 252*nyears(edhec) clean.lo <- function(column.R,q) { # compute the lagged return series gamma.k =matrix(0,q) mu = sum(column.R)/(Time) + Rf= Rf/(Time) for(i in 1:q){ lagR = lag(column.R, k=i) # compute the Momentum Lagged Values @@ -93,7 +76,6 @@ # RESULTS: - # return(reclass(geltner,match.to=Ra)) } @@ -105,6 +87,6 @@ # This R package is distributed under the terms of the GNU Public License (GPL) # for full details see the file COPYING # -# $Id: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ +# $Id: LoSharpe.R # ############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.ModGeltner.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.ModGeltner.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.ModGeltner.R 2013-07-22 10:38:54 UTC (rev 2618) @@ -0,0 +1,90 @@ +#'@title The Noiseless Stationary Transfer Function Model of Appriasal Smoothing +#' @description calculate Geltner liquidity-adjusted return series +#' David Geltner developed a method to remove estimating or liquidity bias in +#' real estate index returns. It has since been applied with success to other +#' return series that show autocorrelation or illiquidity effects. +#' +#' The theory is that by correcting for autocorrelation, you are uncovering a +#' "true" return from a series of observed returns that contain illiquidity or +#' manual pricing effects. +#' +#' The Geltner autocorrelation adjusted return series may be calculated via: +#' +#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param q number of lag factors +#' @param \dots any other passthru parameters +#' @author Brian Peterson +#' @references "Edhec Funds of Hedge Funds Reporting Survey : A Return-Based +#' Approach to Funds of Hedge Funds Reporting",Edhec Risk and Asset Management +#' Research Centre, January 2005,p. 27 +#' +#' Geltner, David, 1991, Smoothing in Appraisal-Based Returns, Journal of Real +#' Estate Finance and Economics, Vol.4, p.327-345. +#' +#' Geltner, David, 1993, Estimating Market Values from Appraised Values without +#' Assuming an Efficient Market, Journal of Real Estate Research, Vol.8, +#' p.325-345. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' head(Return.Geltner(managers[,1:3]),n=20) +#' +#' @export +Return.ModGeltner <- + function (Ra,q=3, ...) + { # @author Brian G. Peterson, Peter Carl + + # Description: + # Geltner Returns came from real estate where they are used to uncover a + # liquidity-adjusted return series. + + # Ra return vector + + # Function: + R = checkData(Ra, method="xts") + # Get dimensions and labels + columns.a = ncol(R) + columnnames.a = colnames(R) + + clean.modgeltner <- function(column.R,q=3) { + # compute the lagged return series + #lagR = lag(column.R, k=1) + # compute the first order autocorrelation + f_acf = as.numeric(acf(as.numeric(column.R), plot = FALSE)[1:q][[1]]) + # now calculate and return the Geltner series + column.geltner = column.R + for(i in 1:q){ + column.geltner = (column.geltner- lag(column.R, k=i)*f_acf[q]) + } + column.geltner= column.geltner/sum(f_acf) + } + + for(column.a in 1:columns.a) { # for each asset passed in as R + # clean the data and get rid of NAs + column.geltner = na.skip(R[,column.a], clean.modgeltner) + + if(column.a == 1) { geltner = column.geltner } + else { geltner = cbind (geltner, column.geltner) } + + } + + colnames(geltner) = columnnames.a + + # RESULTS: + return(reclass(geltner,match.to=Ra)) + + } + +############################################################################### +# 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: Return.Geltner.R 2163 2012-07-16 00:30:19Z braverock $ +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Rplots.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Rplots.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R 2013-07-22 01:18:35 UTC (rev 2617) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R 2013-07-22 10:38:54 UTC (rev 2618) @@ -3,9 +3,7 @@ # We have simulated cash flows over a period of 36 monthly returns and measured maximum #drawdown for varied levels of annualised return divided by volatility varying from minus # two to two by step of 0.1. The process has been repeated six thousand times. -AcarSim <- - function () -{ + mu=mean(Return.annualized(edhec)) monthly=(1+mu)^(1/12)-1 sig=StdDev.annualized(edhec[,1])[1]; @@ -32,9 +30,8 @@ r[j,2:37]=monthly+sig*dz - ddown[j,i]= ES((r[j,]))/monthly + ddown[j,i]= ES((r[j,])) } } plot(ddown[1,]) -} \ No newline at end of file From noreply at r-forge.r-project.org Mon Jul 22 15:44:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 15:44:16 +0200 (CEST) Subject: [Returnanalytics-commits] r2619 - in pkg/PerformanceAnalytics/sandbox/pulkit: week2/code week2/tests week3_4/code Message-ID: <20130722134416.693A41859EC@r-forge.r-project.org> Author: pulkit Date: 2013-07-22 15:44:16 +0200 (Mon, 22 Jul 2013) New Revision: 2619 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R pkg/PerformanceAnalytics/sandbox/pulkit/week2/tests/test_SharpeIndifference.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R Log: changes in Triple Penance and Becnhmark plots Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-22 10:38:54 UTC (rev 2618) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-22 13:44:16 UTC (rev 2619) @@ -3,8 +3,17 @@ #'@description #'Benchmark Sharpe Ratio Plots are used to give the relation ship between the #'Benchmark Sharpe Ratio and average correlation,average sharpe ratio or the number of #'strategies keeping other parameters constant. Here average Sharpe ratio , average #'correlation stand for the average of all the strategies in the portfolio. The original -#'point of the return series is also shown on the plots. +#'point of the return series is also shown on the plots. #' +#'The equation for the Benchamark Sharpe Ratio is. +#' +#'\deqn{SR_B = \overline{SR}\sqrt{\frac{S}{1+(S-1)\overline{\rho}}}} +#' +#'Here \eqn{S} is the number of strategies and \eqn{\overline{\rho}} is the average +#'correlation across off diagonal elements and is given by +#' +#'\deqn{\overline{\rho} = \frac{2\sum_{s=1}^{S} \sum_{t=s+1}^{S} \rho_{S,t}}{S(S-1)}} +#' #'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of #' asset returns #'@param ylab set the y-axis label, as in \code{\link{plot}} @@ -133,4 +142,4 @@ # # $Id: BenchmarkSRPlots.R $ # -############################################################################### \ No newline at end of file +############################################################################### Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/tests/test_SharpeIndifference.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/tests/test_SharpeIndifference.R 2013-07-22 10:38:54 UTC (rev 2618) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/tests/test_SharpeIndifference.R 2013-07-22 13:44:16 UTC (rev 2619) @@ -4,6 +4,6 @@ test_BenchmarkSR<-function(){ - checkEqualsNumeric(BenchmanrkSR(edhec),0.170288,tolerance = 1.0e-6) + checkEqualsNumeric(BenchmarkSR(edhec),0.393797,tolerance = 1.0e-6) } \ No newline at end of file Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-22 10:38:54 UTC (rev 2618) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-22 13:44:16 UTC (rev 2619) @@ -1,17 +1,61 @@ - #' @title #' Triple Penance Rule #' #' @description #' \code{MaxDD} calculates the Maximum drawdown for a particular confidence interval. +#' Maximum Drawdown tells us Up to how much could a particular strategy lose with +#' a given confidence level ?. This function calculated Maximum Drawdown for two +#' underlying processes normal and autoregressive. For a normal process +#' Maximum Drawdown is given by the formula +#' When the distibution is normal +#' +#' \deqn{MaxDD_{\alpha}=max\left\{0,\frac{(z_{\alpha}\sigma)^2}{4\mu}\right\}} +#' +#' The time at which the Maximum Drawdown occurs is given by +#' \deqn{t^\ast=\biggl(\frac{Z_{\alpha}\sigma}{2\mu}\biggr)^2} +#' Here $Z_{\alpha}$ is the critical value of the Standard Normal Distribution +#' associated with a probability $\alpha$.$\sigma$ and $\mu$ are the Standard +#' Distribution and the mean respectively. +#' When the distribution is non-normal and time dependent, Autoregressive process. +#' +#' \deqn{Q_{\alpha,t}=\frac{\phi^{(t+1)}-\phi}{\phi-1}(\triangle\pi_0-\mu)+{\mu}t+Z_{\alpha}\frac{\sigma}{|\phi-1|}\biggl(\frac{\phi^{2(t+1)}-1}{\phi^2-1}-2\frac{\phi^(t+1)-1}{\phi-1}+t+1\biggr)^{1/2}} +#' +#' $\phi$ is estimated as +#' +#' \deqn{\hat{\phi} = Cov_0[\triangle\pi_\tau,\triangle\pi_{\tau-1}](Cov_0[\triangle\pi_{\tau-1},\triangle\pi_{\tau-1}])^{-1}} +#' +#' and the Maximum Drawdown is given by. +#' +#' \deqn{MaxDD_{\alpha}=max\left\{0,-MinQ_\alpha\right\}} +#' +#' Golden Section Algorithm is used to calculate the Minimum of the function Q. #' #' @param R Returns #' @param confidence the confidence interval +#' @param type The type of distribution "normal" or "ar"."ar" stands for Autoregressive. #' #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). +#' +#' @examples +#' +#' data(edhec) +#' MaxDD(edhec,0.95,"ar") +#' MaxDD(edhec[,1],0.95,"normal") #expected values 4.241799 6.618966 MaxDD<-function(R,confidence,type=c("ar","normal"),...) { + + # DESCRIPTION: + # Calculates the maximum drawdown for the return series based on the given + # distribution normal or autoregressive. + + # INPUT: + # The Return Series of the portfolio is taken as the input. The Return + # Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of + # asset returns. The type of distribution , "normal" or non-normal "ar", The confidence + # level + + # FUNCTION: x = checkData(R) if(ncol(x)==1 || is.null(R) || is.vector(R)){ Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-22 10:38:54 UTC (rev 2618) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-22 13:44:16 UTC (rev 2619) @@ -1,14 +1,27 @@ #' @title -#' Time Under Water +#' Maximum Time Under Water #' #' @description #' \code{TriplePenance} calculates the maximum -#' Time under water for a particular confidence interval. +#' Maximum Time under water for a particular confidence interval is given by +#' +#' For a particular sequence $\left\{\pi_t\right\}$, the time under water $(TuW)$ +#' is the minimum number of observations, $t>0$, such that $\pi_{t-1}<0$ and $\pi_t>0$. +#' +#' For a normal distribution Maximum Time Under Water is given by the following expression. +#' \deqn{MaxTuW_\alpha=\biggl(\frac{Z_\alpha{\sigma}}{\mu}\biggr)^2} +#' +#' For a Autoregressive process the Time under water is found using the golden section algorithm. #' #' @param R return series #' @param confidence the confidence interval +#' @param type The type of distribution "normal" or "ar"."ar" stands for Autoregressive. #' #' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). +#' +#' @examples +#' TuW(edhec,0.95,"ar") +#' uW(edhec[,1],0.95,"normal") # expected value 103.2573 TuW<-function(R,confidence,type=c("ar","normal"),...){ x = checkData(R) Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R 2013-07-22 10:38:54 UTC (rev 2618) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R 2013-07-22 13:44:16 UTC (rev 2619) @@ -1,15 +1,59 @@ #'@title #'Penance vs phi plot -#' #'A plot for Penance vs phi for the given portfolio +#'The relationship between penance and phi is given by #' +#'\deqn{penance = \frac{Maximum Drawdown}{Maximum Time Under Water}} +#' +#'Penance Measures how long it takes to recover from the maximum drawdown +#'as a multiple of the time it took to reach the bottom. Penance is smaller, +#'the higher the value of \eqn{\phi(Phi)} and the higher the ratio \eqn{\frac{\mu}{\sigma}}. +#'Positive serial autocorrelation leads to smaller Penance due to greater periods under +#'water. #'@param R an xts, vector, matrix, data frame, #'timeSeries or zoo object of asset returns. #'@param confidence the confidence level +#'@param type The type of distribution "normal" or "ar"."ar" stands for Autoregressive. +#'@param reference.grid if true, draws a grid aligned with the points on the x +#'and y axes +#'@param ylab set the y-axis label, as in \code{\link{plot}} +#'@param xlab set the x-axis label, as in \code{\link{plot}} +#'@param main set the chart title, as in \code{\link{plot}} +#'@param element.color set the element.color value as in \code{\link{plot}} +#'@param lwd set the width of the line, as in \code{\link{plot}} +#'@param pch set the pch value, as in \code{\link{plot}} +#'@param cex set the cex value, as in \code{\link{plot}} +#'@param cex.axis set the cex.axis value, as in \code{\link{plot}} +#'@param cex.main set the cex.main value, as in \code{\link{plot}} +#'@param ylim set the ylim value, as in \code{\link{plot}} +#'@param xlim set the xlim value, as in \code{\link{plot}} #' +#'@seealso \code{\link{plot}} +#'@keywords ts multivariate distribution models hplot +#'@examples +#' +#' #'@reference Bailey, David H. and Lopez de Prado, Marcos,Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). -chart.Penance<-function(R,confidence,...){ +chart.Penance<-function(R,confidence,type=c("ar","normal"),reference.grid = TRUE,main=NULL,ylab = NULL,xlab = NULL,element.color="darkgrey",lwd = 2,pch = 1,cex = 1,cex.axis=0.8,cex.lab = 1,cex.main = 1,xlim = NULL,ylim = NULL,...){ + + # DESCRIPTION: + # Draws the scatter plot of Phi vs Penance. + + # INPUT: + # The Return Series of the portfolio is taken as the input. The Return + # Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of + # asset returns. The type of distribution , "normal" or non-normal "ar", The confidence + # level + + # All other inputs are the same as "plot" and are principally included + # so that some sensible defaults could be set. + + # Output: + # Draws the scatter plot of Phi vs Penance with some sensible defaults. + + # FUNCTION: + x = checkData(R) columns = ncol(x) columnnames = colnames(x) @@ -17,10 +61,25 @@ penance = 1:columns for(column in 1:columns){ phi[column] = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])])) - penance[column]<-get_minq(x[,column],confidence)[1]/get_TuW(x[,column],confidence) + penance[column]<-MaxDD(x[,column],confidence,type = type)[1]/TuW(x[,column],confidence,type = type) } - plot(x=phi,y=penance,xlab="Phi",ylab = "Penance",main="Penance vs Phi",pch=2) - text(phi,penance,columnnames,pos = 4,col=c(1:columns)) + if(is.null(ylab)){ + ylab = "Penance" + } + if(is.null(xlab)){ + xlab = "Phi" + } + if(is.null(main)){ + main = "Penance vs Phi" + } + + plot(x=phi,y=penance,xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab) + text(phi,penance,columnnames,pos = 4,col=c(1:columns),cex = 0.8) + if(reference.grid) { + grid(col = element.color) + abline(h = 0, col = element.color) + abline(v = 0, col = element.color) + } } From noreply at r-forge.r-project.org Mon Jul 22 20:34:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 20:34:24 +0200 (CEST) Subject: [Returnanalytics-commits] r2620 - in pkg/PerformanceAnalytics/sandbox/pulkit: . week6 Message-ID: <20130722183424.B432C1846AF@r-forge.r-project.org> Author: pulkit Date: 2013-07-22 20:34:24 +0200 (Mon, 22 Jul 2013) New Revision: 2620 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week6/ pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R Log: Conditional Drawdown at risk Added: pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R 2013-07-22 18:34:24 UTC (rev 2620) @@ -0,0 +1,65 @@ +CDD<-function (R, weights = NULL, geometric = TRUE, invert = TRUE, + p = 0.95, ...) +{ + #p = .setalphaprob(p) + if (is.vector(R) || ncol(R) == 1) { + R = na.omit(R) + nr = nrow(R) + # checking if nr*p is an integer + if((p*nr) %% 1 == 0){ + drawdowns = as.matrix(Drawdowns(R)) + drawdowns = drawdowns(order(drawdowns),decreasing = TRUE) + # average of the drawdowns greater the (1-alpha).100% largest drawdowns + result = (1/((1-p)*nr(R)))*sum(drawdowns[((1-p)*nr):nr]) + } + else{ + f.obj = c(rep(0,nr),rep((1/(1-alpha))*(1/nr),nr),1) + + f.con = cbind(-diag(nr),diag(nr),1) + f.dir = c(rep(">=",nr)) + f.rhs = c(rep(0,nr)) + + ut = diag(nr) + ut[-1,-nr] = ut[-1,-nr] - diag(nr - 1) + f.con = rbind(f.con,cbind(ut,matrix(0,nr,nr),1)) + f.dir = c(rep(">=",nr)) + f.rhs = c(f.rhs,-R) + + f.con = rbind(f.con,cbind(matrix(0,nr,nr),diag(nr),1)) + f.dir = c(rep(">=",nr)) + f.rhs = c(f.rhs,rep(0,nr)) + + f.con = rbind(f.con,cbind(diag(nr),matrix(0,nr,nr),1)) + f.dir = c(rep(">=",nr)) + f.rhs = c(f.rhs,rep(0,nr)) + + val = lp("min",f.obj,f.con,f.dir,f.rhs) + result = val$objval + } + if (invert) + result <- -result + + return(result) + } + else { + R = checkData(R, method = "matrix") + if (is.null(weights)) { + result = matrix(nrow = 1, ncol = ncol(R)) + for (i in 1:ncol(R)) { + result[i] <- CDD(R[, i, drop = FALSE], p = p, + geometric = geometric, invert = invert, ... = ...) + } + dim(result) = c(1, NCOL(R)) + colnames(result) = colnames(R) + rownames(result) = paste("Conditional Drawdown ", + p * 100, "%", sep = "") + } + else { + portret <- Return.portfolio(R, weights = weights, + geometric = geometric) + result <- CDD(portret, p = p, geometric = geometric, + invert = invert, ... = ...) + } + return(result) + } +} From noreply at r-forge.r-project.org Mon Jul 22 21:36:44 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 21:36:44 +0200 (CEST) Subject: [Returnanalytics-commits] r2621 - pkg/PerformanceAnalytics/R Message-ID: <20130722193644.CF73B184EB5@r-forge.r-project.org> Author: peter_carl Date: 2013-07-22 21:36:44 +0200 (Mon, 22 Jul 2013) New Revision: 2621 Modified: pkg/PerformanceAnalytics/R/chart.Boxplot.R Log: - fix allows passthrough of horizontal parameter Modified: pkg/PerformanceAnalytics/R/chart.Boxplot.R =================================================================== --- pkg/PerformanceAnalytics/R/chart.Boxplot.R 2013-07-22 18:34:24 UTC (rev 2620) +++ pkg/PerformanceAnalytics/R/chart.Boxplot.R 2013-07-22 19:36:44 UTC (rev 2621) @@ -109,10 +109,10 @@ ) # end switch if(as.Tufte){ - boxplot(R[,column.order], horizontal = TRUE, names = names, main = main, xlab = xlab, ylab = "", pars = list(boxcol = "white", medlty = "blank", medpch = median.symbol, medlwd = 2, medcex = .8, medcol = colorset[column.order], whisklty = c(1,1), whiskcol = colorset[column.order], staplelty = "blank", outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order] ), axes = FALSE, ...) + boxplot(R[,column.order], horizontal = horizontal, names = names, main = main, xlab = xlab, ylab = "", pars = list(boxcol = "white", medlty = "blank", medpch = median.symbol, medlwd = 2, medcex = .8, medcol = colorset[column.order], whisklty = c(1,1), whiskcol = colorset[column.order], staplelty = "blank", outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order] ), axes = FALSE, ...) } else{ - boxplot(R[,column.order], horizontal = TRUE, names = names, main = main, xlab = xlab, ylab = "", pars = list(boxcol = colorset[column.order], medlwd = 1, medcol = colorset[column.order], whisklty = c(1,1), whiskcol = colorset[column.order], staplelty = 1, staplecol = colorset[column.order], staplecex = .5, outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order] ), axes = FALSE, boxwex=.6, ...) + boxplot(R[,column.order], horizontal = horizontal, names = names, main = main, xlab = xlab, ylab = "", pars = list(boxcol = colorset[column.order], medlwd = 1, medcol = colorset[column.order], whisklty = c(1,1), whiskcol = colorset[column.order], staplelty = 1, staplecol = colorset[column.order], staplecex = .5, outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order] ), axes = FALSE, boxwex=.6, ...) } # end else if(!is.null(show.data)) { From noreply at r-forge.r-project.org Mon Jul 22 21:56:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 21:56:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2622 - in pkg/FactorAnalytics: R data man Message-ID: <20130722195601.4B16718596B@r-forge.r-project.org> Author: chenyian Date: 2013-07-22 21:56:00 +0200 (Mon, 22 Jul 2013) New Revision: 2622 Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r pkg/FactorAnalytics/R/plot.StatFactorModel.r pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r pkg/FactorAnalytics/R/predict.StatFactorModel.r pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r pkg/FactorAnalytics/data/stat.fm.data.RData pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/predict.StatFactorModel.Rd pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd Log: debug Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-22 19:56:00 UTC (rev 2622) @@ -35,6 +35,8 @@ #' the data. #' @param assetvar A character string giving the name of the asset variable in #' the data. +#' @param exposure.names A character string giving the name of the exposure variable in +#' the data. #' @return an S3 object containing #' \itemize{ #' \item returns.cov A "list" object contains covariance information for @@ -418,7 +420,8 @@ beta = B.final, datevar = datevar, returnsvar = returnsvar, - assetvar = assetvar) + assetvar = assetvar, + exposure.names = exposure.names) class(output) <- "FundamentalFactorModel" return(output) } \ No newline at end of file Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-22 19:56:00 UTC (rev 2622) @@ -63,9 +63,9 @@ "1L" = { factor.names <- colnames(fit.fund$factors) - nn <- length(factor.names) - par(mfrow=c(nn,1)) - for (i in factor.names) { +# nn <- length(factor.names) + par(mfrow=c(n/2,2)) + for (i in factor.names[1:n]) { plot(fit.fund$factors[,i],main=paste(i," Factor Returns",sep="") ) } par(mfrow=c(1,1)) Modified: pkg/FactorAnalytics/R/plot.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-07-22 19:56:00 UTC (rev 2622) @@ -135,9 +135,7 @@ fit.lm = fit.stat$asset.fit[[asset.name]] - if (!(class(fit.lm) == "lm")) - stop("Must pass a valid lm object") - + ## exact information from lm object factorNames = colnames(fit.lm$model)[-1] @@ -250,8 +248,8 @@ ) } else { #apca method - dates <- rownames(fit.stat$factors) - actual.z <- zoo(fit.stat$asset.ret,as.Date(dates)) + dates <- names(fit.stat$data[,asset.name]) + actual.z <- zoo(fit.stat$asset.ret[,asset.name],as.Date(dates)) residuals.z <- zoo(fit.stat$residuals,as.Date(dates)) fitted.z <- actual.z - residuals.z t <- length(dates) Modified: pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r 2013-07-22 19:56:00 UTC (rev 2622) @@ -13,24 +13,38 @@ #' @export #' @author Yi-An Chen #' -predict.FundamentalFactorModel <- function(fit,newdata,new.assetvar,new.datevar){ +predict.FundamentalFactorModel <- function(fit.fund,newdata,new.assetvar,new.datevar){ # if there is no newdata provided # calculate fitted values - datevar <- as.character(fit$call)[4] - assetvar <- as.character(fit$call)[6] - assets = unique(data[,assetvar]) - timedates = as.Date(unique(data[,datevar])) - + datevar <- as.character(fit.fund$datevar) + assetvar <- as.character(fit.fund$assetvar) + assets = unique(fit.fund$data[,assetvar]) + timedates = as.Date(unique(fit.fund$data[,datevar])) + exposure.names <- fit.fund$exposure.names + numTimePoints <- length(timedates) numExposures <- length(exposure.names) numAssets <- length(assets) - f <- fit$factors # T X 3 - exposure.names <- colnames(f)[-1] + f <- fit.fund$factors # T X 3 + - predictor <- function(data,datevar,assetvar) { - + predictor <- function(data) { + fitted <- rep(NA,numAssets) + for (i in 1:numTimePoints) { + fit.tmp <- fit.fund$beta %*% t(f[i,]) + fitted <- rbind(fitted,t(fit.tmp)) + } + fitted <- fitted[-1,] + colnames(fitted) <- assets + return(fitted) + } + + + + predictor.new <- function(data,datevar,assetvar) { + beta.all <- data[,c(datevar,assetvar,exposure.names)] # (N * T ) X 4 names(beta.all)[1:2] <- c("time","assets.names") @@ -49,7 +63,7 @@ } if (missing(newdata) || is.null(newdata)) { - ans <- predictor(fit$data,datevar,assetvar) + ans <- predictor(fit.fund$data) } # predict returns by newdata @@ -65,7 +79,7 @@ } else if( length(setdiff(intersect(names(newdata),exposure.names),exposure.names))!=0 ) { stop("newdata must have exact the same exposure.names") } else { - ans <- predictor(newdata,new.datevar,new.assetvar) + ans <- predictor.new(newdata,new.datevar,new.assetvar) } } Modified: pkg/FactorAnalytics/R/predict.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/predict.StatFactorModel.r 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/R/predict.StatFactorModel.r 2013-07-22 19:56:00 UTC (rev 2622) @@ -4,9 +4,7 @@ #' function \code{predict.lm}. #' #' @param fit "StatFactorModel" object created by fitStatisticalFactorModel. -#' @param newdata An optional data frame in which to look for variables with which to predict. -#' If omitted, the fitted values are used. -#' @param ... Any other arguments used in \code{predict.lm} +#' @param ... Any other arguments used in \code{predict.lm}. For example like newdata and fit.se. #' @author Yi-An Chen. #' ' #' @examples Modified: pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r 2013-07-22 19:56:00 UTC (rev 2622) @@ -4,11 +4,9 @@ #' function \code{predict.lm}. #' #' @param fit "TimeSeriesFactorModel" object created by fitTimeSeiresFactorModel. -#' @param newdata An optional data frame in which to look for variables with which to predict. -#' If omitted, the fitted values are used. -#' @param ... Any other arguments used in \code{predict.lm} +#' @param ... Any other arguments used in \code{predict.lm}. for example newdata and se.fit. #' @author Yi-An Chen. -#' ' +#' #' @examples #' #' # load data from the database @@ -25,15 +23,17 @@ #' @export #' -predict.TimeSeriesFactorModel <- function(fit,newdata,...){ - if (missing(newdata) || is.null(newdata) ) { - lapply(fit$asset.fit, predict,...) - } +predict.TimeSeriesFactorModel <- function(fit.macro,...){ +# if (missing(newdata) || is.null(newdata) ) { + lapply(fit.macro$asset.fit, predict,...) +# } + +# # if ( !(missing(newdata) && !is.null(newdata) )) { -# numAssets <- length(names(fit$asset.fit)) +# numAssets <- length(names(fit.macro$asset.fit)) # -# data <- fit$data -# factors <- data[,fit$factors.names] +# data <- fit.macro$data +# factors <- data[,fit.macro$factors.names] # mu.factors <- apply(factors,2,mean) # cov.factors <- cov(factors) # @@ -53,6 +53,6 @@ # # # } -# + } \ No newline at end of file Modified: pkg/FactorAnalytics/data/stat.fm.data.RData =================================================================== (Binary files differ) Modified: pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd 2013-07-22 19:56:00 UTC (rev 2622) @@ -1,41 +1,46 @@ -\name{plot.FundamentalFactorModel} -\alias{plot.FundamentalFactorModel} -\title{plot FundamentalFactorModel object.} -\usage{ - plot.FundamentalFactorModel(fund.fit, - which.plot = c("none", "1L", "2L", "3L", "4L"), - max.show = 12) -} -\arguments{ - \item{fund.fit}{fit object created by - fitFundamentalFactorModel.} - - \item{which.plot}{integer indicating which plot to - create: "none" will create a menu to choose. Defualt is - none. 1 = "factor returns", 2 = "R square", 3 = "Variance - of Residuals", 4 = "FM Correlation",} - - \item{max.show}{Maximum assets to plot. Default is 12.} -} -\description{ - Generic function of plot method for - fitFundamentalFactorModel. -} -\examples{ -\dontrun{ -# BARRA type factor model -# there are 447 assets -data(stock) -assets = unique(fulldata[,"PERMNO"]) -timedates = as.Date(unique(fulldata[,"DATE"])) -exposures <- exposures.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -fund.fit <- fitFundamentalFactorModel(fulldata=fulldata, timedates=timedates, exposures=exposures,covariance="classic", assets=assets,full.resid.cov=TRUE, - regression="classic",wls=TRUE) - -plot(fund.fit) -} -} -\author{ - Eric Zivot and Yi-An Chen. -} - +\name{plot.FundamentalFactorModel} +\alias{plot.FundamentalFactorModel} +\title{plot FundamentalFactorModel object.} +\usage{ + plot.FundamentalFactorModel(fit.fund, + which.plot = c("none", "1L", "2L", "3L", "4L"), + max.show = 10) +} +\arguments{ + \item{fit.fund}{fit object created by + fitFundamentalFactorModel.} + + \item{which.plot}{integer indicating which plot to + create: "none" will create a menu to choose. Defualt is + none. 1 = "factor returns", 2 = "R square", 3 = "Variance + of Residuals", 4 = "FM Correlation",} + + \item{max.show}{Maximum assets to plot. Default is 12.} +} +\description{ + Generic function of plot method for + fitFundamentalFactorModel. +} +\examples{ +\dontrun{ +# BARRA type factor model +# there are 447 assets +data(stock) +# BARRA type factor model +data(stock) +# there are 447 assets +exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +fit.fund <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, + datevar = "DATE", returnsvar = "RETURN", + assetvar = "TICKER", wls = TRUE, + regression = "classic", + covariance = "classic", full.resid.cov = TRUE, + robust.scale = TRUE) + +plot(fit.fund) +} +} +\author{ + Eric Zivot and Yi-An Chen. +} + Modified: pkg/FactorAnalytics/man/predict.StatFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.StatFactorModel.Rd 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/man/predict.StatFactorModel.Rd 2013-07-22 19:56:00 UTC (rev 2622) @@ -8,11 +8,8 @@ \item{fit}{"StatFactorModel" object created by fitStatisticalFactorModel.} - \item{newdata}{An optional data frame in which to look - for variables with which to predict. If omitted, the - fitted values are used.} - - \item{...}{Any other arguments used in \code{predict.lm}} + \item{...}{Any other arguments used in \code{predict.lm}. + For example like newdata and fit.se.} } \description{ Generic function of predict method for Modified: pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2013-07-22 19:36:44 UTC (rev 2621) +++ pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2013-07-22 19:56:00 UTC (rev 2622) @@ -2,17 +2,14 @@ \alias{predict.TimeSeriesFactorModel} \title{predict method for TimeSeriesModel object.} \usage{ - predict.TimeSeriesFactorModel(fit, newdata, ...) + predict.TimeSeriesFactorModel(fit.macro, ...) } \arguments{ \item{fit}{"TimeSeriesFactorModel" object created by fitTimeSeiresFactorModel.} - \item{newdata}{An optional data frame in which to look - for variables with which to predict. If omitted, the - fitted values are used.} - - \item{...}{Any other arguments used in \code{predict.lm}} + \item{...}{Any other arguments used in \code{predict.lm}. + for example newdata and se.fit.} } \description{ Generic function of predict method for @@ -32,6 +29,6 @@ predict(fit,newdata,interval="confidence") } \author{ - Yi-An Chen. ' + Yi-An Chen. } From noreply at r-forge.r-project.org Tue Jul 23 01:39:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 01:39:15 +0200 (CEST) Subject: [Returnanalytics-commits] r2623 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130722233916.05029185A01@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 01:39:15 +0200 (Tue, 23 Jul 2013) New Revision: 2623 Added: pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio.Rd Log: alias optimize.portfolio_v2 to optimize.portfolio and add _v1 to old optimize.portfolio Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 19:56:00 UTC (rev 2622) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:39:15 UTC (rev 2623) @@ -34,10 +34,10 @@ export(is.portfolio) export(minmax_objective) export(objective) +export(optimize.portfolio_v1) export(optimize.portfolio_v2) export(optimize.portfolio.parallel) export(optimize.portfolio.rebalancing) -export(optimize.portfolio) export(plot.optimize.portfolio.DEoptim) export(plot.optimize.portfolio.random) export(plot.optimize.portfolio) Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-22 19:56:00 UTC (rev 2622) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-22 23:39:15 UTC (rev 2623) @@ -66,7 +66,7 @@ #' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information #' @author Kris Boudt, Peter Carl, Brian G. Peterson #' @export -optimize.portfolio <- function( +optimize.portfolio_v1 <- function( R, constraints, optimize_method=c("DEoptim","random","ROI","ROI_old","pso","GenSA"), @@ -521,6 +521,8 @@ #' #' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information #' @author Kris Boudt, Peter Carl, Brian G. Peterson +#' @aliases optimize.portfolio +#' @rdname optimize.portfolio #' @export optimize.portfolio_v2 <- function( R, @@ -893,6 +895,9 @@ return(out) } +# Alias for optimize.portfolio_v2 +optimize.portfolio <- optimize.portfolio_v2 + #' portfolio optimization with support for rebalancing or rolling periods #' #' This function may eventually be wrapped into optimize.portfolio Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.Rd 2013-07-22 19:56:00 UTC (rev 2622) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.Rd 2013-07-22 23:39:15 UTC (rev 2623) @@ -1,18 +1,20 @@ -\name{optimize.portfolio} +\name{optimize.portfolio_v2} \alias{optimize.portfolio} -\title{wrapper for constrained optimization of portfolios} +\alias{optimize.portfolio_v2} +\title{version 2 wrapper for constrained optimization of portfolios} \usage{ - optimize.portfolio(R, constraints, + optimize.portfolio_v2(R, portfolio, optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), search_size = 20000, trace = FALSE, ..., rp = NULL, - momentFUN = "set.portfolio.moments") + momentFUN = "set.portfolio.moments_v2", + message = FALSE) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} - \item{constraints}{an object of type "constraints" - specifying the constraints for the optimization, see + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization, see \code{\link{constraint}}, if using closed for solver, need to pass a \code{\link{constraint_ROI}} object.} @@ -39,7 +41,10 @@ \item{momentFUN}{the name of a function to call to set portfolio moments, default - \code{\link{set.portfolio.moments}}} + \code{\link{set.portfolio.moments_v2}}} + + \item{message}{TRUE/FALSE. The default is message=FALSE. + Display messages if TRUE.} } \value{ a list containing the optimal weights, some summary @@ -49,12 +54,13 @@ \description{ This function aims to provide a wrapper for constrained optimization of portfolios that allows the user to - specify box constraints and business objectives. + specify constraints and business objectives. } \details{ - This function currently supports DEoptim and random - portfolios as back ends. Additional back end - contributions for Rmetrics, ghyp, etc. would be welcome. + This function currently supports DEoptim, random + portfolios, ROI, pso, and GenSA as back ends. Additional + back end contributions for Rmetrics, ghyp, etc. would be + welcome. When using random portfolios, search_size is precisely that, how many portfolios to test. You need to make sure @@ -77,43 +83,25 @@ When using GenSA and want to set \code{verbose=TRUE}, instead use \code{trace}. - The extension to ROI solves a limit type of convex + The extension to ROI solves a limited type of convex optimization problems: 1) Maxmimize portfolio return - subject box constraints on weights 2) Minimize portfolio - variance subject to box constraints (otherwise known as - global minimum variance portfolio) 3) Minimize portfolio - variance subject to box constraints and a desired - portfolio return 4) Maximize quadratic utility subject to - box constraints and risk aversion parameter (this is - passed into \code{optimize.portfolio} as as added - argument to the \code{constraints} object) 5) Mean CVaR - optiimization subject to box constraints and target - portfolio return Lastly, because these convex + subject leverage, box, and/or constraints on weights 2) + Minimize portfolio variance subject to leverage, box, + and/or group constraints (otherwise known as global + minimum variance portfolio) 3) Minimize portfolio + variance subject to leverage, box, and/or group + constraints and a desired portfolio return 4) Maximize + quadratic utility subject to leverage, box, and/or group + constraints and risk aversion parameter (this is passed + into \code{optimize.portfolio} as as added argument to + the \code{constraints} object) 5) Mean CVaR optimization + subject to leverage, box, and/or group constraints and + target portfolio return Lastly, because these convex optimization problem are standardized, there is no need for a penalty term. Therefore, the \code{multiplier} argument in \code{\link{add.objective}} passed into the complete constraint object are ingnored by the solver. - ROI also can solve quadratic and linear problems with - group constraints by added a \code{groups} argument into - the constraints object. This argument is a vector with - each of its elements the number of assets per group. The - group constraints, \code{cLO} and \code{cUP}, are also - added to the constraints object. - For example, if you have 9 assets, and would like to - require that the the first 3 assets are in one group, the - second 3 are in another, and the third are in another, - then you add the grouping by \code{constraints$groups <- - c(3,3,3)}. To apply the constraints that the first group - must compose of at least 20% of the weight, the second - group 15%, and the third group 10%, and that now signle - group should compose of more that 50% of the weight, then - you would add the lower group constraint as - \code{constraints$cLO <- c(0.20, 0.15, 0.10)} and the - upper constraints as \code{constraints$cUP <- - rep(0.5,3)}. These group constraint can be set for all - five optimization problems listed above. - If you would like to interface with \code{optimize.portfolio} using matrix formulations, then use \code{ROI_old}. Added: pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd 2013-07-22 23:39:15 UTC (rev 2623) @@ -0,0 +1,124 @@ +\name{optimize.portfolio_v1} +\alias{optimize.portfolio_v1} +\title{wrapper for constrained optimization of portfolios} +\usage{ + optimize.portfolio_v1(R, constraints, + optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), + search_size = 20000, trace = FALSE, ..., rp = NULL, + momentFUN = "set.portfolio.moments") +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{constraints}{an object of type "constraints" + specifying the constraints for the optimization, see + \code{\link{constraint}}, if using closed for solver, + need to pass a \code{\link{constraint_ROI}} object.} + + \item{optimize_method}{one of "DEoptim", "random", + "ROI","ROI_old", "pso", "GenSA". For using + \code{ROI_old}, need to use a constraint_ROI object in + constraints. For using \code{ROI}, pass standard + \code{constratint} object in \code{constraints} argument. + Presently, ROI has plugins for \code{quadprog} and + \code{Rglpk}.} + + \item{search_size}{integer, how many portfolios to test, + default 20,000} + + \item{trace}{TRUE/FALSE if TRUE will attempt to return + additional information on the path or portfolios + searched} + + \item{\dots}{any other passthru parameters} + + \item{rp}{matrix of random portfolio weights, default + NULL, mostly for automated use by rebalancing + optimization or repeated tests on same portfolios} + + \item{momentFUN}{the name of a function to call to set + portfolio moments, default + \code{\link{set.portfolio.moments}}} +} +\value{ + a list containing the optimal weights, some summary + statistics, the function call, and optionally trace + information +} +\description{ + This function aims to provide a wrapper for constrained + optimization of portfolios that allows the user to + specify box constraints and business objectives. +} +\details{ + This function currently supports DEoptim and random + portfolios as back ends. Additional back end + contributions for Rmetrics, ghyp, etc. would be welcome. + + When using random portfolios, search_size is precisely + that, how many portfolios to test. You need to make sure + to set your feasible weights in generatesequence to make + sure you have search_size unique portfolios to test, + typically by manipulating the 'by' parameter to select + something smaller than .01 (I often use .002, as .001 + seems like overkill) + + When using DE, search_size is decomposed into two other + parameters which it interacts with, NP and itermax. + + NP, the number of members in each population, is set to + cap at 2000 in DEoptim, and by default is the number of + parameters (assets/weights) *10. + + itermax, if not passed in dots, defaults to the number of + parameters (assets/weights) *50. + + When using GenSA and want to set \code{verbose=TRUE}, + instead use \code{trace}. + + The extension to ROI solves a limit type of convex + optimization problems: 1) Maxmimize portfolio return + subject box constraints on weights 2) Minimize portfolio + variance subject to box constraints (otherwise known as + global minimum variance portfolio) 3) Minimize portfolio + variance subject to box constraints and a desired + portfolio return 4) Maximize quadratic utility subject to + box constraints and risk aversion parameter (this is + passed into \code{optimize.portfolio} as as added + argument to the \code{constraints} object) 5) Mean CVaR + optiimization subject to box constraints and target + portfolio return Lastly, because these convex + optimization problem are standardized, there is no need + for a penalty term. Therefore, the \code{multiplier} + argument in \code{\link{add.objective}} passed into the + complete constraint object are ingnored by the solver. + ROI also can solve quadratic and linear problems with + group constraints by added a \code{groups} argument into + the constraints object. This argument is a vector with + each of its elements the number of assets per group. The + group constraints, \code{cLO} and \code{cUP}, are also + added to the constraints object. + + For example, if you have 9 assets, and would like to + require that the the first 3 assets are in one group, the + second 3 are in another, and the third are in another, + then you add the grouping by \code{constraints$groups <- + c(3,3,3)}. To apply the constraints that the first group + must compose of at least 20% of the weight, the second + group 15%, and the third group 10%, and that now signle + group should compose of more that 50% of the weight, then + you would add the lower group constraint as + \code{constraints$cLO <- c(0.20, 0.15, 0.10)} and the + upper constraints as \code{constraints$cUP <- + rep(0.5,3)}. These group constraint can be set for all + five optimization problems listed above. + + If you would like to interface with + \code{optimize.portfolio} using matrix formulations, then + use \code{ROI_old}. +} +\author{ + Kris Boudt, Peter Carl, Brian G. Peterson +} + From noreply at r-forge.r-project.org Tue Jul 23 01:44:43 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 01:44:43 +0200 (CEST) Subject: [Returnanalytics-commits] r2624 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130722234443.734D5185C35@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 01:44:43 +0200 (Tue, 23 Jul 2013) New Revision: 2624 Added: pkg/PortfolioAnalytics/man/add.objective_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/objective.R pkg/PortfolioAnalytics/man/add.objective.Rd Log: alias add.objective_v2 to add.objective and add _v1 to old add.objective Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:39:15 UTC (rev 2623) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:44:43 UTC (rev 2624) @@ -1,6 +1,6 @@ export(add.constraint) +export(add.objective_v1) export(add.objective_v2) -export(add.objective) export(box_constraint) export(CCCgarch.MM) export(chart.Scatter.DE) Modified: pkg/PortfolioAnalytics/R/objective.R =================================================================== --- pkg/PortfolioAnalytics/R/objective.R 2013-07-22 23:39:15 UTC (rev 2623) +++ pkg/PortfolioAnalytics/R/objective.R 2013-07-22 23:44:43 UTC (rev 2624) @@ -69,7 +69,7 @@ #' @seealso \code{\link{constraint}} #' #' @export -add.objective <- function(constraints, type, name, arguments=NULL, enabled=TRUE, ..., indexnum=NULL) +add.objective_v1 <- function(constraints, type, name, arguments=NULL, enabled=TRUE, ..., indexnum=NULL) { if (!is.constraint(constraints)) {stop("constraints passed in are not of class constraint")} @@ -146,7 +146,8 @@ #' @param \dots any other passthru parameters #' @param indexnum if you are updating a specific constraint, the index number in the $objectives list to update #' @author Brian G. Peterson and Ross Bennett -#' +#' @aliases add.objective +#' @rdname add.objective #' @seealso \code{\link{objective}} #' #' @export @@ -214,6 +215,9 @@ return(portfolio) } +# Alias add.objective_v2 to add.objective +add.objective <- add.objective_v2 + # update.objective <- function(object, ...) { # # here we do a bunch of magic to update the correct index'd objective # Modified: pkg/PortfolioAnalytics/man/add.objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.objective.Rd 2013-07-22 23:39:15 UTC (rev 2623) +++ pkg/PortfolioAnalytics/man/add.objective.Rd 2013-07-22 23:44:43 UTC (rev 2624) @@ -1,14 +1,15 @@ -\name{add.objective} +\name{add.objective_v2} \alias{add.objective} +\alias{add.objective_v2} \title{General interface for adding optimization objectives, including risk, return, and risk budget} \usage{ - add.objective(constraints, type, name, arguments = NULL, + add.objective_v2(portfolio, type, name, arguments = NULL, enabled = TRUE, ..., indexnum = NULL) } \arguments{ - \item{constraints}{an object of type "constraints" to add - the objective to, specifying the constraints for the - optimization, see \code{\link{constraint}}} + \item{portfolio}{an object of type 'portfolio' to add the + objective to, specifying the portfolio for the + optimization, see \code{\link{portfolio}}} \item{type}{character type of the objective to add or update, currently 'return','risk', or 'risk_budget'} @@ -30,7 +31,7 @@ \description{ This function is the main function for adding and updating business objectives in an object of type - \code{\link{constraint}}. + \code{\link{portfolio}}. } \details{ In general, you will define your objective as one of @@ -40,9 +41,9 @@ objectives, including mean, median, VaR, ES, etc. } \author{ - Brian G. Peterson + Brian G. Peterson and Ross Bennett } \seealso{ - \code{\link{constraint}} + \code{\link{objective}} } Added: pkg/PortfolioAnalytics/man/add.objective_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/add.objective_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/add.objective_v1.Rd 2013-07-22 23:44:43 UTC (rev 2624) @@ -0,0 +1,48 @@ +\name{add.objective_v1} +\alias{add.objective_v1} +\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) +} +\arguments{ + \item{constraints}{an object of type "constraints" to add + the objective to, specifying the constraints for the + optimization, see \code{\link{constraint}}} + + \item{type}{character type of the objective to add or + update, currently 'return','risk', or 'risk_budget'} + + \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{enabled}{TRUE/FALSE} + + \item{\dots}{any other passthru parameters} + + \item{indexnum}{if you are updating a specific + constraint, 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{constraint}}. +} +\details{ + In general, you will define your objective as one of + three types: 'return', 'risk', or 'risk_budget'. 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. +} +\author{ + Brian G. Peterson +} +\seealso{ + \code{\link{constraint}} +} + From noreply at r-forge.r-project.org Tue Jul 23 01:51:40 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 01:51:40 +0200 (CEST) Subject: [Returnanalytics-commits] r2625 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130722235140.E0FE71858CE@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 01:51:40 +0200 (Tue, 23 Jul 2013) New Revision: 2625 Added: pkg/PortfolioAnalytics/man/random_portfolios_v1.Rd pkg/PortfolioAnalytics/man/randomize_portfolio_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/random_portfolios.R pkg/PortfolioAnalytics/man/random_portfolios.Rd pkg/PortfolioAnalytics/man/randomize_portfolio.Rd Log: alias _v2 of random portfolios functions and add _v1 to old random portfolios functions Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:44:43 UTC (rev 2624) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:51:40 UTC (rev 2625) @@ -51,11 +51,11 @@ export(print.optimize.portfolio.pso) export(print.optimize.portfolio.random) export(print.optimize.portfolio.ROI) +export(random_portfolios_v1) export(random_portfolios_v2) -export(random_portfolios) export(random_walk_portfolios) +export(randomize_portfolio_v1) export(randomize_portfolio_v2) -export(randomize_portfolio) export(return_objective) export(risk_budget_objective) export(rp_transform) Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-22 23:44:43 UTC (rev 2624) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-22 23:51:40 UTC (rev 2625) @@ -53,7 +53,7 @@ #' @return named weighting vector #' @author Peter Carl, Brian G. Peterson, (based on an idea by Pat Burns) #' @export -randomize_portfolio <- function (rpconstraints, max_permutations=200, rounding=3) +randomize_portfolio_v1 <- function (rpconstraints, max_permutations=200, rounding=3) { # @author: Peter Carl, Brian Peterson (based on an idea by Pat Burns) # generate random permutations of a portfolio seed meeting your constraints on the weights of each asset @@ -173,7 +173,7 @@ #' rpconstraint<-constraint(assets=10, min_mult=-Inf, max_mult=Inf, min_sum=.99, max_sum=1.01, min=.01, max=.4, weight_seq=generatesequence()) #' rp<- random_portfolios(rpconstraints=rpconstraint,permutations=1000) #' head(rp) -random_portfolios <- function (rpconstraints,permutations=100,...) +random_portfolios_v1 <- function (rpconstraints,permutations=100,...) { # # this function generates a series of portfolios that are a "random walk" from the current portfolio seed=rpconstraints$assets @@ -203,9 +203,10 @@ #' @param rounding integer how many decimals should we round to #' @return named weighting vector #' @author Peter Carl, Brian G. Peterson, (based on an idea by Pat Burns) +#' @aliases randomize_portfolio +#' @rdname randomize_portfolio #' @export randomize_portfolio_v2 <- function (portfolio, max_permutations=200) { - # @author: Peter Carl, Brian Peterson (based on an idea by Pat Burns) # generate random permutations of a portfolio seed meeting your constraints on the weights of each asset # set the portfolio to the seed seed <- portfolio$assets @@ -324,6 +325,8 @@ #' @return matrix of random portfolio weights #' @seealso \code{\link{portfolio.spec}}, \code{\link{objective}}, \code{\link{randomize_portfolio_v2}} #' @author Peter Carl, Brian G. Peterson, (based on an idea by Pat Burns) +#' @aliases random_portfolios +#' @rdname random_portfolios #' @export random_portfolios_v2 <- function( portfolio, permutations=100, ...) { # @@ -348,6 +351,12 @@ return(result) } +# Alias randomize_portfolio_v2 to randomize_portfolio +randomize_portfolio <- randomize_portfolio_v2 + +# Alias random_portfolios_v2 to random_portfolios +random_portfolios <- random_portfolios_v2 + # EXAMPLE: start_t<- Sys.time(); x=random_walk_portfolios(rep(1/5,5), generatesequence(min=0.01, max=0.30, by=0.01), max_permutations=500, permutations=5000, min_sum=.99, max_sum=1.01); end_t<-Sys.time(); end_t-start_t; # > nrow(unique(x)) # [1] 4906 Modified: pkg/PortfolioAnalytics/man/random_portfolios.Rd =================================================================== --- pkg/PortfolioAnalytics/man/random_portfolios.Rd 2013-07-22 23:44:43 UTC (rev 2624) +++ pkg/PortfolioAnalytics/man/random_portfolios.Rd 2013-07-22 23:51:40 UTC (rev 2625) @@ -1,12 +1,13 @@ -\name{random_portfolios} +\name{random_portfolios_v2} \alias{random_portfolios} -\title{generate an arbitary number of constrained random portfolios} +\alias{random_portfolios_v2} +\title{version 2 generate an arbitary number of constrained random portfolios} \usage{ - random_portfolios(rpconstraints, permutations = 100, ...) + random_portfolios_v2(portfolio, permutations = 100, ...) } \arguments{ - \item{rpconstraints}{an object of type "constraints" - specifying the constraints for the optimization, see + \item{portfolio}{an object of type "portfolio" specifying + the constraints for the optimization, see \code{\link{constraint}}} \item{permutations}{integer: number of unique constrained @@ -22,17 +23,12 @@ generate an arbitrary number of constrained random portfolios. } -\examples{ -rpconstraint<-constraint(assets=10, min_mult=-Inf, max_mult=Inf, min_sum=.99, max_sum=1.01, min=.01, max=.4, weight_seq=generatesequence()) -rp<- random_portfolios(rpconstraints=rpconstraint,permutations=1000) -head(rp) -} \author{ Peter Carl, Brian G. Peterson, (based on an idea by Pat Burns) } \seealso{ - \code{\link{constraint}}, \code{\link{objective}}, - \code{\link{randomize_portfolio}} + \code{\link{portfolio.spec}}, \code{\link{objective}}, + \code{\link{randomize_portfolio_v2}} } Added: pkg/PortfolioAnalytics/man/random_portfolios_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/random_portfolios_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/random_portfolios_v1.Rd 2013-07-22 23:51:40 UTC (rev 2625) @@ -0,0 +1,39 @@ +\name{random_portfolios_v1} +\alias{random_portfolios_v1} +\title{generate an arbitary number of constrained random portfolios} +\usage{ + random_portfolios_v1(rpconstraints, permutations = 100, + ...) +} +\arguments{ + \item{rpconstraints}{an object of type "constraints" + specifying the constraints for the optimization, see + \code{\link{constraint}}} + + \item{permutations}{integer: number of unique constrained + random portfolios to generate} + + \item{\dots}{any other passthru parameters} +} +\value{ + matrix of random portfolio weights +} +\description{ + repeatedly calls \code{\link{randomize_portfolio}} to + generate an arbitrary number of constrained random + portfolios. +} +\examples{ +rpconstraint<-constraint(assets=10, min_mult=-Inf, max_mult=Inf, min_sum=.99, max_sum=1.01, min=.01, max=.4, weight_seq=generatesequence()) +rp<- random_portfolios(rpconstraints=rpconstraint,permutations=1000) +head(rp) +} +\author{ + Peter Carl, Brian G. Peterson, (based on an idea by Pat + Burns) +} +\seealso{ + \code{\link{constraint}}, \code{\link{objective}}, + \code{\link{randomize_portfolio}} +} + Modified: pkg/PortfolioAnalytics/man/randomize_portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/randomize_portfolio.Rd 2013-07-22 23:44:43 UTC (rev 2624) +++ pkg/PortfolioAnalytics/man/randomize_portfolio.Rd 2013-07-22 23:51:40 UTC (rev 2625) @@ -1,14 +1,14 @@ -\name{randomize_portfolio} +\name{randomize_portfolio_v2} \alias{randomize_portfolio} -\title{generate random permutations of a portfolio seed meeting your constraints on the weights of each asset} +\alias{randomize_portfolio_v2} +\title{version 2 generate random permutations of a portfolio seed meeting your constraints on the weights of each asset} \usage{ - randomize_portfolio(rpconstraints, - max_permutations = 200, rounding = 3) + randomize_portfolio_v2(portfolio, max_permutations = 200) } \arguments{ - \item{rpconstraints}{an object of type "constraints" - specifying the constraints for the optimization, see - \code{\link{constraint}}} + \item{portfolio}{an object of type "portfolio" specifying + the constraints for the optimization, see + \code{\link{portfolio.spec}}} \item{max_permutations}{integer: maximum number of iterations to try for a valid portfolio, default 200} @@ -20,8 +20,9 @@ named weighting vector } \description{ - generate random permutations of a portfolio seed meeting - your constraints on the weights of each asset + version 2 generate random permutations of a portfolio + seed meeting your constraints on the weights of each + asset } \author{ Peter Carl, Brian G. Peterson, (based on an idea by Pat Added: pkg/PortfolioAnalytics/man/randomize_portfolio_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/randomize_portfolio_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/randomize_portfolio_v1.Rd 2013-07-22 23:51:40 UTC (rev 2625) @@ -0,0 +1,30 @@ +\name{randomize_portfolio_v1} +\alias{randomize_portfolio_v1} +\title{generate random permutations of a portfolio seed meeting your constraints on the weights of each asset} +\usage{ + randomize_portfolio_v1(rpconstraints, + max_permutations = 200, rounding = 3) +} +\arguments{ + \item{rpconstraints}{an object of type "constraints" + specifying the constraints for the optimization, see + \code{\link{constraint}}} + + \item{max_permutations}{integer: maximum number of + iterations to try for a valid portfolio, default 200} + + \item{rounding}{integer how many decimals should we round + to} +} +\value{ + named weighting vector +} +\description{ + generate random permutations of a portfolio seed meeting + your constraints on the weights of each asset +} +\author{ + Peter Carl, Brian G. Peterson, (based on an idea by Pat + Burns) +} + From noreply at r-forge.r-project.org Tue Jul 23 01:56:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 01:56:57 +0200 (CEST) Subject: [Returnanalytics-commits] r2626 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130722235657.8E85C1858CE@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 01:56:57 +0200 (Tue, 23 Jul 2013) New Revision: 2626 Added: pkg/PortfolioAnalytics/man/constrained_objective_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/man/constrained_objective.Rd Log: alias _v2 of constrained_objective and add _v1 to old constrained_objective Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:51:40 UTC (rev 2625) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:56:57 UTC (rev 2626) @@ -10,8 +10,8 @@ export(charts.DE) export(charts.RP) export(constrained_group_tmp) +export(constrained_objective_v1) export(constrained_objective_v2) -export(constrained_objective) export(constraint_ROI) export(constraint_v2) export(constraint) Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-22 23:51:40 UTC (rev 2625) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-22 23:56:57 UTC (rev 2626) @@ -62,7 +62,7 @@ #' @seealso \code{\link{constraint}}, \code{\link{objective}}, \code{\link[DEoptim]{DEoptim.control}} #' @author Kris Boudt, Peter Carl, Brian G. Peterson #' @export -constrained_objective <- function(w, R, constraints, ..., trace=FALSE, normalize=TRUE, storage=FALSE) +constrained_objective_v1 <- function(w, R, constraints, ..., trace=FALSE, normalize=TRUE, storage=FALSE) { if (ncol(R)>length(w)) { R=R[,1:length(w)] @@ -382,6 +382,8 @@ #' @param storage TRUE/FALSE default TRUE for DEoptim with trace, otherwise FALSE. not typically user-called #' @seealso \code{\link{constraint}}, \code{\link{objective}}, \code{\link[DEoptim]{DEoptim.control}} #' @author Kris Boudt, Peter Carl, Brian G. Peterson, Ross Bennett +#' @aliases constrained_objective +#' @rdname constrained_objective #' @export constrained_objective_v2 <- function(w, R, portfolio, ..., trace=FALSE, normalize=TRUE, storage=FALSE) { @@ -715,3 +717,5 @@ return(list(out=as.numeric(out), weights=w, objective_measures=tmp_return)) } } + +constrained_objective <- constrained_objective_v1 \ No newline at end of file Modified: pkg/PortfolioAnalytics/man/constrained_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constrained_objective.Rd 2013-07-22 23:51:40 UTC (rev 2625) +++ pkg/PortfolioAnalytics/man/constrained_objective.Rd 2013-07-22 23:56:57 UTC (rev 2626) @@ -1,8 +1,9 @@ -\name{constrained_objective} +\name{constrained_objective_v2} \alias{constrained_objective} -\title{function to calculate a numeric return value for a portfolio based on a set of constraints} +\alias{constrained_objective_v2} +\title{constrained_objective_v2 2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives} \usage{ - constrained_objective(w, R, constraints, ..., + constrained_objective_v2(w, R, portfolio, ..., trace = FALSE, normalize = TRUE, storage = FALSE) } \arguments{ @@ -11,8 +12,8 @@ \item{w}{a vector of weights to test} - \item{constraints}{an object of type "constraints" - specifying the constraints for the optimization, see + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization, see \code{\link{constraint}}} \item{\dots}{any other passthru parameters} @@ -84,7 +85,7 @@ via \dots } \author{ - Kris Boudt, Peter Carl, Brian G. Peterson + Kris Boudt, Peter Carl, Brian G. Peterson, Ross Bennett } \seealso{ \code{\link{constraint}}, \code{\link{objective}}, Added: pkg/PortfolioAnalytics/man/constrained_objective_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constrained_objective_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/constrained_objective_v1.Rd 2013-07-22 23:56:57 UTC (rev 2626) @@ -0,0 +1,93 @@ +\name{constrained_objective_v1} +\alias{constrained_objective_v1} +\title{function to calculate a numeric return value for a portfolio based on a set of constraints} +\usage{ + constrained_objective_v1(w, R, constraints, ..., + trace = FALSE, normalize = TRUE, storage = FALSE) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{w}{a vector of weights to test} + + \item{constraints}{an object of type "constraints" + specifying the constraints for the optimization, see + \code{\link{constraint}}} + + \item{\dots}{any other passthru parameters} + + \item{trace}{TRUE/FALSE whether to include debugging and + additional detail in the output list} + + \item{normalize}{TRUE/FALSE whether to normalize results + to min/max sum (TRUE), or let the optimizer penalize + portfolios that do not conform (FALSE)} + + \item{storage}{TRUE/FALSE default TRUE for DEoptim with + trace, otherwise FALSE. not typically user-called} +} +\description{ + function to calculate a numeric return value for a + portfolio based on a set of constraints, we'll try to + make as few assumptions as possible, and only run + objectives that are required by the user +} +\details{ + If the user has passed in either min_sum or max_sum + constraints for the portfolio, or both, and are using a + numerical optimization method like DEoptim, and + normalize=TRUE, the default, we'll normalize the weights + passed in to whichever boundary condition has been + violated. If using random portfolios, all the portfolios + generated will meet the constraints by construction. + NOTE: this means that the weights produced by a numeric + optimization algorithm like DEoptim might violate your + constraints, so you'd need to renormalize them after + optimizing We apply the same normalization in + \code{\link{optimize.portfolio}} so that the weights you + see have been normalized to min_sum if the generated + portfolio is smaller than min_sum or max_sum if the + generated portfolio is larger than max_sum. This + normalization increases the speed of optimization and + convergence by several orders of magnitude in many cases. + + You may find that for some portfolios, normalization is + not desirable, if the algorithm cannot find a direction + in which to move to head towards an optimal portfolio. + In these cases, it may be best to set normalize=FALSE, + and penalize the portfolios if the sum of the weighting + vector lies outside the min_sum and/or max_sum. + + Whether or not we normalize the weights using min_sum and + max_sum, and are using a numerical optimization engine + like DEoptim, we will penalize portfolios that violate + weight constraints in much the same way we penalize other + constraints. If a min_sum/max_sum normalization has not + occurred, convergence can take a very long time. We + currently do not allow for a non-normalized full + investment constraint. Future version of this function + could include this additional constraint penalty. + + When you are optimizing a return objective, you must + specify a negative multiplier for the return objective so + that the function will maximize return. If you specify a + target return, any return less than your target will be + penalized. If you do not specify a target return, you + may need to specify a negative VTR (value to reach) , or + the function will not converge. Try the maximum expected + return times the multiplier (e.g. -1 or -10). Adding a + return objective defaults the multiplier to -1. + + Additional parameters for random portfolios or + \code{\link[DEoptim]{DEoptim.control}} may be passed in + via \dots +} +\author{ + Kris Boudt, Peter Carl, Brian G. Peterson +} +\seealso{ + \code{\link{constraint}}, \code{\link{objective}}, + \code{\link[DEoptim]{DEoptim.control}} +} + From noreply at r-forge.r-project.org Tue Jul 23 01:59:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 01:59:46 +0200 (CEST) Subject: [Returnanalytics-commits] r2627 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130722235946.BFA1C18592D@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 01:59:46 +0200 (Tue, 23 Jul 2013) New Revision: 2627 Added: pkg/PortfolioAnalytics/man/set.portfolio.moments_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd Log: alias _v2 of set.portfolio.moments and add _v1 to old set.portfolio.moments Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:56:57 UTC (rev 2626) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-22 23:59:46 UTC (rev 2627) @@ -59,8 +59,8 @@ export(return_objective) export(risk_budget_objective) export(rp_transform) +export(set.portfolio.moments_v1) export(set.portfolio.moments_v2) -export(set.portfolio.moments) export(summary.optimize.portfolio.rebalancing) export(summary.optimize.portfolio) export(summary.portfolio) Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-22 23:56:57 UTC (rev 2626) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-22 23:59:46 UTC (rev 2627) @@ -66,7 +66,7 @@ #' @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 <- function(R, constraints, momentargs=NULL,...){ +set.portfolio.moments_v1 <- function(R, constraints, momentargs=NULL,...){ if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list() if(is.null(constraints$objectives)) { @@ -146,6 +146,8 @@ #' @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,...){ @@ -224,6 +226,9 @@ return(momentargs) } +# Alias for set.portfolio.moments +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)),] Modified: pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd =================================================================== --- pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2013-07-22 23:56:57 UTC (rev 2626) +++ pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2013-07-22 23:59:46 UTC (rev 2627) @@ -1,17 +1,18 @@ -\name{set.portfolio.moments} +\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} \usage{ - set.portfolio.moments(R, constraints, momentargs = NULL, + set.portfolio.moments_v2(R, portfolio, momentargs = NULL, ...) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} - \item{constraints}{an object of type "constraints" - specifying the constraints for the optimization, see - \code{\link{constraint}}} + \item{portfolio}{an object of type "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} Added: pkg/PortfolioAnalytics/man/set.portfolio.moments_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/set.portfolio.moments_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/set.portfolio.moments_v1.Rd 2013-07-22 23:59:46 UTC (rev 2627) @@ -0,0 +1,25 @@ +\name{set.portfolio.moments_v1} +\alias{set.portfolio.moments_v1} +\title{set portfolio moments for use by lower level optimization functions} +\usage{ + set.portfolio.moments_v1(R, constraints, + momentargs = NULL, ...) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{constraints}{an object of type "constraints" + specifying the constraints for the optimization, see + \code{\link{constraint}}} + + \item{momentargs}{list containing arguments to be passed + down to lower level functions, default NULL} + + \item{\dots}{any other passthru parameters} +} +\description{ + set portfolio moments for use by lower level optimization + functions +} + From noreply at r-forge.r-project.org Tue Jul 23 02:03:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 02:03:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2628 - in pkg/PortfolioAnalytics: R man Message-ID: <20130723000359.899D118592D@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 02:03:47 +0200 (Tue, 23 Jul 2013) New Revision: 2628 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/man/constrained_objective.Rd Log: using alias set.portfolio.moments in constrained_objective_v2 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-22 23:59:46 UTC (rev 2627) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-23 00:03:47 UTC (rev 2628) @@ -336,7 +336,7 @@ } } -#' constrained_objective_v2 2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives +#' constrained_objective_v2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives #' #' function to calculate a numeric return value for a portfolio based on a set of constraints, #' we'll try to make as few assumptions as possible, and only run objectives that are required by the user @@ -526,7 +526,7 @@ nargs <- NULL } - nargs <- set.portfolio.moments_v2(R, portfolio, momentargs=nargs) + nargs <- set.portfolio.moments(R, portfolio, momentargs=nargs) if(is.null(portfolio$objectives)) { warning("no objectives specified in portfolio") Modified: pkg/PortfolioAnalytics/man/constrained_objective.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constrained_objective.Rd 2013-07-22 23:59:46 UTC (rev 2627) +++ pkg/PortfolioAnalytics/man/constrained_objective.Rd 2013-07-23 00:03:47 UTC (rev 2628) @@ -1,7 +1,7 @@ \name{constrained_objective_v2} \alias{constrained_objective} \alias{constrained_objective_v2} -\title{constrained_objective_v2 2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives} +\title{constrained_objective_v2 function to calculate a numeric return value for a portfolio based on a set of constraints and objectives} \usage{ constrained_objective_v2(w, R, portfolio, ..., trace = FALSE, normalize = TRUE, storage = FALSE) From noreply at r-forge.r-project.org Tue Jul 23 02:14:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 02:14:22 +0200 (CEST) Subject: [Returnanalytics-commits] r2629 - in pkg/PortfolioAnalytics: R man Message-ID: <20130723001422.9AE4F185184@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 02:14:22 +0200 (Tue, 23 Jul 2013) New Revision: 2629 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio.Rd Log: using alias functions constrained_objective, random_portfolios, and set.portfolio.moments inside optimize.portfolio Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-23 00:03:47 UTC (rev 2628) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-23 00:14:22 UTC (rev 2629) @@ -531,7 +531,7 @@ search_size=20000, trace=FALSE, ..., rp=NULL, - momentFUN='set.portfolio.moments_v2', + momentFUN='set.portfolio.moments', message=FALSE ) { @@ -666,14 +666,14 @@ if(hasArg(rpseed) & isTRUE(rpseed)) { # initial seed population is generated with random_portfolios function # if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01 - rp <- random_portfolios_v2(portfolio=portfolio, permutations=NP) + rp <- random_portfolios(portfolio=portfolio, permutations=NP) DEcformals$initialpop <- rp } controlDE <- do.call(DEoptim.control, DEcformals) # We are passing fn_map to the optional fnMap function to do the # transformation so we need to force normalize=FALSE in call to constrained_objective - minw = try(DEoptim( constrained_objective_v2, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=..., normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio)$weights)) # add ,silent=TRUE here? + minw = try(DEoptim( constrained_objective, lower=lower[1:N], upper=upper[1:N], control=controlDE, R=R, portfolio=portfolio, nargs = dotargs , ...=..., normalize=FALSE, fnMap=function(x) fn_map(x, portfolio=portfolio)$weights)) # add ,silent=TRUE here? if(inherits(minw, "try-error")) { minw=NULL } if(is.null(minw)){ @@ -689,7 +689,7 @@ weights <- normalize_weights(weights) names(weights) <- colnames(R) - out <- list(weights=weights, objective_measures=constrained_objective_v2(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=minw$optim$bestval, call=call) + out <- list(weights=weights, objective_measures=constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=minw$optim$bestval, call=call) if (isTRUE(trace)){ out$DEoutput <- minw out$DEoptim_objective_results <- try(get('.objectivestorage',pos='.GlobalEnv'),silent=TRUE) @@ -702,16 +702,16 @@ if(optimize_method=="random"){ #' call random_portfolios() with portfolio and search_size to create matrix of portfolios if(missing(rp) | is.null(rp)){ - rp <- random_portfolios_v2(portfolio=portfolio, permutations=search_size) + rp <- random_portfolios(portfolio=portfolio, permutations=search_size) } #' store matrix in out if trace=TRUE if (isTRUE(trace)) out$random_portfolios <- rp # rp is already being generated with a call to fn_map so set normalize=FALSE in the call to constrained_objective #' write foreach loop to call constrained_objective() with each portfolio if ("package:foreach" %in% search() & !hasArg(parallel)){ - rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective_v2(w=rp[ii,], R, portfolio, trace=trace,...=dotargs, normalize=FALSE) + rp_objective_results <- foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective(w=rp[ii,], R, portfolio, trace=trace,...=dotargs, normalize=FALSE) } else { - rp_objective_results <- apply(rp, 1, constrained_objective_v2, R=R, portfolio=portfolio, trace=trace, ...=dotargs, normalize=FALSE) + rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, ...=dotargs, normalize=FALSE) } #' if trace=TRUE , store results of foreach in out$random_results if(isTRUE(trace)) out$random_portfolio_objective_results <- rp_objective_results @@ -735,7 +735,7 @@ } #' re-call constrained_objective on the best portfolio, as above in DEoptim, with trace=TRUE to get results for out list out$weights <- min_objective_weights - out$objective_measures <- try(constrained_objective_v2(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE)$objective_measures) + out$objective_measures <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE)$objective_measures) out$call <- call #' construct out list to be as similar as possible to DEoptim list, within reason @@ -816,7 +816,7 @@ upper <- constraints$max lower <- constraints$min - minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective_v2, R=R, portfolio=portfolio, + minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective, R=R, portfolio=portfolio, lower = lower[1:N] , upper = upper[1:N] , control = controlPSO)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } @@ -830,7 +830,7 @@ names(weights) <- colnames(R) out <- list(weights=weights, - objective_measures=constrained_objective_v2(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures, + objective_measures=constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures, out=minw$value, call=call) if (isTRUE(trace)){ @@ -861,7 +861,7 @@ lower <- constraints$min minw = try(GenSA( par = rep(1/N, N), lower = lower[1:N] , upper = upper[1:N], control = controlGenSA, - fn = constrained_objective_v2 , R=R, portfolio=portfolio)) # add ,silent=TRUE here? + fn = constrained_objective , R=R, portfolio=portfolio)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } if(is.null(minw)){ @@ -874,7 +874,7 @@ names(weights) <- colnames(R) out = list(weights=weights, - objective_measures=constrained_objective_v2(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures, + objective_measures=constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures, out=minw$value, call=call) if (isTRUE(trace)){ Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.Rd 2013-07-23 00:03:47 UTC (rev 2628) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.Rd 2013-07-23 00:14:22 UTC (rev 2629) @@ -6,8 +6,7 @@ optimize.portfolio_v2(R, portfolio, optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), search_size = 20000, trace = FALSE, ..., rp = NULL, - momentFUN = "set.portfolio.moments_v2", - message = FALSE) + momentFUN = "set.portfolio.moments", message = FALSE) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries From noreply at r-forge.r-project.org Tue Jul 23 02:26:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 02:26:04 +0200 (CEST) Subject: [Returnanalytics-commits] r2630 - in pkg/PortfolioAnalytics: . R Message-ID: <20130723002604.9058B185A9D@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 02:26:04 +0200 (Tue, 23 Jul 2013) New Revision: 2630 Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/R/moment.functions.R pkg/PortfolioAnalytics/R/objective.R pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/R/random_portfolios.R Log: adding @export tag for all aliased functions Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-23 00:14:22 UTC (rev 2629) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-23 00:26:04 UTC (rev 2630) @@ -1,6 +1,7 @@ export(add.constraint) export(add.objective_v1) export(add.objective_v2) +export(add.objective) export(box_constraint) export(CCCgarch.MM) export(chart.Scatter.DE) @@ -12,6 +13,7 @@ export(constrained_group_tmp) export(constrained_objective_v1) export(constrained_objective_v2) +export(constrained_objective) export(constraint_ROI) export(constraint_v2) export(constraint) @@ -38,6 +40,7 @@ export(optimize.portfolio_v2) export(optimize.portfolio.parallel) export(optimize.portfolio.rebalancing) +export(optimize.portfolio) export(plot.optimize.portfolio.DEoptim) export(plot.optimize.portfolio.random) export(plot.optimize.portfolio) @@ -53,14 +56,17 @@ export(print.optimize.portfolio.ROI) export(random_portfolios_v1) export(random_portfolios_v2) +export(random_portfolios) export(random_walk_portfolios) export(randomize_portfolio_v1) export(randomize_portfolio_v2) +export(randomize_portfolio) export(return_objective) export(risk_budget_objective) export(rp_transform) export(set.portfolio.moments_v1) export(set.portfolio.moments_v2) +export(set.portfolio.moments) export(summary.optimize.portfolio.rebalancing) export(summary.optimize.portfolio) export(summary.portfolio) Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-23 00:14:22 UTC (rev 2629) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-07-23 00:26:04 UTC (rev 2630) @@ -718,4 +718,6 @@ } } -constrained_objective <- constrained_objective_v1 \ No newline at end of file +# Alias constrained_objective_v2 to constrained_objective +#' @export +constrained_objective <- constrained_objective_v2 \ No newline at end of file Modified: pkg/PortfolioAnalytics/R/moment.functions.R =================================================================== --- pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-23 00:14:22 UTC (rev 2629) +++ pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-23 00:26:04 UTC (rev 2630) @@ -227,6 +227,7 @@ } # Alias for set.portfolio.moments +#' @export set.portfolio.moments <- set.portfolio.moments_v2 garch.mm <- function(R,mu_ts, covlist,momentargs=list(),...) { Modified: pkg/PortfolioAnalytics/R/objective.R =================================================================== --- pkg/PortfolioAnalytics/R/objective.R 2013-07-23 00:14:22 UTC (rev 2629) +++ pkg/PortfolioAnalytics/R/objective.R 2013-07-23 00:26:04 UTC (rev 2630) @@ -216,6 +216,7 @@ } # Alias add.objective_v2 to add.objective +#' @export add.objective <- add.objective_v2 # update.objective <- function(object, ...) { Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-23 00:14:22 UTC (rev 2629) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-23 00:26:04 UTC (rev 2630) @@ -895,7 +895,8 @@ return(out) } -# Alias for optimize.portfolio_v2 +# Alias for optimize.portfolio_ +#' @export optimize.portfolio <- optimize.portfolio_v2 #' portfolio optimization with support for rebalancing or rolling periods Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-23 00:14:22 UTC (rev 2629) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-23 00:26:04 UTC (rev 2630) @@ -352,9 +352,11 @@ } # Alias randomize_portfolio_v2 to randomize_portfolio +#' @export randomize_portfolio <- randomize_portfolio_v2 # Alias random_portfolios_v2 to random_portfolios +#' @export random_portfolios <- random_portfolios_v2 # EXAMPLE: start_t<- Sys.time(); x=random_walk_portfolios(rep(1/5,5), generatesequence(min=0.01, max=0.30, by=0.01), max_permutations=500, permutations=5000, min_sum=.99, max_sum=1.01); end_t<-Sys.time(); end_t-start_t; From noreply at r-forge.r-project.org Tue Jul 23 02:49:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 02:49:04 +0200 (CEST) Subject: [Returnanalytics-commits] r2631 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130723004904.16ED51849ED@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 02:49:03 +0200 (Tue, 23 Jul 2013) New Revision: 2631 Modified: pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R pkg/PortfolioAnalytics/sandbox/testing_portfolio_specification.R Log: updatind testing scripts to omit the old interface and omit the _v2 in optimize.portfolio and add.objective Modified: pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R 2013-07-23 00:26:04 UTC (rev 2630) +++ pkg/PortfolioAnalytics/sandbox/testing_ROI_Martin.R 2013-07-23 00:49:03 UTC (rev 2631) @@ -25,36 +25,16 @@ returns <- midcap.ts[, 1:10] funds <- colnames(returns) -# Set up initial constraint object -# Here we specify the minimum weight of any asset is -Inf and the maximum -# weight of any asset is Inf. This is essentially an unconstrained GMV portfolio -# We specify the full investment constraint (w' 1 = 1) by setting min_sum=1 -# and max_sum=1. -gen.constr <- constraint(assets=funds, min=-Inf, max=Inf, min_sum=1, max_sum=1) -# Add objective to minimize variance -gen.constr <- add.objective(constraints=gen.constr, type="risk", name="var", enabled=TRUE) - ##### Example 1.1: Global Minimum Variance (GMV) Portfolio ##### -# Global Minimum variance portfolio -gmv.constr <- gen.constr -# Call the optimizer to minimize portfolio variance -gmv.opt <- optimize.portfolio(R=returns, constraints=gmv.constr, optimize_method="ROI") - -# Optimal weights -round(gmv.opt$weights, 3) - -# Portfolio standard deviation -sqrt(gmv.opt$out) - # GMV portfolio using new interface pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=-Inf, max=Inf, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -63,32 +43,14 @@ sqrt(opt$out) ##### Example 1.2: Long Only GMV Portfolio ##### -gmv.longonly.constr <- gen.constr -# Set the min and max vectors for long only constraints -min <- rep(0, length(funds)) -max <- rep(1, length(funds)) - -# Modify the min and max vectors in gmv.longonly.constr -gmv.longonly.constr$min <- min -gmv.longonly.constr$max <- max - -# Call the optimizer -gmv.longonly.opt <- optimize.portfolio(R=returns, constraints=gmv.longonly.constr, optimize_method="ROI") - -# Optimal weights -round(gmv.longonly.opt$weights, 3) - -# Portfolio standard deviation -sqrt(gmv.longonly.opt$out) - # GMV long only portfolio using new interface pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -97,34 +59,14 @@ sqrt(opt$out) ##### Example 1.3: GMV Box Constraints ##### -gmv.box.constr <- gen.constr -# Set the min and max vectors for box constraints -# The box constraints are such that the minimum weight of any asset is 0.03 -# and the maximum weight of any asset is 0.25 -min <- rep(0.03, length(funds)) -max <- rep(0.25, length(funds)) - -# Modify the min and max vectors in gmv.longonly.constr -gmv.box.constr$min <- min -gmv.box.constr$max <- max - -# Call the optimizer -gmv.box.opt <- optimize.portfolio(R=returns, constraints=gmv.box.constr, optimize_method="ROI") - -# Optimal weights -round(gmv.box.opt$weights, 3) - -# Portfolio standard deviation -sqrt(gmv.box.opt$out) - # GMV box constraints portfolio using new interface pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -132,31 +74,6 @@ # Portfolio standard deviation sqrt(opt$out) -##### Example 1.3a: GMV Box Constraints ##### -gmv.box.constr <- gen.constr - -# As an alternative to box constriants, we can also linear inequality -# constraints for the minimum and maximum asset weights - -# Set the min and max vectors for box constraints -# The box constraints are such that the minimum weight of any asset is 0.03 -# and the maximum weight of any asset is 0.25 -min <- c(0.02, 0.02, 0.02, 0.04, 0.05, 0.05, 0.02, 0, 0, 0.1) -max <- c(0.2, 0.4, 0.4, 0.45, 0.3, 0.5, 0.4, 0.4, 0.4, 0.4) - -# Modify the min and max vectors in gmv.longonly.constr -gmv.box.constr$min <- min -gmv.box.constr$max <- max - -# Mean variance optimization (MVO) seeks to minimize portfolio variance -gmv.box.opt <- optimize.portfolio(R=returns, constraints=gmv.box.constr, optimize_method="ROI") - -# Optimal weights -round(gmv.box.opt$weights, 3) - -# Portfolio standard deviation -sqrt(gmv.box.opt$out) - ##### Example 1.4: GMV long only with Group Constraints ##### # Combine returns from different market cap groups returns.cap <- cbind(microcap.ts[, 1:2], @@ -166,31 +83,6 @@ funds.cap <- colnames(returns.cap) -# Set up constraints object for the market caps -lo.group.constr <- constraint(assets=funds.cap, min=0, max=1, min_sum=1, max_sum=1) - -# Add group constraints to gmv.box.group.constr -# Market cap constraints -# At least 10% and no more than 25% in micro-caps -# At least 15% and no more than 35% in small-caps -# At least 0% and no more than 35% in mid-caps -# At least 0% and no more than 45% in large-caps -lo.group.constr$groups <- c(2, 2, 2, 2) -lo.group.constr$cLO <- c(0.1, 0.15, 0, 0) -lo.group.constr$cUP <- c(0.25, .35, 0.35, 0.45) - -# Add objective to minimize variance -gmv.lo.group.constr <- add.objective(constraints=lo.group.constr, type="risk", name="var", enabled=TRUE) - -# Call optimizer -gmv.lo.group.opt <- optimize.portfolio(R=returns.cap, constraints=gmv.lo.group.constr, optimize_method="ROI") - -# Optimal weights -round(gmv.lo.group.opt$weights, 3) - -# Group weights -gmv.lo.group.opt$weights[c(1, 3, 5, 7)] + gmv.lo.group.opt$weights[c(2, 4, 6, 8)] - # GMV group constraints portfolio using new interface pspec <- portfolio.spec(assets=funds.cap) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) @@ -200,9 +92,9 @@ group_min=c(0.1, 0.15, 0, 0), group_max=c(0.25, .35, 0.35, 0.45), group_labels=c("MICRO", "SMALL", "MID", "LARGE")) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns.cap, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns.cap, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -211,8 +103,8 @@ # This is something I will work to include in the summary.optimize.portfolio.ROI groups <- pspec$constraints[[3]]$groups group_labels <- pspec$constraints[[3]]$group_labels -group_weights <- rep(0, n.groups) n.groups <- length(groups) +group_weights <- rep(0, n.groups) k <- 1 l <- 0 for(i in 1:n.groups){ @@ -231,29 +123,14 @@ # The solve.QP plugin is selected automatically by optimize.portfolio when "var" is the objective ##### Example 1.6: Maximize mean-return with box constraints ##### -# Set up initial constraint object -# Here we specify the minimum weight of any asset is 0.03 and the maximum weight of any asset is 0.25 -# We specify the full investment constraint (w' 1 = 1) by setting min_sum=1 and max_sum=1 -gen.constr <- constraint(assets=funds, min=0.03, max=0.25, min_sum=1, max_sum=1) -# Add objective to maximize return -gen.constr <- add.objective(constraints=gen.constr, type="return", name="mean", enabled=TRUE) - -maxret.constr <- gen.constr - -# Call optimizer to maximize return subject to given constraints -maxret.opt <- optimize.portfolio(R=returns, constraints=maxret.constr, optimize_method="ROI") - -# Optimal weights -maxret.opt$weights - # Maximize mean return with box constraints portfolio using new interface pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="return", name="mean", enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -262,19 +139,7 @@ sqrt(opt$out) ##### Example 1.7 Maximize mean-return Long Only with Group Constraints ##### -# Re-use lo.group.constr from Example 1.5 -maxret.lo.group.constr <- lo.group.constr -maxret.lo.group.constr <- add.objective(constraints=maxret.lo.group.constr, type="return", name="mean", enabled=TRUE) - -maxret.lo.group.opt <- optimize.portfolio(R=returns.cap, constraints=maxret.lo.group.constr, optimize_method="ROI") - -# Optimal weights -maxret.lo.group.opt$weights - -# Group weights -maxret.lo.group.opt$weights[c(1, 3, 5, 7)] + maxret.lo.group.opt$weights[c(2, 4, 6, 8)] - # GMV group constraints portfolio using new interface pspec <- portfolio.spec(assets=funds.cap) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) @@ -284,9 +149,9 @@ group_min=c(0.1, 0.15, 0, 0), group_max=c(0.25, .35, 0.35, 0.45), group_labels=c("MICRO", "SMALL", "MID", "LARGE")) -pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="return", name="mean", enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns.cap, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns.cap, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -311,21 +176,6 @@ # Portfolio standard deviation sqrt(opt$out) -##### Example 1.X: Maximize Quadratic Utility ##### -# Quadratic utility maximize return penalizing variance -qu.constr <- constraint(assets=funds, min=0, max=1, min_sum=1, max_sum=1) - -# Add mean return as an objective -qu.constr <- add.objective(constraints=qu.constr, type="return", name="mean", enabled=TRUE) - -# Add variance as an objective -qu.constr <- add.objective(constraints=qu.constr, type="risk", name="var", enabled=TRUE, risk_aversion=20) - -qu.opt <- optimize.portfolio(R=returns, constraints=qu.constr, optimize_method="ROI") - -wts1 <- round(qu.opt$weights, 4) -wts1 - # Check results for quadratic utility with manual code p <- ncol(returns) V <- var(returns) @@ -343,37 +193,20 @@ names(wts2) <- colnames(returns) wts2 -all.equal(wts1, wts2) - # Note that target mean return CANNOT be specified as a constraint currently # It is specified as a target in the return objective # Can do quadratic utility optimization with target return -##### Example 1.X: Maximize Quadratic Utility ##### -# Quadratic utility maximize return penalizing variance -qu.constr <- constraint(assets=funds, min=0, max=1, min_sum=1, max_sum=1) - -# Add mean return as an objective -qu.constr <- add.objective(constraints=qu.constr, type="return", name="mean", target=0.025, enabled=TRUE) - -# Add variance as an objective -# Set risk aversion parameter high to approximate mvo -qu.constr <- add.objective(constraints=qu.constr, type="risk", name="var", enabled=TRUE, risk_aversion=1e6) - -qu.opt <- optimize.portfolio(R=returns, constraints=qu.constr, optimize_method="ROI") - -round(qu.opt$weights, 4) - ##### Example X: Mean Variance Optimization (MVO) with target mean return constraint ##### # MVO with target mean return pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=-Inf, max=Inf, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -388,10 +221,10 @@ pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -405,10 +238,10 @@ pspec <- portfolio.spec(assets=funds) pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) -pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="var", risk_aversion=1e6, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="return", name="mean", target=0.014, enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -422,9 +255,9 @@ pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) # This can be specified with ETL, ES, or CVaR for name -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -435,9 +268,9 @@ pspec <- add.constraint(portfolio=pspec, type="full_investment", enabled=TRUE) pspec <- add.constraint(portfolio=pspec, type="box", min=0.03, max=0.25, enabled=TRUE) # This can be specified with ETL, ES, or CVaR for name -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) @@ -453,9 +286,9 @@ group_min=c(0.1, 0.15, 0, 0), group_max=c(0.25, .35, 0.35, 0.45), group_labels=c("MICRO", "SMALL", "MID", "LARGE")) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) +pspec <- add.objective(portfolio=pspec, type="risk", name="ETL", alpha=0.05, enabled=TRUE) -opt <- optimize.portfolio_v2(R=returns.cap, portfolio=pspec, optimize_method="ROI") +opt <- optimize.portfolio(R=returns.cap, portfolio=pspec, optimize_method="ROI") # Optimal weights round(opt$weights, 3) Modified: pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-23 00:26:04 UTC (rev 2630) +++ pkg/PortfolioAnalytics/sandbox/testing_optimize.portfolio_v2.R 2013-07-23 00:49:03 UTC (rev 2631) @@ -7,9 +7,9 @@ funds <- colnames(ret) # Set up constraints and objectives using old interface -gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, - weight_seq = generatesequence(min=0, max=1, by=0.002)) -gen.constr <- add.objective(constraints=gen.constr, type="return", name="mean", enabled=TRUE, multiplier=-1) +# gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, +# weight_seq = generatesequence(min=0, max=1, by=0.002)) +# gen.constr <- add.objective(constraints=gen.constr, type="return", name="mean", enabled=TRUE, multiplier=-1) # Set up constraints and objectives using new interface pspec <- portfolio.spec(assets=funds, weight_seq = generatesequence(min=0, max=1, by=0.002)) @@ -25,62 +25,62 @@ # generate an initial population with random_portfolios rp <- random_portfolios_v2(portfolio=pspec, permutations=40) -set.seed(123) -opt_out_de <- optimize.portfolio(R=ret, gen.constr, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) +# set.seed(123) +# opt_out_de <- optimize.portfolio(R=ret, gen.constr, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) set.seed(123) opt_de <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="DEoptim", search_size=1000, trace=FALSE, rpseed=rp) # The results should be the same using the same initial population and set.seed -all.equal(opt_out_de$weights, opt_de$weights) -all.equal(opt_out_de$objective_measures, opt_de$objective_measures) +# all.equal(opt_out_de$weights, opt_de$weights) +# all.equal(opt_out_de$objective_measures, opt_de$objective_measures) # Note that values are now different since I added fnMap=fn_map to DEoptim in optimize.portfolio_v2 # This is likely due to how normalization/transformation is handled ##### Simple test for random method with optimize.portfolio_v2 ##### -set.seed(123) -opt_out_rp <- optimize.portfolio(R=ret, gen.constr, optimize_method="random", search_size=2000, trace=FALSE) +# set.seed(123) +# opt_out_rp <- optimize.portfolio(R=ret, gen.constr, optimize_method="random", search_size=2000, trace=FALSE) set.seed(123) opt_rp <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="random", search_size=2000, trace=FALSE) # The results should be the same -all.equal(opt_out_rp$weights, opt_rp$weights) -all.equal(opt_out_rp$objective_measures, opt_rp$objective_measures) +# all.equal(opt_out_rp$weights, opt_rp$weights) +# all.equal(opt_out_rp$objective_measures, opt_rp$objective_measures) ##### Simple test for pso method with optimize.portfolio_v2 ##### -set.seed(123) -opt_out_pso <- optimize.portfolio(R=ret, gen.constr, optimize_method="pso", search_size=2000, trace=FALSE) +# set.seed(123) +# opt_out_pso <- optimize.portfolio(R=ret, gen.constr, optimize_method="pso", search_size=2000, trace=FALSE) set.seed(123) opt_pso <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="pso", search_size=2000, trace=FALSE) # The results should be the same -all.equal(opt_out_pso$weights, opt_pso$weights) -all.equal(opt_out_pso$objective_measures, opt_pso$objective_measures) +# all.equal(opt_out_pso$weights, opt_pso$weights) +# all.equal(opt_out_pso$objective_measures, opt_pso$objective_measures) ##### Simple test for GenSA method with optimize.portfolio_v2 ##### -set.seed(123) -opt_out_gensa <- optimize.portfolio(R=ret, gen.constr, optimize_method="GenSA", search_size=2000, trace=FALSE) +# set.seed(123) +# opt_out_gensa <- optimize.portfolio(R=ret, gen.constr, optimize_method="GenSA", search_size=2000, trace=FALSE) set.seed(123) opt_gensa <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="GenSA", search_size=2000, trace=FALSE) # The results should be the same -all.equal(opt_out_gensa$weights, opt_gensa$weights) -all.equal(opt_out_gensa$objective_measures, opt_gensa$objective_measures) +# all.equal(opt_out_gensa$weights, opt_gensa$weights) +# all.equal(opt_out_gensa$objective_measures, opt_gensa$objective_measures) ##### Simple test for ROI method with optimize.portfolio_v2 ##### # specify CVaR with old interface and ETL with new interface # Set up constraints and objectives using old interface -gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, - weight_seq = generatesequence(min=0, max=1, by=0.002)) -gen.constr <- add.objective(constraints=gen.constr, type="risk", name="CVaR", enabled=TRUE, multiplier=-1) +# gen.constr <- constraint(assets=funds, min=0, max=1, min_sum=0.99, max_sum=1.01, +# weight_seq = generatesequence(min=0, max=1, by=0.002)) +# gen.constr <- add.objective(constraints=gen.constr, type="risk", name="CVaR", enabled=TRUE, multiplier=-1) # Set up constraints and objectives using new interface pspec <- portfolio.spec(assets=funds, weight_seq = generatesequence(min=0, max=1, by=0.002)) @@ -88,16 +88,16 @@ pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1, enabled=TRUE) pspec <- add.objective_v2(portfolio=pspec, type="risk", name="ETL", multiplier=-1, enabled=TRUE) -opt_out_roi <- optimize.portfolio(R=ret, gen.constr, optimize_method="ROI", search_size=2000, trace=FALSE) +# opt_out_roi <- optimize.portfolio(R=ret, gen.constr, optimize_method="ROI", search_size=2000, trace=FALSE) opt_roi <- optimize.portfolio_v2(R=ret, portfolio=pspec, optimize_method="ROI", search_size=2000, trace=FALSE) # The results should be the same -all.equal(opt_out_roi$weights, opt_roi$weights) -all.equal(opt_out_roi$objective_measures, opt_roi$objective_measures) +# all.equal(opt_out_roi$weights, opt_roi$weights) +# all.equal(opt_out_roi$objective_measures, opt_roi$objective_measures) ##### Test version of random_portfolios ##### -tmp <- random_portfolios(gen.constr) -tmp1 <- random_portfolios_v2(pspec) -all(rowSums(tmp1) <= 1.01) & all(rowSums(tmp1) >= 0.99) +# tmp <- random_portfolios(gen.constr) +# tmp1 <- random_portfolios_v2(pspec) +# all(rowSums(tmp1) <= 1.01) & all(rowSums(tmp1) >= 0.99) Modified: pkg/PortfolioAnalytics/sandbox/testing_portfolio_specification.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_portfolio_specification.R 2013-07-23 00:26:04 UTC (rev 2630) +++ pkg/PortfolioAnalytics/sandbox/testing_portfolio_specification.R 2013-07-23 00:49:03 UTC (rev 2631) @@ -1,7 +1,6 @@ # Testing for the new portfolio specification # Load necessary packages -library(PerformanceAnalytics) library(PortfolioAnalytics) # Load the edhec data @@ -46,15 +45,15 @@ print(pspec) # Add objectives to the pspec object -pspec <- add.objective_v2(portfolio=pspec, type="return", name="mean", +pspec <- add.objective(portfolio=pspec, type="return", name="mean", enabled=FALSE, multiplier=0) print(pspec) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="var", +pspec <- add.objective(portfolio=pspec, type="risk", name="var", enabled=FALSE, multiplier=0, risk_aversion=10) print(pspec) -pspec <- add.objective_v2(portfolio=pspec, type="risk", name="CVaR", +pspec <- add.objective(portfolio=pspec, type="risk", name="CVaR", enabled=FALSE, multiplier=0) print(pspec) From noreply at r-forge.r-project.org Tue Jul 23 03:04:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 03:04:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2632 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130723010445.8B641185C44@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 03:04:44 +0200 (Tue, 23 Jul 2013) New Revision: 2632 Added: pkg/PortfolioAnalytics/man/constraint_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/man/constraint.Rd Log: updating constraints to alias constraint_v2 to constraint and use constraint inside functions Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-23 00:49:03 UTC (rev 2631) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-23 01:04:44 UTC (rev 2632) @@ -15,6 +15,7 @@ export(constrained_objective_v2) export(constrained_objective) export(constraint_ROI) +export(constraint_v1) export(constraint_v2) export(constraint) export(diversification_constraint) Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-23 00:49:03 UTC (rev 2631) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-23 01:04:44 UTC (rev 2632) @@ -25,7 +25,7 @@ #' @examples #' exconstr <- constraint(assets=10, min_sum=1, max_sum=1, min=.01, max=.35, weight_seq=generatesequence()) #' @export -constraint <- function(assets=NULL, ... ,min,max,min_mult,max_mult,min_sum=.99,max_sum=1.01,weight_seq=NULL) +constraint_v1 <- function(assets=NULL, ... ,min,max,min_mult,max_mult,min_sum=.99,max_sum=1.01,weight_seq=NULL) { # based on GPL R-Forge pkg roi by Stefan Thuessel,Kurt Hornik,David Meyer if (hasArg(min) & hasArg(max)) { if (is.null(assets) & (!length(min)>1) & (!length(max)>1)) { @@ -159,6 +159,8 @@ #' @param ... any other passthru parameters #' @param constrclass character to name the constraint class #' @author Ross Bennett +#' @aliases constraint +#' @rdname constraint #' @export constraint_v2 <- function(type, enabled=TRUE, ..., constrclass="v2_constraint"){ if(!hasArg(type)) stop("you must specify a constraint type") @@ -173,6 +175,10 @@ ) } +# Alias constraint_v2 to constraint +#' @export +constraint <- constraint_v2 + #' General interface for adding and/or updating optimization constraints. #' #' This is the main function for adding and/or updating constraints in an object of type \code{\link{portfolio}}. @@ -386,7 +392,7 @@ max[which(tmp_max < max)] <- tmp_max[which(tmp_max < max)] } - Constraint <- constraint_v2(type=type, enabled=enabled, constrclass="box_constraint", ...) + Constraint <- constraint(type=type, enabled=enabled, constrclass="box_constraint", ...) Constraint$min <- min Constraint$max <- max return(Constraint) @@ -462,7 +468,7 @@ } } - Constraint <- constraint_v2(type, enabled=enabled, constrclass="group_constraint", ...) + Constraint <- constraint(type, enabled=enabled, constrclass="group_constraint", ...) Constraint$groups <- groups Constraint$group_labels <- group_labels Constraint$cLO <- group_min @@ -506,7 +512,7 @@ #' pspec <- add.constraint(pspec, type="active") #' @export weight_sum_constraint <- function(type, min_sum=0.99, max_sum=1.01, enabled=TRUE, ...){ - Constraint <- constraint_v2(type, enabled=enabled, constrclass="weight_sum_constraint", ...) + Constraint <- constraint(type, enabled=enabled, constrclass="weight_sum_constraint", ...) Constraint$min_sum <- min_sum Constraint$max_sum <- max_sum return(Constraint) @@ -627,7 +633,7 @@ #' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) #' @export turnover_constraint <- function(type, turnover_target, enabled=TRUE, message=FALSE, ...){ - Constraint <- constraint_v2(type, enabled=enabled, constrclass="turnover_constraint", ...) + Constraint <- constraint(type, enabled=enabled, constrclass="turnover_constraint", ...) Constraint$turnover_target <- turnover_target return(Constraint) } @@ -651,7 +657,7 @@ #' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) #' @export diversification_constraint <- function(type, div_target, enabled=TRUE, message=FALSE, ...){ - Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...) + Constraint <- constraint(type, enabled=enabled, constrclass="diversification_constraint", ...) Constraint$div_target <- div_target return(Constraint) } @@ -716,7 +722,7 @@ # coerce to integer max_pos_short <- as.integer(max_pos_short) } - Constraint <- constraint_v2(type, enabled=enabled, constrclass="position_limit_constraint", ...) + Constraint <- constraint(type, enabled=enabled, constrclass="position_limit_constraint", ...) Constraint$max_pos <- max_pos Constraint$max_pos_long <- max_pos_long Constraint$max_pos_short <- max_pos_short Modified: pkg/PortfolioAnalytics/man/constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constraint.Rd 2013-07-23 00:49:03 UTC (rev 2631) +++ pkg/PortfolioAnalytics/man/constraint.Rd 2013-07-23 01:04:44 UTC (rev 2632) @@ -1,47 +1,27 @@ -\name{constraint} +\name{constraint_v2} \alias{constraint} -\title{constructor for class constraint} +\alias{constraint_v2} +\title{constructor for class v2_constraint} \usage{ - constraint(assets = NULL, ..., min, max, min_mult, - max_mult, min_sum = 0.99, max_sum = 1.01, - weight_seq = NULL) + constraint_v2(type, enabled = TRUE, ..., + constrclass = "v2_constraint") } \arguments{ + \item{type}{character type of the constraint to add or + update, currently 'weight_sum', 'box', or 'group'} + \item{assets}{number of assets, or optionally a named vector of assets specifying seed weights} \item{...}{any other passthru parameters} - \item{min}{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 seed weight in - \code{assets}} - - \item{max_mult}{numeric or named vector specifying - maximum multiplier box constraint from seed weight in - \code{assets}} - - \item{min_sum}{minimum sum of all asset weights, default - .99} - - \item{max_sum}{maximum sum of all asset weights, default - 1.01} - - \item{weight_seq}{seed sequence of weights, see - \code{\link{generatesequence}}} + \item{constrclass}{character to name the constraint + class} } \description{ - constructor for class constraint + constructor for class v2_constraint } -\examples{ -exconstr <- constraint(assets=10, min_sum=1, max_sum=1, min=.01, max=.35, weight_seq=generatesequence()) -} \author{ - Peter Carl and Brian G. Peterson + Ross Bennett } Added: pkg/PortfolioAnalytics/man/constraint_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constraint_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/constraint_v1.Rd 2013-07-23 01:04:44 UTC (rev 2632) @@ -0,0 +1,47 @@ +\name{constraint_v1} +\alias{constraint_v1} +\title{constructor for class constraint} +\usage{ + constraint_v1(assets = NULL, ..., min, max, min_mult, + max_mult, min_sum = 0.99, max_sum = 1.01, + weight_seq = NULL) +} +\arguments{ + \item{assets}{number of assets, or optionally a named + vector of assets specifying seed weights} + + \item{...}{any other passthru parameters} + + \item{min}{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 seed weight in + \code{assets}} + + \item{max_mult}{numeric or named vector specifying + maximum multiplier box constraint from seed weight in + \code{assets}} + + \item{min_sum}{minimum sum of all asset weights, default + .99} + + \item{max_sum}{maximum sum of all asset weights, default + 1.01} + + \item{weight_seq}{seed sequence of weights, see + \code{\link{generatesequence}}} +} +\description{ + constructor for class constraint +} +\examples{ +exconstr <- constraint(assets=10, min_sum=1, max_sum=1, min=.01, max=.35, weight_seq=generatesequence()) +} +\author{ + Peter Carl and Brian G. Peterson +} + From noreply at r-forge.r-project.org Tue Jul 23 05:25:51 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 05:25:51 +0200 (CEST) Subject: [Returnanalytics-commits] r2633 - pkg/PortfolioAnalytics/R Message-ID: <20130723032551.A96A9180FDD@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-23 05:25:51 +0200 (Tue, 23 Jul 2013) New Revision: 2633 Modified: pkg/PortfolioAnalytics/R/generics.R Log: modifying summary method for class 'portfolio' Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-07-23 01:04:44 UTC (rev 2632) +++ pkg/PortfolioAnalytics/R/generics.R 2013-07-23 03:25:51 UTC (rev 2633) @@ -52,6 +52,9 @@ cat("PortfolioAnalytics Portfolio Specification", "\n") cat(rep("*", 50) ,"\n", sep="") + cat("\nCall:\n", paste(deparse(portfolio$call), sep = "\n", collapse = "\n"), + "\n", sep = "") + # Assets cat("\nAssets\n") nassets <- length(portfolio$assets) @@ -60,20 +63,25 @@ # Constraints cat("\nConstraints\n") nconstraints <- length(portfolio$constraints) - # logical vector of enabled constraints - enabled.constraints <- sapply(pspec$constraints, function(x) x$enabled) + if(nconstraints > 0){ + # logical vector of enabled constraints + enabled.constraints <- which(sapply(portfolio$constraints, function(x) x$enabled)) + n.enabled.constraints <- ifelse(length(enabled.constraints) > 0, length(enabled.constraints), 0) + } else { + n.enabled.constraints <- 0 + } # character vector of constraint types - names.constraints <- sapply(pspec$constraints, function(x) x$type) + names.constraints <- sapply(portfolio$constraints, function(x) x$type) cat("Number of constraints:", nconstraints, "\n") - cat("Number of enabled constraints:", sum(enabled.constraints), "\n") - if(sum(enabled.constraints) > 0){ + cat("Number of enabled constraints:", n.enabled.constraints, "\n") + if(length(enabled.constraints) > 0){ cat("Enabled constraint types\n") for(type in names.constraints[enabled.constraints]) { cat("\t\t-", type, "\n") } } - cat("Number of disabled constraints:", nconstraints - sum(enabled.constraints), "\n") - if((nconstraints - sum(enabled.constraints)) > 0){ + cat("Number of disabled constraints:", nconstraints - n.enabled.constraints, "\n") + if((nconstraints - n.enabled.constraints) > 0){ cat("Disabled constraint types\n") for(type in setdiff(names.constraints, names.constraints[enabled.constraints])) { cat("\t\t-", type, "\n") @@ -83,20 +91,25 @@ # Objectives cat("\nObjectives\n") nobjectives <- length(portfolio$objectives) - # logical vector of enabled objectives - enabled.objectives <- sapply(pspec$objectives, function(x) x$enabled) + if(nobjectives > 0){ + # logical vector of enabled objectives + enabled.objectives <- which(sapply(portfolio$objectives, function(x) x$enabled)) + n.enabled.objectives <- ifelse(length(enabled.objectives) > 0, length(enabled.objectives), 0) + } else { + n.enabled.objectives <- 0 + } # character vector of objective names - names.objectives <- sapply(pspec$objectives, function(x) x$name) + names.objectives <- sapply(portfolio$objectives, function(x) x$name) cat("Number of objectives:", nobjectives, "\n") - cat("Number of enabled objectives:", sum(enabled.objectives), "\n") - if(sum(enabled.objectives) > 0){ + cat("Number of enabled objectives:", n.enabled.objectives, "\n") + if(n.enabled.objectives > 0){ cat("Enabled objective names\n") for(name in names.objectives[enabled.objectives]) { cat("\t\t-", name, "\n") } } - cat("Number of disabled objectives:", nobjectives - sum(enabled.objectives), "\n") - if((nobjectives - sum(enabled.objectives)) > 0){ + cat("Number of disabled objectives:", nobjectives - n.enabled.objectives, "\n") + if((nobjectives - n.enabled.objectives) > 0){ cat("Disabled objective types\n") for(name in setdiff(names.objectives, names.objectives[enabled.objectives])) { cat("\t\t-", name, "\n") From noreply at r-forge.r-project.org Tue Jul 23 21:23:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 21:23:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2634 - in pkg/PerformanceAnalytics/sandbox/pulkit: week2/code week3_4/code week5 Message-ID: <20130723192301.5468118074F@r-forge.r-project.org> Author: pulkit Date: 2013-07-23 21:23:01 +0200 (Tue, 23 Jul 2013) New Revision: 2634 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Log: fixed monte simulation for triple penance Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-23 03:25:51 UTC (rev 2633) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-23 19:23:01 UTC (rev 2634) @@ -50,11 +50,11 @@ corr_avg = 0 for(i in 1:(columns-1)){ for(j in (i+1):columns){ - corr_avg = corr_avg + corr[(i-1)*columns+j,] + corr_avg = corr_avg + corr[(i-1)*columns+j,1] } } corr_avg = corr_avg*2/(columns*(columns-1)) - SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg[1,1])) + SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg)) return(SR_Benchmark) } ############################################################################### Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-23 03:25:51 UTC (rev 2633) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-23 19:23:01 UTC (rev 2634) @@ -27,6 +27,15 @@ #' and the Maximum Drawdown is given by. #' #' \deqn{MaxDD_{\alpha}=max\left\{0,-MinQ_\alpha\right\}} +#' +#'The non normal time dependent process is defined by +#' +#'\deqn{\triangle{\pi_{\tau}}=(1-\phi)\mu + \phi{\delta_{\tau-1}} + \sigma{\epsilon_{\tau}}} +#' +#'The random shocks are iid distributed \eqn{\epsilon_{\tau}~N(0,1)}. These random shocks follow an independent and +#'identically distributed Gaussian Process, however \eqn{\triangle{\pi_\tau}} is neither an independent nor an +#'identically distributed Gaussian Process. This is due to the parameter \eqn{\phi}, which incorporates a first-order +#'serial-correlation effect of auto-regressive form. #' #' Golden Section Algorithm is used to calculate the Minimum of the function Q. #' Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R 2013-07-23 03:25:51 UTC (rev 2633) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R 2013-07-23 19:23:01 UTC (rev 2634) @@ -1,33 +1,64 @@ #' @title #' Monte Carlo Simulation for the Triple Penance Rule #' -#' @param R Hedge Fund log Returns +#'@description +#' +#'The following process is simulated using the monte carlo process and the maximum drawdown is calculated using it. +#'\deqn{\triangle{\pi_{\tau}}=(1-\phi)\mu + \phi{\delta_{\tau-1}} + \sigma{\epsilon_{\tau}}} +#' +#'The random shocks are iid distributed \eqn{\epsilon_{\tau}~N(0,1)}. These random shocks follow an independent and +#'identically distributed Gaussian Process, however \eqn{\triangle{\pi_\tau}} is neither an independent nor an +#'identically distributed Gaussian Process. This is due to the parameter \eqn{\phi}, which incorporates a first-order +#'serial-correlation effect of auto-regressive form. +#' +#' +#' @param size size of the Monte Carlo experiment +#' @param phi AR(1) coefficient +#' @param mu unconditional mean +#' @param sigma Standard deviation of the random shock +#' @param dp0 Bet at origin (initialization of AR(1)) +#' @param bets Number of bets in the cumulative process +#' @param confidence Confidence level for quantile #' -#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ?Triple Penance? Rule(January 1, 2013). +#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs +#' and the ?Triple Penance? Rule(January 1, 2013). +#' +#' @examples +#' MonteSimulTriplePenance(10^6,0.5,1,2,1,25,0.95) # Expected Value Quantile (Exact) = 6.781592 +#' -monte_simul<-function(size){ - - phi = 0.5 - mu = 1 - sigma = 2 - dp0 = 1 - bets = 25 - confidence = 0.95 +MonteSimulTriplePenance<-function(size,phi,mu,sigma,dp0,bets,confidence){ + # DESCRIPTION: + # The function gives Value of Maximum Drawdown generated by a monte carlo process. + + # INPUTS: + # The size, AR(1) coefficient, unconditional mean, Standard deviation of the random shock, + # Bet at origin (initialization of AR(1)), Number of bets in the cumulative process,Confidence level for quantile + # are taken as the input + + # FUNCTION: q_value = getQ(bets, phi, mu, sigma, dp0, confidence) - ms = NULL - + ms = numeric(size) + delta = 0 + for(i in 1:size){ - ms[i] = sum((1-phi)*mu + rnorm(bets)*sigma + delta*phi) + pnl = 0 + delta = 0 + for(j in 1:bets){ + delta = (1-phi)*mu + rnorm(1)*sigma + delta*phi + pnl = pnl +delta + } + ms[i] <- pnl } - q_ms = quantile(ms,(1-confidence)*100) + q_ms = quantile(ms,(1-confidence)) diff = q_value - q_ms - - print(q_value) - print(q_ms) - print(q_value - q_ms) + result <- matrix(c(q_value,q_ms,diff),nrow = 3) + rownames(result)= c("Exact","Monte Carlo","Difference") + colnames(result) = "Quantile" + return(result) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-23 03:25:51 UTC (rev 2633) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-23 19:23:01 UTC (rev 2634) @@ -12,7 +12,17 @@ #' \deqn{MaxTuW_\alpha=\biggl(\frac{Z_\alpha{\sigma}}{\mu}\biggr)^2} #' #' For a Autoregressive process the Time under water is found using the golden section algorithm. +#' +#'The non normal time dependent process is defined by #' +#'\deqn{\triangle{\pi_{\tau}}=(1-\phi)\mu + \phi{\delta_{\tau-1}} + \sigma{\epsilon_{\tau}}} +#' +#'The random shocks are iid distributed \eqn{\epsilon_{\tau}~N(0,1)}. These random shocks follow an independent and +#'identically distributed Gaussian Process, however \eqn{\triangle{\pi_\tau}} is neither an independent nor an +#'identically distributed Gaussian Process. This is due to the parameter \eqn{\phi}, which incorporates a first-order +#'serial-correlation effect of auto-regressive form. + +#' #' @param R return series #' @param confidence the confidence interval #' @param type The type of distribution "normal" or "ar"."ar" stands for Autoregressive. Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-23 03:25:51 UTC (rev 2633) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-23 19:23:01 UTC (rev 2634) @@ -63,12 +63,11 @@ sd = StdDev(R) factor = (as.vector(sharpe)/as.vector(sd)+0.5)/(1-delta^2) redd = rollDrawdown(R,Rf,h,geometric) - redd = na.omit(redd) xt = max(0,(delta-redd)/(1-redd)) return(xt) } for(column in 1:columns){ - column.xt <- na.skip(x[,column],FUN = dynamicPort) + column.xt <- as.xts(apply((x[,column],MARGIN = 1,FUN = dynamicPort))) if(column == 1) xt = column.xt else xt = merge(xt, column.xt) Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-23 03:25:51 UTC (rev 2633) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-23 19:23:01 UTC (rev 2634) @@ -61,7 +61,7 @@ } for(column in 1:columns){ - column.drawdown <- apply.rolling(x[,column],width = h, FUN = REDD, geometric = geometric) + column.drawdown <- rollapplyr(x[,column],width = h, FUN = REDD, geometric = geometric) if(column == 1) rolldrawdown = column.drawdown else rolldrawdown = merge(rolldrawdown, column.drawdown) From noreply at r-forge.r-project.org Tue Jul 23 21:43:07 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 21:43:07 +0200 (CEST) Subject: [Returnanalytics-commits] r2635 - pkg/FactorAnalytics/R Message-ID: <20130723194307.83BF5184D17@r-forge.r-project.org> Author: chenyian Date: 2013-07-23 21:43:07 +0200 (Tue, 23 Jul 2013) New Revision: 2635 Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r Log: Create factor contribution to VaR and ES plot. Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-23 19:23:01 UTC (rev 2634) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-23 19:43:07 UTC (rev 2635) @@ -110,67 +110,63 @@ legend.text=T, args.legend=list(x="topleft"), col=c(1:50) ) } , -# "6L" = { -# factor.es.decomp.list = list() -# names = fit.fund$asset.names -# for (i in names) { -# # check for missing values in fund data -# asset.n = which( colnames(fit.fund$data) == as.name(fit.fund$assetvar)) -# as.symbol(fit.fund$assetvar) -# subset(fit.fund$data,fit.fund$assetvar == "STI") -# -# subset(fit.fund$data,TICKER == "STI")[[fit.fund$returnsvar]] -# -# [,fit.fund$returnsvar] -# idx = which(!is.na(fit.fund$data[,i])) -# tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, -# fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i])) -# colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") -# factor.es.decomp.list[[i]] = -# factorModelEsDecomposition(tmpData, -# fit.stat$loadings[,i], -# fit.stat$resid.variance[i], tail.prob=0.05) -# } -# -# -# # stacked bar charts of percent contributions to ES -# getCETL = function(x) { -# x$cES -# } -# # report as positive number -# cr.etl = sapply(factor.es.decomp.list, getCETL) -# rownames(cr.etl) = c(colnames(fit.stat$factors), "residual") -# barplot(cr.etl[,(1:max.show)], main="Factor Contributions to ES", -# legend.text=T, args.legend=list(x="topleft"), -# col=c(1:50) ) -# }, -# "7L" = { -# factor.VaR.decomp.list = list() -# names = colnames(fit.stat$asset.ret) -# for (i in names) { -# # check for missing values in fund data -# idx = which(!is.na(fit.stat$asset.ret[,i])) -# tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors, -# fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i])) -# colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") -# factor.VaR.decomp.list[[i]] = -# factorModelVaRDecomposition(tmpData, -# fit.stat$loadings[,i], -# fit.stat$resid.variance[i], tail.prob=0.05) -# } -# -# -# # stacked bar charts of percent contributions to VaR -# getCVaR = function(x) { -# x$cVaR.fm -# } -# # report as positive number -# cr.var = sapply(factor.VaR.decomp.list, getCVaR) -# rownames(cr.var) = c(colnames(fit.stat$factors), "residual") -# barplot(cr.var[,(1:max.show)], main="Factor Contributions to VaR", -# legend.text=T, args.legend=list(x="topleft"), -# col=c(1:50) ) -# }, + "6L" = { + factor.es.decomp.list = list() + names = fit.fund$asset.names + for (i in names) { + # check for missing values in fund data +# idx = which(!is.na(fit.fund$data[,i])) + idx <- fit.fund$data[,fit.fund$assetvar] == i + asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] + tmpData = cbind(asset.ret, fit.fund$factors, + fit.fund$residuals[,i]/sqrt(fit.fund$resid.variance[i]) ) + colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") + factor.es.decomp.list[[i]] = + factorModelEsDecomposition(tmpData, + fit.fund$beta[i,], + fit.fund$resid.variance[i], tail.prob=0.05) + } + + # stacked bar charts of percent contributions to ES + getCETL = function(x) { + x$cES + } + # report as positive number + cr.etl = sapply(factor.es.decomp.list, getCETL) + rownames(cr.etl) = c(colnames(fit.fund$factors), "residual") + barplot(cr.etl[,(1:max.show)], main="Factor Contributions to ES", + legend.text=T, args.legend=list(x="topleft"), + col=c(1:50) ) + }, + "7L" = { + factor.VaR.decomp.list = list() + names = fit.fund$asset.names + for (i in names) { + # check for missing values in fund data + # idx = which(!is.na(fit.fund$data[,i])) + idx <- fit.fund$data[,fit.fund$assetvar] == i + asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] + tmpData = cbind(asset.ret, fit.fund$factors, + fit.fund$residuals[,i]/sqrt(fit.fund$resid.variance[i]) ) + colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") + factor.VaR.decomp.list[[i]] = + factorModelVaRDecomposition(tmpData, + fit.fund$beta[i,], + fit.fund$resid.variance[i], tail.prob=0.05) + } + + + # stacked bar charts of percent contributions to VaR + getCVaR = function(x) { + x$cVaR.fm + } + # report as positive number + cr.var = sapply(factor.VaR.decomp.list, getCVaR) + rownames(cr.var) = c(colnames(fit.fund$factors), "residual") + barplot(cr.var[,(1:max.show)], main="Factor Contributions to VaR", + legend.text=T, args.legend=list(x="topleft"), + col=c(1:50) ) + }, invisible() ) From noreply at r-forge.r-project.org Wed Jul 24 00:21:38 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 00:21:38 +0200 (CEST) Subject: [Returnanalytics-commits] r2636 - in pkg/FactorAnalytics: R man Message-ID: <20130723222138.916CC185165@r-forge.r-project.org> Author: chenyian Date: 2013-07-24 00:21:38 +0200 (Wed, 24 Jul 2013) New Revision: 2636 Modified: pkg/FactorAnalytics/R/factorModelEsDecomposition.R pkg/FactorAnalytics/R/factorModelMonteCarlo.R pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd Log: 1. Debugging plot.FundamentalFactorModel.Rd and factorModelEsDecomposition.R 2. test factorModelMonteCarlo.R Modified: pkg/FactorAnalytics/R/factorModelEsDecomposition.R =================================================================== --- pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2013-07-23 19:43:07 UTC (rev 2635) +++ pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2013-07-23 22:21:38 UTC (rev 2636) @@ -1,140 +1,151 @@ -#' Compute Factor Model Factor 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) = t(beta)*F(t) + e(t) = -#' t(beta.star)*F.star(t)} \cr where \code{beta.star = t(beta, sig.e)} and -#' \code{F.star(t) = (t(F(t)), t(z(t)))} By Euler's theorem \cr \code{ES.fm = -#' sum(cES.fm) = sum(beta.star*mcES.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. -#' @return A list with the following components: -#' @returnItem VaR Scalar, nonparametric VaR value for fund reported as a -#' positive number. -#' @returnItem n.exceed Scalar, number of observations beyond VaR. -#' @returnItem idx.exceed \code{n.exceed x 1} vector giving index values of -#' exceedences. -#' @returnItem ES scalar, nonparametric ES value for fund reported as a -#' positive number. -#' @returnItem mcES \code{(K+1) x 1} vector of factor marginal contributions to -#' ES. -#' @returnItem cES \code{(K+1) x 1} vector of factor component contributions to -#' ES. -#' @returnItem pcES \code{(K+1) x 1} vector of factor percent contributions to -#' ES. -#' @author Eric Zviot and Yi-An Chen. -#' @references 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A -#' General Analysis", \emph{The Journal of Risk} 5/2. \cr 2. Yamai and Yoshiba -#' (2002). "Comparative Analyses of Expected Shortfall and Value-at-Risk: Their -#' Estimation Error, Decomposition, and Optimization", Bank of Japan. \cr 3. -#' Meucci (2007). "Risk Contributions from Generic User-Defined Factors," -#' \emph{Risk}. -#' @examples -#' -#' data(managers.df) -#' ret.assets = managers.df[,(1:6)] -#' factors = managers.df[,(7:9)] -#' # fit the factor model with OLS -#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS", -#' variable.selection="all subsets",factor.set=3) -#' # risk factor contribution to ETL -#' # combine fund returns, factor returns and residual returns for HAM1 -#' tmpData = cbind(ret.assets[,1], factors, -#' residuals(fit$asset.fit$HAM1)/sqrt(fit$residVars.vec[1])) -#' colnames(tmpData)[c(1,5)] = c("HAM1", "residual") -#' factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit$beta.mat[1,], -#' fit$residVars.vec[1], tail.prob=0.05) -#' -#' -#' -factorModelEsDecomposition <- -function(Data, beta.vec, sig2.e, tail.prob = 0.05) { -## Compute factor model factor ES decomposition based on Euler's theorem given historic -## or simulated data and factor model parameters. -## The partial derivative of ES wrt factor beta is computed -## as the expected factor return given fund return is less than or equal to its VaR -## VaR is compute either as the sample quantile or as an estimated quantile -## using the Cornish-Fisher expansion -## inputs: -## Data B x (k+2) matrix of data. First column contains the fund returns, -## second through k+1 columns contain factor returns, (k+2)nd column contain residuals -## scaled to have variance 1. -## beta.vec k x 1 vector of factor betas -## sig2.e scalar, residual variance from factor model -## tail.prob scalar tail probability -## output: -## A list with the following components: -## VaR scalar, nonparametric VaR value for fund reported as a positive number -## n.exceed scalar, number of observations beyond VaR -## idx.exceed n.exceed x 1 vector giving index values of exceedences -## ES scalar, nonparametric ES value for fund reported as a positive number -## mcES k+1 x 1 vector of factor marginal contributions to ES -## cES k+1 x 1 vector of factor component contributions to ES -## pcES k+1 x 1 vector of factor percent contributions to ES -## Remarks: -## The factor model has the form -## R(t) = beta'F(t) + e(t) = beta.star'F.star(t) -## where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' -## By Euler's theorem -## ES.fm = sum(cES.fm) = sum(beta.star*mcES.fm) -## References: -## 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A General Analysis", -## The Journal of Risk 5/2. -## 2. Yamai and Yoshiba (2002). "Comparative Analyses of Expected Shortfall and -## Value-at-Risk: Their Estimation Error, Decomposition, and Optimization -## Bank of Japan. -## 3. Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk. - 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 - - VaR.fm = quantile(Data[, 1], prob=tail.prob) - idx = which(Data[, 1] <= VaR.fm) - 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 = -VaR.fm, - n.exceed = length(idx), - idx.exceed = idx, - ES = ES.fm, - mcES = t(mcES.fm), - cES = t(cES.fm), - pcES = t(pcES.fm)) -return(ans) -} - +#' Compute Factor Model Factor 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) = t(beta)*F(t) + e(t) = +#' t(beta.star)*F.star(t)} \cr where \code{beta.star = t(beta, sig.e)} and +#' \code{F.star(t) = (t(F(t)), t(z(t)))} By Euler's theorem \cr \code{ES.fm = +#' sum(cES.fm) = sum(beta.star*mcES.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. +#' @return A list with the following components: +#' @returnItem VaR Scalar, nonparametric VaR value for fund reported as a +#' positive number. +#' @returnItem n.exceed Scalar, number of observations beyond VaR. +#' @returnItem idx.exceed \code{n.exceed x 1} vector giving index values of +#' exceedences. +#' @returnItem ES scalar, nonparametric ES value for fund reported as a +#' positive number. +#' @returnItem mcES \code{(K+1) x 1} vector of factor marginal contributions to +#' ES. +#' @returnItem cES \code{(K+1) x 1} vector of factor component contributions to +#' ES. +#' @returnItem pcES \code{(K+1) x 1} vector of factor percent contributions to +#' ES. +#' @author Eric Zviot and Yi-An Chen. +#' @references 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A +#' General Analysis", \emph{The Journal of Risk} 5/2. \cr 2. Yamai and Yoshiba +#' (2002). "Comparative Analyses of Expected Shortfall and Value-at-Risk: Their +#' Estimation Error, Decomposition, and Optimization", Bank of Japan. \cr 3. +#' Meucci (2007). "Risk Contributions from Generic User-Defined Factors," +#' \emph{Risk}. +#' @examples +#' +#' data(managers.df) +#' ret.assets = managers.df[,(1:6)] +#' factors = managers.df[,(7:9)] +#' # fit the factor model with OLS +#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS", +#' variable.selection="all subsets",factor.set=3) +#' # risk factor contribution to ETL +#' # combine fund returns, factor returns and residual returns for HAM1 +#' tmpData = cbind(ret.assets[,1], factors, +#' residuals(fit$asset.fit$HAM1)/sqrt(fit$residVars.vec[1])) +#' colnames(tmpData)[c(1,5)] = c("HAM1", "residual") +#' factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit$beta.mat[1,], +#' fit$residVars.vec[1], tail.prob=0.05) +#' +#' # fundamental factor model +#' # try to find factor contribution to ES for STI +#' idx <- fit.fund$data[,fit.fund$assetvar] == "STI" +#' asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] +#' tmpData = cbind(asset.ret, fit.fund$factors, +#' 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) +#' +#' +#' +factorModelEsDecomposition <- +function(Data, beta.vec, sig2.e, tail.prob = 0.05) { +## Compute factor model factor ES decomposition based on Euler's theorem given historic +## or simulated data and factor model parameters. +## The partial derivative of ES wrt factor beta is computed +## as the expected factor return given fund return is less than or equal to its VaR +## VaR is compute either as the sample quantile or as an estimated quantile +## using the Cornish-Fisher expansion +## inputs: +## Data B x (k+2) matrix of data. First column contains the fund returns, +## second through k+1 columns contain factor returns, (k+2)nd column contain residuals +## scaled to have variance 1. +## beta.vec k x 1 vector of factor betas +## sig2.e scalar, residual variance from factor model +## tail.prob scalar tail probability +## output: +## A list with the following components: +## VaR scalar, nonparametric VaR value for fund reported as a positive number +## n.exceed scalar, number of observations beyond VaR +## idx.exceed n.exceed x 1 vector giving index values of exceedences +## ES scalar, nonparametric ES value for fund reported as a positive number +## mcES k+1 x 1 vector of factor marginal contributions to ES +## cES k+1 x 1 vector of factor component contributions to ES +## pcES k+1 x 1 vector of factor percent contributions to ES +## Remarks: +## The factor model has the form +## R(t) = beta'F(t) + e(t) = beta.star'F.star(t) +## where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' +## By Euler's theorem +## ES.fm = sum(cES.fm) = sum(beta.star*mcES.fm) +## References: +## 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A General Analysis", +## The Journal of Risk 5/2. +## 2. Yamai and Yoshiba (2002). "Comparative Analyses of Expected Shortfall and +## Value-at-Risk: Their Estimation Error, Decomposition, and Optimization +## Bank of Japan. +## 3. Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk. + 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 + + VaR.fm = quantile(Data[, 1], prob=tail.prob) + idx = which(Data[, 1] <= VaR.fm) + 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 = -VaR.fm, + n.exceed = length(idx), + idx.exceed = idx, + ES = ES.fm, + mcES = t(mcES.fm), + cES = t(cES.fm), + pcES = t(pcES.fm)) +return(ans) +} + Modified: pkg/FactorAnalytics/R/factorModelMonteCarlo.R =================================================================== --- pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2013-07-23 19:43:07 UTC (rev 2635) +++ pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2013-07-23 22:21:38 UTC (rev 2636) @@ -1,194 +1,164 @@ -#' 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 like 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: -#' @returnItem returns \code{n.boot x n.funds} matrix of simulated fund -#' returns. -#' @returnItem factors \code{n.boot x n.factors} matrix of resampled factor -#' returns. Returned only if \code{return.factors = TRUE}. -#' @returnItem 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. -#' @examples -#' -#' # load data from the database -#' data(managers.df) -#' ret.assets = managers.df[,(1:6)] -#' factors = managers.df[,(7:9)] -#' # fit the factor model with OLS -#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS", -#' variable.selection="all subsets",factor.set=3) -#' factorData=factors -#' Beta.mat=fit$beta.mat -#' residualData=as.matrix(fit$residVars.vec,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("location","scale","shape","df") -#' 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 ) { -## inputs: -## n.boot number of bootstrap samples -## factorData n.months x n.funds matrix or data.frame of factor returns -## Beta.mat n.funds x n.factors matrix of factor betas -## Alpha.mat n.funds x 1 matrix of factor alphas (intercepts). If NULL then -## assume that all alphas are zero. -## residualData n.funds x n.parms matrix of residual distribution parameters. The -## columns of residualData depend on the value of residual.dist. If -## residual.dist = "normal", then residualData has one column vector -## containing variance values; if residual.dist = "Cornish-Fisher", -## then residualData has three columns containing variance, -## skewness and excess kurtosis values; if residual.dist="skew-t", -## then residualData has four columns containing location, scale, -## shape and df values. -## 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. -## boot.method character vector specifying the resampling method. Choices are -## "random" for random sampling with replacement (non-parametric bootstrap); -## "block" for stationary block bootstrapping. -## seed integer random number seed. -## return.factors logical; if TRUE then return resampled factors -## return.residuals logical; if TRUE then return simulated residuals -## -## output: A list with the following components: -## returns n.boot x n.funds matrix of simulated fund returns -## factors n.boot x n.factors matrix of resampled factor returns. Returned -## only if return.factors = TRUE. -## residuals n.boot x n.funds matrix of simulated fund residuals. Returned only -## if return.residuals = TRUE. - require(tseries) # for function tsbootstrap() - require(sn) # for function rst() - 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 - } -## -## reseample from empirical distribution of factors -## - 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) { -## need to make sure that length(bootIdx) = n.boot - bootIdx = c(bootIdx, bootIdx[1:n.adj]) - } - } - factorDataBoot = factorData[bootIdx, ] -## -## run factor model Monte Carlo loop over funds -## - 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 random number seed for fund specific residual simulations - set.seed(which(fund.names == i)) - ## simulate from residual distributions - if (residual.dist == "normal") { - residualsSim[, i] = rnorm(n.boot, sd=sqrt(residualData[i,])) - } else if (residual.dist == "Cornish-Fisher") { - ## residual distribution is CornishFisher - residualsSim[, i] = rCornishFisher(n.boot, - sigma=sqrt(residualData[i,"var"]), - skew=residualData[i,"skew"], - ekurt=residualData[i,"ekurt"]) - } else if (residual.dist == "skew-t") { - ## residual distribution is CornishFisher - residualsSim[, i] = rst(n.boot, - location=residualData[i, "location"], - scale=residualData[i,"scale"], - shape=residualData[i,"shape"], - df=residualData[i,"df"]) - } else { - stop("Invalid residual distribution") - } - ## simulated fund returns - fundReturnsBoot[, i] = Alpha.mat[i,1] + factorDataBoot[, colnames(Beta.mat)] %*% t(Beta.mat[i, ,drop=FALSE]) + residualsSim[, i] - } # end loop over funds - - 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 like 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: +#' @returnItem returns \code{n.boot x n.funds} matrix of simulated fund +#' returns. +#' @returnItem factors \code{n.boot x n.factors} matrix of resampled factor +#' returns. Returned only if \code{return.factors = TRUE}. +#' @returnItem 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. +#' @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=factors +#' Beta.mat=fit$beta.mat +#' residualData=as.matrix(fit$residVars.vec,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("location","scale","shape","df") +#' 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) # for function tsbootstrap() + require(sn) # for function rst() + 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 + } +## +## reseample from empirical distribution of factors +## + 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) { +## need to make sure that length(bootIdx) = n.boot + bootIdx = c(bootIdx, bootIdx[1:n.adj]) + } + } + factorDataBoot = factorData[bootIdx, ] +## +## run factor model Monte Carlo loop over funds +## + 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 random number seed for fund specific residual simulations + set.seed(which(fund.names == i)) + ## simulate from residual distributions + if (residual.dist == "normal") { + residualsSim[, i] = rnorm(n.boot, sd=sqrt(residualData[i,])) + } else if (residual.dist == "Cornish-Fisher") { + ## residual distribution is CornishFisher + residualsSim[, i] = rCornishFisher(n.boot, + sigma=sqrt(residualData[i,"var"]), + skew=residualData[i,"skew"], + ekurt=residualData[i,"ekurt"]) + } else if (residual.dist == "skew-t") { + ## residual distribution is CornishFisher + residualsSim[, i] = rst(n.boot, + location=residualData[i, "location"], + scale=residualData[i,"scale"], + shape=residualData[i,"shape"], + df=residualData[i,"df"]) + } else { + stop("Invalid residual distribution") + } + ## simulated fund returns + fundReturnsBoot[, i] = Alpha.mat[i,1] + factorDataBoot[, colnames(Beta.mat)] %*% t(Beta.mat[i, ,drop=FALSE]) + residualsSim[, i] + } # end loop over funds + + ans = list(returns=fundReturnsBoot) + if (return.factors) { + ans$factors=factorDataBoot + } + if (return.residuals) { + ans$residuals=residualsSim + } + return(ans) +} + Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-23 19:43:07 UTC (rev 2635) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-23 22:21:38 UTC (rev 2636) @@ -11,9 +11,30 @@ #' #' @param fit.fund fit object created by fitFundamentalFactorModel. #' @param which.plot integer indicating which plot to create: "none" will -#' create a menu to choose. Defualt is none. 1 = "factor returns", 2 = "R -#' square", 3 = "Variance of Residuals", 4 = "FM Correlation", -#' @param max.show Maximum assets to plot. Default is 12. +#' create a menu to choose. Defualt is none. +#' 1 = "Factor returns", +#' 2 = "Residual plots", +#' 3 = "Variance of Residuals", +#' 4 = "Factor Model Correlation", +#' 5 = "Factor Contributions to SD", +#' 6 = "Factor Contributions to ES", +#' 7 = "Factor Contributions to VaR" +#' @param max.show Maximum assets to plot. Default is 4. +#' #' @param plot.single Plot a single asset of lm class. Defualt is FALSE. +#' @param asset.name Name of the asset to be plotted. +#' @param which.plot.single integer indicating which plot to create: "none" [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2636 From noreply at r-forge.r-project.org Wed Jul 24 13:10:58 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 13:10:58 +0200 (CEST) Subject: [Returnanalytics-commits] r2638 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: Week1/Code Week5/Code Message-ID: <20130724111059.20B11184511@r-forge.r-project.org> Author: shubhanm Date: 2013-07-24 13:10:58 +0200 (Wed, 24 Jul 2013) New Revision: 2638 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R Log: Added : Okunev Model for Unsmoothed Return (Tested and Implemented) Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R 2013-07-24 11:10:58 UTC (rev 2638) @@ -0,0 +1,20 @@ +quad <- function(R,d) +{ + coeff = as.numeric(acf(as.numeric(edhec[,1]), plot = FALSE)[1:2][[1]]) +b=-(1+coeff[2]-2*d*coeff[1]) +c=(coeff[1]-d) + ans= (-b-sqrt(b*b-4*c*c))/(2*c) + a <- a[!is.na(a)] + return(c(ans)) +} +Return.Okunev<-function(R,q=3) +{ + column.okunev=R + column.okunev <- column.okunev[!is.na(column.okunev)] + for(i in 1:q) + { + lagR = lag(column.okunev, k=i) + column.okunev= (column.okunev-(lagR*quad(lagR,0)))/(1-quad(lagR,0)) + } + return(c(column.okunev)) +} Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R 2013-07-24 02:56:50 UTC (rev 2637) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R 2013-07-24 11:10:58 UTC (rev 2638) @@ -1,5 +1,36 @@ +#' Active Premium or Active Return +#' +#' The return on an investment's annualized return minus the benchmark's +#' annualized return. +#' +#' Active Premium = Investment's annualized return - Benchmark's annualized +#' return +#' +#' Also commonly referred to as 'active return'. +#' +#' @param Ra return vector of the portfolio +#' @param Rb return vector of the benchmark asset +#' @param scale number of periods in a year (daily scale = 252, monthly scale = +#' 12, quarterly scale = 4) +#' @author Peter Carl +#' @seealso \code{\link{InformationRatio}} \code{\link{TrackingError}} +#' \code{\link{Return.annualized}} +#' @references Sharpe, W.F. The Sharpe Ratio,\emph{Journal of Portfolio +#' Management},Fall 1994, 49-58. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' ActivePremium(managers[, "HAM1", drop=FALSE], managers[, "SP500 TR", drop=FALSE]) +#' ActivePremium(managers[,1,drop=FALSE], managers[,8,drop=FALSE]) +#' ActivePremium(managers[,1:6], managers[,8,drop=FALSE]) +#' ActivePremium(managers[,1:6], managers[,8:7,drop=FALSE]) +#' @rdname ActivePremium +#' @aliases ActivePremium, ActiveReturn +#' @export + CDrawdown <- - function (R,p=0.95, ...) + function (R,p=0.90, ...) { y = checkData(R, method = "xts") columns = ncol(y) From noreply at r-forge.r-project.org Wed Jul 24 16:06:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 16:06:04 +0200 (CEST) Subject: [Returnanalytics-commits] r2639 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130724140604.BF74718502B@r-forge.r-project.org> Author: pulkit Date: 2013-07-24 16:06:04 +0200 (Wed, 24 Jul 2013) New Revision: 2639 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R Log: REDD COPS multi asset Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-24 11:10:58 UTC (rev 2638) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-24 14:06:04 UTC (rev 2639) @@ -39,7 +39,7 @@ #'@export #' -REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,sharpe=NULL,...){ +REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,asset = c("one","two","three"),...){ # DESCRIPTION # Calculates the dynamic weights for single and double risky asset portfolios # using Rolling Economic Drawdown @@ -51,32 +51,65 @@ # FUNCTION: x = checkData(R) columns = ncol(x) - n = nrow(x) columnnames = colnames(x) - rf = checkData(Rf) - nr = length(Rf) + sharpe = SharpeRatio(x,FUN="StdDev",Rf ,p=0.95) + sd = StdDev(x) + rho = cor(x) + if(asset == "two" && columns != 2 ){ + stop("The number of series should be two") + } + + if(asset == "three" && columns != 3){ + stop("The number of series should be three") + } + dynamicPort<-function(x,column){ - if(is.null(sharpe)){ - sharpe = SharpeRatio(R,FUN="StdDev",Rf ,p=0.95) + if(asset == "one"){ + factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2) + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + if(asset == "two"){ + if(column == 1){ + factor = (sharpe[,1] + 0.5*sd[,1]-rho[1,1]*(sharpe[,2] + 0.5*sd[,2]))/sd[,1] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + if(column == 2){ + factor = (sharpe[,2] + 0.5*sd[,2]-rho[1,1]*(sharpe[,1] + 0.5*sd[,1]))/sd[,2] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + } - dynamicPort<-function(x){ - sd = StdDev(R) - factor = (as.vector(sharpe)/as.vector(sd)+0.5)/(1-delta^2) - redd = rollDrawdown(R,Rf,h,geometric) - xt = max(0,(delta-redd)/(1-redd)) + if(asset == "three"){ + if(column == 1){ + factor = ((sharpe[,1] + 0.5*sd[,1])*(1-rho[2,3]^2)-(rho[2,3]*rho[1,3]-rho[1,2])*(sharpe[,2] + 0.5*sd[,2])+(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,1] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + if(column == 2){ + factor = ((sharpe[,2] + 0.5*sd[,2])*(1-rho[1,3]^2)-(rho[1,3]*rho[2,3]-rho[1,2])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,2] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + + if(column == 3){ + factor = ((sharpe[,3] + 0.5*sd[,3])*(1-rho[1,2]^2)-(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,2] + 0.5*sd[,2]))/sd[,3] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + + } return(xt) } + redd = rollDrawdown(R,Rf,h,geometric) + for(column in 1:columns){ - column.xt <- as.xts(apply((x[,column],MARGIN = 1,FUN = dynamicPort))) + column.xt <- na.skip(redd[,column],FUN = dynamicPort,column = column) if(column == 1) xt = column.xt else xt = merge(xt, column.xt) } colnames(xt) = columnnames - xt = reclass(xt, x) return(xt) } + ############################################################################### # R (http://r-project.org/) Econometrics for Performance and Risk Analysis # From noreply at r-forge.r-project.org Thu Jul 25 02:27:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 02:27:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2640 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130725002759.A5A59184F70@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-25 02:27:59 +0200 (Thu, 25 Jul 2013) New Revision: 2640 Added: pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing_v1.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraint_fn_map.R pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd Log: Changing old version of optimize.portfolio.rebalancing to _v1 and adding optimize.portfolio.rebalancing to accept new portfolio interface Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-24 14:06:04 UTC (rev 2639) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-25 00:27:59 UTC (rev 2640) @@ -40,6 +40,7 @@ export(optimize.portfolio_v1) export(optimize.portfolio_v2) export(optimize.portfolio.parallel) +export(optimize.portfolio.rebalancing_v1) export(optimize.portfolio.rebalancing) export(optimize.portfolio) export(plot.optimize.portfolio.DEoptim) Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-24 14:06:04 UTC (rev 2639) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-07-25 00:27:59 UTC (rev 2640) @@ -34,7 +34,6 @@ #' @author Ross Bennett #' @export fn_map <- function(weights, portfolio, relax=FALSE, ...){ - if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class 'portfolio'") nassets <- length(portfolio$assets) Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-24 14:06:04 UTC (rev 2639) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-25 00:27:59 UTC (rev 2640) @@ -686,7 +686,7 @@ weights <- as.vector(minw$optim$bestmem) print(weights) # is it necessary to normalize the weights here? - weights <- normalize_weights(weights) + # weights <- normalize_weights(weights) names(weights) <- colnames(R) out <- list(weights=weights, objective_measures=constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures, out=minw$optim$bestval, call=call) @@ -899,7 +899,7 @@ #' @export optimize.portfolio <- optimize.portfolio_v2 -#' portfolio optimization with support for rebalancing or rolling periods +#' version 1 portfolio optimization with support for rebalancing or rolling periods #' #' This function may eventually be wrapped into optimize.portfolio #' @@ -920,7 +920,7 @@ #' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information #' @author Kris Boudt, Peter Carl, Brian G. Peterson #' @export -optimize.portfolio.rebalancing <- function(R,constraints,optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, trailing_periods=NULL) +optimize.portfolio.rebalancing_v1 <- function(R,constraints,optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, trailing_periods=NULL) { stopifnot("package:foreach" %in% search() || require("foreach",quietly=TRUE)) start_t<-Sys.time() @@ -959,6 +959,66 @@ return(out_list) } +#' portfolio optimization with support for rebalancing or rolling periods +#' +#' This function may eventually be wrapped into optimize.portfolio +#' +#' For now, we'll set the rebalancing periods here, though I think they should eventually be part of the constraints object +#' +#' This function is massively parallel, and will require 'foreach' and we suggest that you register a parallel backend. +#' +#' @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 +#' @param optimize_method one of "DEoptim", "random", or "ROI" +#' @param search_size integer, how many portfolios to test, default 20,000 +#' @param trace TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched +#' @param \dots any other passthru parameters +#' @param rp a set of random portfolios passed into the function, to prevent recalculation +#' @param rebalance_on a periodicity as returned by xts function periodicity and usable by endpoints +#' @param training_period period to use as training in the front of the data +#' @param trailing_periods if set, an integer with the number of periods to roll over, default NULL will run from inception +#' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information +#' @author Kris Boudt, Peter Carl, Brian G. Peterson +#' @export +optimize.portfolio.rebalancing <- function(R, portfolio, optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, trailing_periods=NULL) +{ + stopifnot("package:foreach" %in% search() || require("foreach",quietly=TRUE)) + start_t<-Sys.time() + + #store the call for later + call <- match.call() + if(optimize_method=="random"){ + #' call random_portfolios() with constraints and search_size to create matrix of portfolios + if(is.null(rp)) + rp<-random_portfolios(portfolio=portfolio, permutations=search_size) + } else { + rp=NULL + } + + if(is.null(training_period)) {if(nrow(R)<36) training_period=nrow(R) else training_period=36} + if (is.null(trailing_periods)){ + # define the index endpoints of our periods + ep.i<-endpoints(R,on=rebalance_on)[which(endpoints(R, on = rebalance_on)>=training_period)] + # now apply optimize.portfolio to the periods, in parallel if available + out_list<-foreach(ep=iter(ep.i), .errorhandling='pass', .packages='PortfolioAnalytics') %dopar% { + optimize.portfolio(R[1:ep,], portfolio=portfolio, optimize_method=optimize_method, search_size=search_size, trace=trace, rp=rp, parallel=FALSE, ...=...) + } + } else { + # define the index endpoints of our periods + ep.i<-endpoints(R,on=rebalance_on)[which(endpoints(R, on = rebalance_on)>=training_period)] + # now apply optimize.portfolio to the periods, in parallel if available + out_list<-foreach(ep=iter(ep.i), .errorhandling='pass', .packages='PortfolioAnalytics') %dopar% { + optimize.portfolio(R[(ifelse(ep-trailing_periods>=1,ep-trailing_periods,1)):ep,], portfolio=portfolio, optimize_method=optimize_method, search_size=search_size, trace=trace, rp=rp, parallel=FALSE, ...=...) + } + } + names(out_list)<-index(R[ep.i]) + + end_t<-Sys.time() + message(c("overall elapsed time:",end_t-start_t)) + class(out_list)<-c("optimize.portfolio.rebalancing") + return(out_list) +} + #'execute multiple optimize.portfolio calls, presumably in parallel #' #' TODO write function to check sensitivity of optimal results by using optimize.portfolio.parallel results Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2013-07-24 14:06:04 UTC (rev 2639) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2013-07-25 00:27:59 UTC (rev 2640) @@ -2,7 +2,7 @@ \alias{optimize.portfolio.rebalancing} \title{portfolio optimization with support for rebalancing or rolling periods} \usage{ - optimize.portfolio.rebalancing(R, constraints, + optimize.portfolio.rebalancing(R, portfolio, optimize_method = c("DEoptim", "random", "ROI"), search_size = 20000, trace = FALSE, ..., rp = NULL, rebalance_on = NULL, training_period = NULL, @@ -12,11 +12,11 @@ \item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns} - \item{constraints}{an object of type "constraints" - specifying the constraints for the optimization, see - \code{\link{constraint}}} + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization} - \item{optimize_method}{one of "DEoptim" or "random"} + \item{optimize_method}{one of "DEoptim", "random", or + "ROI"} \item{search_size}{integer, how many portfolios to test, default 20,000} Added: pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing_v1.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing_v1.Rd 2013-07-25 00:27:59 UTC (rev 2640) @@ -0,0 +1,64 @@ +\name{optimize.portfolio.rebalancing_v1} +\alias{optimize.portfolio.rebalancing_v1} +\title{version 1 portfolio optimization with support for rebalancing or rolling periods} +\usage{ + optimize.portfolio.rebalancing_v1(R, constraints, + optimize_method = c("DEoptim", "random", "ROI"), + search_size = 20000, trace = FALSE, ..., rp = NULL, + rebalance_on = NULL, training_period = NULL, + trailing_periods = NULL) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{constraints}{an object of type "constraints" + specifying the constraints for the optimization, see + \code{\link{constraint}}} + + \item{optimize_method}{one of "DEoptim" or "random"} + + \item{search_size}{integer, how many portfolios to test, + default 20,000} + + \item{trace}{TRUE/FALSE if TRUE will attempt to return + additional information on the path or portfolios + searched} + + \item{\dots}{any other passthru parameters} + + \item{rp}{a set of random portfolios passed into the + function, to prevent recalculation} + + \item{rebalance_on}{a periodicity as returned by xts + function periodicity and usable by endpoints} + + \item{training_period}{period to use as training in the + front of the data} + + \item{trailing_periods}{if set, an integer with the + number of periods to roll over, default NULL will run + from inception} +} +\value{ + a list containing the optimal weights, some summary + statistics, the function call, and optionally trace + information +} +\description{ + This function may eventually be wrapped into + optimize.portfolio +} +\details{ + For now, we'll set the rebalancing periods here, though I + think they should eventually be part of the constraints + object + + This function is massively parallel, and will require + 'foreach' and we suggest that you register a parallel + backend. +} +\author{ + Kris Boudt, Peter Carl, Brian G. Peterson +} + From noreply at r-forge.r-project.org Thu Jul 25 04:06:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 04:06:57 +0200 (CEST) Subject: [Returnanalytics-commits] r2641 - pkg/PortfolioAnalytics/R Message-ID: <20130725020657.D3ED11802F0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-25 04:06:56 +0200 (Thu, 25 Jul 2013) New Revision: 2641 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: modifying optimize.portfolio_v2 so the user can pass in a traceDE argument which is then passed to DEcformals so the user can control the output for optimize_method='DEoptim' Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-25 00:27:59 UTC (rev 2640) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-25 02:06:56 UTC (rev 2641) @@ -641,9 +641,10 @@ if(!hasArg(parallelType) ) DEcformals$parallelType='auto' #use all cores if(!hasArg(packages) ) DEcformals$packages <- names(sessionInfo()$otherPkgs) #use all packages } - #TODO FIXME also check for a passed in controlDE list, including checking its class, and match formals } + if(hasArg(traceDE)) traceDE=match.call(expand.dots=TRUE)$traceDE else traceDE=TRUE + DEcformals$trace <- traceDE if(isTRUE(trace)) { #we can't pass trace=TRUE into constrained objective with DEoptim, because it expects a single numeric return From noreply at r-forge.r-project.org Thu Jul 25 10:40:55 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 10:40:55 +0200 (CEST) Subject: [Returnanalytics-commits] r2642 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130725084055.58A4C1850EE@r-forge.r-project.org> Author: pulkit Date: 2013-07-25 10:40:55 +0200 (Thu, 25 Jul 2013) New Revision: 2642 Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R Log: risk-based REDD COPS Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-25 02:06:56 UTC (rev 2641) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-25 08:40:55 UTC (rev 2642) @@ -34,12 +34,14 @@ #' #' #'@examples +#'data(edhec) #'REDDCOPS(edhec,delta = 0.1,Rf = 0,h = 40) -#' +#'data(managers) +#'REDDCOPS(managers[,1],0.80, Rf = managers[,10,drop=FALSE],12,asset="one") #'@export #' -REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,asset = c("one","two","three"),...){ +REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,asset = c("one","two","three"),type=c("calibrated","risk-based"),...){ # DESCRIPTION # Calculates the dynamic weights for single and double risky asset portfolios # using Rolling Economic Drawdown @@ -52,9 +54,11 @@ x = checkData(R) columns = ncol(x) columnnames = colnames(x) - sharpe = SharpeRatio(x,FUN="StdDev",Rf ,p=0.95) - sd = StdDev(x) + sharpe = SharpeRatio.annualized(x,Rf) + sd = StdDev.annualized(R) rho = cor(x) + asset = asset[1] + type = type[1] if(asset == "two" && columns != 2 ){ stop("The number of series should be two") } @@ -63,40 +67,52 @@ stop("The number of series should be three") } dynamicPort<-function(x,column){ - - if(asset == "one"){ - factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2) - xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) - } - if(asset == "two"){ - if(column == 1){ - factor = (sharpe[,1] + 0.5*sd[,1]-rho[1,1]*(sharpe[,2] + 0.5*sd[,2]))/sd[,1] - xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) - } - if(column == 2){ - factor = (sharpe[,2] + 0.5*sd[,2]-rho[1,1]*(sharpe[,1] + 0.5*sd[,1]))/sd[,2] + if(type == "calibrated"){ + if(asset == "one"){ + factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2) xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + print(sd[,column]) } - - } - if(asset == "three"){ - if(column == 1){ - factor = ((sharpe[,1] + 0.5*sd[,1])*(1-rho[2,3]^2)-(rho[2,3]*rho[1,3]-rho[1,2])*(sharpe[,2] + 0.5*sd[,2])+(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,1] - xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + if(asset == "two"){ + if(column == 1){ + factor = (sharpe[,1] + 0.5*sd[,1]-rho[1,1]*(sharpe[,2] + 0.5*sd[,2]))/sd[,1] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + if(column == 2){ + factor = (sharpe[,2] + 0.5*sd[,2]-rho[1,1]*(sharpe[,1] + 0.5*sd[,1]))/sd[,2] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + } - if(column == 2){ - factor = ((sharpe[,2] + 0.5*sd[,2])*(1-rho[1,3]^2)-(rho[1,3]*rho[2,3]-rho[1,2])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,2] - xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + if(asset == "three"){ + if(column == 1){ + factor = ((sharpe[,1] + 0.5*sd[,1])*(1-rho[2,3]^2)-(rho[2,3]*rho[1,3]-rho[1,2])*(sharpe[,2] + 0.5*sd[,2])+(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,1] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + if(column == 2){ + factor = ((sharpe[,2] + 0.5*sd[,2])*(1-rho[1,3]^2)-(rho[1,3]*rho[2,3]-rho[1,2])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,2] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + + if(column == 3){ + factor = ((sharpe[,3] + 0.5*sd[,3])*(1-rho[1,2]^2)-(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,2] + 0.5*sd[,2]))/sd[,3] + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } + } - if(column == 3){ - factor = ((sharpe[,3] + 0.5*sd[,3])*(1-rho[1,2]^2)-(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,2] + 0.5*sd[,2]))/sd[,3] - xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) - } + } + if(type =="risk-based"){ + sharpe = mean(na.omit(apply.rolling(x,width = h,FUN = SharpeRatio.annualized,Rf = 0))) + sd = mean(na.omit(apply.rolling(x,width = h, FUN = StdDev.annualized))) + factor = 1/(1-delta^2) + xt = (sharpe/sd + 0.5)*ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + } return(xt) } + redd = rollDrawdown(R,Rf,h,geometric) for(column in 1:columns){ From noreply at r-forge.r-project.org Thu Jul 25 18:56:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 18:56:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2643 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130725165645.E9868184976@r-forge.r-project.org> Author: pulkit Date: 2013-07-25 18:56:45 +0200 (Thu, 25 Jul 2013) New Revision: 2643 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/returns.csv Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R Log: added data file for testing redd cops Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-25 08:40:55 UTC (rev 2642) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-25 16:56:45 UTC (rev 2643) @@ -34,6 +34,12 @@ #' #' #'@examples +#' +#' # with S&P 500 data and T-bill data +#' +#'dt<-read.zoo("returns.csv",sep=",",header = TRUE) +#'REDDCOPS(dt[,1],delta = 0.33,Rf = (1+dt[,2])^(1/12)-1,h = 12,geometric = TRUE,asset = "one") +#' #'data(edhec) #'REDDCOPS(edhec,delta = 0.1,Rf = 0,h = 40) #'data(managers) @@ -70,6 +76,7 @@ if(type == "calibrated"){ if(asset == "one"){ factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2) + print(factor) xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) print(sd[,column]) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R 2013-07-25 08:40:55 UTC (rev 2642) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R 2013-07-25 16:56:45 UTC (rev 2643) @@ -52,7 +52,7 @@ } else{ prodRf = prod(1+rf) - REM = max(Return.cumulative*prodRf) + REM = max(Return.cumulative*as.numeric(last(prodRf)/prodRf)) } result = REM } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-25 08:40:55 UTC (rev 2642) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-25 16:56:45 UTC (rev 2643) @@ -45,23 +45,25 @@ stop("The number of rows of the returns and the risk free rate do not match") } - REDD<-function(x,geometric){ + REDD<-function(xh,geometric){ if(geometric) - Return.cumulative = cumprod(1+x) - else Return.cumulative = 1 + cumsum(x) + Return.cumulative = cumprod(1+xh) + else Return.cumulative = 1 + cumsum(xh) l = length(Return.cumulative) if(nr == 1){ REM = max(Return.cumulative*(1+rf)^(l-c(1:l))) } else{ - prodRf = prod(1+rf) - REM = max(Return.cumulative*prodRf) + rf = rf[index(xh)] + prodRf = cumprod(1+rf) + REM = max(Return.cumulative*as.numeric(last(prodRf)/prodRf)) } - result = 1 - Return.cumulative[l]/REM + #as.numeric(first(prodRf[index(xh[which(xh==max(xh))])])) + result = 1 - last(Return.cumulative)/REM } for(column in 1:columns){ - column.drawdown <- rollapplyr(x[,column],width = h, FUN = REDD, geometric = geometric) + column.drawdown <- apply.rolling(x[,column],width = h, FUN = REDD, geometric = geometric) if(column == 1) rolldrawdown = column.drawdown else rolldrawdown = merge(rolldrawdown, column.drawdown) Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/returns.csv =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/returns.csv (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/returns.csv 2013-07-25 16:56:45 UTC (rev 2643) @@ -0,0 +1,697 @@ +"Index","S&P","3-month,T-bill" +1954-01-31,0.0511890366787586,0.0102 +1954-02-28,0.00268404907975461,0.01 +1954-03-31,0.0302103250478012,0.0103 +1954-04-30,0.0489977728285078,0.0081 +1954-05-31,0.0329087048832271,0.0072 +1954-06-30,0.000685166152792016,0.0064 +1954-07-31,0.0571722013009244,0.0079 +1954-08-31,-0.0340025906735751,0.0105 +1954-09-30,0.0831377807576268,0.0099 +1954-10-31,-0.0194986072423399,0.01 +1954-11-30,0.0808080808080809,0.0101 +1954-12-31,0.0508177570093455,0.0102 +1955-01-31,0.0180655919955532,0.0112 +1955-02-28,0.00354900354900334,0.0137 +1955-03-31,-0.00489662676822633,0.0141 +1955-04-30,0.0377255330781849,0.0159 +1955-05-31,-0.00131717597471037,0.0139 +1955-06-30,0.0823001846478504,0.0147 +1955-07-31,0.0606873019741654,0.0175 +1955-08-31,-0.00781250000000011,0.0209 +1955-09-30,0.0113478462251042,0.0215 +1955-10-31,-0.0304556904053125,0.0215 +1955-11-30,0.0748700991969766,0.0244 +1955-12-31,-0.000659195781147037,0.025 +1956-01-31,-0.036499560246262,0.0232 +1956-02-29,0.0346873573710635,0.023 +1956-03-31,0.0692545213939124,0.023 +1956-04-30,-0.00206270627062699,0.0269 +1956-05-31,-0.0657296403472509,0.0257 +1956-06-30,0.039159292035398,0.0242 +1956-07-31,0.0515222482435598,0.023 +1956-08-31,-0.0380643855031383,0.0266 +1956-09-30,-0.0454641128183539,0.0291 +1956-10-31,0.00507166482910693,0.0286 +1956-11-30,-0.0109697235629662,0.0304 +1956-12-31,0.035270629991127,0.0322 +1957-01-31,-0.041782729805014,0.0312 +1957-02-28,-0.0326475849731664,0.0328 +1957-03-31,0.0196486361534907,0.0296 +1957-04-30,0.0369530718657902,0.0301 +1957-05-31,0.0369479667686925,0.0331 +1957-06-30,-0.00126502213788748,0.0322 +1957-07-31,0.0113996200126663,0.0338 +1957-08-31,-0.0561469421832602,0.035 +1957-09-30,-0.0619195046439628,0.0346 +1957-10-31,-0.032060348892032,0.036 +1957-11-30,0.0160740379931805,0.0314 +1957-12-31,-0.0414669223394055,0.0275 +1958-01-31,0.0427606901725432,0.0155 +1958-02-28,-0.0206235011990408,0.0127 +1958-03-31,0.0308521057786484,0.011 +1958-04-30,0.0318289786223278,0.012 +1958-05-31,0.0149631675874771,0.0058 +1958-06-30,0.0260830120208664,0.0075 +1958-07-31,0.0431034482758619,0.0091 +1958-08-31,0.0118669209578302,0.0233 +1958-09-30,0.0483769633507853,0.027 +1958-10-31,0.0253695565321612,0.0255 +1958-11-30,0.0224040522111826,0.0278 +1958-12-31,0.0520198170731707,0.0268 +1959-01-31,0.00434703857996754,0.0264 +1959-02-28,-0.000721370604148008,0.0276 +1959-03-31,0.000541418516513348,0.0278 +1959-04-30,0.0387806637806638,0.0285 +1959-05-31,0.0189268970307344,0.0308 +1959-06-30,-0.00357873210633952,0.0314 +1959-07-31,0.0348896870189841,0.03 +1959-08-31,-0.0150388365559411,0.0388 +1959-09-30,-0.0456375838926174,0.041 +1959-10-31,0.0112517580872011,0.04 +1959-11-30,0.0132127955493742,0.0444 +1959-12-31,0.0276252573781743,0.044 +1960-01-31,-0.0714643513107364,0.0399 +1960-02-29,0.00917101240784035,0.0419 +1960-03-31,-0.0138987883107625,0.0302 +1960-04-30,-0.0175280086736539,0.0304 +1960-05-31,0.0268530439580652,0.0312 +1960-06-30,0.0195235536449938,0.0219 +1960-07-31,-0.0247716092761772,0.0219 +1960-08-31,0.0261214195640425,0.0257 +1960-09-30,-0.0603932584269663,0.023 +1960-10-31,-0.00242899850523171,0.0212 +1960-11-30,0.0402697134294812,0.024 +1960-12-31,0.0462729564277997,0.022 +1961-01-31,0.0631560832903115,0.0228 +1961-02-28,0.026869537067012,0.0258 +1961-03-31,0.0255359394703658,0.0242 +1961-04-30,0.00384260682446969,0.0227 +1961-05-31,0.0191394885928649,0.0234 +1961-06-30,-0.0288461538461539,0.0227 +1961-07-31,0.0327970297029703,0.0226 +1961-08-31,0.0196225284601557,0.0235 +1961-09-30,-0.0196856177464373,0.0223 +1961-10-31,0.0283230930615914,0.0228 +1961-11-30,0.0393471291168754,0.0255 +1961-12-31,0.00322490185081326,0.0267 +1962-01-31,-0.037875611460517,0.0273 +1962-02-28,0.0162696106914584,0.0271 +1962-03-31,-0.00586049170954828,0.0275 +1962-04-30,-0.0619698058950395,0.0274 +1962-05-31,-0.0859901900674431,0.027 +1962-06-30,-0.081838001006205,0.029 +1962-07-31,0.0635616438356164,0.0286 +1962-08-31,0.0152842177571699,0.0281 +1962-09-30,-0.0482070365358592,0.0274 +1962-10-31,0.00444286475919675,0.0272 +1962-11-30,0.101556970983723,0.0286 +1962-12-31,0.0134918085448121,0.0292 +1963-01-31,0.0491283676703644,0.0293 +1963-02-28,-0.0288519637462236,0.029 +1963-03-31,0.0354643023798411,0.0291 +1963-04-30,0.0485203545140453,0.029 +1963-05-31,0.0143266475644699,0.03 +1963-06-30,-0.0201977401129942,0.0299 +1963-07-31,-0.00345970880784219,0.0327 +1963-08-31,0.0487487342687691,0.0339 +1963-09-30,-0.0110344827586206,0.0337 +1963-10-31,0.0322175732217573,0.0348 +1963-11-30,-0.0105391163356303,0.035 +1963-12-31,0.0244435340707359,0.0351 +1964-01-31,0.02692615302586,0.035 +1964-02-29,0.00986500519210787,0.036 +1964-03-31,0.0151670951156813,0.0351 +1964-04-30,0.00607748797163832,0.0345 +1964-05-31,0.0114523030455576,0.0347 +1964-06-30,0.0164240388204553,0.0347 +1964-07-31,0.0182396866201495,0.0347 +1964-08-31,-0.0162298629478241,0.035 +1964-09-30,0.0287180740559698,0.0355 +1964-10-31,0.00807792824899023,0.0355 +1964-11-30,-0.00518501060570353,0.0384 +1964-12-31,0.003909026297086,0.0382 +1965-01-31,0.0331563421828909,0.0387 +1965-02-28,-0.00148469620831426,0.0399 +1965-03-31,-0.0145259064394374,0.0393 +1965-04-30,0.0342386258124421,0.0391 +1965-05-31,-0.00774323869374927,0.0387 +1965-06-30,-0.0486315313277539,0.0381 +1965-07-31,0.0134331906799809,0.0381 +1965-08-31,0.0225219941348973,0.039 +1965-09-30,0.032006424228519,0.0402 +1965-10-31,0.0273454868830592,0.0406 +1965-11-30,-0.00876433672365295,0.0413 +1965-12-31,0.00895098788341886,0.0449 +1966-01-31,0.00486854917234658,0.0463 +1966-02-28,-0.0178725236864772,0.0464 +1966-03-31,-0.0218153913615434,0.0452 +1966-04-30,0.0205087974896334,0.0465 +1966-05-31,-0.0541401273885351,0.0464 +1966-06-30,-0.0161383954487403,0.0458 +1966-07-31,-0.0134529147982063,0.0477 +1966-08-31,-0.0777511961722488,0.0506 +1966-09-30,-0.00700389105058352,0.0534 +1966-10-31,0.047544409613375,0.0522 +1966-11-30,0.00311720698254359,0.0516 +1966-12-31,-0.00149160969546303,0.0481 +1967-01-31,0.0781775177393254,0.0451 +1967-02-28,0.00196282184505248,0.0454 +1967-03-31,0.0394100023046786,0.0401 +1967-04-30,0.0422394678492239,0.0373 +1967-05-31,-0.0524412296564196,0.0346 +1967-06-30,0.0175123484508308,0.04 +1967-07-31,0.0453442188879083,0.0412 +1967-08-31,-0.0117150395778364,0.0438 +1967-09-30,0.0327851345578811,0.0439 +1967-10-31,-0.0352600558370385,0.0456 +1967-11-30,0.007502679528403,0.0495 +1967-12-31,0.0262765957446809,0.0504 +1968-01-31,-0.0438478283404168,0.0488 +1968-02-29,-0.03122289679098,0.0502 +1968-03-31,0.00940017905102963,0.0517 +1968-04-30,0.0804878048780486,0.0551 +1968-05-31,0.0125179560845476,0.0568 +1968-06-30,0.00912038913660318,0.053 +1968-07-31,-0.0184776059449689,0.0517 +1968-08-31,0.0114589727849397,0.0518 +1968-09-30,0.0385393485737406,0.0516 +1968-10-31,0.00720755819616237,0.0548 +1968-11-30,0.0479644134996615,0.0552 +1968-12-31,-0.0416166835840177,0.0625 +1969-01-31,-0.0081840939726554,0.0619 +1969-02-28,-0.0473740413552083,0.0619 +1969-03-31,0.0344441047589932,0.0599 +1969-04-30,0.0214757166781596,0.0587 +1969-05-31,-0.00221815025556948,0.0608 +1969-06-30,-0.055577034602745,0.0629 +1969-07-31,-0.0601780779858765,0.0706 +1969-08-31,0.0400740498747687,0.0695 +1969-09-30,-0.0250235577426448,0.0714 +1969-10-31,0.0429553264604812,0.0699 +1969-11-30,-0.0340815485996705,0.0751 +1969-12-31,-0.0186547276409764,0.0801 +1970-01-31,-0.0764718661742343,0.0786 +1970-02-28,0.0526934838861446,0.0685 +1970-03-31,0.0014525139664805,0.0638 +1970-04-30,-0.0904830971772844,0.0693 +1970-05-31,-0.0609666339548577,0.0693 +1970-06-30,-0.050032658393207,0.0649 +1970-07-31,0.0732948294829483,0.0638 +1970-08-31,0.0444586803331197,0.0633 +1970-09-30,0.0341020608439646,0.0584 +1970-10-31,-0.0124555160142349,0.0584 +1970-11-30,0.0474474474474476,0.0504 +1970-12-31,0.0567660550458715,0.0485 +1971-01-31,0.0404774823657079,0.0415 +1971-02-28,0.00907384230287867,0.034 +1971-03-31,0.0367958656330749,0.0364 +1971-04-30,0.0362875087229588,0.0393 +1971-05-31,-0.0415584415584417,0.0434 +1971-06-30,-0.00933453778982229,0.0522 +1971-07-31,-0.0316109422492402,0.0531 +1971-08-31,0.0360954174513497,0.0444 +1971-09-30,-0.00696758558012722,0.046 +1971-10-31,-0.0417937766931056,0.0431 +1971-11-30,-0.002546959567017,0.0434 +1971-12-31,0.0861793807851901,0.0368 +1972-01-31,0.0181212655500049,0.0335 +1972-02-29,0.0253030594573793,0.0346 +1972-03-31,0.00591160739420116,0.0383 +1972-04-30,0.00438432835820901,0.0363 +1972-05-31,0.0172750069657286,0.0381 +1972-06-30,-0.0218205057974984,0.0406 +1972-07-31,0.0023333955572149,0.038 +1972-08-31,0.0344538597634789,0.0455 +1972-09-30,-0.0048609235754794,0.0455 +1972-10-31,0.009317051108096,0.0476 +1972-11-30,0.0456174941745833,0.0488 +1972-12-31,0.0118282334790434,0.0514 +1973-01-31,-0.01711139347734,0.0568 +1973-02-28,-0.0374903042316642,0.0585 +1973-03-31,-0.0014326647564471,0.064 +1973-04-30,-0.040799856527977,0.0623 +1973-05-31,-0.0188837991960362,0.0692 +1973-06-30,-0.00657455931395901,0.0752 +1973-07-31,0.0379819681565317,0.0832 +1973-08-31,-0.0366845315098873,0.0866 +1973-09-30,0.0400959232613909,0.0698 +1973-10-31,-0.00129115558424786,0.0736 +1973-11-30,-0.11386092898698,0.073 +1973-12-31,0.0165694039182993,0.0746 +1974-01-31,-0.0100461301896464,0.0748 +1974-02-28,-0.00362431396914153,0.0746 +1974-03-31,-0.0232799833714404,0.0828 +1974-04-30,-0.0390508618855075,0.089 +1974-05-31,-0.0335511017606024,0.0808 +1974-06-30,-0.0146654445462878,0.0734 +1974-07-31,-0.0777906976744186,0.0767 +1974-08-31,-0.0902786533854495,0.0893 +1974-09-30,-0.119334719334719,0.0612 +1974-10-31,0.163046899590809,0.078 +1974-11-30,-0.0531799729364006,0.0747 +1974-12-31,-0.020151493497213,0.0706 +1975-01-31,0.122812135355893,0.0568 +1975-02-28,0.0598856845934008,0.054 +1975-03-31,0.0216938350288025,0.0553 +1975-04-30,0.0472648752399232,0.055 +1975-05-31,0.0441008018327607,0.052 +1975-06-30,0.044322545255074,0.0586 +1975-07-31,-0.0676541653535035,0.0625 +1975-08-31,-0.0210704225352113,0.0636 +1975-09-30,-0.0346454880294659,0.0658 +1975-10-31,0.0616430189579111,0.0551 +1975-11-30,0.0247079964061094,0.0554 +1975-12-31,-0.0115081104778606,0.052 +1976-01-31,0.118305798869054,0.0473 +1976-02-29,-0.0114019432877256,0.05 +1976-03-31,0.030688998094474,0.0497 +1976-04-30,-0.010995426680938,0.0491 +1976-05-31,-0.0143644234553325,0.0549 +1976-06-30,0.0409263326013176,0.0537 +1976-07-31,-0.00805523590333723,0.0517 +1976-08-31,-0.00512374323279197,0.0509 +1976-09-30,0.0226411427460889,0.0506 +1976-10-31,-0.0222348916761687,0.0489 +1976-11-30,-0.00777453838678344,0.0442 +1976-12-31,0.0524975514201762,0.0434 +1977-01-31,-0.0505304299274147,0.0472 +1977-02-28,-0.0216602959913752,0.047 +1977-03-31,-0.0140252454417952,0.0454 +1977-04-30,0.000203210729526448,0.0469 +1977-05-31,-0.023567655424624,0.0503 +1977-06-30,0.0453599667082814,0.0498 +1977-07-31,-0.0162221337579619,0.054 +1977-08-31,-0.0210419828022256,0.0556 +1977-09-30,-0.00248010747132366,0.0589 +1977-10-31,-0.0434061949652957,0.0618 +1977-11-30,0.0269655620532814,0.0604 +1977-12-31,0.00284720025308438,0.0613 +1978-01-31,-0.0615141955835962,0.0642 +1978-02-28,-0.0247619047619047,0.0642 +1978-03-31,0.0249310661764703,0.0647 +1978-04-30,0.0854164331352989,0.0635 +1978-05-31,0.00423422493029024,0.0665 +1978-06-30,-0.0175853558206499,0.0701 +1978-07-31,0.0539097665654769,0.0676 +1978-08-31,0.0259237187127532,0.0754 +1978-09-30,-0.00726110949753123,0.0798 +1978-10-31,-0.0915740198946753,0.0875 +1978-11-30,0.0166398282340312,0.0901 +1978-12-31,0.0148891235480464,0.0926 +1979-01-31,0.0397461242326502,0.0929 +1979-02-28,-0.0365255678975284,0.0945 +1979-03-31,0.0551516410469464,0.0944 +1979-04-30,0.00167339305049707,0.0956 +1979-05-31,-0.0263364779874214,0.0957 +1979-06-30,0.0386556318126765,0.0895 +1979-07-31,0.00874550578175115,0.0918 +1979-08-31,0.053077738175513,0.0981 +1979-09-30,0,0.1012 +1979-10-31,-0.0686059275521405,0.1212 +1979-11-30,0.0426242388528777,0.1149 +1979-12-31,0.0167671439336849,0.1204 +1980-01-31,0.0576246062627386,0.12 +1980-02-29,-0.00437981779957952,0.1401 +1980-03-31,-0.101794826676051,0.1424 +1980-04-30,0.0411401704378489,0.1039 +1980-05-31,0.0465707027942421,0.0775 +1980-06-30,0.0269687162891046,0.0788 +1980-07-31,0.0650385154061626,0.0862 +1980-08-31,0.0058354565628338,0.0996 +1980-09-30,0.0251675110312142,0.1144 +1980-10-31,0.0160210425633669,0.1271 +1980-11-30,0.102377029889386,0.1448 +1980-12-31,-0.0338741816111587,0.143 +1981-01-31,-0.0457424867413081,0.1459 +1981-02-28,0.0132767271323813,0.1422 +1981-03-31,0.0360326045554962,0.1246 +1981-04-30,-0.0234558823529412,0.1486 +1981-05-31,-0.0016565017694451,0.151 +1981-06-30,-0.0104080247379138,0.1428 +1981-07-31,-0.00221019739349149,0.1487 +1981-08-31,-0.0620989917506873,0.1552 +1981-09-30,-0.0538317452561283,0.1434 +1981-10-31,0.0491478739886382,0.1275 +1981-11-30,0.0365903683649191,0.1037 +1981-12-31,-0.0300751879699248,0.1108 +1982-01-31,-0.0175438596491228,0.1252 +1982-02-28,-0.0605481727574751,0.1244 +1982-03-31,-0.0101670939793123,0.1326 +1982-04-30,0.0400142908181493,0.1234 +1982-05-31,-0.039161800068705,0.115 +1982-06-30,-0.0202895959957097,0.1276 +1982-07-31,-0.0229906030471672,0.1017 +1982-08-31,0.115977215426277,0.0842 +1982-09-30,0.00761442557108194,0.0762 +1982-10-31,0.110446769639595,0.079 +1982-11-30,0.0359706850134609,0.0828 +1982-12-31,0.0152313578286292,0.0792 +1983-01-31,0.0331342434584758,0.081 +1983-02-28,0.01899518238128,0.0793 +1983-03-31,0.0330946913413481,0.0864 +1983-04-30,0.0749869246861925,0.0808 +1983-05-31,-0.0124064951651159,0.0863 +1983-06-30,0.0323295769443932,0.0879 +1983-07-31,-0.0303030303030302,0.0922 +1983-08-31,0.0113188976377954,0.0926 +1983-09-30,0.0101581508515813,0.0871 +1983-10-31,-0.015174324080207,0.0851 +1983-11-30,0.0174258636502598,0.0888 +1983-12-31,-0.00883413461538463,0.0897 +1984-01-31,-0.00921603104347302,0.0889 +1984-02-29,-0.0388593109356832,0.0914 +1984-03-31,0.0134980262320132,0.0972 +1984-04-30,0.00546551074255563,0.0972 +1984-05-31,-0.0593564511090284,0.0975 +1984-06-30,0.0174692793091995,0.0992 +1984-07-31,-0.0164512338425382,0.104 +1984-08-31,0.106332138590203,0.1063 +1984-09-30,-0.00347972162227028,0.1022 +1984-10-31,-6.02046959662372e-05,0.0901 +1984-11-30,-0.0151122885182732,0.0844 +1984-12-31,0.0223743733952806,0.0785 +1985-01-31,0.0740851470939965,0.0805 +1985-02-28,0.00862884818794196,0.085 +1985-03-31,-0.00287007395959826,0.0818 +1985-04-30,-0.00459426547105046,0.0785 +1985-05-31,0.0540510482122003,0.0714 +1985-06-30,0.0121340015826958,0.0683 +1985-07-31,-0.00484753713838937,0.0728 +1985-08-31,-0.011994552692227,0.0714 +1985-09-30,-0.0347240629804378,0.0704 +1985-10-31,0.0425087873462213,0.0719 +1985-11-30,0.0650616373406385,0.0716 +1985-12-31,0.0450610872038384,0.0705 +1986-01-31,0.00236652783036728,0.0697 +1986-02-28,0.0714892813296817,0.0702 +1986-03-31,0.0527939361889653,0.0634 +1986-04-30,-0.0141481791544579,0.061 +1986-05-31,0.0502292798913042,0.063 +1986-06-30,0.0141095613503133,0.0596 +1986-07-31,-0.0586828257056291,0.0579 +1986-08-31,0.0711926139251229,0.0517 +1986-09-30,-0.0854386589174871,0.052 +1986-10-31,0.0547293792149404,0.052 +1986-11-30,0.0214771702598575,0.0539 +1986-12-31,-0.0282882593692321,0.0567 +1987-01-31,0.131766940578932,0.056 +1987-02-28,0.0369235259778167,0.0545 +1987-03-31,0.0263898662913442,0.0561 +1987-04-30,-0.0114501199862872,0.0553 +1987-05-31,0.00603412401165215,0.0568 +1987-06-30,0.0479145122371596,0.0573 +1987-07-31,0.0482236842105264,0.0607 +1987-08-31,0.0349588903533546,0.0625 +1987-09-30,-0.0241661613098849,0.0661 +1987-10-31,-0.217630426001305,0.0527 +1987-11-30,-0.0853489018626633,0.0521 +1987-12-31,0.0728614850195397,0.0568 +1988-01-31,0.0404322486644002,0.0564 +1988-02-29,0.0418174038199712,0.0562 +1988-03-31,-0.033343290269584,0.0571 +1988-04-30,0.00942485225385292,0.0598 +1988-05-31,0.00317606091914446,0.0643 +1988-06-30,0.0432560268538296,0.0656 +1988-07-31,-0.00541133455210241,0.0695 +1988-08-31,-0.0386001029336078,0.073 +1988-09-30,0.0397292750076477,0.0725 +1988-10-31,0.0259644735390387,0.0736 +1988-11-30,-0.0188909201706278,0.0783 +1988-12-31,0.0146876141761054,0.081 +1989-01-31,0.0711147918767103,0.0839 +1989-02-28,-0.0289440952028777,0.0871 +1989-03-31,0.0208059267465208,0.089 +1989-04-30,0.0500898701122527,0.0841 +1989-05-31,0.0351375791241442,0.0861 +1989-06-30,-0.00792462248845616,0.0799 +1989-07-31,0.0883703377570915,0.078 +1989-08-31,0.0155166435506242,0.0789 +1989-09-30,-0.00654431640347142,0.0791 +1989-10-31,-0.0251754260346555,0.0777 +1989-11-30,0.0165413092020215,0.0759 +1989-12-31,0.0214168039538714,0.0755 +1990-01-31,-0.0688172043010753,0.0774 +1990-02-28,0.0085389570925003,0.0777 +1990-03-31,0.0242550242550243,0.078 +1990-04-30,-0.0268870977231276,0.0779 +1990-05-31,0.0919891172914147,0.0775 +1990-06-30,-0.00888630512415922,0.0774 +1990-07-31,-0.00522317188983856,0.0749 +1990-08-31,-0.0943141934578127,0.0739 +1990-09-30,-0.0511842757936508,0.0714 +1990-10-31,-0.00669825191962103,0.0711 +1990-11-30,0.0599342105263159,0.0702 +1990-12-31,0.02482775743281,0.0644 +1991-01-31,0.0415177760281025,0.0619 +1991-02-28,0.0672811327886489,0.0604 +1991-03-31,0.0222028495927209,0.0574 +1991-04-30,0.000319812376738948,0.0551 +1991-05-31,0.0386049981350243,0.0553 +1991-06-30,-0.0478926711643536,0.0554 +1991-07-31,0.0448593598448108,0.0553 +1991-08-31,0.0196487970913592,0.0533 +1991-09-30,-0.0191437169663404,0.0511 +1991-10-31,0.0118341669674624,0.0482 +1991-11-30,-0.0439036819977067,0.0435 +1991-12-31,0.111587868450509,0.0388 +1992-01-31,-0.0199237574624181,0.0384 +1992-02-29,0.00958951025001231,0.0393 +1992-03-31,-0.0218318391083111,0.0405 +1992-04-30,0.0278926899353464,0.037 +1992-05-31,0.000963971562838895,0.037 +1992-06-30,-0.0173588539785724,0.0357 +1992-07-31,0.0393737443034252,0.0318 +1992-08-31,-0.0239975483840551,0.0316 +1992-09-30,0.00910562036567408,0.0269 +1992-10-31,0.00210627094303484,0.0296 +1992-11-30,0.0302617751027037,0.0327 +1992-12-31,0.0101078010896023,0.0308 +1993-01-31,0.00704597094397652,0.029 +1993-02-28,0.0104836136560464,0.0295 +1993-03-31,0.0186972799855656,0.0289 +1993-04-30,-0.0254167865919809,0.0291 +1993-05-31,0.0227174629137419,0.0306 +1993-06-30,0.00075523667784716,0.0303 +1993-07-31,-0.00532705924133792,0.0303 +1993-08-31,0.0344319728650169,0.0301 +1993-09-30,-0.00998791957891099,0.0292 +1993-10-31,0.0193929357418343,0.0303 +1993-11-30,-0.012910672680247,0.0314 +1993-12-31,0.010091166980662,0.0301 +1994-01-31,0.0325008039446886,0.0296 +1994-02-28,-0.0300450572039618,0.0336 +1994-03-31,-0.0457464571648757,0.0348 +1994-04-30,0.011530609955807,0.0387 +1994-05-31,0.0123971524250959,0.0416 +1994-06-30,-0.0267907995618839,0.0415 +1994-07-31,0.0314898597699598,0.0427 +1994-08-31,0.0375987430716187,0.0456 +1994-09-30,-0.0268775368567163,0.0467 +1994-10-31,0.020833783579348,0.0503 +1994-11-30,-0.0395046046363926,0.0556 +1994-12-31,0.0122991469946439,0.0553 +1995-01-31,0.0242776580225141,0.0583 +1995-02-28,0.0360741465073764,0.0576 +1995-03-31,0.027329243521615,0.057 +1995-04-30,0.0279602963791417,0.0569 +1995-05-31,0.0363117095063239,0.0563 +1995-06-30,0.021278590176228,0.0544 +1995-07-31,0.0317760440569068,0.0542 +1995-08-31,-0.000320250507063191,0.0529 +1995-09-30,0.0400975297216486,0.0524 +1995-10-31,-0.00497938091408423,0.0532 +1995-11-30,0.041049011177988,0.0532 +1995-12-31,0.0174438772981811,0.0496 +1996-01-31,0.0326173428798728,0.0491 +1996-02-29,0.00693374422187976,0.0489 +1996-03-31,0.00791655606389474,0.05 +1996-04-30,0.013431448489543,0.0501 +1996-05-31,0.0228533867343352,0.0504 +1996-06-30,0.0022566953610712,0.0504 +1996-07-31,-0.0457480279736963,0.0518 +1996-08-31,0.0188139698413938,0.0515 +1996-09-30,0.054203285326462,0.0491 +1996-10-31,0.0261009995198811,0.0503 +1996-11-30,0.0733761538134332,0.05 +1996-12-31,-0.021505376344086,0.0507 +1997-01-31,0.0613170613170613,0.0502 +1997-02-28,0.00592754655540872,0.0509 +1997-03-31,-0.0426139955995044,0.0521 +1997-04-30,0.0584055367709215,0.0514 +1997-05-31,0.0585768837197693,0.0482 +1997-06-30,0.0434526335643892,0.0506 +1997-07-31,0.0781458300381861,0.0511 +1997-08-31,-0.0574656034202722,0.051 +1997-09-30,0.0531535237417591,0.0493 +1997-10-31,-0.0344776623595979,0.0507 +1997-11-30,0.0445868229428614,0.0508 +1997-12-31,0.0157316307305839,0.0522 +1998-01-31,0.0101501396288244,0.0506 +1998-02-28,0.0704492593952748,0.0518 +1998-03-31,0.0499456801418035,0.0502 +1998-04-30,0.0090764692534604,0.0487 +1998-05-31,-0.0188261749494042,0.0489 +1998-06-30,0.0394382207880311,0.0497 +1998-07-31,-0.0116153954702602,0.0497 +1998-08-31,-0.14579671089616,0.0477 +1998-09-30,0.0623955373558416,0.0426 +1998-10-31,0.0802941957306222,0.0423 +1998-11-30,0.0591260342049933,0.0442 +1998-12-31,0.0563753083024672,0.0437 +1999-01-31,0.0410094123963782,0.0437 +1999-02-28,-0.0322825169578945,0.0455 +1999-03-31,0.0387941824877052,0.0437 +1999-04-30,0.0379439819025631,0.0443 +1999-05-31,-0.0249704159738763,0.0453 +1999-06-30,0.0544383334357526,0.0465 +1999-07-31,-0.0320460985932935,0.0462 +1999-08-31,-0.00625413932205432,0.0484 +1999-09-30,-0.0285517377178302,0.0474 +1999-10-31,0.0625394672217414,0.0497 +1999-11-30,0.0190618740507582,0.0515 +1999-12-31,0.0578439207724042,0.0517 +2000-01-31,-0.0509035222052067,0.0553 +2000-02-29,-0.0201081422199274,0.0562 +2000-03-31,0.0967198957860687,0.0572 +2000-04-30,-0.0307958200429739,0.0566 +2000-05-31,-0.0219149976246705,0.0548 +2000-06-30,0.0239335492045614,0.0571 +2000-07-31,-0.0163412622026674,0.0603 +2000-08-31,0.0606990348259402,0.0613 +2000-09-30,-0.0534829476569502,0.0605 +2000-10-31,-0.00494949565265812,0.0619 +2000-11-30,-0.0800685602350637,0.0603 +2000-12-31,0.00405338606030647,0.0573 +2001-01-31,0.0346365922380101,0.0486 +2001-02-28,-0.0922906860125474,0.0473 +2001-03-31,-0.0642047195832057,0.042 +2001-04-30,0.0768143545370714,0.0386 +2001-05-31,0.00509019896595331,0.0355 +2001-06-30,-0.0250354350145721,0.0357 +2001-07-31,-0.0107401296982964,0.0346 +2001-08-31,-0.0641083856905791,0.033 +2001-09-30,-0.0817233896152013,0.0235 +2001-10-31,0.0180990258804541,0.0201 +2001-11-30,0.0751759799203608,0.0175 +2001-12-31,0.00757382947913454,0.0171 +2002-01-31,-0.0155738276078321,0.0173 +2002-02-28,-0.0207662360644134,0.0176 +2002-03-31,0.0367388613302251,0.0176 +2002-04-30,-0.0614176522368157,0.0174 +2002-05-31,-0.00908145451844145,0.0171 +2002-06-30,-0.0724553479393519,0.0167 +2002-07-31,-0.0790042634014265,0.0168 +2002-08-31,0.00488141988986635,0.0166 +2002-09-30,-0.110024343117884,0.0154 +2002-10-31,0.0864488273967225,0.0142 +2002-11-30,0.0570696351156068,0.012 +2002-12-31,-0.0603325821576186,0.012 +2003-01-31,-0.0274146984610488,0.0116 +2003-02-28,-0.0170036227649878,0.0118 +2003-03-31,0.00835760565891941,0.0112 +2003-04-30,0.0810441179938222,0.0111 +2003-05-31,0.0508986607337609,0.0109 +2003-06-30,0.0113222428626283,0.0089 +2003-07-31,0.0162237044638276,0.0094 +2003-08-31,0.0178731912229504,0.0096 +2003-09-30,-0.0119443259491473,0.0093 +2003-10-31,0.0549614948241413,0.0094 +2003-11-30,0.00712851310066531,0.0091 +2003-12-31,0.0507654507654507,0.0093 +2004-01-31,0.0172764227642277,0.009 +2004-02-29,0.012209029908145,0.0094 +2004-03-31,-0.0163589358394326,0.0093 +2004-04-30,-0.016790829419025,0.0096 +2004-05-31,0.0120834462205366,0.0106 +2004-06-30,0.0179890780597494,0.0131 +2004-07-31,-0.0342905227726937,0.0142 +2004-08-31,0.00228733253458224,0.0157 +2004-09-30,0.00936390639716,0.0168 +2004-10-31,0.0140142475192451,0.0187 +2004-11-30,0.0385949389488585,0.022 +2004-12-31,0.0324581281627507,0.0218 +2005-01-31,-0.0252904482144036,0.0248 +2005-02-28,0.0189033836464143,0.0272 +2005-03-31,-0.0191176470588236,0.0273 +2005-04-30,-0.0201085897729102,0.0284 +2005-05-31,0.0299520248951897,0.0293 +2005-06-30,-0.000142677297524152,0.0306 +2005-07-31,0.0359682036043751,0.0334 +2005-08-31,-0.0112220259605569,0.0344 +2005-09-30,0.0069489400408087,0.0347 +2005-10-31,-0.0177407410421464,0.0389 +2005-11-30,0.0351861210760473,0.0386 +2005-12-31,-0.000952396196817973,0.0399 +2006-01-31,0.025466838635253,0.0437 +2006-02-28,0.000453096681457543,0.0451 +2006-03-31,0.0110958412068776,0.0452 +2006-04-30,0.0121556604137867,0.0465 +2006-05-31,-0.0309169012902388,0.0474 +2006-06-30,8.66080356511922e-05,0.0487 +2006-07-31,0.0050858132577547,0.0497 +2006-08-31,0.0212742625287858,0.0492 +2006-09-30,0.0245662744857418,0.0477 +2006-10-31,0.0315080285960252,0.0495 +2006-11-30,0.0164666095766144,0.049 +2006-12-31,0.012615751483261,0.0489 +2007-01-31,0.0140590848198547,0.0499 +2007-02-28,-0.0218461452886862,0.0501 +2007-03-31,0.0099799547916577,0.049 +2007-04-30,0.0432906831074138,0.0479 +2007-05-31,0.032549228600147,0.046 +2007-06-30,-0.0178163097306974,0.0468 +2007-07-31,-0.0319819070742009,0.0482 +2007-08-31,0.012863592323074,0.0391 +2007-09-30,0.0357940013161555,0.0372 +2007-10-31,0.0148223350253809,0.0384 +2007-11-30,-0.0440434238211413,0.0308 +2007-12-31,-0.00862848886668388,0.0329 +2008-01-31,-0.0611634748971641,0.0192 +2008-02-29,-0.0347611620906023,0.0181 +2008-03-31,-0.00595958305464339,0.0136 +2008-04-30,0.0475466848113706,0.0141 +2008-05-31,0.0106741532487966,0.0185 +2008-06-30,-0.0859623816392694,0.0187 +2008-07-31,-0.00985937499999989,0.0165 +2008-08-31,0.0121905032429104,0.0169 +2008-09-30,-0.090791453271283,0.009 +2008-10-31,-0.169424534449055,0.0044 +2008-11-30,-0.0748490322580645,1e-04 +2008-12-31,0.00782156565205749,0.0011 +2009-01-31,-0.0856573484638804,0.0024 +2009-02-28,-0.109931224875285,0.0026 +2009-03-31,0.0854045082915016,0.0021 +2009-04-30,0.0939250755135548,0.0014 +2009-05-31,0.0530814266564317,0.0014 +2009-06-30,0.000195835237287056,0.0019 +2009-07-31,0.0741417569507896,0.0018 +2009-08-31,0.0335601733705999,0.0015 +2009-09-30,0.0357233838255178,0.0014 +2009-10-31,-0.0197619858478071,5e-04 +2009-11-30,0.0573639969503663,6e-04 +2009-12-31,0.0177705977382874,6e-04 +2010-01-31,-0.0369742623979912,8e-04 +2010-02-28,0.0285136934638273,0.0013 +2010-03-31,0.0587963675542558,0.0016 +2010-04-30,0.01475932719359,0.0016 +2010-05-31,-0.0819759162038949,0.0016 +2010-06-30,-0.0538823766993144,0.0018 +2010-07-31,0.0687778327560613,0.0015 +2010-08-31,-0.0474491648511256,0.0014 +2010-09-30,0.0875511040378147,0.0016 +2010-10-31,0.0368559411146161,0.0012 +2010-11-30,-0.00229028277808774,0.0017 +2010-12-31,0.0653000720003389,0.0012 +2011-01-31,0.0226455901529847,0.0015 +2011-02-28,0.0319565825894941,0.0015 +2011-03-31,-0.00104730187911584,9e-04 +2011-04-30,0.0284953576250349,4e-04 +2011-05-31,-0.0135009276846018,6e-04 +2011-06-30,-0.0182575081772227,3e-04 +2011-07-31,-0.0214744366367823,0.001 +2011-08-31,-0.0567910979044788,2e-04 +2011-09-30,-0.071762012979022,2e-04 +2011-10-31,0.107723038305846,1e-04 +2011-11-30,-0.00505864517673338,1e-04 +2011-12-31,0.0085327516520175,2e-04 From noreply at r-forge.r-project.org Thu Jul 25 20:18:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 20:18:00 +0200 (CEST) Subject: [Returnanalytics-commits] r2644 - in pkg/FactorAnalytics: R man Message-ID: <20130725181800.7011D1845D3@r-forge.r-project.org> Author: chenyian Date: 2013-07-25 20:18:00 +0200 (Thu, 25 Jul 2013) New Revision: 2644 Modified: pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd Log: create print.TimeSeriesFactorModel.r and print.TimeSeriesFactorModel.Rd Modified: pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 16:56:45 UTC (rev 2643) +++ pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 18:18:00 UTC (rev 2644) @@ -4,20 +4,26 @@ #' #' #' @param fit.macro fit object created by fitTimeSeriesFactorModel. +#' @param digits. integer indicating the number of decimal places. #' @author Eric Zivot and Yi-An Chen. #' @examples #' #' # load data from the database #' data(managers.df) -#' ret.assets = managers.df[,(1:6)] -#' factors = managers.df[,(7:9)] -#' # fit the factor model with OLS -#' fit.macro <- fitTimeSeriesFactorModel(ret.assets,factors,fit.method="OLS", -#' variable.selection="all subsets") +#' 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(fit.macro) { - lapply(fit.macro[[1]], print) - } +#' @export +print.TimeSeriesFactorModel <- function(fit.macro,digits=3){ +n <- length(fit.macro$beta) +table.macro <- as.matrix(fit.macro$alpha,nrow=n[1]) +table.macro <- cbind(table.macro,fit.macro$beta,fit.macro$r2,fit.macro$resid.variance) +beta.names <- colnames(fit.macro$beta) +for (i in 1:length(beta.names)) { +beta.names[i] <- paste("beta.",beta.names[i],sep="") +} +colnames(table.macro) <- c("alpha",beta.names,"r2","resid.var") +print(round(table.macro,digits=digits)) +} Modified: pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd 2013-07-25 16:56:45 UTC (rev 2643) +++ pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd 2013-07-25 18:18:00 UTC (rev 2644) @@ -2,11 +2,14 @@ \alias{print.TimeSeriesFactorModel} \title{print TimeSeriesfactorModel object} \usage{ - print.TimeSeriesFactorModel(fit.macro) + print.TimeSeriesFactorModel(fit.macro, digits = 3) } \arguments{ \item{fit.macro}{fit object created by fitTimeSeriesFactorModel.} + + \item{digits.}{integer indicating the number of decimal + places.} } \description{ Generic function of print method for @@ -15,11 +18,9 @@ \examples{ # load data from the database data(managers.df) -ret.assets = managers.df[,(1:6)] -factors = managers.df[,(7:9)] -# fit the factor model with OLS -fit.macro <- fitTimeSeriesFactorModel(ret.assets,factors,fit.method="OLS", - variable.selection="all subsets") +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) } \author{ From noreply at r-forge.r-project.org Thu Jul 25 20:50:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 20:50:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2645 - in pkg/FactorAnalytics: R man Message-ID: <20130725185033.0C45E184F80@r-forge.r-project.org> Author: chenyian Date: 2013-07-25 20:50:32 +0200 (Thu, 25 Jul 2013) New Revision: 2645 Modified: pkg/FactorAnalytics/R/print.StatFactorModel.r pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r pkg/FactorAnalytics/man/print.StatFactorModel.Rd pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd Log: create print.StatFactorModel.r and print.StatFactorModel.Rd Modified: pkg/FactorAnalytics/R/print.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.StatFactorModel.r 2013-07-25 18:18:00 UTC (rev 2644) +++ pkg/FactorAnalytics/R/print.StatFactorModel.r 2013-07-25 18:50:32 UTC (rev 2645) @@ -1,36 +1,40 @@ -#' print StatFactorModel object -#' -#' Generic function of print method for fitStatFactorModel. -#' -#' -#' @param fit.stat fit object created by fitMacroeconomicFactorModel. -#' @param digits maximum digits. Default is 3. -#' @param ... Other variables for print methods. -#' @author Eric Zivot and Yi-An Chen. -#' @examples -#' -#' # load data for fitStatisticalFactorModel.r -#' # data from finmetric berndt.dat and folio.dat -#' -#' data(stat.fm.data) -#' # pca -#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) -#' print(sfm.pca.fit) -#' -#' -print.StatFactorModel <- -function(fit.stat, digits = max(3, .Options$digits - 3), ...) -{ - if(!is.null(cl <- fit.stat$call)) { - cat("\nCall:\n") - dput(cl) - } - cat("\nFactor Model:\n") - tmp <- c(dim(fit.stat$loadings), nrow(fit.stat$factors)) - names(tmp) <- c("Factors", "Variables", "Periods") - print(tmp) - cat("\nFactor Loadings:\n") - print(fit.stat$loadings, digits = digits, ...) - cat("\nRegression R-squared:\n") - print(fit.stat$r2, digits = digits, ...) -} +#' print StatFactorModel object +#' +#' Generic function of print method for fitStatFactorModel. +#' +#' +#' @param fit.stat fit object created by fitMacroeconomicFactorModel. +#' @param digits integer indicating the number of decimal places. Default is 3. +#' @param ... Other arguments for print methods. +#' @author Eric Zivot and Yi-An Chen. +#' @examples +#' +#' # load data for fitStatisticalFactorModel.r +#' # data from finmetric berndt.dat and folio.dat +#' +#' data(stat.fm.data) +#' # pca +#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) +#' print(sfm.pca.fit) +#' +#' +print.StatFactorModel <- +function(fit.stat, digits = max(3, .Options$digits - 3), ...) +{ + if(!is.null(cl <- fit.stat$call)) { + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Model:\n") + tmp <- c(dim(fit.stat$loadings), nrow(fit.stat$factors)) + names(tmp) <- c("Factors", "Variables", "Periods") + print(tmp) + cat("\nRegression alphas:\n") + print(fit.stat$alpha , digits = digits, ...) + cat("\nFactor Loadings:\n") + print(fit.stat$loadings, digits = digits, ...) + cat("\nRegression R-squared:\n") + print(fit.stat$r2, digits = digits, ...) + cat("\nResidual Variance:\n") + print(fit.stat$resid.variance, digits = digits, ...) +} Modified: pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 18:18:00 UTC (rev 2644) +++ pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 18:50:32 UTC (rev 2645) @@ -4,7 +4,8 @@ #' #' #' @param fit.macro fit object created by fitTimeSeriesFactorModel. -#' @param digits. integer indicating the number of decimal places. +#' @param digits. integer indicating the number of decimal places. Default is 3. +#' @param ... arguments to be passed to print method. #' @author Eric Zivot and Yi-An Chen. #' @examples #' @@ -16,14 +17,31 @@ #' print(fit.macro) #' #' @export -print.TimeSeriesFactorModel <- function(fit.macro,digits=3){ -n <- length(fit.macro$beta) -table.macro <- as.matrix(fit.macro$alpha,nrow=n[1]) -table.macro <- cbind(table.macro,fit.macro$beta,fit.macro$r2,fit.macro$resid.variance) -beta.names <- colnames(fit.macro$beta) -for (i in 1:length(beta.names)) { -beta.names[i] <- paste("beta.",beta.names[i],sep="") +print.TimeSeriesFactorModel <- function(fit.macro,digits=max(3, .Options$digits - 3),...){ + if(!is.null(cl <- fit.macro$call)) { + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Model:\n") + tmp <- c(dim(t(fit.macro$beta)), nrow(fit.macro$data)) + names(tmp) <- c("Factors", "Variables", "Periods") + print(tmp) + cat("\nRegression alphas:\n") + print(fit.macro$alpha , digits = digits, ...) + cat("\nFactor Betas:\n") + print(t(fit.macro$beta), digits = digits, ...) + cat("\nRegression R-squared:\n") + print(fit.macro$r2, digits = digits, ...) + cat("\nResidual Variance:\n") + print(fit.macro$resid.variance, digits = digits, ...) + +# n <- length(fit.macro$beta) +# table.macro <- as.matrix(fit.macro$alpha,nrow=n[1]) +# table.macro <- cbind(table.macro,fit.macro$beta,fit.macro$r2,fit.macro$resid.variance) +# beta.names <- colnames(fit.macro$beta) +# for (i in 1:length(beta.names)) { +# beta.names[i] <- paste("beta.",beta.names[i],sep="") +# } +# colnames(table.macro) <- c("alpha",beta.names,"r2","resid.var") +# print(round(table.macro,digits=digits)) } -colnames(table.macro) <- c("alpha",beta.names,"r2","resid.var") -print(round(table.macro,digits=digits)) -} Modified: pkg/FactorAnalytics/man/print.StatFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/print.StatFactorModel.Rd 2013-07-25 18:18:00 UTC (rev 2644) +++ pkg/FactorAnalytics/man/print.StatFactorModel.Rd 2013-07-25 18:50:32 UTC (rev 2645) @@ -1,31 +1,32 @@ -\name{print.StatFactorModel} -\alias{print.StatFactorModel} -\title{print StatFactorModel object} -\usage{ - print.StatFactorModel(fit.stat, - digits = max(3, .Options$digits - 3), ...) -} -\arguments{ - \item{fit.stat}{fit object created by - fitMacroeconomicFactorModel.} - - \item{digits}{maximum digits. Default is 3.} - - \item{...}{Other variables for print methods.} -} -\description{ - Generic function of print method for fitStatFactorModel. -} -\examples{ -# load data for fitStatisticalFactorModel.r -# data from finmetric berndt.dat and folio.dat - -data(stat.fm.data) -# pca -sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) -print(sfm.pca.fit) -} -\author{ - Eric Zivot and Yi-An Chen. -} - +\name{print.StatFactorModel} +\alias{print.StatFactorModel} +\title{print StatFactorModel object} +\usage{ + print.StatFactorModel(fit.stat, + digits = max(3, .Options$digits - 3), ...) +} +\arguments{ + \item{fit.stat}{fit object created by + fitMacroeconomicFactorModel.} + + \item{digits}{integer indicating the number of decimal + places. Default is 3.} + + \item{...}{Other arguments for print methods.} +} +\description{ + Generic function of print method for fitStatFactorModel. +} +\examples{ +# load data for fitStatisticalFactorModel.r +# data from finmetric berndt.dat and folio.dat + +data(stat.fm.data) +# pca +sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) +print(sfm.pca.fit) +} +\author{ + Eric Zivot and Yi-An Chen. +} + Modified: pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd 2013-07-25 18:18:00 UTC (rev 2644) +++ pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd 2013-07-25 18:50:32 UTC (rev 2645) @@ -2,14 +2,17 @@ \alias{print.TimeSeriesFactorModel} \title{print TimeSeriesfactorModel object} \usage{ - print.TimeSeriesFactorModel(fit.macro, digits = 3) + print.TimeSeriesFactorModel(fit.macro, + digits = max(3, .Options$digits - 3), ...) } \arguments{ \item{fit.macro}{fit object created by fitTimeSeriesFactorModel.} \item{digits.}{integer indicating the number of decimal - places.} + places. Default is 3.} + + \item{...}{arguments to be passed to print method.} } \description{ Generic function of print method for From noreply at r-forge.r-project.org Thu Jul 25 22:30:30 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 25 Jul 2013 22:30:30 +0200 (CEST) Subject: [Returnanalytics-commits] r2646 - in pkg/FactorAnalytics: R man Message-ID: <20130725203030.B9AF1184F80@r-forge.r-project.org> Author: chenyian Date: 2013-07-25 22:30:30 +0200 (Thu, 25 Jul 2013) New Revision: 2646 Added: pkg/FactorAnalytics/R/print.FundamentalFactorModel.r pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r pkg/FactorAnalytics/R/print.StatFactorModel.r pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd pkg/FactorAnalytics/man/print.StatFactorModel.Rd pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd Log: Add print.FundamentalFactorModel.Rd and print.FundamentalFactorModel.r Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-25 20:30:30 UTC (rev 2646) @@ -51,7 +51,7 @@ #' residuals for each asset. If "wls" is TRUE, these are the weights used in #' the weighted least squares regressions. If "cov = robust" these values are #' computed with "scale.tau". Otherwise they are computed with "var". -#' \item factors A "xts" object containing the times series of +#' \item factor.returns A "xts" object containing the times series of #' estimated factor returns and intercepts. #' \item residuals A "xts" object containing the time series of residuals #' for each asset. @@ -67,7 +67,7 @@ #' data(stock) #' # there are 447 assets #' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -#' ttest.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, +#' test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, #' datevar = "DATE", returnsvar = "RETURN", #' assetvar = "TICKER", wls = TRUE, #' regression = "classic", @@ -340,7 +340,7 @@ # give back the names of timedates timedates <- as.Date(as.numeric(dimnames(FE.hat)[[1]]), origin = "1970-01-01") coefs.names <- colnames(FE.hat.mat)[2:(1 + numCoefs)] - # estimated factors ordered by time + # estimated factors returns ordered by time f.hat <- xts(x = FE.hat.mat[, 2:(1 + numCoefs)], order.by = timedates) # check for outlier gomat <- apply(coredata(f.hat), 2, function(x) abs(x - median(x, @@ -406,12 +406,18 @@ else { Cov.resids <- NULL } +# +# # r-square for each asset = 1 - SSE/SST +# SSE <- apply(fit.fund$residuals^2,2,sum) +# SST <- tapply(data[,returnsvar],data[,assetvar],function(x) sum((x-mean(x))^2)) +# r2 <- 1- SSE/SST + output <- list(returns.cov = Cov.returns, factor.cov = Cov.factors, resids.cov = Cov.resids, resid.variance = resid.vars, - factors = f.hat, + factor.returns = f.hat, residuals = resids, tstats = tstats, call = this.call, Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-25 20:30:30 UTC (rev 2646) @@ -57,7 +57,7 @@ #' } #' plot.FundamentalFactorModel <- -function(fit.fund,which.plot=c("none","1L","2L","3L","4L"),max.show=4, +function(fit.fund,which.plot=c("none","1L","2L","3L","4L","5L","6L"),max.show=4, plot.single=FALSE, asset.name, which.plot.single=c("none","1L","2L","3L","4L","5L","6L", "7L","8L","9L"),legend.txt=TRUE,...) Added: pkg/FactorAnalytics/R/print.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.FundamentalFactorModel.r (rev 0) +++ pkg/FactorAnalytics/R/print.FundamentalFactorModel.r 2013-07-25 20:30:30 UTC (rev 2646) @@ -0,0 +1,40 @@ +#' print FundamentalFactorModel object +#' +#' Generic function of print method for fitFundamentalFactorModel. +#' +#' +#' @param fit.fund fit object created by fitFundamentalFactorModel. +#' @param digits integer indicating the number of decimal places. Default is 3. +#' @param ... Other arguments for print methods. +#' @author Yi-An Chen. +#' @examples +#' +#' data(stock) +#' # there are 447 assets +#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, +#' datevar = "DATE", returnsvar = "RETURN", +#' assetvar = "TICKER", wls = TRUE, +#' regression = "classic", +#' covariance = "classic", full.resid.cov = TRUE, +#' robust.scale = TRUE) +#' +#' print(test.fit) +#' +#' @export +print.FundamentalFactorModel <- + function(fit.fund, digits = max(3, .Options$digits - 3), ...) + { + if(!is.null(cl <- fit.fund$call)) { + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Model:\n") + tmp <- c(dim(fit.fund$beta)[2]-1,length(fit.fund$asset.names), nrow(fit.fund$factor.returns)) + names(tmp) <- c("Exposures", "Variables", "Periods") + print(tmp) + cat("\nFactor Returns:\n") + print(fit.fund$factor.returns, digits = digits, ...) + cat("\nResidual Variance:\n") + print(fit.fund$resid.variance, digits = digits, ...) + } Modified: pkg/FactorAnalytics/R/print.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.StatFactorModel.r 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/R/print.StatFactorModel.r 2013-07-25 20:30:30 UTC (rev 2646) @@ -3,7 +3,7 @@ #' Generic function of print method for fitStatFactorModel. #' #' -#' @param fit.stat fit object created by fitMacroeconomicFactorModel. +#' @param fit.stat fit object created by fitStatisticalFactorModel. #' @param digits integer indicating the number of decimal places. Default is 3. #' @param ... Other arguments for print methods. #' @author Eric Zivot and Yi-An Chen. @@ -17,7 +17,7 @@ #' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=10) #' print(sfm.pca.fit) #' -#' +#' @export print.StatFactorModel <- function(fit.stat, digits = max(3, .Options$digits - 3), ...) { Modified: pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 20:30:30 UTC (rev 2646) @@ -6,7 +6,7 @@ #' @param fit.macro fit object created by fitTimeSeriesFactorModel. #' @param digits. integer indicating the number of decimal places. Default is 3. #' @param ... arguments to be passed to print method. -#' @author Eric Zivot and Yi-An Chen. +#' @author Yi-An Chen. #' @examples #' #' # load data from the database Modified: pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd 2013-07-25 20:30:30 UTC (rev 2646) @@ -61,12 +61,12 @@ is TRUE, these are the weights used in the weighted least squares regressions. If "cov = robust" these values are computed with "scale.tau". Otherwise they are computed - with "var". \item factors A "xts" object containing the - times series of estimated factor returns and intercepts. - \item residuals A "xts" object containing the time series - of residuals for each asset. \item tstats A "xts" object - containing the time series of t-statistics for each - exposure. \item call function call } + with "var". \item factor.returns A "xts" object + containing the times series of estimated factor returns + and intercepts. \item residuals A "xts" object containing + the time series of residuals for each asset. \item tstats + A "xts" object containing the time series of t-statistics + for each exposure. \item call function call } } \description{ fit fundamental factor model or cross-sectional time @@ -93,7 +93,7 @@ data(stock) # there are 447 assets exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -ttest.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, +test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, datevar = "DATE", returnsvar = "RETURN", assetvar = "TICKER", wls = TRUE, regression = "classic", Modified: pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd 2013-07-25 20:30:30 UTC (rev 2646) @@ -3,7 +3,7 @@ \title{plot FundamentalFactorModel object.} \usage{ plot.FundamentalFactorModel(fit.fund, - which.plot = c("none", "1L", "2L", "3L", "4L"), + which.plot = c("none", "1L", "2L", "3L", "4L", "5L", "6L"), max.show = 4, plot.single = FALSE, asset.name, which.plot.single = c("none", "1L", "2L", "3L", "4L", "5L", "6L", "7L", "8L", "9L"), legend.txt = TRUE, ...) Added: pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd (rev 0) +++ pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd 2013-07-25 20:30:30 UTC (rev 2646) @@ -0,0 +1,37 @@ +\name{print.FundamentalFactorModel} +\alias{print.FundamentalFactorModel} +\title{print FundamentalFactorModel object} +\usage{ + print.FundamentalFactorModel(fit.fund, + digits = max(3, .Options$digits - 3), ...) +} +\arguments{ + \item{fit.fund}{fit object created by + fitFundamentalFactorModel.} + + \item{digits}{integer indicating the number of decimal + places. Default is 3.} + + \item{...}{Other arguments for print methods.} +} +\description{ + Generic function of print method for + fitFundamentalFactorModel. +} +\examples{ +data(stock) +# there are 447 assets +exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, + datevar = "DATE", returnsvar = "RETURN", + assetvar = "TICKER", wls = TRUE, + regression = "classic", + covariance = "classic", full.resid.cov = TRUE, + robust.scale = TRUE) + +print(test.fit) +} +\author{ + Yi-An Chen. +} + Modified: pkg/FactorAnalytics/man/print.StatFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/print.StatFactorModel.Rd 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/man/print.StatFactorModel.Rd 2013-07-25 20:30:30 UTC (rev 2646) @@ -7,7 +7,7 @@ } \arguments{ \item{fit.stat}{fit object created by - fitMacroeconomicFactorModel.} + fitStatisticalFactorModel.} \item{digits}{integer indicating the number of decimal places. Default is 3.} Modified: pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd 2013-07-25 18:50:32 UTC (rev 2645) +++ pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd 2013-07-25 20:30:30 UTC (rev 2646) @@ -27,6 +27,6 @@ print(fit.macro) } \author{ - Eric Zivot and Yi-An Chen. + Yi-An Chen. } From noreply at r-forge.r-project.org Fri Jul 26 00:12:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 26 Jul 2013 00:12:37 +0200 (CEST) Subject: [Returnanalytics-commits] r2647 - pkg/FactorAnalytics/R Message-ID: <20130725221237.875D5184D4D@r-forge.r-project.org> Author: chenyian Date: 2013-07-26 00:12:37 +0200 (Fri, 26 Jul 2013) New Revision: 2647 Modified: pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r Log: revise summary.TimeSeriesFactorModel.r to matrix look. Modified: pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 20:30:30 UTC (rev 2646) +++ pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r 2013-07-25 22:12:37 UTC (rev 2647) @@ -34,14 +34,5 @@ print(fit.macro$r2, digits = digits, ...) cat("\nResidual Variance:\n") print(fit.macro$resid.variance, digits = digits, ...) - -# n <- length(fit.macro$beta) -# table.macro <- as.matrix(fit.macro$alpha,nrow=n[1]) -# table.macro <- cbind(table.macro,fit.macro$beta,fit.macro$r2,fit.macro$resid.variance) -# beta.names <- colnames(fit.macro$beta) -# for (i in 1:length(beta.names)) { -# beta.names[i] <- paste("beta.",beta.names[i],sep="") -# } -# colnames(table.macro) <- c("alpha",beta.names,"r2","resid.var") -# print(round(table.macro,digits=digits)) + } Modified: pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r 2013-07-25 20:30:30 UTC (rev 2646) +++ pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r 2013-07-25 22:12:37 UTC (rev 2647) @@ -11,8 +11,6 @@ #' #' # load data from the database #' data(managers.df) -#' ret.assets = managers.df[,(1:6)] -#' factors = managers.df[,(7:9)] #' # fit the factor model with OLS #' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), #' factors.names=c("EDHEC.LS.EQ","SP500.TR"), @@ -21,7 +19,21 @@ #' #' @export #' -summary.TimeSeriesFactorModel <- function(fit,...){ - lapply(fit[[1]], summary,...) +summary.TimeSeriesFactorModel <- function(fit,digits=3){ + if(!is.null(cl <- fit.macro$call)) { + cat("\nCall:\n") + dput(cl) } + cat("\nFactor Betas\n") + n <- length(fit.macro$assets.names) + for (i in 1:n) { + options(digits = digits) + cat("\n", fit.macro$assets.names[i], "\n") + table.macro <- t(summary(fit.macro$asset.fit[[i]])$coefficients) + colnames(table.macro)[1] <- "alpha" + print(table.macro,digits = digits) + cat("\nR-square =", fit.macro$r2[i] ,",residual variance =" + , fit.macro$resid.variance[i],"\n") + } +} From noreply at r-forge.r-project.org Fri Jul 26 17:25:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 26 Jul 2013 17:25:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2648 - in pkg/PerformanceAnalytics/sandbox/pulkit: week3_4/code week5 Message-ID: <20130726152501.579551845BC@r-forge.r-project.org> Author: pulkit Date: 2013-07-26 17:25:01 +0200 (Fri, 26 Jul 2013) New Revision: 2648 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R Log: Economic Drawdown Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R 2013-07-25 22:12:37 UTC (rev 2647) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R 2013-07-26 15:25:01 UTC (rev 2648) @@ -1,5 +1,19 @@ +## A set of functions for Triple Penance Rule +## +## These set of functions are used for calculating Maximum Drawdown and Maximum Time under water +## for different distributions such as normal and non-normal. +## +## FUNCTIONS: +## dd_norm +## tuw_norm +## get_minq +## getQ +## get_TuW +## +## REFERENCE: +## Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs +## and the ?Triple Penance? Rule(January 1, 2013). - dd_norm<-function(x,confidence){ # DESCRIPTION: # A function to return the maximum drawdown for a normal distribution @@ -79,6 +93,7 @@ # dp0: The r0 or the first return # # confidence: The confidence level of the quantile function + mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets var = sigma^2/(phi-1)^2 var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1) @@ -116,6 +131,24 @@ diff_Q<-function(bets,phi,mu,sigma,dp0,confidence){ + + # DESCRIPTION: + # The functions to be minimized to calculate the maximum Time Under water using + # Golden section algorithm + # + # Inputs: + # bets: The number fo steps + # + # phi: The coefficient for AR[1] + # + # mu: The mean of the returns + # + # sigma: The standard deviation of the returns + # + # dp0: The r0 or the first return + # + # confidence: The confidence level of the quantile function + return(abs(getQ(bets,phi,mu,sigma,dp0,confidence))) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-25 22:12:37 UTC (rev 2647) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-26 15:25:01 UTC (rev 2648) @@ -75,10 +75,9 @@ dynamicPort<-function(x,column){ if(type == "calibrated"){ if(asset == "one"){ + mu = mean(x[,column]) factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2) - print(factor) xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) - print(sd[,column]) } if(asset == "two"){ if(column == 1){ Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R 2013-07-26 15:25:01 UTC (rev 2648) @@ -0,0 +1,84 @@ +#'@title Calculate the Economic Drawdown +#' +#'@description +#'\code{EconomicDrawdown} calculates the Economic Drawdown(EDD) for +#'a return series.To calculate the economic drawdown cumulative +#'return and economic max is calculated for each point. The risk +#'free return(rf) is taken as the input. +#' +#'Economic Drawdown is given by the equation +#' +#'\deqn{EDD(t)=1-\frac{W_t}/{EM(t)}} +#' +#'Here EM stands for Economic Max and is the code \code{\link{EconomicMax}} +#' +#' +#'@param R an xts, vector, matrix, data frame, timeseries, or zoo object of asset return. +#'@param Rf risk free rate can be vector such as government security rate of return +#'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining(FALSE) +#'to aggregate returns, default is TRUE +#'@param \dots any other variable +#'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to +#'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012) +#'@examples +#'EconomicDrawdown(edhec,0.08,100) +#' +#' @export +EconomicDrawdown<-function(R,Rf, geometric = TRUE,...) +{ + + # DESCRIPTION: + # calculates the Economic Drawdown(EDD) for + # a return series.To calculate the economic drawdown cumulative + # return and rolling economic max is calculated for each point. The risk + # free return(rf) is taken as the input. + + # FUNCTION: + x = checkData(R) + columns = ncol(x) + n = nrow(x) + columnnames = colnames(x) + rf = checkData(Rf) + nr = length(Rf) + if(nr != 1 && nr != n ){ + stop("The number of rows of the returns and the risk free rate do not match") + } + + EDD<-function(xh,geometric){ + if(geometric) + Return.cumulative = cumprod(1+xh) + else Return.cumulative = 1 + cumsum(xh) + l = length(Return.cumulative) + if(nr == 1){ + EM = max(Return.cumulative*(1+rf)^(l-c(1:l))) + } + else{ + rf = rf[index(xh)] + prodRf = cumprod(1+rf) + EM = max(Return.cumulative*as.numeric(last(prodRf)/prodRf)) + } + result = 1 - last(Return.cumulative)/EM + } + + for(column in 1:columns){ + column.drawdown <- as.xts(apply.fromstart(x[,column], FUN = EDD, geometric = geometric,gap = 1)) + if(column == 1) + Economicdrawdown = column.drawdown + else Economicdrawdown = merge(Economicdrawdown, column.drawdown) + } + colnames(Economicdrawdown) = columnnames + Economicdrawdown = reclass(Economicdrawdown, x) + return(Economicdrawdown) +} + +############################################################################### +# 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: edd.R $ +# +############################################################################## From noreply at r-forge.r-project.org Fri Jul 26 20:08:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 26 Jul 2013 20:08:20 +0200 (CEST) Subject: [Returnanalytics-commits] r2649 - in pkg/FactorAnalytics: R data man Message-ID: <20130726180820.CE3031858CA@r-forge.r-project.org> Author: chenyian Date: 2013-07-26 20:08:20 +0200 (Fri, 26 Jul 2013) New Revision: 2649 Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R pkg/FactorAnalytics/R/summary.StatFactorModel.r pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r pkg/FactorAnalytics/data/stock.RDATA pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd pkg/FactorAnalytics/man/summary.StatFactorModel.Rd pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd Log: add summary.StatFactorModel.Rd and summary.StatFactorModel.r Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-07-26 18:08:20 UTC (rev 2649) @@ -5,7 +5,7 @@ #' #' #' @param data a vector, matrix, data.frame, xts, timeSeries or zoo object with asset returns -#' and factors retunrs rownames +#' and factors retunrs names #' @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. @@ -393,6 +393,7 @@ ans$resid.variance <- apply(ans$residuals,2,var) ans$call <- call ans$data <- data + ans$assets.names <- colnames(data) class(ans) <- "StatFactorModel" return(ans) } Modified: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-07-26 18:08:20 UTC (rev 2649) @@ -66,7 +66,7 @@ #' chart.TimeSeries(dataToPlot, main="FM fit for HAM1", #' colorset=c("black","blue"), legend.loc="bottomleft") #' } -fitTimeseriesFactorModel <- +fitTimeSeriesFactorModel <- function(assets.names, factors.names, data=data, num.factor.subset = 1, fit.method=c("OLS","DLS","Robust"), variable.selection="none", Modified: pkg/FactorAnalytics/R/summary.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/summary.StatFactorModel.r 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/R/summary.StatFactorModel.r 2013-07-26 18:08:20 UTC (rev 2649) @@ -1,24 +1,38 @@ #' summary method for StatFactorModel object. #' -#' Generic function of summary method for fitStatisticalFactorModel. It utilizes -#' function \code{summary.lm}. +#' Generic function of summary method for fitStatisticalFactorModel. #' -#' @param fit "StatFactorModel" object created by fitStatisticalFactorModel. -#' @param newdata An optional data frame in which to look for variables with which to predict. -#' If omitted, the fitted values are used. -#' @param ... Any other arguments used in \code{summary.lm} +#' +#' @param fit.stat fit.stat object created by fitStatisticalFactorModel. +#' @param digits Integer indicating the number of decimal places. Default is 3. +#' @param ... other option used in \code{summary.lm} #' @author Yi-An Chen. -#' ' #' @examples -#' data(stat.fm.data) -#'.fit <- fitStatisticalFactorModel(sfm.dat,k=2, -# ckeckData.method="data.frame") #' +#' # load data from the database +#' data(managers.df) +#' # fit the factor model with OLS +#' fit <- fitStatisticalFactorModel(fitStatisticalFactorModel(sfm.dat,k=2, +#' ckeckData.method="data.frame")) #' summary(fit) +#' #' @export #' +summary.StatFactorModel <- function(fit.stat,digits=3){ + if(!is.null(cl <- fit.stat$call)) { + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Betas\n") + n <- length(fit.stat$assets.names) + for (i in 1:n) { + options(digits = digits) + cat("\n", fit.stat$assets.names[i], "\n") + table.macro <- t(summary(fit.stat$asset.fit[[i]])$coefficients) + colnames(table.macro)[1] <- "alpha" + print(table.macro,digits = digits) + cat("\nR-square =", fit.stat$r2[i] ,",residual variance =" + , fit.stat$resid.variance[i],"\n") + } +} - -summary.StatFactorModel <- function(fit,...){ - lapply(fit$asset.fit, summary,...) -} \ No newline at end of file Modified: pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r 2013-07-26 18:08:20 UTC (rev 2649) @@ -1,10 +1,10 @@ #' summary method for TimeSeriesModel object. #' #' Generic function of summary method for fitTimeSeriesFactorModel. -#' It utilizes \code{summary.lm} #' #' -#' @param fit fit object created by fitTimeSeiresFactorModel. +#' @param fit.macro fit.macro object created by fitTimeSeiresFactorModel. +#' @param digits Integer indicating the number of decimal places. Default is 3. #' @param ... other option used in \code{summary.lm} #' @author Yi-An Chen. #' @examples @@ -19,7 +19,7 @@ #' #' @export #' -summary.TimeSeriesFactorModel <- function(fit,digits=3){ +summary.TimeSeriesFactorModel <- function(fit.macro,digits=3){ if(!is.null(cl <- fit.macro$call)) { cat("\nCall:\n") dput(cl) Modified: pkg/FactorAnalytics/data/stock.RDATA =================================================================== (Binary files differ) Modified: pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd 2013-07-26 18:08:20 UTC (rev 2649) @@ -9,7 +9,7 @@ \arguments{ \item{data}{a vector, matrix, data.frame, xts, timeSeries or zoo object with asset returns and factors retunrs - rownames} + names} \item{k}{numbers of factors if it is scalar or method of choosing optimal number of factors. "bn" represents Bai Modified: pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/man/fitTimeseriesFactorModel.Rd 2013-07-26 18:08:20 UTC (rev 2649) @@ -1,8 +1,8 @@ -\name{fitTimeseriesFactorModel} -\alias{fitTimeseriesFactorModel} +\name{fitTimeSeriesFactorModel} +\alias{fitTimeSeriesFactorModel} \title{Fit time series factor model by time series regression techniques.} \usage{ - fitTimeseriesFactorModel(assets.names, factors.names, + fitTimeSeriesFactorModel(assets.names, factors.names, data = data, num.factor.subset = 1, fit.method = c("OLS", "DLS", "Robust"), variable.selection = "none", decay.factor = 0.95, Modified: pkg/FactorAnalytics/man/summary.StatFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/summary.StatFactorModel.Rd 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/man/summary.StatFactorModel.Rd 2013-07-26 18:08:20 UTC (rev 2649) @@ -2,30 +2,30 @@ \alias{summary.StatFactorModel} \title{summary method for StatFactorModel object.} \usage{ - summary.StatFactorModel(fit, ...) + summary.StatFactorModel(fit.stat, digits = 3) } \arguments{ - \item{fit}{"StatFactorModel" object created by + \item{fit.stat}{fit.stat object created by fitStatisticalFactorModel.} - \item{newdata}{An optional data frame in which to look - for variables with which to predict. If omitted, the - fitted values are used.} + \item{digits}{Integer indicating the number of decimal + places. Default is 3.} - \item{...}{Any other arguments used in \code{summary.lm}} + \item{...}{other option used in \code{summary.lm}} } \description{ Generic function of summary method for - fitStatisticalFactorModel. It utilizes function - \code{summary.lm}. + fitStatisticalFactorModel. } \examples{ -data(stat.fm.data) -.fit <- fitStatisticalFactorModel(sfm.dat,k=2, - +# load data from the database +data(managers.df) +# fit the factor model with OLS +fit <- fitStatisticalFactorModel(fitStatisticalFactorModel(sfm.dat,k=2, + ckeckData.method="data.frame")) summary(fit) } \author{ - Yi-An Chen. ' + Yi-An Chen. } Modified: pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd 2013-07-26 15:25:01 UTC (rev 2648) +++ pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd 2013-07-26 18:08:20 UTC (rev 2649) @@ -2,23 +2,24 @@ \alias{summary.TimeSeriesFactorModel} \title{summary method for TimeSeriesModel object.} \usage{ - summary.TimeSeriesFactorModel(fit, ...) + summary.TimeSeriesFactorModel(fit.macro, digits = 3) } \arguments{ - \item{fit}{fit object created by + \item{fit.macro}{fit.macro object created by fitTimeSeiresFactorModel.} + \item{digits}{Integer indicating the number of decimal + places. Default is 3.} + \item{...}{other option used in \code{summary.lm}} } \description{ Generic function of summary method for - fitTimeSeriesFactorModel. It utilizes \code{summary.lm} + fitTimeSeriesFactorModel. } \examples{ # load data from the database data(managers.df) -ret.assets = managers.df[,(1:6)] -factors = managers.df[,(7:9)] # fit the factor model with OLS fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]), factors.names=c("EDHEC.LS.EQ","SP500.TR"), From noreply at r-forge.r-project.org Fri Jul 26 21:45:12 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 26 Jul 2013 21:45:12 +0200 (CEST) Subject: [Returnanalytics-commits] r2650 - in pkg/FactorAnalytics: R man Message-ID: <20130726194513.14DB418518B@r-forge.r-project.org> Author: chenyian Date: 2013-07-26 21:45:12 +0200 (Fri, 26 Jul 2013) New Revision: 2650 Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R pkg/FactorAnalytics/R/summary.FundamentalFactorModel.r pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd Log: add summary.FundamentalFactorModel.Rd and summary.FundamentalFactorModel.r Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R =================================================================== --- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-26 18:08:20 UTC (rev 2649) +++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-07-26 19:45:12 UTC (rev 2650) @@ -411,8 +411,10 @@ # SSE <- apply(fit.fund$residuals^2,2,sum) # SST <- tapply(data[,returnsvar],data[,assetvar],function(x) sum((x-mean(x))^2)) # r2 <- 1- SSE/SST - +# change names for intercept +colnames(f.hat)[1] <- "Intercept" + output <- list(returns.cov = Cov.returns, factor.cov = Cov.factors, resids.cov = Cov.resids, Modified: pkg/FactorAnalytics/R/summary.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/summary.FundamentalFactorModel.r 2013-07-26 18:08:20 UTC (rev 2649) +++ pkg/FactorAnalytics/R/summary.FundamentalFactorModel.r 2013-07-26 19:45:12 UTC (rev 2650) @@ -1,18 +1,48 @@ -#' summary method for FundamentalFactorModel +#' summary FundamentalFactorModel object #' -#' Generic function of summary method for fitTimeSeriesFactorModel. +#' Generic function of summary method for fitFundamentalFactorModel. #' -#' @param fit it object created by fitFundamentalFactorModel. #' -#' @author Yi-An Chen +#' @param fit.fund fit object created by fitFundamentalFactorModel. +#' @param digits integer indicating the number of decimal places. Default is 3. +#' @param ... Other arguments for print methods. +#' @author Yi-An Chen. +#' @examples #' +#' data(stock) +#' # there are 447 assets +#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, +#' datevar = "DATE", returnsvar = "RETURN", +#' assetvar = "TICKER", wls = TRUE, +#' regression = "classic", +#' covariance = "classic", full.resid.cov = TRUE, +#' robust.scale = TRUE) #' +#' summary(test.fit) #' -#' @export -#' - -summary.FundamentalFactorModel <- function(fit) { -dim(fit$factors) -print(fit$factors) +#' @export +summary.FundamentalFactorModel <- + function(fit.fund, digits = max(3, .Options$digits - 3), ...) + { + if(!is.null(cl <- fit.fund$call)) { + cat("\nCall:\n") + dput(cl) + } -} \ No newline at end of file + cat("\nFactor Returns:\n") + n <- dim(fit.fund$factor.returns)[1] + k <- dim(fit.fund$factor.returns)[2] + se.beta <- fit.fund$factor.returns/fit.fund$tstat + pvalue <- 1- pt(fit.fund$tstat,df=n-k) + table.fund <- cbind(fit.fund$factor.returns[,1],se.beta[,1],fit.fund$tstat[,1]) + f.names <- colnames(fit.fund$factor.returns) + for (i in 1:k) { + cat("\n",f.names[i],"\n") + table.fund <- cbind(fit.fund$factor.returns[,i],se.beta[,i],fit.fund$tstat[,i],pvalue[,i]) + colnames(table.fund)[1:4] <- c("Estimate","Std. Error","t value","Pr(>|t|)") + print(table.fund, digits = digits,...) + } + cat("\nResidual Variance:\n") + print(fit.fund$resid.variance, digits = digits, ...) + } Modified: pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd 2013-07-26 18:08:20 UTC (rev 2649) +++ pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd 2013-07-26 19:45:12 UTC (rev 2650) @@ -1,18 +1,37 @@ \name{summary.FundamentalFactorModel} \alias{summary.FundamentalFactorModel} -\title{summary method for FundamentalFactorModel} +\title{summary FundamentalFactorModel object} \usage{ - summary.FundamentalFactorModel(fit) + summary.FundamentalFactorModel(fit.fund, + digits = max(3, .Options$digits - 3), ...) } \arguments{ - \item{fit}{it object created by + \item{fit.fund}{fit object created by fitFundamentalFactorModel.} + + \item{digits}{integer indicating the number of decimal + places. Default is 3.} + + \item{...}{Other arguments for print methods.} } \description{ Generic function of summary method for - fitTimeSeriesFactorModel. + fitFundamentalFactorModel. } +\examples{ +data(stock) +# there are 447 assets +exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") +test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names, + datevar = "DATE", returnsvar = "RETURN", + assetvar = "TICKER", wls = TRUE, + regression = "classic", + covariance = "classic", full.resid.cov = TRUE, + robust.scale = TRUE) + +summary(test.fit) +} \author{ - Yi-An Chen + Yi-An Chen. } From noreply at r-forge.r-project.org Sat Jul 27 12:10:07 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 27 Jul 2013 12:10:07 +0200 (CEST) Subject: [Returnanalytics-commits] r2651 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: Week1 Week1/Code Week1/Vignette Week4/Code Week5/Code Message-ID: <20130727101007.E7115184BAE@r-forge.r-project.org> Author: shubhanm Date: 2013-07-27 12:10:07 +0200 (Sat, 27 Jul 2013) New Revision: 2651 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Return.Okunev.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-Graph1.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-Graph10.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/Rplots.pdf Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Code/CDrawdown.R Log: Modified : Week 5 and Week 1 Code Final Vignette : Week 1 Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R 2013-07-26 19:45:12 UTC (rev 2650) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/LoSharpe.R 2013-07-27 10:10:07 UTC (rev 2651) @@ -1,31 +1,31 @@ -#'@title Andrew Lo Sharpe Ratio -#'@description -#' Although the Sharpe ratio has become part of the canon of modern financial -#' analysis, its applications typically do not account for the fact that it is an -#' estimated quantity, subject to estimation errors that can be substantial in -#' some cases. -#' -#' Many studies have documented various violations of the assumption of -#' IID returns for financial securities. -#' -#' Under the assumption of stationarity,a version of the Central Limit Theorem can -#' still be applied to the estimator . -#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of -#' daily asset returns -#' @param Rf an xts, vector, matrix, data frame, timeSeries or zoo object of -#' annualized Risk Free Rate -#' @param q Number of autocorrelated lag periods. Taken as 3 (Default) -#' @param \dots any other passthru parameters -#' @author R -#' @references "The Statistics of Sharpe Ratios" Andrew. W. Lo -#' -#' @keywords ts multivariate distribution models non-iid -#' @examples -#' -#' data(edhec) -#' head(LoSharpe(edhec,0,3) -#' -#' @export +##'@title Andrew Lo Sharpe Ratio +##'@description +##' Although the Sharpe ratio has become part of the canon of modern financial +##' analysis, its applications typically do not account for the fact that it is an +##' estimated quantity, subject to estimation errors that can be substantial in +##' some cases. +##' +##' Many studies have documented various violations of the assumption of +##' IID returns for financial securities. +##' +##' Under the assumption of stationarity,a version of the Central Limit Theorem can +##' still be applied to the estimator . +##' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of +##' daily asset returns +##' @param Rf an xts, vector, matrix, data frame, timeSeries or zoo object of +##' annualized Risk Free Rate +##' @param q Number of autocorrelated lag periods. Taken as 3 (Default) +##' @param \dots any other passthru parameters +##' @author R +##' @references "The Statistics of Sharpe Ratios" Andrew. W. Lo +##' +##' @keywords ts multivariate distribution models non-iid +##' @examples +##' +##' data(edhec) +##' head(LoSharpe(edhec,0,3) +##' +##' @export LoSharpe <- function (Ra,Rf = 0,q = 3, ...) { # @author Brian G. Peterson, Peter Carl Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R 2013-07-26 19:45:12 UTC (rev 2650) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Code/Return.Okunev.R 2013-07-27 10:10:07 UTC (rev 2651) @@ -1,12 +1,3 @@ -quad <- function(R,d) -{ - coeff = as.numeric(acf(as.numeric(edhec[,1]), plot = FALSE)[1:2][[1]]) -b=-(1+coeff[2]-2*d*coeff[1]) -c=(coeff[1]-d) - ans= (-b-sqrt(b*b-4*c*c))/(2*c) - a <- a[!is.na(a)] - return(c(ans)) -} Return.Okunev<-function(R,q=3) { column.okunev=R @@ -18,3 +9,13 @@ } return(c(column.okunev)) } + +quad <- function(R,d) +{ + coeff = as.numeric(acf(as.numeric(edhec[,1]), plot = FALSE)[1:2][[1]]) +b=-(1+coeff[2]-2*d*coeff[1]) +c=(coeff[1]-d) + ans= (-b-sqrt(b*b-4*c*c))/(2*c) + #a <- a[!is.na(a)] + return(c(ans)) +} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Return.Okunev.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Return.Okunev.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Return.Okunev.R 2013-07-27 10:10:07 UTC (rev 2651) @@ -0,0 +1,20 @@ +quad <- function(R,d) +{ + coeff = as.numeric(acf(as.numeric(edhec[,1]), plot = FALSE)[1:2][[1]]) +b=-(1+coeff[2]-2*d*coeff[1]) +c=(coeff[1]-d) + ans= (-b-sqrt(b*b-4*c*c))/(2*c) + a <- a[!is.na(a)] + return(c(ans)) +} +Return.Okunev<-function(R,q=3) +{ + column.okunev=R + column.okunev <- column.okunev[!is.na(column.okunev)] + for(i in 1:q) + { + lagR = lag(column.okunev, k=i) + column.okunev= (column.okunev-(lagR*quad(lagR,0)))/(1-quad(lagR,0)) + } + return(c(column.okunev)) +} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.Rnw 2013-07-27 10:10:07 UTC (rev 2651) @@ -0,0 +1,107 @@ +%% no need for \DeclareGraphicsExtensions{.pdf,.eps} + +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +%\usepackage{noweb} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{Performance Attribution from Bacon} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{returns, performance, risk, benchmark, portfolio} +%\VignettePackage{PerformanceAnalytics} + +%\documentclass[a4paper]{article} +%\usepackage[noae]{Sweave} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage[top=3cm, bottom=3cm, left=2.5cm]{geometry} +%\usepackage{graphicx} +%\usepackage{graphicx, verbatim} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage{graphicx} + +\title{GLM Smoothing Index} +\author{R Project for Statistical Computing} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\maketitle + + +\begin{abstract} +The returns to hedge funds and other alternative investments are often highly serially correlated.Gemanstsy,Lo and Markov propose an econometric model of return smoothingand develop estimators for the smoothing profile.The magnitude of impact is measured by the smoothing index, which is a measure of concentration of weight in lagged terms. +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) +@ + +<>= +source("../code/GLMSmoothIndex.R") +@ + +\section{Background} +To quantify the impact of all of these possible sources of serial correlation, denote by \(R_t\),the true economic return of a hedge fund in period t; and let \(R_t\) satisfy the following linear single-factor model: + +\begin{equation} + R_t = \\ {\mu} + {\beta}{{\delta}}_t+ \xi_t +\end{equation} + +Where $\xi_t, \sim N(0,1)$ +and Var[\(R_t\)] = $\sigma$\ \(^2\) + +True returns represent the flow of information that would determine the equilibrium value of the fund's securities in a frictionless market. However, true economic returns are not observed. Instead, \(R_t^0\) denotes the reported or observed return in period t; and let +%$Z = \sin(X)$. $\sqrt{X}$. + +%$\hat{\mu}$ = $\displaystyle\frac{22}{7}$ +%e^{2 \mu} = 1 +%\begin{equation} +%\left(\sum_{t=1}^{T} R_t/T\right) = \hat{\mu} \\ +%\end{equation} +\begin{equation} + R_t^0 = \theta _0R_{t} + \theta _1R_{t-1}+\theta _2R_{t-2} + \cdots + \theta _kR_{t-k}\\ +\end{equation} +\begin{equation} +\theta _j \epsilon [0,1] where : j = 0,1, \cdots , k \\ +\end{equation} + +and +%\left(\mu \right) = \sum_{t=1}^{T} \(Ri)/T\ \\ +\begin{equation} +\theta _1 + \theta _2 + \theta _3 \cdots + \theta _k = 1 \\ +\end{equation} + +which is a weighted average of the fund's true returns over the most recent k + 1 +periods, including the current period. + +\section{Smoothing Index} +A useful summary statistic for measuringthe concentration of weights is : +\begin{equation} +\xi = \sum_{j=0}^{k} \theta _j^2 \\ +\end{equation} + +This measure is well known in the industrial organization literature as the Herfindahl index, a measure of the concentration of firms in a given industry where $\theta$\(_j\) represents the market share of firm j. Becaus $\xi_t$\ is confined to the unit interval, and is minimized when all the $\theta$\(_j\) 's are identical, which implies a value of 1/k+1 for $\xi_i$\ ; and is maximized when one coefficient is 1 and the rest are 0. In the context of smoothed returns, a lower value of implies more smoothing, and the upper bound of 1 implies no smoothing, hence we shall refer to $\theta$\(_j\) as a ''\textbf{smoothingindex}''. + +\section{Usage} + +In this example we use edhec database, to compute Smoothing Index for Hedge Fund Returns. +<<>>= +library(PerformanceAnalytics) +data(edhec) +GLMSmoothIndex(edhec) +@ + + +\end{document} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/GLMSmoothIndex.tex 2013-07-27 10:10:07 UTC (rev 2651) @@ -0,0 +1,112 @@ +%% no need for \DeclareGraphicsExtensions{.pdf,.eps} + +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +%\usepackage{noweb} +\usepackage{Rd} + +\usepackage{Sweave} + +%\VignetteIndexEntry{Performance Attribution from Bacon} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{returns, performance, risk, benchmark, portfolio} +%\VignettePackage{PerformanceAnalytics} + +%\documentclass[a4paper]{article} +%\usepackage[noae]{Sweave} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage[top=3cm, bottom=3cm, left=2.5cm]{geometry} +%\usepackage{graphicx} +%\usepackage{graphicx, verbatim} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage{graphicx} + +\title{GLM Smoothing Index} +\author{R Project for Statistical Computing} + +\begin{document} +\input{GLMSmoothIndex-concordance} + +\maketitle + + +\begin{abstract} +The returns to hedge funds and other alternative investments are often highly serially correlated.Gemanstsy,Lo and Markov propose an econometric model of return smoothingand develop estimators for the smoothing profile.The magnitude of impact is measured by the smoothing index, which is a measure of concentration of weight in lagged terms. +\end{abstract} + + + +\section{Background} +To quantify the impact of all of these possible sources of serial correlation, denote by \(R_t\),the true economic return of a hedge fund in period t; and let \(R_t\) satisfy the following linear single-factor model: + +\begin{equation} + R_t = \\ {\mu} + {\beta}{{\delta}}_t+ \xi_t +\end{equation} + +Where $\xi_t, \sim N(0,1)$ +and Var[\(R_t\)] = $\sigma$\ \(^2\) + +True returns represent the flow of information that would determine the equilibrium value of the fund's securities in a frictionless market. However, true economic returns are not observed. Instead, \(R_t^0\) denotes the reported or observed return in period t; and let +%$Z = \sin(X)$. $\sqrt{X}$. + +%$\hat{\mu}$ = $\displaystyle\frac{22}{7}$ +%e^{2 \mu} = 1 +%\begin{equation} +%\left(\sum_{t=1}^{T} R_t/T\right) = \hat{\mu} \\ +%\end{equation} +\begin{equation} + R_t^0 = \theta _0R_{t} + \theta _1R_{t-1}+\theta _2R_{t-2} + \cdots + \theta _kR_{t-k}\\ +\end{equation} +\begin{equation} +\theta _j \epsilon [0,1] where : j = 0,1, \cdots , k \\ +\end{equation} + +and +%\left(\mu \right) = \sum_{t=1}^{T} \(Ri)/T\ \\ +\begin{equation} +\theta _1 + \theta _2 + \theta _3 \cdots + \theta _k = 1 \\ +\end{equation} + +which is a weighted average of the fund's true returns over the most recent k + 1 +periods, including the current period. + +\section{Smoothing Index} +A useful summary statistic for measuringthe concentration of weights is : +\begin{equation} +\xi = \sum_{j=0}^{k} \theta _j^2 \\ +\end{equation} + +This measure is well known in the industrial organization literature as the Herfindahl index, a measure of the concentration of firms in a given industry where $\theta$\(_j\) represents the market share of firm j. Becaus $\xi_t$\ is confined to the unit interval, and is minimized when all the $\theta$\(_j\) 's are identical, which implies a value of 1/k+1 for $\xi_i$\ ; and is maximized when one coefficient is 1 and the rest are 0. In the context of smoothed returns, a lower value of implies more smoothing, and the upper bound of 1 implies no smoothing, hence we shall refer to $\theta$\(_j\) as a ''\textbf{smoothingindex}''. + +\section{Usage} + +In this example we use edhec database, to compute Smoothing Index for Hedge Fund Returns. +\begin{Schunk} +\begin{Sinput} +> library(PerformanceAnalytics) +> data(edhec) +> GLMSmoothIndex(edhec) +\end{Sinput} +\begin{Soutput} + Convertible Arbitrage CTA Global Distressed Securities +GLM Smooth Index 0.3487825 0.1866095 0.3187229 + Emerging Markets Equity Market Neutral Event Driven +GLM Smooth Index 0.3022908 0.2046973 0.3580198 + Fixed Income Arbitrage Global Macro Long/Short Equity +GLM Smooth Index 0.3090088 0.252546 0.277132 + Merger Arbitrage Relative Value Short Selling Funds of Funds +GLM Smooth Index 0.2292355 0.2917355 0.2348319 0.2873716 +\end{Soutput} +\end{Schunk} + + +\end{document} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio-concordance.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio-concordance.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio-concordance.tex 2013-07-27 10:10:07 UTC (rev 2651) @@ -0,0 +1,2 @@ +\Sconcordance{concordance:LoSharpeRatio.tex:LoSharpeRatio.Rnw:% +1 50 1 1 5 1 4 50 1 1 2 1 0 2 1 13 0 1 2 2 1} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.Rnw 2013-07-27 10:10:07 UTC (rev 2651) @@ -0,0 +1,118 @@ +%% no need for \DeclareGraphicsExtensions{.pdf,.eps} + +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +%\usepackage{noweb} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{Performance Attribution from Bacon} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{returns, performance, risk, benchmark, portfolio} +%\VignettePackage{PerformanceAnalytics} + +%\documentclass[a4paper]{article} +%\usepackage[noae]{Sweave} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage[top=3cm, bottom=3cm, left=2.5cm]{geometry} +%\usepackage{graphicx} +%\usepackage{graphicx, verbatim} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage{graphicx} + +\title{Lo Sharpe Ratio} +\author{R Project for Statistical Computing} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\maketitle + + +\begin{abstract} +The building blocks of the Sharpe ratio-expected returns and volatilities- +are unknown quantities that must be estimated statistically and are, +therefore, subject to estimation error.In an illustrative +empirical example of mutual funds and hedge funds, Andrew Lo finds that the annual Sharpe ratio for a hedge fund can be overstated by as much as 65 percent +because of the presence of serial correlation in monthly returns, and once +this serial correlation is properly taken into account, the rankings of hedge +funds based on Sharpe ratios can change dramatically. +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) +@ + +<>= +source("../code/LoSharpe.R") +@ + +\section{Background} +Given a sample of historical returns \((R_1,R_2, . . .,R_T)\), the standard estimators for these moments are the sample mean and variance: + +%Let $X \sim N(0,1)$ and $Y \sim \textrm{Exponential}(\mu)$. Let +%$Z = \sin(X)$. $\sqrt{X}$. + +%$\hat{\mu}$ = $\displaystyle\frac{22}{7}$ +%e^{2 \mu} = 1 +%\begin{equation} +%\left(\sum_{t=1}^{T} R_t/T\right) = \hat{\mu} \\ +%\end{equation} +\begin{equation} + \hat{\mu} = \sum_{t=1}^{T} (R_t)/T\\ +\end{equation} +\begin{equation} +\hat{\sigma^2} = \sum_{t=1}^{T} (R_t-\hat{\mu})^2/T\\ +\end{equation} + +From which the estimator of the Sharpe ratio $\hat{SR}$ follows immediately: +%\left(\mu \right) = \sum_{t=1}^{T} \(Ri)/T\ \\ +\begin{equation} +\hat{SR} = (\hat{\mu}- R_f)/\hat{\sigma} \\ +\end{equation} + +Using a set of techniques collectively known as "large-sample'' or "asymptotic'' statistical theory in which the Central Limit Theorem is applied to +estimators such as and , the distribution of and other nonlinear functions of and can be easily derived. + +\section{Non-IID Returns} +The relationship between SR and SR(q) is somewhat more involved for non- +IID returns because the variance of Rt(q) is not just the sum of the variances of component returns but also includes all the covariances. Specifically, under +the assumption that returns \(R_t\) are stationary, +\begin{equation} +Var[(R_t)] = \sum_{i=0}^{q-1} \sum_{j=1}^{q-1} Cov(R(t-i),R(t-j)) = q\hat{\sigma^2} + 2\hat{\sigma^2} \sum_{k=1}^{q-1} (q-k)\rho_k \\ +\end{equation} + +Where $\rho$\(_k\) = Cov(\(R(t)\),\(R(t-k\)))/Var[\(R_t\)] is the \(k^{th}\) order autocorrelation coefficient of the series of returns.This yields the following relationship between SR and SR(q): + +\begin{equation} +\hat{SR}(q) = \eta(q) \\ +\end{equation} + +Where : + +\begin{equation} +\eta(q) = \frac{q}{\sqrt{(q\hat{\sigma^2} + 2\hat{\sigma^2} \sum_{k=1}^{q-1} (q-k)\rho_k)}} \\ +\end{equation} + +\section{Usage} + +In this example we use edhec database, to compute Sharpe Ratio for Hedge Fund Returns. +<<>>= +library(PerformanceAnalytics) +data(edhec) +LoSharpe(edhec) +@ + + +\end{document} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.log =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.log (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/LoSharpeRatio.log 2013-07-27 10:10:07 UTC (rev 2651) @@ -0,0 +1,354 @@ +This is pdfTeX, Version 3.1415926-2.4-1.40.13 (MiKTeX 2.9) (preloaded format=pdflatex 2013.7.14) 26 JUL 2013 23:22 +entering extended mode +**LoSharpeRatio.tex + +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week1\Vignette\LoSharpeRatio.tex" +LaTeX2e <2011/06/27> +Babel and hyphenation patterns for english, afrikaans, ancientgreek, ar +abic, armenian, assamese, basque, bengali, bokmal, bulgarian, catalan, coptic, +croatian, czech, danish, dutch, esperanto, estonian, farsi, finnish, french, ga +lician, german, german-x-2012-05-30, greek, gujarati, hindi, hungarian, iceland +ic, indonesian, interlingua, irish, italian, kannada, kurmanji, latin, latvian, + lithuanian, malayalam, marathi, mongolian, mongolianlmc, monogreek, ngerman, n +german-x-2012-05-30, nynorsk, oriya, panjabi, pinyin, polish, portuguese, roman +ian, russian, sanskrit, serbian, slovak, slovenian, spanish, swedish, swissgerm +an, tamil, telugu, turkish, turkmen, ukenglish, ukrainian, uppersorbian, usengl +ishmax, welsh, loaded. +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\article.cls" +Document Class: article 2007/10/19 v1.4h Standard LaTeX document class +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\size12.clo" +File: size12.clo 2007/10/19 v1.4h Standard LaTeX file (size option) +) +\c at part=\count79 +\c at section=\count80 +\c at subsection=\count81 +\c at subsubsection=\count82 +\c at paragraph=\count83 +\c at subparagraph=\count84 +\c at figure=\count85 +\c at table=\count86 +\abovecaptionskip=\skip41 +\belowcaptionskip=\skip42 +\bibindent=\dimen102 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\psnfss\times.sty" +Package: times 2005/04/12 PSNFSS-v9.2a (SPQR) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ltxmisc\url.sty" +\Urlmuskip=\muskip10 +Package: url 2006/04/12 ver 3.3 Verb mode for urls, etc. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.sty" +Package: babel 2008/07/08 v3.8m The Babel package + +************************************* +* Local config file bblopts.cfg used +* +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\bblopts.cfg" +File: bblopts.cfg 2006/07/31 v1.0 MiKTeX 'babel' configuration +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\english.ldf" +Language: english 2005/03/30 v3.3o English support from the babel system + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.def" +File: babel.def 2008/07/08 v3.8m Babel common definitions +\babel at savecnt=\count87 +\U at D=\dimen103 +) +\l at canadian = a dialect from \language\l at american +\l at australian = a dialect from \language\l at british +\l at newzealand = a dialect from \language\l at british +)) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Rd.sty +Package: Rd + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ifthen.sty" +Package: ifthen 2001/05/26 v1.1c Standard LaTeX ifthen package (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\longtable.sty" +Package: longtable 2004/02/01 v4.11 Multi-page Table package (DPC) +\LTleft=\skip43 +\LTright=\skip44 +\LTpre=\skip45 +\LTpost=\skip46 +\LTchunksize=\count88 +\LTcapwidth=\dimen104 +\LT at head=\box26 +\LT at firsthead=\box27 +\LT at foot=\box28 +\LT at lastfoot=\box29 +\LT at cols=\count89 +\LT at rows=\count90 +\c at LT@tables=\count91 +\c at LT@chunks=\count92 +\LT at p@ftn=\toks14 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\bm.sty" +Package: bm 2004/02/26 v1.1c Bold Symbol Support (DPC/FMi) +\symboldoperators=\mathgroup4 +\symboldletters=\mathgroup5 +\symboldsymbols=\mathgroup6 +LaTeX Font Info: Redeclaring math alphabet \mathbf on input line 138. +LaTeX Info: Redefining \bm on input line 204. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\alltt.sty" +Package: alltt 1997/06/16 v2.0g defines alltt environment +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\verbatim.sty" +Package: verbatim 2003/08/22 v1.5q LaTeX2e package for verbatim enhancements +\every at verbatim=\toks15 +\verbatim at line=\toks16 +\verbatim at in@stream=\read1 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\upquote\upquote.sty" +Package: upquote 2012/04/19 v1.3 upright-quote and grave-accent glyphs in verba +tim + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\textcomp.sty" +Package: textcomp 2005/09/27 v1.99g Standard LaTeX package +Package textcomp Info: Sub-encoding information: +(textcomp) 5 = only ISO-Adobe without \textcurrency +(textcomp) 4 = 5 + \texteuro +(textcomp) 3 = 4 + \textohm +(textcomp) 2 = 3 + \textestimated + \textcurrency +(textcomp) 1 = TS1 - \textcircled - \t +(textcomp) 0 = TS1 (full) +(textcomp) Font families with sub-encoding setting implement +(textcomp) only a restricted character set as indicated. +(textcomp) Family '?' is the default used for unknown fonts. +(textcomp) See the documentation for details. +Package textcomp Info: Setting ? sub-encoding to TS1/1 on input line 71. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ts1enc.def" +File: ts1enc.def 2001/06/05 v3.0e (jk/car/fm) Standard LaTeX file +) +LaTeX Info: Redefining \oldstylenums on input line 266. +Package textcomp Info: Setting cmr sub-encoding to TS1/0 on input line 281. +Package textcomp Info: Setting cmss sub-encoding to TS1/0 on input line 282. +Package textcomp Info: Setting cmtt sub-encoding to TS1/0 on input line 283. +Package textcomp Info: Setting cmvtt sub-encoding to TS1/0 on input line 284. +Package textcomp Info: Setting cmbr sub-encoding to TS1/0 on input line 285. +Package textcomp Info: Setting cmtl sub-encoding to TS1/0 on input line 286. +Package textcomp Info: Setting ccr sub-encoding to TS1/0 on input line 287. +Package textcomp Info: Setting ptm sub-encoding to TS1/4 on input line 288. +Package textcomp Info: Setting pcr sub-encoding to TS1/4 on input line 289. +Package textcomp Info: Setting phv sub-encoding to TS1/4 on input line 290. +Package textcomp Info: Setting ppl sub-encoding to TS1/3 on input line 291. +Package textcomp Info: Setting pag sub-encoding to TS1/4 on input line 292. +Package textcomp Info: Setting pbk sub-encoding to TS1/4 on input line 293. +Package textcomp Info: Setting pnc sub-encoding to TS1/4 on input line 294. +Package textcomp Info: Setting pzc sub-encoding to TS1/4 on input line 295. +Package textcomp Info: Setting bch sub-encoding to TS1/4 on input line 296. +Package textcomp Info: Setting put sub-encoding to TS1/5 on input line 297. +Package textcomp Info: Setting uag sub-encoding to TS1/5 on input line 298. +Package textcomp Info: Setting ugq sub-encoding to TS1/5 on input line 299. +Package textcomp Info: Setting ul8 sub-encoding to TS1/4 on input line 300. +Package textcomp Info: Setting ul9 sub-encoding to TS1/4 on input line 301. +Package textcomp Info: Setting augie sub-encoding to TS1/5 on input line 302. +Package textcomp Info: Setting dayrom sub-encoding to TS1/3 on input line 303. +Package textcomp Info: Setting dayroms sub-encoding to TS1/3 on input line 304. + +Package textcomp Info: Setting pxr sub-encoding to TS1/0 on input line 305. +Package textcomp Info: Setting pxss sub-encoding to TS1/0 on input line 306. +Package textcomp Info: Setting pxtt sub-encoding to TS1/0 on input line 307. +Package textcomp Info: Setting txr sub-encoding to TS1/0 on input line 308. +Package textcomp Info: Setting txss sub-encoding to TS1/0 on input line 309. +Package textcomp Info: Setting txtt sub-encoding to TS1/0 on input line 310. +Package textcomp Info: Setting lmr sub-encoding to TS1/0 on input line 311. +Package textcomp Info: Setting lmdh sub-encoding to TS1/0 on input line 312. +Package textcomp Info: Setting lmss sub-encoding to TS1/0 on input line 313. +Package textcomp Info: Setting lmssq sub-encoding to TS1/0 on input line 314. +Package textcomp Info: Setting lmvtt sub-encoding to TS1/0 on input line 315. +Package textcomp Info: Setting qhv sub-encoding to TS1/0 on input line 316. +Package textcomp Info: Setting qag sub-encoding to TS1/0 on input line 317. +Package textcomp Info: Setting qbk sub-encoding to TS1/0 on input line 318. +Package textcomp Info: Setting qcr sub-encoding to TS1/0 on input line 319. +Package textcomp Info: Setting qcs sub-encoding to TS1/0 on input line 320. +Package textcomp Info: Setting qpl sub-encoding to TS1/0 on input line 321. +Package textcomp Info: Setting qtm sub-encoding to TS1/0 on input line 322. +Package textcomp Info: Setting qzc sub-encoding to TS1/0 on input line 323. +Package textcomp Info: Setting qhvc sub-encoding to TS1/0 on input line 324. +Package textcomp Info: Setting futs sub-encoding to TS1/4 on input line 325. +Package textcomp Info: Setting futx sub-encoding to TS1/4 on input line 326. +Package textcomp Info: Setting futj sub-encoding to TS1/4 on input line 327. +Package textcomp Info: Setting hlh sub-encoding to TS1/3 on input line 328. +Package textcomp Info: Setting hls sub-encoding to TS1/3 on input line 329. +Package textcomp Info: Setting hlst sub-encoding to TS1/3 on input line 330. +Package textcomp Info: Setting hlct sub-encoding to TS1/5 on input line 331. +Package textcomp Info: Setting hlx sub-encoding to TS1/5 on input line 332. +Package textcomp Info: Setting hlce sub-encoding to TS1/5 on input line 333. +Package textcomp Info: Setting hlcn sub-encoding to TS1/5 on input line 334. +Package textcomp Info: Setting hlcw sub-encoding to TS1/5 on input line 335. +Package textcomp Info: Setting hlcf sub-encoding to TS1/5 on input line 336. +Package textcomp Info: Setting pplx sub-encoding to TS1/3 on input line 337. +Package textcomp Info: Setting pplj sub-encoding to TS1/3 on input line 338. +Package textcomp Info: Setting ptmx sub-encoding to TS1/4 on input line 339. +Package textcomp Info: Setting ptmj sub-encoding to TS1/4 on input line 340. +)) +\ldescriptionwidth=\skip47 + +NOT loading ae NOT loading times NOT loading lmodern) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Sweave.sty +Package: Sweave + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\graphicx.sty" +Package: graphicx 1999/02/16 v1.0f Enhanced LaTeX Graphics (DPC,SPQR) + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\keyval.sty" +Package: keyval 1999/03/16 v1.13 key=value parser (DPC) +\KV at toks@=\toks17 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\graphics.sty" +Package: graphics 2009/02/05 v1.0o Standard LaTeX Graphics (DPC,SPQR) + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\trig.sty" +Package: trig 1999/03/16 v1.09 sin cos tan (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\graphics.cfg" +File: graphics.cfg 2007/01/18 v1.5 graphics configuration of teTeX/TeXLive +) +Package graphics Info: Driver file: pdftex.def on input line 91. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\pdftex-def\pdftex.def" +File: pdftex.def 2011/05/27 v0.06d Graphics/color for pdfTeX + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\oberdiek\infwarerr.sty" +Package: infwarerr 2010/04/08 v1.3 Providing info/warning/error messages (HO) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\oberdiek\ltxcmds.sty" +Package: ltxcmds 2011/11/09 v1.22 LaTeX kernel commands for general use (HO) +) +\Gread at gobject=\count93 +)) +\Gin at req@height=\dimen105 +\Gin at req@width=\dimen106 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\fancyvrb\fancyvrb.sty" +Package: fancyvrb 2008/02/07 + +Style option: `fancyvrb' v2.7a, with DG/SPQR fixes, and firstline=lastline fix +<2008/02/07> (tvz) +\FV at CodeLineNo=\count94 +\FV at InFile=\read2 +\FV at TabBox=\box30 +\c at FancyVerbLine=\count95 +\FV at StepNumber=\count96 +\FV at OutFile=\write3 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\ae.sty" +Package: ae 2001/02/12 1.3 Almost European Computer Modern + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +) +LaTeX Font Info: Try loading font information for T1+aer on input line 100. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\t1aer.fd" +File: t1aer.fd 1997/11/16 Font definitions for T1/aer. +)))) +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week1\Vignette\LoSharpeRatio.aux") +LaTeX Font Info: Checking defaults for OML/cmm/m/it on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for T1/cmr/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for OT1/cmr/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for OMS/cmsy/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for OMX/cmex/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for U/cmr/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for TS1/cmr/m/n on input line 36. +LaTeX Font Info: Try loading font information for TS1+cmr on input line 36. + [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2651 From noreply at r-forge.r-project.org Sat Jul 27 16:32:41 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 27 Jul 2013 16:32:41 +0200 (CEST) Subject: [Returnanalytics-commits] r2652 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130727143241.B3AA11848F4@r-forge.r-project.org> Author: pulkit Date: 2013-07-27 16:32:41 +0200 (Sat, 27 Jul 2013) New Revision: 2652 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R Log: EDD COPS Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R 2013-07-27 14:32:41 UTC (rev 2652) @@ -0,0 +1,85 @@ +#'@title +#'Economic Drawdown Controlled Optimal Portfolio Strategy +#' +#'@description +#'The Economic Drawdown Controlled Optimal Portfolio Strategy(EDD-COPS) has +#'the portfolio fraction allocated to single risky asset as: +#' +#' \deqn{x_t = Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-EDD(t)}{1-EDD(t)}\biggr]\right\}} +#' +#' The risk free asset accounts for the rest of the portfolio allocation \eqn{x_f = 1 - x_t}. +#' +#' +#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#'@param delta Drawdown limit +#'@param gamma (1-gamma) is the investor risk aversion +#'else the return series will be used +#'@param Rf risk free rate can be vector such as government security rate of return. +#'@param h Look back period +#'@param geomtric geometric utilize geometric chaining (TRUE) or simple/arithmetic #'chaining(FALSE) to aggregate returns, default is TRUE. +#'@param ... any other variable +#' +#'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to +#'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012) +#' +#' +#'@examples +#' +#' # with S&P 500 data and T-bill data +#' +#'dt<-read.zoo("returns.csv",sep=",",header = TRUE) +#'dt<-as.xts(dt) +#'EDDCOPS(dt[,1],delta = 0.33,gamma = 0.7,Rf = (1+dt[,2])^(1/12)-1,geometric = TRUE) +#' +#'data(edhec) +#'EDDCOPS(edhec,delta = 0.1,gamma = 0.7,Rf = 0) +#'@export +#' + +EDDCOPS<-function(R ,delta,gamma,Rf,geometric = TRUE,...){ + # DESCRIPTION + # Calculates the dynamic weights for single and double risky asset portfolios + # using Economic Drawdown + + # INPUT: + # The Return series ,drawdown limit, risk aversion,risk free rate are + # given as the input + + # FUNCTION: + x = checkData(R) + rf = checkData(Rf) + columns = ncol(x) + columnnames = colnames(x) + sharpe = SharpeRatio.annualized(x,rf) + sd = StdDev.annualized(R) + dynamicPort<-function(x){ + factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta*gamma) + xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) + return(xt) + } + + edd = EconomicDrawdown(R,Rf,geometric) + for(column in 1:columns){ + column.xt <- na.omit(edd[,column],FUN = dynamicPort,column = column) + if(column == 1) + xt = column.xt + else xt = merge(xt, column.xt) + } + colnames(xt) = columnnames + xt = reclass(xt, x) + return(xt) + +} + +############################################################################### +# 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: EDDCOPS.R $ +# +############################################################################## Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-27 10:10:07 UTC (rev 2651) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-27 14:32:41 UTC (rev 2652) @@ -38,6 +38,7 @@ #' # with S&P 500 data and T-bill data #' #'dt<-read.zoo("returns.csv",sep=",",header = TRUE) +#'dt<-as.xts(dt) #'REDDCOPS(dt[,1],delta = 0.33,Rf = (1+dt[,2])^(1/12)-1,h = 12,geometric = TRUE,asset = "one") #' #'data(edhec) @@ -128,6 +129,7 @@ else xt = merge(xt, column.xt) } colnames(xt) = columnnames + xt = reclass(xt, x) return(xt) } Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R 2013-07-27 10:10:07 UTC (rev 2651) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R 2013-07-27 14:32:41 UTC (rev 2652) @@ -67,7 +67,7 @@ else Economicdrawdown = merge(Economicdrawdown, column.drawdown) } colnames(Economicdrawdown) = columnnames - Economicdrawdown = reclass(Economicdrawdown, x) + #Economicdrawdown = reclass(Economicdrawdown, x) return(Economicdrawdown) } From noreply at r-forge.r-project.org Sun Jul 28 13:16:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 13:16:20 +0200 (CEST) Subject: [Returnanalytics-commits] r2653 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: Week3/Code Week3/Vignette Week5 Week5/Vignette Message-ID: <20130728111620.E1096184E2D@r-forge.r-project.org> Author: shubhanm Date: 2013-07-28 13:16:20 +0200 (Sun, 28 Jul 2013) New Revision: 2653 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-003.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.synctex.gz pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.synctex.gz pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown-Graph10.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown.synctex.gz pkg/PerformanceAnalytics/sandbox/Shubhankit/Week5/Vignette/ConditionalDrawdown.tex Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R Log: Vignette : Week 3 and 5 Status : Complete Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R 2013-07-27 14:32:41 UTC (rev 2652) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R 2013-07-28 11:16:20 UTC (rev 2653) @@ -33,8 +33,8 @@ # Graph autos with adjacent bars using rainbow colors aa= table.Autocorrelation(R) -barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient", - , xlab = "Fund Type",beside=TRUE, col=rainbow(6)) + barplot(as.matrix(aa), main="ACF Lag Plot", ylab= "Value of Coefficient", + , xlab = NULL,col=rainbow(6)) # Place the legend at the top-left corner with no frame # using rainbow colors Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-003.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-003.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-concordance.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-concordance.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot-concordance.tex 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,2 @@ +\Sconcordance{concordance:ACFbarplot.tex:ACFbarplot.Rnw:% +1 44 1 1 5 1 4 4 1 1 2 1 0 2 1 4 0 1 2 3 1} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.Rnw 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,67 @@ +%% no need for \DeclareGraphicsExtensions{.pdf,.eps} + +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +%\usepackage{noweb} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{Performance Attribution from Bacon} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{returns, performance, risk, benchmark, portfolio} +%\VignettePackage{PerformanceAnalytics} + +%\documentclass[a4paper]{article} +%\usepackage[noae]{Sweave} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage[top=3cm, bottom=3cm, left=2.5cm]{geometry} +%\usepackage{graphicx} +%\usepackage{graphicx, verbatim} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage{graphicx} + +\title{Stacked Bar Plot of Autocorrelation Coefficient} +\author{R Project for Statistical Computing} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\maketitle + + +\begin{abstract} +Creates an ACF chart stacked bar plot with the ACF and PACF set to some depict the ACF weightage of different lag factors. +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) +@ + +<>= +source("../Code/chart.Autocorrelation.R") +@ + +\section{Usage} + +In this example we use edhec database, to show autocorrelation effect of the return time series with respect to lag factors. + +<>= +library(PerformanceAnalytics) +data(edhec) +chart.Autocorrelation(edhec[,1:3]) +@ + + + +\end{document} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.log =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.log (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.log 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,348 @@ +This is pdfTeX, Version 3.1415926-2.4-1.40.13 (MiKTeX 2.9) (preloaded format=pdflatex 2013.7.14) 28 JUL 2013 19:13 +entering extended mode +**ACFbarplot.tex + +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week3\Vignette\ACFbarplot.tex" +LaTeX2e <2011/06/27> +Babel and hyphenation patterns for english, afrikaans, ancientgreek, ar +abic, armenian, assamese, basque, bengali, bokmal, bulgarian, catalan, coptic, +croatian, czech, danish, dutch, esperanto, estonian, farsi, finnish, french, ga +lician, german, german-x-2012-05-30, greek, gujarati, hindi, hungarian, iceland +ic, indonesian, interlingua, irish, italian, kannada, kurmanji, latin, latvian, + lithuanian, malayalam, marathi, mongolian, mongolianlmc, monogreek, ngerman, n +german-x-2012-05-30, nynorsk, oriya, panjabi, pinyin, polish, portuguese, roman +ian, russian, sanskrit, serbian, slovak, slovenian, spanish, swedish, swissgerm +an, tamil, telugu, turkish, turkmen, ukenglish, ukrainian, uppersorbian, usengl +ishmax, welsh, loaded. +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\article.cls" +Document Class: article 2007/10/19 v1.4h Standard LaTeX document class +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\size12.clo" +File: size12.clo 2007/10/19 v1.4h Standard LaTeX file (size option) +) +\c at part=\count79 +\c at section=\count80 +\c at subsection=\count81 +\c at subsubsection=\count82 +\c at paragraph=\count83 +\c at subparagraph=\count84 +\c at figure=\count85 +\c at table=\count86 +\abovecaptionskip=\skip41 +\belowcaptionskip=\skip42 +\bibindent=\dimen102 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\psnfss\times.sty" +Package: times 2005/04/12 PSNFSS-v9.2a (SPQR) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ltxmisc\url.sty" +\Urlmuskip=\muskip10 +Package: url 2006/04/12 ver 3.3 Verb mode for urls, etc. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.sty" +Package: babel 2008/07/08 v3.8m The Babel package + +************************************* +* Local config file bblopts.cfg used +* +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\bblopts.cfg" +File: bblopts.cfg 2006/07/31 v1.0 MiKTeX 'babel' configuration +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\english.ldf" +Language: english 2005/03/30 v3.3o English support from the babel system + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.def" +File: babel.def 2008/07/08 v3.8m Babel common definitions +\babel at savecnt=\count87 +\U at D=\dimen103 +) +\l at canadian = a dialect from \language\l at american +\l at australian = a dialect from \language\l at british +\l at newzealand = a dialect from \language\l at british +)) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Rd.sty +Package: Rd + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ifthen.sty" +Package: ifthen 2001/05/26 v1.1c Standard LaTeX ifthen package (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\longtable.sty" +Package: longtable 2004/02/01 v4.11 Multi-page Table package (DPC) +\LTleft=\skip43 +\LTright=\skip44 +\LTpre=\skip45 +\LTpost=\skip46 +\LTchunksize=\count88 +\LTcapwidth=\dimen104 +\LT at head=\box26 +\LT at firsthead=\box27 +\LT at foot=\box28 +\LT at lastfoot=\box29 +\LT at cols=\count89 +\LT at rows=\count90 +\c at LT@tables=\count91 +\c at LT@chunks=\count92 +\LT at p@ftn=\toks14 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\bm.sty" +Package: bm 2004/02/26 v1.1c Bold Symbol Support (DPC/FMi) +\symboldoperators=\mathgroup4 +\symboldletters=\mathgroup5 +\symboldsymbols=\mathgroup6 +LaTeX Font Info: Redeclaring math alphabet \mathbf on input line 138. +LaTeX Info: Redefining \bm on input line 204. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\alltt.sty" +Package: alltt 1997/06/16 v2.0g defines alltt environment +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\verbatim.sty" +Package: verbatim 2003/08/22 v1.5q LaTeX2e package for verbatim enhancements +\every at verbatim=\toks15 +\verbatim at line=\toks16 +\verbatim at in@stream=\read1 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\upquote\upquote.sty" +Package: upquote 2012/04/19 v1.3 upright-quote and grave-accent glyphs in verba +tim + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\textcomp.sty" +Package: textcomp 2005/09/27 v1.99g Standard LaTeX package +Package textcomp Info: Sub-encoding information: +(textcomp) 5 = only ISO-Adobe without \textcurrency +(textcomp) 4 = 5 + \texteuro +(textcomp) 3 = 4 + \textohm +(textcomp) 2 = 3 + \textestimated + \textcurrency +(textcomp) 1 = TS1 - \textcircled - \t +(textcomp) 0 = TS1 (full) +(textcomp) Font families with sub-encoding setting implement +(textcomp) only a restricted character set as indicated. +(textcomp) Family '?' is the default used for unknown fonts. +(textcomp) See the documentation for details. +Package textcomp Info: Setting ? sub-encoding to TS1/1 on input line 71. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ts1enc.def" +File: ts1enc.def 2001/06/05 v3.0e (jk/car/fm) Standard LaTeX file +) +LaTeX Info: Redefining \oldstylenums on input line 266. +Package textcomp Info: Setting cmr sub-encoding to TS1/0 on input line 281. +Package textcomp Info: Setting cmss sub-encoding to TS1/0 on input line 282. +Package textcomp Info: Setting cmtt sub-encoding to TS1/0 on input line 283. +Package textcomp Info: Setting cmvtt sub-encoding to TS1/0 on input line 284. +Package textcomp Info: Setting cmbr sub-encoding to TS1/0 on input line 285. +Package textcomp Info: Setting cmtl sub-encoding to TS1/0 on input line 286. +Package textcomp Info: Setting ccr sub-encoding to TS1/0 on input line 287. +Package textcomp Info: Setting ptm sub-encoding to TS1/4 on input line 288. +Package textcomp Info: Setting pcr sub-encoding to TS1/4 on input line 289. +Package textcomp Info: Setting phv sub-encoding to TS1/4 on input line 290. +Package textcomp Info: Setting ppl sub-encoding to TS1/3 on input line 291. +Package textcomp Info: Setting pag sub-encoding to TS1/4 on input line 292. +Package textcomp Info: Setting pbk sub-encoding to TS1/4 on input line 293. +Package textcomp Info: Setting pnc sub-encoding to TS1/4 on input line 294. +Package textcomp Info: Setting pzc sub-encoding to TS1/4 on input line 295. +Package textcomp Info: Setting bch sub-encoding to TS1/4 on input line 296. +Package textcomp Info: Setting put sub-encoding to TS1/5 on input line 297. +Package textcomp Info: Setting uag sub-encoding to TS1/5 on input line 298. +Package textcomp Info: Setting ugq sub-encoding to TS1/5 on input line 299. +Package textcomp Info: Setting ul8 sub-encoding to TS1/4 on input line 300. +Package textcomp Info: Setting ul9 sub-encoding to TS1/4 on input line 301. +Package textcomp Info: Setting augie sub-encoding to TS1/5 on input line 302. +Package textcomp Info: Setting dayrom sub-encoding to TS1/3 on input line 303. +Package textcomp Info: Setting dayroms sub-encoding to TS1/3 on input line 304. + +Package textcomp Info: Setting pxr sub-encoding to TS1/0 on input line 305. +Package textcomp Info: Setting pxss sub-encoding to TS1/0 on input line 306. +Package textcomp Info: Setting pxtt sub-encoding to TS1/0 on input line 307. +Package textcomp Info: Setting txr sub-encoding to TS1/0 on input line 308. +Package textcomp Info: Setting txss sub-encoding to TS1/0 on input line 309. +Package textcomp Info: Setting txtt sub-encoding to TS1/0 on input line 310. +Package textcomp Info: Setting lmr sub-encoding to TS1/0 on input line 311. +Package textcomp Info: Setting lmdh sub-encoding to TS1/0 on input line 312. +Package textcomp Info: Setting lmss sub-encoding to TS1/0 on input line 313. +Package textcomp Info: Setting lmssq sub-encoding to TS1/0 on input line 314. +Package textcomp Info: Setting lmvtt sub-encoding to TS1/0 on input line 315. +Package textcomp Info: Setting qhv sub-encoding to TS1/0 on input line 316. +Package textcomp Info: Setting qag sub-encoding to TS1/0 on input line 317. +Package textcomp Info: Setting qbk sub-encoding to TS1/0 on input line 318. +Package textcomp Info: Setting qcr sub-encoding to TS1/0 on input line 319. +Package textcomp Info: Setting qcs sub-encoding to TS1/0 on input line 320. +Package textcomp Info: Setting qpl sub-encoding to TS1/0 on input line 321. +Package textcomp Info: Setting qtm sub-encoding to TS1/0 on input line 322. +Package textcomp Info: Setting qzc sub-encoding to TS1/0 on input line 323. +Package textcomp Info: Setting qhvc sub-encoding to TS1/0 on input line 324. +Package textcomp Info: Setting futs sub-encoding to TS1/4 on input line 325. +Package textcomp Info: Setting futx sub-encoding to TS1/4 on input line 326. +Package textcomp Info: Setting futj sub-encoding to TS1/4 on input line 327. +Package textcomp Info: Setting hlh sub-encoding to TS1/3 on input line 328. +Package textcomp Info: Setting hls sub-encoding to TS1/3 on input line 329. +Package textcomp Info: Setting hlst sub-encoding to TS1/3 on input line 330. +Package textcomp Info: Setting hlct sub-encoding to TS1/5 on input line 331. +Package textcomp Info: Setting hlx sub-encoding to TS1/5 on input line 332. +Package textcomp Info: Setting hlce sub-encoding to TS1/5 on input line 333. +Package textcomp Info: Setting hlcn sub-encoding to TS1/5 on input line 334. +Package textcomp Info: Setting hlcw sub-encoding to TS1/5 on input line 335. +Package textcomp Info: Setting hlcf sub-encoding to TS1/5 on input line 336. +Package textcomp Info: Setting pplx sub-encoding to TS1/3 on input line 337. +Package textcomp Info: Setting pplj sub-encoding to TS1/3 on input line 338. +Package textcomp Info: Setting ptmx sub-encoding to TS1/4 on input line 339. +Package textcomp Info: Setting ptmj sub-encoding to TS1/4 on input line 340. +)) +\ldescriptionwidth=\skip47 + +NOT loading ae NOT loading times NOT loading lmodern) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Sweave.sty +Package: Sweave + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\graphicx.sty" +Package: graphicx 1999/02/16 v1.0f Enhanced LaTeX Graphics (DPC,SPQR) + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\keyval.sty" +Package: keyval 1999/03/16 v1.13 key=value parser (DPC) +\KV at toks@=\toks17 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\graphics.sty" +Package: graphics 2009/02/05 v1.0o Standard LaTeX Graphics (DPC,SPQR) + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\trig.sty" +Package: trig 1999/03/16 v1.09 sin cos tan (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\graphics.cfg" +File: graphics.cfg 2007/01/18 v1.5 graphics configuration of teTeX/TeXLive +) +Package graphics Info: Driver file: pdftex.def on input line 91. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\pdftex-def\pdftex.def" +File: pdftex.def 2011/05/27 v0.06d Graphics/color for pdfTeX + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\oberdiek\infwarerr.sty" +Package: infwarerr 2010/04/08 v1.3 Providing info/warning/error messages (HO) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\oberdiek\ltxcmds.sty" +Package: ltxcmds 2011/11/09 v1.22 LaTeX kernel commands for general use (HO) +) +\Gread at gobject=\count93 +)) +\Gin at req@height=\dimen105 +\Gin at req@width=\dimen106 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\fancyvrb\fancyvrb.sty" +Package: fancyvrb 2008/02/07 + +Style option: `fancyvrb' v2.7a, with DG/SPQR fixes, and firstline=lastline fix +<2008/02/07> (tvz) +\FV at CodeLineNo=\count94 +\FV at InFile=\read2 +\FV at TabBox=\box30 +\c at FancyVerbLine=\count95 +\FV at StepNumber=\count96 +\FV at OutFile=\write3 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\ae.sty" +Package: ae 2001/02/12 1.3 Almost European Computer Modern + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +) +LaTeX Font Info: Try loading font information for T1+aer on input line 100. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\t1aer.fd" +File: t1aer.fd 1997/11/16 Font definitions for T1/aer. +)))) +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week3\Vignette\ACFbarplot.aux") +LaTeX Font Info: Checking defaults for OML/cmm/m/it on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for T1/cmr/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for OT1/cmr/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for OMS/cmsy/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for OMX/cmex/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for U/cmr/m/n on input line 36. +LaTeX Font Info: ... okay on input line 36. +LaTeX Font Info: Checking defaults for TS1/cmr/m/n on input line 36. +LaTeX Font Info: Try loading font information for TS1+cmr on input line 36. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ts1cmr.fd" +File: ts1cmr.fd 1999/05/25 v2.5h Standard LaTeX font definitions +) +LaTeX Font Info: ... okay on input line 36. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\context\base\supp-pdf.mkii" +[Loading MPS to PDF converter (version 2006.09.02).] +\scratchcounter=\count97 +\scratchdimen=\dimen107 +\scratchbox=\box31 +\nofMPsegments=\count98 +\nofMParguments=\count99 +\everyMPshowfont=\toks18 +\MPscratchCnt=\count100 +\MPscratchDim=\dimen108 +\MPnumerator=\count101 +\makeMPintoPDFobject=\count102 +\everyMPtoPDFconversion=\toks19 +) +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week3\Vignette\ACFbarplot-concordance.tex") +LaTeX Font Info: External font `cmex10' loaded for size +(Font) <14.4> on input line 39. +LaTeX Font Info: External font `cmex10' loaded for size +(Font) <7> on input line 39. +LaTeX Font Info: Try loading font information for T1+aett on input line 53. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\t1aett.fd" +File: t1aett.fd 1997/11/16 Font definitions for T1/aett. +) + +File: ACFbarplot-003.pdf Graphic file (type pdf) + +Package pdftex.def Info: ACFbarplot-003.pdf used on input line 59. +(pdftex.def) Requested size: 366.63068pt x 366.64673pt. + +[1 + +{C:/ProgramData/MiKTeX/2.9/pdftex/config/pdftex.map}] [2 ] +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week3\Vignette\ACFbarplot.aux") ) +Here is how much of TeX's memory you used: + 3113 strings out of 493921 + 42601 string characters out of 3144861 + 89154 words of memory out of 3000000 + 6328 multiletter control sequences out of 15000+200000 + 28686 words of font info for 66 fonts, out of 3000000 for 9000 + 841 hyphenation exceptions out of 8191 + 35i,6n,22p,277b,192s stack positions out of 5000i,500n,10000p,200000b,50000s + +Output written on ACFbarplot.pdf (2 pages, 80054 bytes). +PDF statistics: + 41 PDF objects out of 1000 (max. 8388607) + 0 named destinations out of 1000 (max. 500000) + 10 words of extra memory for PDF output out of 10000 (max. 10000000) + Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.synctex.gz =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.synctex.gz ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ACFbarplot.tex 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,63 @@ +%% no need for \DeclareGraphicsExtensions{.pdf,.eps} + +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +%\usepackage{noweb} +\usepackage{Rd} + +\usepackage{Sweave} + +%\VignetteIndexEntry{Performance Attribution from Bacon} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{returns, performance, risk, benchmark, portfolio} +%\VignettePackage{PerformanceAnalytics} + +%\documentclass[a4paper]{article} +%\usepackage[noae]{Sweave} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage[top=3cm, bottom=3cm, left=2.5cm]{geometry} +%\usepackage{graphicx} +%\usepackage{graphicx, verbatim} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage{graphicx} + +\title{Stacked Bar Plot of Autocorrelation Coefficient} +\author{R Project for Statistical Computing} + +\begin{document} +\input{ACFbarplot-concordance} + +\maketitle + + +\begin{abstract} +Creates an ACF chart stacked bar plot with the ACF and PACF set to some depict the ACF weightage of different lag factors. +\end{abstract} + + + +\section{Usage} + +In this example we use edhec database, to show autocorrelation effect of the return time series with respect to lag factors. + +\begin{Schunk} +\begin{Sinput} +> library(PerformanceAnalytics) +> data(edhec) +> chart.Autocorrelation(edhec[,1:3]) +\end{Sinput} +\end{Schunk} +\includegraphics{ACFbarplot-003} + + + +\end{document} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB-concordance.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB-concordance.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB-concordance.tex 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,2 @@ +\Sconcordance{concordance:ExpectedMaxDDGMB.tex:ExpectedMaxDDGMB.Rnw:% +1 45 1 1 5 1 4 9 1 1 2 1 0 2 1 25 0 1 2 3 1} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.Rnw 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,73 @@ +%% no need for \DeclareGraphicsExtensions{.pdf,.eps} + +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +%\usepackage{noweb} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{Performance Attribution from Bacon} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{returns, performance, risk, benchmark, portfolio} +%\VignettePackage{PerformanceAnalytics} + +%\documentclass[a4paper]{article} +%\usepackage[noae]{Sweave} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage[top=3cm, bottom=3cm, left=2.5cm]{geometry} +%\usepackage{graphicx} +%\usepackage{graphicx, verbatim} +%\usepackage{ucs} +%\usepackage[utf8x]{inputenc} +%\usepackage{amsmath, amsthm, latexsym} +%\usepackage{graphicx} + +\title{Maximum Drawdown of a Brownian Motion} +\author{R Project for Statistical Computing} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\maketitle + + +\begin{abstract} +if $\hat{X}$(t) is a random process on [0,T], the maximum drawdown in defined as the largest drop from a peak to a bottom.This paper investigates the behavior of this statistic for a Brownian motion with drift. In particular, it gives an $\infty$ series representation of its distribution, and consider its expected value. When the drift is zero, it gives an analytic expression for the expected value, and for non-zero drift, it gives an $\infty$ series representation.For all cases, we compute the limiting T tends to $\infty$ behavior, which can be +logarithmic ($\mu$ greater than 0), square root ( $\mu$ equal to 0), or linear ($\mu$ less than 0). +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) +@ + +<>= +source("../Code/EmaxDDGBM.R") +@ + +\section{Background} + +The maximum drawdown is a commonly used in finance as a measure of risk for a stock that follows a particular random process. Here we consider the maximum drawdown of a Brownian motion. + + +\section{Usage} + +In this example we use edhec database, to compute true Hedge Fund Returns. + +<<>>= +library(PerformanceAnalytics) +data(edhec) +table.EMaxDDGBM(edhec) +@ + + + +\end{document} \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.log =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.log (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/ExpectedMaxDDGMB.log 2013-07-28 11:16:20 UTC (rev 2653) @@ -0,0 +1,348 @@ +This is pdfTeX, Version 3.1415926-2.4-1.40.13 (MiKTeX 2.9) (preloaded format=pdflatex 2013.7.14) 28 JUL 2013 16:29 +entering extended mode +**ExpectedMaxDDGMB.tex + +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week3\Vignette\ExpectedMaxDDGMB.tex" +LaTeX2e <2011/06/27> +Babel and hyphenation patterns for english, afrikaans, ancientgreek, ar +abic, armenian, assamese, basque, bengali, bokmal, bulgarian, catalan, coptic, +croatian, czech, danish, dutch, esperanto, estonian, farsi, finnish, french, ga +lician, german, german-x-2012-05-30, greek, gujarati, hindi, hungarian, iceland +ic, indonesian, interlingua, irish, italian, kannada, kurmanji, latin, latvian, + lithuanian, malayalam, marathi, mongolian, mongolianlmc, monogreek, ngerman, n +german-x-2012-05-30, nynorsk, oriya, panjabi, pinyin, polish, portuguese, roman +ian, russian, sanskrit, serbian, slovak, slovenian, spanish, swedish, swissgerm +an, tamil, telugu, turkish, turkmen, ukenglish, ukrainian, uppersorbian, usengl +ishmax, welsh, loaded. +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\article.cls" +Document Class: article 2007/10/19 v1.4h Standard LaTeX document class +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\size12.clo" +File: size12.clo 2007/10/19 v1.4h Standard LaTeX file (size option) +) +\c at part=\count79 +\c at section=\count80 +\c at subsection=\count81 +\c at subsubsection=\count82 +\c at paragraph=\count83 +\c at subparagraph=\count84 +\c at figure=\count85 +\c at table=\count86 +\abovecaptionskip=\skip41 +\belowcaptionskip=\skip42 +\bibindent=\dimen102 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\psnfss\times.sty" +Package: times 2005/04/12 PSNFSS-v9.2a (SPQR) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ltxmisc\url.sty" +\Urlmuskip=\muskip10 +Package: url 2006/04/12 ver 3.3 Verb mode for urls, etc. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.sty" +Package: babel 2008/07/08 v3.8m The Babel package + +************************************* +* Local config file bblopts.cfg used +* +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\bblopts.cfg" +File: bblopts.cfg 2006/07/31 v1.0 MiKTeX 'babel' configuration +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\english.ldf" +Language: english 2005/03/30 v3.3o English support from the babel system + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.def" +File: babel.def 2008/07/08 v3.8m Babel common definitions +\babel at savecnt=\count87 +\U at D=\dimen103 +) +\l at canadian = a dialect from \language\l at american +\l at australian = a dialect from \language\l at british +\l at newzealand = a dialect from \language\l at british +)) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Rd.sty +Package: Rd + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ifthen.sty" +Package: ifthen 2001/05/26 v1.1c Standard LaTeX ifthen package (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\longtable.sty" +Package: longtable 2004/02/01 v4.11 Multi-page Table package (DPC) +\LTleft=\skip43 +\LTright=\skip44 +\LTpre=\skip45 +\LTpost=\skip46 +\LTchunksize=\count88 +\LTcapwidth=\dimen104 +\LT at head=\box26 +\LT at firsthead=\box27 +\LT at foot=\box28 +\LT at lastfoot=\box29 +\LT at cols=\count89 +\LT at rows=\count90 +\c at LT@tables=\count91 +\c at LT@chunks=\count92 +\LT at p@ftn=\toks14 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\bm.sty" +Package: bm 2004/02/26 v1.1c Bold Symbol Support (DPC/FMi) +\symboldoperators=\mathgroup4 +\symboldletters=\mathgroup5 +\symboldsymbols=\mathgroup6 +LaTeX Font Info: Redeclaring math alphabet \mathbf on input line 138. +LaTeX Info: Redefining \bm on input line 204. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\alltt.sty" +Package: alltt 1997/06/16 v2.0g defines alltt environment +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\verbatim.sty" +Package: verbatim 2003/08/22 v1.5q LaTeX2e package for verbatim enhancements +\every at verbatim=\toks15 +\verbatim at line=\toks16 +\verbatim at in@stream=\read1 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\upquote\upquote.sty" +Package: upquote 2012/04/19 v1.3 upright-quote and grave-accent glyphs in verba +tim + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\textcomp.sty" +Package: textcomp 2005/09/27 v1.99g Standard LaTeX package +Package textcomp Info: Sub-encoding information: +(textcomp) 5 = only ISO-Adobe without \textcurrency +(textcomp) 4 = 5 + \texteuro +(textcomp) 3 = 4 + \textohm +(textcomp) 2 = 3 + \textestimated + \textcurrency +(textcomp) 1 = TS1 - \textcircled - \t +(textcomp) 0 = TS1 (full) +(textcomp) Font families with sub-encoding setting implement +(textcomp) only a restricted character set as indicated. +(textcomp) Family '?' is the default used for unknown fonts. +(textcomp) See the documentation for details. +Package textcomp Info: Setting ? sub-encoding to TS1/1 on input line 71. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ts1enc.def" +File: ts1enc.def 2001/06/05 v3.0e (jk/car/fm) Standard LaTeX file +) +LaTeX Info: Redefining \oldstylenums on input line 266. +Package textcomp Info: Setting cmr sub-encoding to TS1/0 on input line 281. +Package textcomp Info: Setting cmss sub-encoding to TS1/0 on input line 282. +Package textcomp Info: Setting cmtt sub-encoding to TS1/0 on input line 283. +Package textcomp Info: Setting cmvtt sub-encoding to TS1/0 on input line 284. +Package textcomp Info: Setting cmbr sub-encoding to TS1/0 on input line 285. [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2653 From noreply at r-forge.r-project.org Sun Jul 28 13:28:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 13:28:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2654 - in pkg/Meucci: . R demo man Message-ID: <20130728112831.9E626184DB2@r-forge.r-project.org> Author: xavierv Date: 2013-07-28 13:28:31 +0200 (Sun, 28 Jul 2013) New Revision: 2654 Added: pkg/Meucci/R/FitMultivariateGarch.R pkg/Meucci/R/MvnRnd.R pkg/Meucci/demo/S_EquitiesInvariants.R pkg/Meucci/demo/S_ProjectNPriceMvGarch.R pkg/Meucci/demo/S_Wishart.R pkg/Meucci/man/FitMultivariateGarch.Rd pkg/Meucci/man/garch1f4.Rd pkg/Meucci/man/garch2f8.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE pkg/Meucci/R/CmaCopula.R Log: - added more demo scripts from chapters 2 and 3 and its associated functions Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-28 11:16:20 UTC (rev 2653) +++ pkg/Meucci/DESCRIPTION 2013-07-28 11:28:31 UTC (rev 2654) @@ -4,7 +4,7 @@ Meucci. Version: 0.2.2 Date: $Date: 2012-06-06 15:18:48 -0500 (Wed, 06 Jun 2012) $ -Author: Ram Ahluwalia, Manan Shah, Xavier Vals +Author: Ram Ahluwalia, Manan Shah, Xavier Valls Maintainer: Brian G. Peterson Description: Attilio Meucci is a thought leader in advanced risk and portfolio management. His innovations include Entropy Pooling (technique for fully @@ -32,9 +32,10 @@ pracma, R.utils, mvtnorm, - dlm + dlm, + quadprog, + signal Suggests: - quadprog, limSolve, Matrix, MASS, @@ -47,7 +48,6 @@ expm, latticeExtra, scatterplot3d, - psych License: GPL URL: http://r-forge.r-project.org/projects/returnanalytics/ Copyright: (c) 2012 @@ -86,3 +86,5 @@ 'GenerateUniformDrawsOnUnitSphere.R' 'PlotMarginalsNormalInverseWishart.R' 'RandNormalInverseWishart.R' + 'FitMultivariateGarch.R' + 'MvnRnd.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-28 11:16:20 UTC (rev 2653) +++ pkg/Meucci/NAMESPACE 2013-07-28 11:28:31 UTC (rev 2654) @@ -11,6 +11,9 @@ export(DetectOutliersViaMVE) export(EntropyProg) export(FitExpectationMaximization) +export(FitMultivariateGarch) +export(garch1f4) +export(garch2f8) export(GenerateLogNormalDistribution) export(GenerateUniformDrawsOnUnitSphere) export(hermitePolynomial) Modified: pkg/Meucci/R/CmaCopula.R =================================================================== --- pkg/Meucci/R/CmaCopula.R 2013-07-28 11:16:20 UTC (rev 2653) +++ pkg/Meucci/R/CmaCopula.R 2013-07-28 11:28:31 UTC (rev 2654) @@ -4,52 +4,7 @@ # fix MvnRnd function (Schur decomposition) # fix warnings -#' Generates normal simulations whose sample moments match the population moments -#' -#' Adapted from file 'MvnRnd.m'. Most recent version of article and code available at http://www.symmys.com/node/162 -#' see A. Meucci - "Simulations with Exact Means and Covariances", Risk, July 2009 -#' -#' @param M a numeric indicating the sample first moment of the distribution -#' @param S a covariance matrix -#' @param J a numeric indicating the number of trials -#' -#' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} -#' @references -#' \url{http://www.symmys.com} -#' TODO: Add Schur decomposition. Right now function is only sampling from mvrnorm so sample moments do no match population moments -#' I have sample code commented out below to implement this correctly but I require a function that returns the unitaryMatrix from a Schur decomposition -#' @export -MvnRnd = function( M , S , J ) -{ - library(MASS) - X = MASS::mvrnorm( n = J , mu = M , Sigma = S ) # Todo: need to swap with Meucci function and Schur method - return( X = X ) - - # # compute sample covariance: NOTE defined as "cov(Y,1)", not as "cov(Y)" - # S_ = cov( Y , 1 ) - # - # # solve Riccati equation using Schur method - # zerosMatrix = matrix( rep( 0 , length( N * N ) ) , nrow = N ) - # # define the Hamiltonian matrix - # H1 = cbind( zerosMatrix , -1*S_ ) - # H2 = cbind( -S , zerosMatrix ) - # H = rbind( H1 , H2 ) - # # perform its Schur decomposition. - # # TODO: check that the result returns real eigenvalues on the diagonal. ?Schur seems to give an example with real eigenvalues - # schurDecomp = Schur( H ) - # T = SchurDecomp - # # U_ = unitaryMatrix??? TODO: Find a function in R that returns the unitaryMatrix from a Schur decomposition - # # U = ordschur(U_,T_,'lhp') - # # U_lu = U(1:N,1:N) - # # U_ld = U(N+1:end,1:N) - # # B = U_ld/U_lu - # - # # affine transformation to match mean and covariances - # # X = Y%*%B + repmat(M', J , 1 ) - # -} - #' CMA separation. Decomposes arbitrary joint distributions (scenario-probabilities) into their copula and marginals #' #' The CMA separation step attains from the cdf "F" for the marginal "X", the scenario-probabilities representation Added: pkg/Meucci/R/FitMultivariateGarch.R =================================================================== --- pkg/Meucci/R/FitMultivariateGarch.R (rev 0) +++ pkg/Meucci/R/FitMultivariateGarch.R 2013-07-28 11:28:31 UTC (rev 2654) @@ -0,0 +1,793 @@ +#' Estimation of multivariate GARCH models +#' +#' @param returns : [matrix] (T x N) returns so rows must correspond to time and columns to assets +#' @param demean : [scalar] specifies whether returns should be demeaned (if demean = 1) or not to estimate the model; default value is 1. +#' @param eps : [scalar] used in enforcing a_ii + b_ii <= 1 - eps; the default value is zero +#' @param df : [scalar] degree of freedom for the t-distribution; the default value is 500 to make it, basically, normal +#' +#' @return mu : [vector] +#' @return ATMF : [matrix] coefficient matrix A-tilde (in the notation of the paper) +#' @return BTMF : [matrix] coefficient matrix B-tilde (in the notation of the paper) +#' @return CTMF : [matrix] coefficient matrix C-tilde (in the notation of the paper) +#' @return Hhat : [matrix] forecasted conditional covariance matrix +#' +#' @note Initially written by Olivier Ledoit and Michael Wolf +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "FitMultivariateGarch.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +FitMultivariateGarch = function( returns, demean = 1, eps = 0, df = 500 ) +{ + if (eps < 0) + { + error("eps must be a (small) positive number") + } + + # Initialization + T = nrow( returns ); + N = ncol( returns ); + if ( 1 == demean ) + { + mu = matrix(apply( returns, 2, mean )); + returns = returns-mu[ array(1,T ), ]; + } + S = t(returns) %*% returns / ( T - 1 ); + x = t(returns); + + A = matrix( 0, N, N ); + B = matrix( 0, N, N ); + C = matrix( 0, N, N ); + + # Rescale Data + scale = sqrt( matrix( apply( t(x)^2, 2, mean ) ) ); + x = x / scale[ , array( 1, T ) ]; + + # Estimation of On-Diagonal Elements + h = matrix( 0, N, T ); + for( i in 1 : N ) + { + # Likelihood Maximization + q = garch1f4( t( x[ i, ] ), eps, df)$q; + A[ i, i ] = q[ 2 ]; + B[ i, i ] = q[ 3 ]; + C[ i, i ] = q[ 1 ]; + h[ i, ] = filter( cbind( 0, q[ 2] ), cbind( 1, -q[ 3 ] ), x[ i, ]^2 * (df-2) / df, mean( x[ i, ] ^ 2) * ( df-2 ) / df ) + + filter( cbind( 0, q[ 1 ] ), cbind( 1, -q[ 3 ] ), matrix( 1, 1, T) ); + } + + # First-step Estimation of Off-Diagonal Elements + for( i in 1 : (N-1) ) + { + for( j in (i +1) : N ) + { + # Likelihood Maximization + theta = garch2f8( x[ i, ] * x[ j, ], C[ i, i ], A[ i, i ], B[ i, i ], x[ i, ]^2, h[ i, ], C[ j, j ], A[ j, j ], B[ j, j ], x[ j, ]^2, h[ j, ], df ); + A[ i, j ] = theta[ 2 ]; + B[ i, j ] = theta[ 3 ]; + C[ i, j ] = theta[ 1 ]; + A[ j, i ] = A[ i, j ]; + B[ j, i ] = B[ i, j ]; + C[ j, i ] = C[ i, j ]; + } + } + + theta = garch2f8( x[ N, ] * x[ N, ], C[ N, N ], A[ N, N ], B[ N, N ], x[ N, ]^2, h[ N, ], C[ N, N ], A[ N, N ], B[ N, N ], x[ N, ]^2, h[ N, ], df ); + A[ N, N ] = theta[ 2 ]; + B[ N, N ] = theta[ 3 ]; + C[ N, N ] = theta[ 1 ]; + A[ N, N ] = A[ N, N ]; + B[ N, N ] = B[ N, N ]; + C[ N, N ] = C[ N, N ]; + + + # Transformation of Coefficient Matrices + ATMF = minfro( A ); + BTMF = minfro( B ); + CTMF = minfro( C /( 1 - B )) * ( 1 - BTMF ); + + # Rescale + #C = C .* (scale * scale'); + CTMF = CTMF * ( scale %*% t(scale) ); + + # Forecast of Conditional Covariance Matrix + Hhat = matrix( 0, N, N ); + for( i in 1 : N ) + { + for( j in 1 : N ) + { + hSeries = filter( cbind( 0, ATMF[ i, j ] ), cbind( 1, -BTMF[ i, j ] ), returns[ , i ] * returns[ , j ], S[ i, j ] ) + + filter( cbind( 0, CTMF[ i, j ] ), cbind( 1, -BTMF[ i, j ] ), matrix( 1, T,1)); + Hhat[ i, j ] = hSeries[ T ]; + } + } + + mu = matrix( mu ); + + return( list( mu = mu, ATMF = ATMF, BTMF = BTMF, CTMF = CTMF, Hhat = Hhat ) ); +} + +#' Fit a GARCH(1,1) model with student-t errors +#' +#' @param x : [vector] (T x 1) data generated by a GARCH(1,1) process +#' +#' @return q : [vector] (4 x 1) parameters of the GARCH(1,1) process +#' @return qerr : [vector] (4 x 1) standard error of parameter estimates +#' @return hf : [scalar] current conditional heteroskedasticity estimate +#' @return hferr : [scalar] standard error on hf +#' +#' @note +#' MATLAB's script initially written by Olivier Ledoit, 4/28/1997 +#' Uses a conditional t-distribution with fixed degrees of freedom +#' Difference with garch1f: errors come from the score alone +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "FitMultivariateGarch.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + + +garch1f4 = function( x, eps, df ) +{ + # Parameters + gold = ( 1 + sqrt(5) ) / 2; # step size increment + tol1 = 1e-7; # for termination criterion + tol2 = 1e-7; # for closeness to boundary + big = 2; # for making the hessian negative definite + maxiter = 50; # maximum number of iterations + n = 30; # number of points on the grid + + # Rescale + y = ( array(x) - mean( array(x)))^2; + t = length(y); + scale = sqrt(mean( y^2 )); + y = y / scale; + s = mean(y); + + # Grid search + #[ag, bg] = meshgrid( seq( 0, 1 - eps, length = n ), seq( 0, 1-eps, length = n ) ); + ag = outer(seq( 0, 1 - eps, length = n )*0, seq( 0, 1-eps, length = n ), FUN = "+" ); + bg = outer(seq( 0, 1 - eps, length = n ) , seq( 0, 1-eps, length = n ) * 0, FUN = "+" ) + cg = pmax( s * (1-ag-bg), 0 ); + likeg = matrix( -Inf, n, n ); + +for( i in 1 : n ) + { + for( j in 1 : (n-i+1) ) + { + h = filter( cbind( 0, ag[ i, j ] ), cbind( 1, -bg[ i, j] ), y * ( df - 2 ) / df, s * ( df - 2 )/ df ) + filter(cbind( 0, cg[ i, j ]),cbind( 1, - bg[ i, j ] ),matrix(1, t, 1)); + likeg[ i, j ] = -sum( log(h) + (df+1) * log( 1 + y /h /df) ); + } + } + maxlikeg = max(likeg, na.rm = TRUE); + maxima = which(likeg == maxlikeg); ##ok + maximum = max( maxima ); + + a = cbind(cg[ maximum ], ag[ maximum], bg[ maximum ]); + best = 0; + da = 0; + #term = 1; + #negdef = 0; + iter = 0; + while( iter < maxiter ) + { + iter = iter + 1; + + # New parameter1 + a = a + gold^best * da; + + # Conditional variance + h = filter(cbind( 0, a[ 2 ] ),cbind( 1, -a[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + filter(cbind( 0, a[ 1 ] ),cbind( 1, -a[ 3 ] ), matrix(1, t, 1 ) ); + + # Likelihood + if( any( a<0 )||( (a[ 2 ] + a[ 3 ]) > (1 - eps) )) + { + like = -Inf; + } else + { + like = -sum( log( h )+( df + 1 ) * log( 1 + y /h /df) ); + } + + GG = cbind( filter(cbind(0, 1),cbind( 1, -a[ 3] ), matrix( 1, t, 1 )), + filter(cbind( 0, 1 ),cbind( 1, -a[3] ), y * (df-2) / df ), + filter(cbind( 0, 1 ),cbind( 1, -a[ 3 ]), h )); + colnames(GG)<-NULL; + g1 = ( ( df+1 ) * ( y / ( y + df * h ) ) - 1 ) / h; + G = GG * (g1 %*% matrix( 1, 1, 3)); + gra = apply( G, 2, sum ); + + # Hessian + GG2 = GG[ ,c( 1, 2, 3, 1, 2, 3, 1, 2, 3)] * GG [, c( 1, 1, 1, 2, 2, 2, 3, 3, 3 ) ]; + g2 = -((df+1) * ( y /( y + df*h) ) - 1 ) / h^2 - ( df * ( df + 1 ) )*(y / ( y+df * h ) ^2 / h ); + HH = matrix( 0, t, 9); + HH[ , 3 ] = filter(cbind(0, 1), cbind(1, -a[ 3 ] ),GG[ ,1 ] ); + HH[ , 7 ] = HH[ , 3 ]; + HH[ , 6 ] = filter(cbind(0, 1), cbind(1, -a[ 3 ] ),GG[ , 2 ] ); + HH[ , 8 ] = HH[ ,6 ]; + HH[ , 9 ] = filter(cbind(0, 1), cbind(1, -a[ 3 ] ),GG[ , 3 ] ); + H = GG2 * (g2 %*% matrix( 1, 1, 9)) + HH * (g1 %*% matrix( 1, 1, 9)) ; + hes = matrix( apply( H, 2, sum), 3, 3 ); + + e = eigen(hes); + + if( any(e$values > 0) ) + { + negdef = 0; + d = min( e$values, max( e$values[ e$values<0 ] ) / big); + hes = e$vectors %*% diag(d, length(d)) %*% t(e$vectors); + } else + { + negdef = 1; + } + + # Direction + da = -gra %*% solve( hes ); + + # Termination criterion + term = (da %*% gra)[1]; + if ((term < tol1) && negdef) + { + break; + } + + best = 0; + newa = a + gold^(best-1) * da; + if( any(newa < 0 ) || ( newa[ 2 ] + newa[ 3 ] > (1-eps) ) ) + { + left = -Inf; + } else + { + h = filter( cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * ( df - 2 )/ df ) + filter(cbind( 0, newa[ 1 ]),cbind( 1, - newa[ 3 ] ),matrix(1, t, 1)); + + left = -sum( log(h) + (df+1) * log( 1 + y /h /df) ) + } + + newa = a + gold^best * da; + + if( any(newa < 0 ) || ( newa[ 2 ] + newa[ 3 ] > (1-eps) ) ) + { + center = -Inf; + } else + { + h = filter( cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * ( df - 2 )/ df ) + filter(cbind( 0, newa[ 1 ]),cbind( 1, - newa[ 3 ] ),matrix(1, t, 1)); + center = -sum( log(h) + (df+1) * log( 1 + y /h /df) ) + } + + newa = a + gold^( best+1 ) * da; + + if( any(newa < 0 ) || ( newa[ 2 ] + newa[ 3 ] > (1-eps) ) ) + { + right=-Inf; + } else + { + h = filter( cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * ( df - 2 )/ df ) + filter(cbind( 0, newa[ 1 ]),cbind( 1, - newa[ 3 ] ),matrix(1, t, 1)); + right = -sum( log(h) + (df+1) * log( 1 + y /h /df) ) + } + if( all(like > c( left, center, right)) || all( left > c( center, right )) ) + { + while( 1 ) + { + best = best-1; + center = left; + newa = a + gold^( best-1 ) * da; + if( any(newa < 0 ) || ( newa[ 2 ] + newa[ 3 ] > (1-eps) ) ) + { + left = -Inf; + } else + { + h = filter( cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * ( df - 2 )/ df ) + filter(cbind( 0, newa[ 1 ]),cbind( 1, - newa[ 3 ] ),matrix(1, t, 1)); + + left = -sum( log(h) + (df+1) * log( 1 + y /h /df) ) + } + if( all( center >= c( like, left ) ) ) + { + break; + } + } + }else + { + if( all( right > c( left, center ) ) ) + { + while( 1 ) + { + best = best+1; + center = right; + newa = a + gold^(best+1) *da; + if( any(newa < 0 ) || ( newa[ 2 ] + newa[ 3 ] > (1-eps) ) ) + { + right = -Inf; + } else + { + h = filter( cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * ( df - 2 )/ df ) + filter(cbind( 0, newa[ 1 ]),cbind( 1, - newa[ 3 ] ),matrix(1, t, 1)); + right = -sum( log(h) + (df+1) * log( 1 + y /h /df) ) + } + if( center > right ) + { + break; + } + } + } + } + + # If stuck at boundary then stop + if( ( center == like ) && ( any(a (1-tol2) ) ) ) + { + break; + } + + # end of optimization loop + } + + if( length(a[ a < tol2 ]) ) + { + a[ a < tol2 ] = matrix( 0, 1, length(a[ a ( 1-tol2 ) ) + { + if( a[ 2 ]< ( 1 - tol2 ) ) + { + a[ 2 ] = a[ 2 ] + (1 - a[ 2 ]-a[ 3 ] ); + }else + { + a[ 3 ] = a[ 3 ] + ( 1 - a[ 2 ]- a[ 3 ] ); + } + } + + # Estimation error and volatility forecast + #aerr=solve(t(G)%*%G); + tmp = ( t(G) %*% G ); + aerr = tmp %*% solve(diag( 1, dim(tmp))); + hf = a[ 1 ] + a[ 2 ] * y[ t ] * (df-2) / df + a[ 3 ] * h[ t ]; + gf = c( 1, y[ t ], h[ t ] ) + a[ 3 ] * GG[ t, ]; + hferr = gf %*% aerr %*% gf; + aerr = t( diag(aerr) ); + + # Revert to original scale + a[ 1 ] = a[ 1 ] * scale; + aerr[ 1 ] = aerr[ 1 ] * scale^2; + hf = hf* scale; + hferr = hferr * scale^2; + + aerr = sqrt(aerr); + hferr = sqrt(hferr); + q = a; + qerr = aerr; + + return( list( q = q, qerr = qerr, hf = hf, hferr = hferr ) ); +} + +#' Off-diagonal parameter estimation in bivariate GARCH(1,1) when diagonal parameters are given. +#' +#' @param x : [vector] (T x 1) data generated by a GARCH(1,1) process +#' +#' @return q : [vector] (4 x 1) parameters of the GARCH(1,1) process +#' @return qerr : [vector] (4 x 1) standard error of parameter estimates +#' @return hf : [scalar] current conditional heteroskedasticity estimate +#' @return hferr : [scalar] standard error on hf +#' +#' @note +#' Initially written by Olivier Ledoit, 4/28/1997 +#' Uses a conditional t-distribution with fixed degrees of freedom +#' Steepest Ascent on boundary, Hessian off boundary, no grid search +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "FitMultivariateGarch.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +garch2f8 = function( y, c1, a1, b1, y1, h1, c2, a2, b2, y2, h2, df ) +{ + # Parameters + gold = ( 1 + sqrt( 5 ) ) / 2; # step size increment + tol1 = 1e-7; # for termination criterion + tol2 = 1e-7; # for closeness to boundary + big = 2; # for making the hessian negative definite + maxiter = 50; # maximum number of iterations + #n=30; # number of points on the grid + + # Prepare + t = length( y ); + y1 = array( y1 ); + y2 = array( y2 ); + y = array( y ); + s = mean( y ); + #s1 = mean(y1); + #s2 = mean(y2); + h1 = array( h1 ); + h2 = array( h2 ); + + # Bounds + low = c(-sqrt(c1*c2), 0, 0 ) + tol2; + high = c( sqrt(c1*c2), sqrt(a1*a2), sqrt(b1*b2) ) - tol2; + + # Starting Point + a0 = 0.9 * sqrt( a1 * a2 ); + b0 = 0.9 * sqrt( b1 * b2 ); + c0 = mean( y ) * ( 1 - a0 - b0 ) %*% ( df - 2 )/df; + c0 = sign( c0 ) * min( abs( c0 ), 0.9 * sqrt( c1*c2 )); + + # Initialize optimization + a = cbind( c0, a0, b0 ); + best = 0; + da = 0; + #term=1; + #negdef=0; + iter = 0; + while( iter < maxiter ) + { + iter = iter + 1; + + # New parameter1 + a = a + gold^best * da; + + # Conditional variance + h = filter(cbind( 0, a[ 2 ] ),cbind( 1, -a[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + filter(cbind( 0, a[ 1 ] ),cbind( 1, -a[ 3 ] ), matrix(1, t, 1 ) ); + d = h1 * h2 - h^2; + z = h2 * y1 + h1 * y2 - 2 * h * y; + + # Likelihood + if( any( ahigh) ) + { + like = -Inf; + } else + { + if( any( d <= 0 ) || any( 1+ z / d / df <= 0 ) ) + { + like = -Inf; + } else + { + #OJO + like = -sum( log( d ) + ( 2 + df ) * log( 1 + z / d / df) /2 ); + } + } + + # Gradient + GG = cbind( filter(cbind(0, 1),cbind( 1, -a[ 3] ), matrix( 1, t, 1 )), + filter(cbind( 0, 1 ),cbind( 1, -a[3] ), y * (df-2) / df ), + filter(cbind( 0, 1 ),cbind( 1, -a[ 3 ]), h )); + colnames(GG)<-NULL; + g1 = ( ( df+1 ) * ( y / ( y + df * h ) ) - 1 ) / h; + #OJO + g1 = h / d + ( 2 + df ) * y / ( z + d * df) - ( 2 + df ) * h * z /( z + d * df ) / d; + G = GG * ( g1 %*% matrix( 1, 1, 3) ); + gra = apply( G, 2, sum ); + + # Hessian + g2 = 1 / d + 2 * h^2 / d^2 - (2 + df) * y / (z + d * df)^2 * ( -2 * y - 2 * df * h) - + (2 + df) * z / ( z + d * df) / d + 2 * (2 + df) * h * y / ( z + d * df ) / d + + (2 + df) * h * z / (z + d * df)^2 / d *( -2 * y - 2 * df * h ) - + 2 * ( 2 + df ) * h^2 * z / ( z + d * df ) / d ^2; + + GG2 = GG[ ,c( 1, 2, 3, 1, 2, 3, 1, 2, 3)] * GG [, c( 1, 1, 1, 2, 2, 2, 3, 3, 3 ) ]; + HH = matrix( 0, t, 9); + HH[ , 3 ] = filter(cbind(0, 1), cbind(1, -a[ 3 ] ),GG[ , 1 ] ); + HH[ , 7 ] = HH[ , 3 ]; + HH[ , 6 ] = filter(cbind(0, 1), cbind(1, -a[ 3 ] ),GG[ , 2 ] ); + HH[ , 8 ] = HH[ ,6 ]; + HH[ , 9 ] = filter(cbind(0, 1), cbind(1, -a[ 3 ] ),GG[ , 3 ] ); + H = GG2 * (g2 %*% matrix( 1, 1, 9)) + HH * (g1 %*% matrix( 1, 1, 9)) ; + hes = matrix( apply( H, 2, sum), 3, 3 ); + + e = eigen(hes); + if( all(e$values>0) ) + { + hes = -diag( 1, 3 ); + negdef = 0; + }else + { + if( any(e$values > 0) ) + { + negdef = 0; + val = pmin( e$values, max( e$values[ e$values<0 ] ) / big); + hes = e$vectors %*% diag( val, length(val)) %*% t(e$vectors); + + } else + { + negdef = 1; + } + } + + # Steepest Ascent or Newton + if( any( c(a==low, a==high) ) ) + { + da = -((gra %*% t(gra))/(gra %*% hes %*% t(gra))) %*% gra; + }else + { + da = -gra %*% solve(hes); + } + + # Termination criterion + term = (da %*% gra)[1] ; + if( ( term < tol1 ) && negdef ) + { + break; + } + + # If you are on the boundary and want to get out, slide along + if( length(da[( a==low ) & (da<0) ])) + { + da[( a==low ) & (da<0) ] = matrix( 0, dim(da[ ( a==low ) & ( da<0 ) ])); + } + if( length( da[( a==high ) & (da>0) ] ) ) + { + da[( a==high ) & (da>0) ] = matrix( 0, dim(da[ ( a==high ) & ( da>0 ) ])); + } + # If you are stuck in a corner, terminate too + if( all(da==0) ) + { + break; + } + + # Go no further than next boundary + hit = cbind(( low[ da != 0 ] - a[ da != 0 ] ) / da[ da != 0 ], + ( high[ da != 0 ] - a[ da != 0 ] ) / da[ da != 0 ]); + if( length(hit[hit <= 0])) hit[ hit <= 0 ] = 0; + da = min(cbind(hit, 1)) * da; + + # Step search + best = 0; + newa = a + gold^( best - 1 ) * da; + if( any( newa < low ) || any(newa > high) ) + { + left = -Inf; + }else + { + h = filter(cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + + filter(cbind( 0, newa[ 1 ] ), cbind( 1, -newa[ 3 ] ), matrix(1, t, 1 ) ); + d = h1 * h2 - h^2; + z = h2 * y1 + h1 * y2 - 2 * h * y; + if( any( d <= 0 ) || any( 1+ z / d / df <= 0 ) ) + { + left = -Inf; + } else + { + left = -sum( log( d ) + ( 2 + df ) * log( 1 + z / d / df) /2 ); + } + } + + newa = a + gold^( best ) * da; + if( any( newa < low ) || any(newa > high) ) + { + center = -Inf; + }else + { + h = filter(cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + + filter(cbind( 0, newa[ 1 ] ), cbind( 1, -newa[ 3 ] ), matrix(1, t, 1 ) ); + d = h1 * h2 - h^2; + z = h2 * y1 + h1 * y2 - 2 * h * y; + if( any( d <= 0 ) || any( 1+ z / d / df <= 0 ) ) + { + center = -Inf; + } else + { + center = -sum( log( d ) + ( 2 + df ) * log( 1 + z / d / df) /2 ); + } + } + + newa = a + gold^( best + 1 ) * da; + if( any( newa < low ) || any(newa > high) ) + { + right = -Inf; + }else + { + h = filter(cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + + filter(cbind( 0, newa[ 1 ] ), cbind( 1, -newa[ 3 ] ), matrix(1, t, 1 ) ); + d = h1 * h2 - h^2; + z = h2 * y1 + h1 * y2 - 2 * h * y; + if( any( d <= 0 ) || any( 1+ z / d / df <= 0 ) ) + { + right = -Inf; + } else + { + right = -sum( log( d ) + ( 2 + df ) * log( 1 + z / d / df) /2 ); + } + } + + if( all( like > c( left, center, right ) )|| all( left > c( center, right ) )) + { + while( 1 ) + { + best = best - 1; + center = left; + newa = a + gold^( best - 1 ) * da; + if( any( newa < low ) || any(newa > high) ) + { + left = -Inf; + }else + { + h = filter(cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + + filter(cbind( 0, newa[ 1 ] ), cbind( 1, -newa[ 3 ] ), matrix(1, t, 1 ) ); + d = h1 * h2 - h^2; + z = h2 * y1 + h1 * y2 - 2 * h * y; + if( any( d <= 0 ) || any( 1+ z / d / df <= 0 ) ) + { + left = -Inf; + } else + { + left = -sum( log( d ) + ( 2 + df ) * log( 1 + z / d / df) /2 ); + } + } + + if( all(center >= c( like, left ) ) ) + { + break; + } + } + }else + { + if( all( right > c( left, center ) ) ) + { + best = best + 1; + center = right; + newa = a + gold^( best + 1 ) * da; + while( 1 ) + { + if( any( newa < low ) || any(newa > high) ) + { + right = -Inf; + }else + { + h = filter(cbind( 0, newa[ 2 ] ), cbind( 1, -newa[ 3 ] ), y * ( df - 2 ) / df, s * (df-2) / df ) + + filter(cbind( 0, newa[ 1 ] ), cbind( 1, -newa[ 3 ] ), matrix(1, t, 1 ) ); + d = h1 * h2 - h^2; + z = h2 * y1 + h1 * y2 - 2 * h * y; + if( any( d <= 0 ) || any( 1+ z / d / df <= 0 ) ) + { + right = -Inf; + } else + { + right = -sum( log( d ) + ( 2 + df ) * log( 1 + z / d / df) /2 ); + } + } + + if( center > right ) + { + break; + } + } + } + } + } + + q = a; + + return( q ); +} + +# +# @param A : [matrix] an indefinite symmetric matrix with non-negative diagonal elements +# +# @return XXX : [matrix] positive semi-definite matrix with same diagonal elements as A that is closest +# to A according to the Frobenius norm +# +# @note Written initially by Ilya Sharapov (1997) +# +# @references +# \url{http://symmys.com/node/170} +# See Meucci's script for "FitMultivariateGarch.m" +# +# @author Xavier Valls \email{flamejat@@gmail.com} + +minfro = function( A ) +{ + if( any( diag( A ) < 0) ) + { + stop("Diagonal Elements Must Be Non-Negative!"); + }else if( any( any( A != t(A) ) ) ) + { + stop("Matrix Must Be Symmetric!"); + }else if( all( eigen(A)$values >= 0 ) ) + { + XXX = A; + }else + { + # if things go wrong make rho bigger and wait longer + rho = 0.75; + tol = 3e-6; # tolerance + maxj = 10; # max number of iterations + + n = nrow( A ); + M = diag( diag(A), ncol(A) ); # initialize with diagonal + oldnorm = norm( M - A , "F" ); + oldnormj = oldnorm; + normj[ 1 ] = oldnorm; + + j = 1; + incmax = 1e32; # just to enter the loop + while((jtol)) + { + incmax = 0; + for( i in 1 : n ) + { + a = rbind( A[ 1:i-1, i ], A[ i+1:n, i ] ); + m = rbind( M[ 1:i-1, i ], M[ i+1:n, i ] ); + aii = A[ i, i ]; + b = a - rho * m; + # Newton's step + x = newton( M, i, b, m, aii, n, rho ); + P = sparse( diag( 1, n ) ); + P[ i, 1:n ] = t(x); + # update + Mtest = P %*% M %*% t(P); + M = Mtest; + inc = oldnorm - norm( M - A, "F" ); + oldnorm = norm( M - A, "F" ); + # find maximal increment over iteration + if( inc > incmax ) + { + incmax = inc; + } + } + + normj[ j+1 ] = oldnorm; ##ok + incj[ j ] = oldnormj - oldnorm; + oldnormj = oldnorm; + + j = j + 1; + + } + + XXX = M; + } + + return( XXX ); +} + +newton = function(M, i, b, m, aii, n, rho) +{ + ## Newton setp + # Subroutine called interbally by minfro.m + + maxit = 40; + eps = 1e-9; # small correction + + # to handle singularity + l = 0.0; + MM = rbind( cbind( M[ 1:i-1, 1:i-1 ], M[ 1:i-1, i+1:n ] ), cbind( M[ i+1:n, 1:i-1 ], M[ i+1:n, i+1:n ]) ) + eps * eye( n - 1 ); + + j = 1; + # loop + while( j < maxit ) + { + tmp = MM %*% MM + l * MM; + IM = tmp %*% solve(diag( 1, dim( tmp ))); + #IM = inv(MM*MM+l*MM); + x = IM %*% ( MM %*% b - l * rho * m); + f = rho * rho * aii + 2 * rho * t(x) %*% m + t(x) %*% MM %*% x - aii; + + if( abs(f) < 1e-7 ) + { + break; + } + + dfdl = -2 * t( rho * m + MM %*% x ) %*% IM %*% ( rho * m + MM %*% x ); + # Newton's step + l = l - f / dfdl; + j = j + 1; + } + + if( abs(f) < 1e-7 ) + { + # converged + xx = rbind( x[ 1:i-1 ], rho, x[ i:n-1 ]); + }else + { + # didn't converge + xx = matrix( 0, n, 1 ); + xx[ i ] = 1; + } + + return( xx ); +} + + + + Added: pkg/Meucci/R/MvnRnd.R =================================================================== --- pkg/Meucci/R/MvnRnd.R (rev 0) +++ pkg/Meucci/R/MvnRnd.R 2013-07-28 11:28:31 UTC (rev 2654) @@ -0,0 +1,44 @@ +#' Generates normal simulations whose sample moments match the population moments +#' +#' Adapted from file 'MvnRnd.m'. Most recent version of article and code available at http://www.symmys.com/node/162 +#' see A. Meucci - "Simulations with Exact Means and Covariances", Risk, July 2009 +#' +#' @param M a numeric indicating the sample first moment of the distribution +#' @param S a covariance matrix +#' @param J a numeric indicating the number of trials +#' +#' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} +#' @references +#' \url{http://www.symmys.com} +#' TODO: Add Schur decomposition. Right now function is only sampling from mvrnorm so sample moments do no match population moments +#' I have sample code commented out below to implement this correctly but I require a function that returns the unitaryMatrix from a Schur decomposition +#' @export +MvnRnd = function( M , S , J ) +{ + library(MASS) + X = MASS::mvrnorm( n = J , mu = M , Sigma = S ) # Todo: need to swap with Meucci function and Schur method + return( X = X ) + + # # compute sample covariance: NOTE defined as "cov(Y,1)", not as "cov(Y)" + # S_ = cov( Y , 1 ) + # + # # solve Riccati equation using Schur method + # zerosMatrix = matrix( rep( 0 , length( N * N ) ) , nrow = N ) + # # define the Hamiltonian matrix + # H1 = cbind( zerosMatrix , -1*S_ ) + # H2 = cbind( -S , zerosMatrix ) + # H = rbind( H1 , H2 ) + # # perform its Schur decomposition. [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2654 From noreply at r-forge.r-project.org Sun Jul 28 15:08:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 15:08:39 +0200 (CEST) Subject: [Returnanalytics-commits] r2655 - pkg/PortfolioAnalytics/R Message-ID: <20130728130839.9DD17184F6E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-28 15:08:39 +0200 (Sun, 28 Jul 2013) New Revision: 2655 Modified: pkg/PortfolioAnalytics/R/charts.DE.R Log: modifying chart.Weights.DE to work with the new interface Modified: pkg/PortfolioAnalytics/R/charts.DE.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.DE.R 2013-07-28 11:28:31 UTC (rev 2654) +++ pkg/PortfolioAnalytics/R/charts.DE.R 2013-07-28 13:08:39 UTC (rev 2655) @@ -29,60 +29,64 @@ #' @seealso \code{\link{optimize.portfolio}} #' @export chart.Weights.DE <- function(DE, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){ -# Specific to the output of the random portfolio code with constraints - # @TODO: check that DE is of the correct class - columnnames = names(DE$weights) - numassets = length(columnnames) - - if(is.null(xlab)) - minmargin = 3 - else - minmargin = 5 - if(main=="") topmargin=1 else topmargin=4 - if(las > 1) {# set the bottom border to accommodate labels - bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab - if(bottommargin > 10 ) { - bottommargin<-10 - columnnames<-substr(columnnames,1,19) - # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels - } + # Specific to the output of the random portfolio code with constraints + # @TODO: check that DE is of the correct class + if(!inherits(DE, "optimize.portfolio.DEoptim")) stop("DE must be of class 'optimize.portfolio.DEoptim'") + + columnnames = names(DE$weights) + numassets = length(columnnames) + + constraints <- get_constraints(DE$portfolio) + + if(is.null(xlab)) + minmargin = 3 + else + minmargin = 5 + if(main=="") topmargin=1 else topmargin=4 + if(las > 1) {# set the bottom border to accommodate labels + bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab + if(bottommargin > 10 ) { + bottommargin<-10 + columnnames<-substr(columnnames,1,19) + # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels } - else { - bottommargin = minmargin - } - par(mar = c(bottommargin, 4, topmargin, 2) +.1) - plot(DE$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=c(0,max(DE$constraints$max)), ylab="Weights", main=main, pch=16, ...) - points(DE$constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24) - points(DE$constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25) -# if(!is.null(neighbors)){ -# if(is.vector(neighbors)){ -# xtract=extractStats(DE) -# weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot -# if(length(neighbors)==1){ -# # overplot nearby portfolios defined by 'out' -# orderx = order(xtract[,"out"]) -# subsetx = head(xtract[orderx,], n=neighbors) -# for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue") -# } else{ -# # assume we have a vector of portfolio numbers -# subsetx = xtract[neighbors,weightcols] -# for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue") -# } -# } -# if(is.matrix(neighbors) | is.data.frame(neighbors)){ -# # the user has likely passed in a matrix containing calculated values for risk.col and return.col -# nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot -# for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue") -# # note that here we need to get weight cols separately from the matrix, not from xtract -# # also note the need for as.numeric. points() doesn't like matrix inputs -# } -# } - -# points(DE$weights, type="b", col="blue", pch=16) - axis(2, cex.axis = cex.axis, col = element.color) - axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis = cex.axis, col = element.color) - box(col = element.color) - + } + else { + bottommargin = minmargin + } + par(mar = c(bottommargin, 4, topmargin, 2) +.1) + plot(DE$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=c(0,max(constraints$max)), ylab="Weights", main=main, pch=16, ...) + points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24) + points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25) + # if(!is.null(neighbors)){ + # if(is.vector(neighbors)){ + # xtract=extractStats(DE) + # weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot + # if(length(neighbors)==1){ + # # overplot nearby portfolios defined by 'out' + # orderx = order(xtract[,"out"]) + # subsetx = head(xtract[orderx,], n=neighbors) + # for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue") + # } else{ + # # assume we have a vector of portfolio numbers + # subsetx = xtract[neighbors,weightcols] + # for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue") + # } + # } + # if(is.matrix(neighbors) | is.data.frame(neighbors)){ + # # the user has likely passed in a matrix containing calculated values for risk.col and return.col + # nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot + # for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue") + # # note that here we need to get weight cols separately from the matrix, not from xtract + # # also note the need for as.numeric. points() doesn't like matrix inputs + # } + # } + + # points(DE$weights, type="b", col="blue", pch=16) + axis(2, cex.axis = cex.axis, col = element.color) + axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis = cex.axis, col = element.color) + box(col = element.color) + } #' classic risk return scatter of DEoptim results From noreply at r-forge.r-project.org Sun Jul 28 15:50:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 15:50:13 +0200 (CEST) Subject: [Returnanalytics-commits] r2656 - pkg/PortfolioAnalytics/R Message-ID: <20130728135013.EE79B185823@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-28 15:50:13 +0200 (Sun, 28 Jul 2013) New Revision: 2656 Modified: pkg/PortfolioAnalytics/R/charts.DE.R Log: modifying chart.Scatter.DE to work with new interface Modified: pkg/PortfolioAnalytics/R/charts.DE.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.DE.R 2013-07-28 13:08:39 UTC (rev 2655) +++ pkg/PortfolioAnalytics/R/charts.DE.R 2013-07-28 13:50:13 UTC (rev 2656) @@ -93,7 +93,7 @@ #' #' @param DE set of portfolios created by \code{\link{optimize.portfolio}} #' @param R an optional an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the objective function where required -#' @param constraints an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}} +#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization #' @param neighbors set of 'neighbor' portfolios to overplot, see Details in \code{\link{charts.DE}} #' @param return.col string matching the objective of a 'return' objective, on vertical axis #' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis @@ -102,7 +102,7 @@ #' @param element.color color for the default plot scatter points #' @seealso \code{\link{optimize.portfolio}} #' @export -chart.Scatter.DE <- function(DE, R=NULL, constraints=NULL, neighbors = NULL, return.col='mean', risk.col='ES', ..., element.color = "darkgray", cex.axis=0.8){ +chart.Scatter.DE <- function(DE, R=NULL, portfolio=NULL, neighbors = NULL, return.col='mean', risk.col='ES', ..., element.color = "darkgray", cex.axis=0.8){ # more or less specific to the output of the random portfolio code with constraints # will work to a point with other functions, such as optimize.porfolio.parallel # there's still a lot to do to improve this. @@ -161,7 +161,7 @@ # } ## Draw solution trajectory - if(!is.null(R) & !is.null(constraints)){ + if(!is.null(R) & !is.null(portfolio)){ w.traj = unique(DE$DEoutput$member$bestmemit) rows = nrow(w.traj) rr = matrix(nrow=rows, ncol=2) @@ -172,7 +172,7 @@ for(i in 1:rows){ w = w.traj[i,] - x = unlist(constrained_objective(w=w, R=R, constraints=constraints, trace=TRUE)) + x = unlist(constrained_objective(w=w, R=R, portfolio=portfolio, trace=TRUE)) names(x)<-name.replace(names(x)) if(is.null(trajnames)) trajnames<-names(x) if(is.null(rsc)){ @@ -210,7 +210,7 @@ } objcols<-unlist(DE[[result.slot]]) names(objcols)<-name.replace(names(objcols)) - return.column = pmatch(return.column,names(objcols)) + return.column = pmatch(return.col,names(objcols)) if(is.na(return.column)) { return.col = paste(return.col,return.col,sep='.') return.column = pmatch(return.col,names(objcols)) From noreply at r-forge.r-project.org Sun Jul 28 21:29:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 21:29:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2657 - pkg/Meucci/demo Message-ID: <20130728192959.C973A184888@r-forge.r-project.org> Author: xavierv Date: 2013-07-28 21:29:59 +0200 (Sun, 28 Jul 2013) New Revision: 2657 Added: pkg/Meucci/demo/S_MaxMinVariance.R Log: -added S_MaxMinVariance.R demo script Added: pkg/Meucci/demo/S_MaxMinVariance.R =================================================================== --- pkg/Meucci/demo/S_MaxMinVariance.R (rev 0) +++ pkg/Meucci/demo/S_MaxMinVariance.R 2013-07-28 19:29:59 UTC (rev 2657) @@ -0,0 +1,88 @@ +#' This script dispays location-dispersion ellipsoid and statistic, as described +#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_MaxMinVariance.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +if ( !require( "mvtnorm" ) ) stop("mvtnorm package installation required for this script") + +################################################################################################################## +### Input parameters +Mu = rbind( 0.5, 0.5 ); +s = rbind( 0.1, 0.1 ); +nu = 40; +r = -0.9; +nSim = 10000; + +################################################################################################################## +### Generate sample +C = rbind( c( 1, r ), c( r, 1)); +Ones = matrix( 1, nSim, 1); +Y = Ones %*% t(Mu) + ( Ones %*% t(s) ) * rmvt( nSim, C, nu ); +X = exp( Y ); +m = matrix( apply( X, 2, mean )); +S = cov( X ); + +################################################################################################################## +### Evaluate standard deviation on a one-dim projection (versor) +Theta = seq( 0, 2 * pi, pi/100 ); +nTheta = length( Theta ); +invS = solve( S ); + +SDev = matrix( NaN, nTheta, 1 ); +Radius = matrix( NaN, nTheta, 1 ); + +for( n in 1 : nTheta ) +{ + th = Theta[ n ]; + # versor + e = rbind( cos(th), sin(th) ); + Z = X %*% e; # projection + SDev[ n ] = sd( Z ); # standard deviation + Radius[ n ] = ( t(e) %*% invS %*% e )^( -1/2 ); # radius of ellipsoid +} + +################################################################################################################## +### Compute min and max standard deviation and respective versor +min_n = which.min( SDev ); +e_min = rbind( cos( Theta[ min_n ] ), sin( Theta[ min_n ] ) ); +s_min = SDev[ min_n ]; + +max_n = which.max( SDev ); +e_max = rbind( cos( Theta[ max_n ] ), sin( Theta[ max_n ] ) ); +s_max = SDev[ max_n ]; + +################################################################################################################## +### Plots +dev.new(); + +# scatter plot simulations +plot( X[ , 1 ], X[ , 2 ] ); + +# plot ellipsoid +Scale = 2; +PlotEigVectors = 1; +PlotSquare = 1; +TwoDimEllipsoid( m, S, Scale, PlotEigVectors, PlotSquare); + +# plot special directions defined by the max-min versors +Center = matrix( apply( X, 2, mean) ) * 0.7; # de-center plot of special directions for better display +v = Scale * matrix( seq( -1, 1, 0.1 ) ); +Ones = 1 + 0 * v; + +v_min = Ones %*% t( Center ) + v %*% s_min %*% t( e_min ); +lines( v_min[ , 1 ], v_min[ , 2 ], col = "red" ); +v_max = Ones %*% t( Center ) + v %*% s_max %*% t( e_max ); +lines( v_max[ , 1 ], v_max[ , 2 ], col = "red" ); + +# plot statistics versus geometry +dev.new(); +Scaled_Theta = Theta / (pi / 2); + # plot standard deviation as function of direction +plot( Scaled_Theta, SDev, type = "l", xlab = "theta/(pi/2)", xlim = c( Scaled_Theta[ 1 ], Scaled_Theta[length(Scaled_Theta)] ) ); +# plot radius of ellipsoid as function of direction +lines( Scaled_Theta, Radius, col="red" ); +legend( "topleft", 1.9, c( "st.dev on projection", "radius of ellipsoid" ), col = c( "black", "red" ), lty = 1, bg = "gray90" ); \ No newline at end of file From noreply at r-forge.r-project.org Sun Jul 28 21:54:14 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 21:54:14 +0200 (CEST) Subject: [Returnanalytics-commits] r2658 - in pkg/Meucci: R man Message-ID: <20130728195414.C360218561D@r-forge.r-project.org> Author: xavierv Date: 2013-07-28 21:54:14 +0200 (Sun, 28 Jul 2013) New Revision: 2658 Removed: pkg/Meucci/R/Cumul2Raw.R Modified: pkg/Meucci/R/InvariantProjection.R pkg/Meucci/man/Cumul2Raw.Rd Log: - fixed duplication for Cumul2Raw Deleted: pkg/Meucci/R/Cumul2Raw.R =================================================================== --- pkg/Meucci/R/Cumul2Raw.R 2013-07-28 19:29:59 UTC (rev 2657) +++ pkg/Meucci/R/Cumul2Raw.R 2013-07-28 19:54:14 UTC (rev 2658) @@ -1,30 +0,0 @@ -#' Map cumulative moments into raw moments, as described in A. Meucci "Risk and Asset Allocation", -#' Springer, 2005 -#' -#' @param ka : [vector] (length N corresponding to order N) cumulative moments -#' -#' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments -#' -#' @references -#' \url{http://symmys.com/node/170} -#' See Meucci's script for "Cumul2Raw.m" -#' -#' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export -Cumul2Raw = function( ka ) -{ - N = length( ka ); - mu_ = ka; - - for( n in 2 : N ) - { - #ka[ n ] = mu_[ n ]; Doesn't make sense - - for( k in 1 : (n-1) ) - { - mu_[ n ] = mu_[ n ] + choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ]; - } - } - - return( mu_ ); -} \ No newline at end of file Modified: pkg/Meucci/R/InvariantProjection.R =================================================================== --- pkg/Meucci/R/InvariantProjection.R 2013-07-28 19:29:59 UTC (rev 2657) +++ pkg/Meucci/R/InvariantProjection.R 2013-07-28 19:54:14 UTC (rev 2658) @@ -34,7 +34,7 @@ return( mu = mu ) } -#' Transforms cumulants of Y-t into raw moments +#' Map cumulative moments into raw moments. #' #' step 5 of the projection process: #' @@ -46,28 +46,35 @@ #' \equiv \kappa^{ \big(n\big) }_{Y} + \sum_{k=1}^{n-1} (n-1)C_{k-1} #' \kappa_{Y}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{Y} } #' -#' @param ka cumulants of Y -#' @return mu_ the raw non-central moments of Y +#' @param ka : [vector] (length N corresponding to order N) cumulative moments +#' +#' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments #' -#' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} +#' @author Xavier Valls \email{flamejat@@gmail.com} and Ram Ahluwalia \email{rahluwalia@@gmail.com} #' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Cumul2Raw.m". +#' #' A. Meucci - "Annualization and General Projection of Skewness, Kurtosis and All Summary Statistics" - formula (24) #' Symmys site containing original MATLAB source code \url{http://www.symmys.com/node/136} #' @export + Cumul2Raw = function( ka ) { - N = length( ka ) - mu_ = ka - - for ( n in 1:N ) + N = length( ka ); + mu_ = ka; + + for( n in 2 : N ) { - mu_[n] = ka[n] - for ( k in 1:(n-1) ) - { - if ( n != 1 ) { mu_[n] = mu_[n] + choose(n-1,k-1) * ka[k] * mu_[n-k] } - } - } - return( mu_ = mu_ ) + #ka[ n ] = mu_[ n ]; Doesn't make sense + + for( k in 1 : (n-1) ) + { + mu_[ n ] = mu_[ n ] + choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ]; + } + } + + return( mu_ ); } #' Transforms raw moments into cumulants Modified: pkg/Meucci/man/Cumul2Raw.Rd =================================================================== --- pkg/Meucci/man/Cumul2Raw.Rd 2013-07-28 19:29:59 UTC (rev 2657) +++ pkg/Meucci/man/Cumul2Raw.Rd 2013-07-28 19:54:14 UTC (rev 2658) @@ -1,19 +1,21 @@ \name{Cumul2Raw} \alias{Cumul2Raw} -\title{Transforms cumulants of Y-t into raw moments} +\title{Map cumulative moments into raw moments.} \usage{ Cumul2Raw(ka) Cumul2Raw(ka) } \arguments{ - \item{ka}{cumulants of Y} + \item{ka}{: [vector] (length N corresponding to order N) + cumulative moments} \item{ka}{: [vector] (length N corresponding to order N) cumulative moments} } \value{ - mu_ the raw non-central moments of Y + mu_ : [vector] (length N corresponding to order N) + corresponding raw moments mu_ : [vector] (length N corresponding to order N) corresponding raw moments @@ -36,11 +38,15 @@ \kappa_{Y}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{Y} } } \author{ - Ram Ahluwalia \email{rahluwalia at gmail.com} + Xavier Valls \email{flamejat at gmail.com} and Ram Ahluwalia + \email{rahluwalia at gmail.com} Xavier Valls \email{flamejat at gmail.com} } \references{ + \url{http://symmys.com/node/170} See Meucci's script for + "Cumul2Raw.m". + A. Meucci - "Annualization and General Projection of Skewness, Kurtosis and All Summary Statistics" - formula (24) Symmys site containing original MATLAB source code From noreply at r-forge.r-project.org Mon Jul 29 05:12:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 05:12:11 +0200 (CEST) Subject: [Returnanalytics-commits] r2659 - pkg/PortfolioAnalytics/R Message-ID: <20130729031211.9B3D51842C5@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 05:12:11 +0200 (Mon, 29 Jul 2013) New Revision: 2659 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: modifying constraints with default arguments for type so that they can be specified separately Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-28 19:54:14 UTC (rev 2658) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 03:12:11 UTC (rev 2659) @@ -313,7 +313,7 @@ #' # specify box constraints per asset #' 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)) #' @export -box_constraint <- function(type, assets, min, max, min_mult, max_mult, enabled=TRUE, message=FALSE, ...){ +box_constraint <- function(type="box", assets, min, max, min_mult, max_mult, enabled=TRUE, message=FALSE, ...){ # Based on the constraint function for object of class constraint_v1 that # included specifying box constraints. @@ -427,7 +427,7 @@ #' group_min=c(0.15, 0.25), #' group_max=c(0.65, 0.55)) #' @export -group_constraint <- function(type, assets, groups, group_labels=NULL, group_min, group_max, group_pos=NULL, enabled=TRUE, message=FALSE, ...) { +group_constraint <- function(type="group", assets, groups, group_labels=NULL, group_min, group_max, group_pos=NULL, enabled=TRUE, message=FALSE, ...) { nassets <- length(assets) ngroups <- length(groups) @@ -511,7 +511,21 @@ #' pspec <- add.constraint(pspec, type="dollar_neutral") #' pspec <- add.constraint(pspec, type="active") #' @export -weight_sum_constraint <- function(type, min_sum=0.99, max_sum=1.01, enabled=TRUE, ...){ +weight_sum_constraint <- function(type="weight_sum", min_sum=0.99, max_sum=1.01, enabled=TRUE, ...){ + switch(type, + full_investment = { + max_sum <- 1 + min_sum <- 1 + }, + dollar_neutral = { + max_sum <- 0 + min_sum <- 0 + }, + active = { + max_sum <- 0 + min_sum <- 0 + } + ) Constraint <- constraint(type, enabled=enabled, constrclass="weight_sum_constraint", ...) Constraint$min_sum <- min_sum Constraint$max_sum <- max_sum @@ -632,7 +646,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) #' @export -turnover_constraint <- function(type, turnover_target, enabled=TRUE, message=FALSE, ...){ +turnover_constraint <- function(type="turnover", turnover_target, enabled=TRUE, message=FALSE, ...){ Constraint <- constraint(type, enabled=enabled, constrclass="turnover_constraint", ...) Constraint$turnover_target <- turnover_target return(Constraint) @@ -656,7 +670,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) #' @export -diversification_constraint <- function(type, div_target, enabled=TRUE, message=FALSE, ...){ +diversification_constraint <- function(type="diversification", div_target, enabled=TRUE, message=FALSE, ...){ Constraint <- constraint(type, enabled=enabled, constrclass="diversification_constraint", ...) Constraint$div_target <- div_target return(Constraint) @@ -683,7 +697,7 @@ #' #' pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3) #' @export -position_limit_constraint <- function(type, assets, max_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, enabled=TRUE, message=FALSE, ...){ +position_limit_constraint <- function(type="position_limit", assets, max_pos=NULL, max_pos_long=NULL, max_pos_short=NULL, enabled=TRUE, message=FALSE, ...){ # Get the length of the assets vector nassets <- length(assets) From noreply at r-forge.r-project.org Mon Jul 29 09:30:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 09:30:39 +0200 (CEST) Subject: [Returnanalytics-commits] r2660 - pkg/Meucci/R Message-ID: <20130729073039.B8D1A184BAE@r-forge.r-project.org> Author: xavierv Date: 2013-07-29 09:30:39 +0200 (Mon, 29 Jul 2013) New Revision: 2660 Removed: pkg/Meucci/R/Central2Raw.R pkg/Meucci/R/Raw2Central.R pkg/Meucci/R/Raw2Cumul.R Modified: pkg/Meucci/R/InvariantProjection.R Log: - fixed function duplication Deleted: pkg/Meucci/R/Central2Raw.R =================================================================== --- pkg/Meucci/R/Central2Raw.R 2013-07-29 03:12:11 UTC (rev 2659) +++ pkg/Meucci/R/Central2Raw.R 2013-07-29 07:30:39 UTC (rev 2660) @@ -1,30 +0,0 @@ -#' Map central moments into raw moments -#' -#' @param mu : [vector] (length N corresponding to order N) central moments -#' -#' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments -#' -#' @references -#' \url{http://} -#' See Meucci's script for "Central2Raw.m" -#' -#' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export - -Central2Raw = function(mu) -{ - N = length(mu); - mu_ = mu; - - for ( n in 2 : N ) - { - mu_[ n ] = ( ( -1 ) ^( n+1 ) ) * ( mu[ 1 ] )^(n); - for( k in 1 : (n-1) ) - { - mu_[ n ] = mu_[ n ] + choose( n, k ) * ( (-1) ^ ( n - k + 1 )) * mu_[ k ] * (mu_[ 1 ]) ^ ( n - k); - } - mu_[ n ] = mu_[ n ] + mu[ n ]; - } - - return( mu_); -} \ No newline at end of file Modified: pkg/Meucci/R/InvariantProjection.R =================================================================== --- pkg/Meucci/R/InvariantProjection.R 2013-07-29 03:12:11 UTC (rev 2659) +++ pkg/Meucci/R/InvariantProjection.R 2013-07-29 07:30:39 UTC (rev 2660) @@ -9,28 +9,36 @@ #' \deqn{\tilde{ \mu } ^ {\big(n\big)} _{X} \equiv E \big\{ X^{n} \big\}, #' \\ \mu ^{ \big(n\big) }_{X} \equiv \sum_0^{n-1} \big(-1\big)^{n-k} \mu ^{n-k}_{X} \tilde{ \mu }^{k}_{X} + \tilde{ \mu }_{X}^{n} } #' -#' @param mu_ the raw (multi-period) non-central moment of Y-t -#' @return mu (multi-period) central moment of Y-t +#' @param mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' +#' @return mu : [vector] (length N corresponding to order N) central moments +#' #' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} +#' #' @references #' A. Meucci - "Exercises in Advanced Risk and Portfolio Management". See page 9 #' Symmys site containing original MATLAB source code \url{http://www.symmys.com} +#' +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Raw2Central.m" #' @export Raw2Central = function( mu_ ) { - N = length( mu_ ) - mu = mu_ - - for ( n in 2:N ) + N = length( mu_ ); + mu = mu_; + + for( n in 1 : N ) { - mu[n] = ((-1)^n) * (mu_[1])^(n) - for ( k in 1:(n-1) ) - { - if ( n != 1 ) { mu[n] = mu[n] + choose( n , k ) * ( ( -1 ) ^ ( n - k ) ) * mu_[k] * ( mu_[ 1 ] ) ^ ( n - k ) } - } - mu[n] = mu[n] + mu_[n] + mu[ n ] = ( (-1) ^ n ) * ( mu_[ 1 ] )^( n ); + + for( k in 1 : (n-1) ) + { + if( n != 1 ){ mu[ n ] = mu[ n ] + choose( n, k ) * ((-1)^(n-k)) * mu_[ k ] * (mu_[ 1 ])^(n-k) } ; + } + + mu[ n ] = mu[ n ] + mu_[ n ]; } - + return( mu = mu ) } @@ -50,7 +58,8 @@ #' #' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments #' -#' @author Xavier Valls \email{flamejat@@gmail.com} and Ram Ahluwalia \email{rahluwalia@@gmail.com} +#' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} +#' #' @references #' \url{http://symmys.com/node/170} #' See Meucci's script for "Cumul2Raw.m". @@ -64,13 +73,13 @@ N = length( ka ); mu_ = ka; - for( n in 2 : N ) + for( n in 1 : N ) { - #ka[ n ] = mu_[ n ]; Doesn't make sense + ka[ n ] = mu_[ n ]; for( k in 1 : (n-1) ) { - mu_[ n ] = mu_[ n ] + choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ]; + if( n != 1 ){ mu_[ n ] = mu_[ n ] + choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ] }; } } @@ -87,14 +96,20 @@ #' in formula (21). See Kendall and Stuart (1969) #' #' \deqn{ \kappa^{ \big(n\big) }_{X} \equiv \tilde{ \mu } ^{ \big(n\big) }_{X} - \sum_{k=1}^{n-1} (n-1)C_{k-1} \kappa_{X}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{X} } -#' -#' @param mu_ non-central moments of the invariant X-t -#' @return ka cumulants of X-t +#' +#' @param mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' +#' @return ka : [vector] (length N corresponding to order N) cumulative moments +#' #' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} #' @references #' A. Meucci - "Annualization and General Projection of Skewness, Kurtosis and All Summary Statistics" - formula (21) #' Symmys site containing original MATLAB source code \url{http://www.symmys.com/node/136} +#' +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Raw2Cumul.m" #' @export + Raw2Cumul = function( mu_ ) { N = length( mu_ ) @@ -102,7 +117,8 @@ for ( i in 1:N ) { - ka[i] = mu_[i] + ka[i] = mu_[i]; + for ( k in 1:(i-1) ) { if ( i != 1 ) { ka[i] = ka[i] - choose(i-1,k-1) * ka[k] * mu_[i-k] } @@ -119,13 +135,19 @@ #' #' \deqn{ \tilde{ \mu }^{ \big(1\big) }_{X} \equiv \mu ^{\big(1\big)}_{X} #' \\ \tilde{ \mu }^{ \big(n\big) }_{X} \equiv \mu ^{n}_{X} \sum_{k=0}^{n-1} \big(-1\big)^{n-k+1} \mu ^{n-k}_{X} \tilde{ \mu }^{\big(k\big)}_{X} } - -#' @param mu a vector of central moments -#' @return mu_ a vector of non-central moments +#' +#' @param mu : [vector] (length N corresponding to order N) central moments +#' +#' @return mu_ : [vector] (length N corresponding to order N) corresponding raw moments +#' #' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} +#' #' @references #' A. Meucci - "Exercises in Advanced Risk and Portfolio Management". See page 10. #' Symmys site containing original MATLAB source code \url{http://www.symmys.com} +#' +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "Central2Raw.m" #' @export Central2Raw = function( mu ) { Deleted: pkg/Meucci/R/Raw2Central.R =================================================================== --- pkg/Meucci/R/Raw2Central.R 2013-07-29 03:12:11 UTC (rev 2659) +++ pkg/Meucci/R/Raw2Central.R 2013-07-29 07:30:39 UTC (rev 2660) @@ -1,33 +0,0 @@ -#' Map raw moments into central moments, as described in A. Meucci "Risk and Asset Allocation", -#' Springer, 2005 -#' -#' @param mu_ : [vector] (length N corresponding to order N) corresponding raw moments -#' -#' @return mu : [vector] (length N corresponding to order N) central moments -#' -#' @references -#' \url{http://symmys.com/node/170} -#' See Meucci's script for "Raw2Central.m" -#' -#' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export - -Raw2Central = function( mu_ ) -{ - N = length( mu_ ); - mu = mu_; - - for( n in 2 : N ) - { - mu[ n ] = ( (-1) ^ n ) * ( mu_[ 1 ] )^( n ); - - for( k in 1 : (n-1) ) - { - mu[ n ] = mu[ n ] + choose( n, k ) * ((-1)^(n-k)) * mu_[ k ] * (mu_[ 1 ])^(n-k) ; - } - - mu[ n ] = mu[ n ] + mu_[ n ]; - } - - return( mu ); -} \ No newline at end of file Deleted: pkg/Meucci/R/Raw2Cumul.R =================================================================== --- pkg/Meucci/R/Raw2Cumul.R 2013-07-29 03:12:11 UTC (rev 2659) +++ pkg/Meucci/R/Raw2Cumul.R 2013-07-29 07:30:39 UTC (rev 2660) @@ -1,30 +0,0 @@ -#' Map raw moments into cumulative moments, as described in A. Meucci "Risk and Asset Allocation", -#' Springer, 2005 -#' -#' @param mu_ : [vector] (length N corresponding to order N) corresponding raw moments -#' -#' @return ka : [vector] (length N corresponding to order N) cumulative moments -#' -#' @references -#' \url{http://symmys.com/node/170} -#' See Meucci's script for "Raw2Cumul.m" -#' -#' @author Xavier Valls \email{flamejat@@gmail.com} -#' @export -Raw2Cumul = function( mu_ ) -{ - N = length( mu_ ); - ka = mu_; - - for( n in 2 : N ) - { - #ka[ n ] = mu_[ n ]; Doesn't make sense - - for( k in 1 : (n-1) ) - { - ka[ n ] = ka[ n ] - choose( n-1, k-1 ) * ka[ k ] * mu_[ n-k ]; - } - } - - return( ka ); -} \ No newline at end of file From noreply at r-forge.r-project.org Mon Jul 29 12:37:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 12:37:59 +0200 (CEST) Subject: [Returnanalytics-commits] r2661 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: . Week2 Week2/Code Week2/Vignette Week4/Code Week4/Vignette Message-ID: <20130729103759.C3960184EBD@r-forge.r-project.org> Author: shubhanm Date: 2013-07-29 12:37:59 +0200 (Mon, 29 Jul 2013) New Revision: 2661 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/ACStdDev.annualized.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/CalmarRatio.Normalized.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/Return.GLM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/UnsmoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.ComparitiveReturn.GLM.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.UnsmoothReturn.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-Graph10.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.synctex.gz pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar-Graph10.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar.rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar.synctex.gz pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/NormCalmar.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/Rplots.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss-003.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss-concordance.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss.synctex.gz pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Vignette/ShaneAcarMaxLoss.tex pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/ Log: Vignette : for Week 2 cum 4 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/ACStdDev.annualized.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/ACStdDev.annualized.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/ACStdDev.annualized.R 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,77 @@ +#' calculate a multiperiod or annualized Autocorrleation adjusted Standard Deviation +#' +#' @aliases sd.multiperiod sd.annualized StdDev.annualized +#' @param x an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param lag : number of autocorrelated lag factors inputted by user +#' @param scale number of periods in a year (daily scale = 252, monthly scale = +#' 12, quarterly scale = 4) +#' @param \dots any other passthru parameters +#' @author R +#' @seealso \code{\link[stats]{sd}} \cr +#' \url{http://wikipedia.org/wiki/inverse-square_law} +#' @references Burghardt, G., and L. Liu, \emph{ It's the Autocorrelation, Stupid (November 2012) Newedge +#' working paper.http://www.amfmblog.com/assets/Newedge-Autocorrelation.pdf \cr +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(edhec) +#' ACsd.annualized(edhec,3) + +#' +#' @export +#' @rdname ACStdDev.annualized +ACStdDev.annualized <- ACsd.annualized <- ACsd.multiperiod <- + function (R,lag=6, scale = NA, ...) + { + columns.a = ncol(R) + columnnames.a = colnames(R) + if(is.na(scale) && !xtsible(R)) + stop("'x' needs to be timeBased or xtsible, or scale must be specified." ) + + if(is.na(scale)) { + freq = periodicity(R) + switch(freq$scale, + #kChec + 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} + ) + } + + for(column.a in 1:columns.a) { # for each asset passed in as R + # clean the data and get rid of NAs + column.return = R[,column.a] + acf = as.numeric(acf(as.numeric(column.return), plot = FALSE)[1:lag][[1]]) + coef= sum(acf*acf) + if(!xtsible(R) & is.na(scale)) + { + stop("'x' needs to be timeBased or xtsible, or scale must be specified." ) + } + else + { + if(column.a == 1) { result = as.numeric(StdDev.annualized(column.return))*(1+2*coef) } + else { result = cbind (result, as.numeric(StdDev.annualized(column.return))*(1+2*coef)) } + } + } + dim(result) = c(1,NCOL(R)) + colnames(result) = colnames(R) + rownames(result) = "Autocorrelated Annualized Standard Deviation" + return(result) + } + +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2013 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: ACStdDev.annualized.R +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/CalmarRatio.Normalized.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/CalmarRatio.Normalized.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/CalmarRatio.Normalized.R 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,137 @@ +#' calculate a Normalized Calmar or Sterling reward/risk ratio +#' +#' Normalized Calmar and Sterling Ratios are yet another method of creating a +#' risk-adjusted measure for ranking investments similar to the +#' \code{\link{SharpeRatio}}. +#' +#' Both the Normalized Calmar and the Sterling ratio are the ratio of annualized return +#' over the absolute value of the maximum drawdown of an investment. The +#' Sterling ratio adds an excess risk measure to the maximum drawdown, +#' traditionally and defaulting to 10\%. +#' +#' It is also traditional to use a three year return series for these +#' calculations, although the functions included here make no effort to +#' determine the length of your series. If you want to use a subset of your +#' series, you'll need to truncate or subset the input data to the desired +#' length. +#' +#' Many other measures have been proposed to do similar reward to risk ranking. +#' It is the opinion of this author that newer measures such as Sortino's +#' \code{\link{UpsidePotentialRatio}} or Favre's modified +#' \code{\link{SharpeRatio}} are both \dQuote{better} measures, and +#' should be preferred to the Calmar or Sterling Ratio. +#' +#' @aliases Normalized.CalmarRatio Normalized.SterlingRatio +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param scale number of periods in a year (daily scale = 252, monthly scale = +#' 12, quarterly scale = 4) +#' @param excess for Sterling Ratio, excess amount to add to the max drawdown, +#' traditionally and default .1 (10\%) +#' @author Brian G. Peterson +#' @seealso +#' \code{\link{Return.annualized}}, \cr +#' \code{\link{maxDrawdown}}, \cr +#' \code{\link{SharpeRatio.modified}}, \cr +#' \code{\link{UpsidePotentialRatio}} +#' @references Bacon, Carl. \emph{Magdon-Ismail, M. and Amir Atiya, Maximum drawdown. Risk Magazine, 01 Oct 2004. +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(managers) +#' Normalized.CalmarRatio(managers[,1,drop=FALSE]) +#' Normalized.CalmarRatio(managers[,1:6]) +#' Normalized.SterlingRatio(managers[,1,drop=FALSE]) +#' Normalized.SterlingRatio(managers[,1:6]) +#' +#' @export +#' @rdname CalmarRatio +#' QP function fo calculation of Sharpe Ratio +QP.Norm <- function (R, tau,scale = NA) +{ + Sharpe= as.numeric(SharpeRatio.annualized(edhec)) +return(.63519+(.5*log(tau))+log(Sharpe)) +} + +CalmarRatio.Normalized <- function (R, tau = 1,scale = NA) +{ # @author Brian G. Peterson + + # DESCRIPTION: + # Inputs: + # Ra: in this case, the function anticipates having a return stream as input, + # rather than prices. + # tau : scaled Time in Years + # scale: number of periods per year + # Outputs: + # This function returns a Calmar Ratio + + # FUNCTION: + + R = checkData(R) + if(is.na(scale)) { + 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} + ) + } + Time = nyears(R) + annualized_return = Return.annualized(R, scale=scale) + drawdown = abs(maxDrawdown(R)) + result = (annualized_return/drawdown)*(QP.Norm(R,Time)/QP.Norm(R,tau))*(tau/Time) + rownames(result) = "Normalized Calmar Ratio" + return(result) +} + +#' @export +#' @rdname CalmarRatio +SterlingRatio.Normalized <- + function (R, tau=1,scale=NA, excess=.1) + { # @author Brian G. Peterson + + # DESCRIPTION: + # Inputs: + # Ra: in this case, the function anticipates having a return stream as input, + # rather than prices. + # scale: number of periods per year + # Outputs: + # This function returns a Sterling Ratio + + # FUNCTION: + Time = nyears(R) + R = checkData(R) + if(is.na(scale)) { + 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} + ) + } + annualized_return = Return.annualized(R, scale=scale) + drawdown = abs(maxDrawdown(R)+excess) + result = annualized_return/drawdown*(QP.Norm(R,Time)/QP.Norm(R,tau))*(tau/Time) + rownames(result) = paste("Normalized Sterling Ratio (Excess = ", round(excess*100,0), "%)", sep="") + return(result) + } + +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2013 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: CalmarRatio.R 1955 2012-05-23 16:38:16Z braverock $ +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/Return.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/Return.GLM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/Return.GLM.R 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,82 @@ +#' True returns represent the flow of information that would determine the equilibrium +#' value of the fund's securities in a frictionless market. However, true economic +#' returns are not observed. Instead, Rot +#' denotes the reported or observed return in +#' period t, which is a weighted average of the fund's true returns over the most recent k ? 1 +#' periods, includingthe current period. +#' This averaging process captures the essence of smoothed returns in several +#' respects. From the perspective of illiquidity-driven smoothing, is consistent +#' with several models in the nonsynchronous tradingliterat ure. For example, Cohen +#' et al. (1 986, Chapter 6.1) propose a similar weighted-average model for observed +#' returns. +#' +#' The Geltner autocorrelation adjusted return series may be calculated via: +#' +#' @param Ra an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns + +#' @param q order of autocorrelation coefficient +#' @author R +#' @references "An econometric model of serial correlation and +#' illiquidity in hedge fund returns +#' Mila Getmansky1, Andrew W. Lo*, Igor Makarov +#' MIT Sloan School of Management, 50 Memorial Drive, E52-432, Cambridge, MA 02142-1347, USA +#' Received 16 October 2002; received in revised form 7 March 2003; accepted 15 May 2003 +#' Available online 10 July 2004 +#' +#' +#' @keywords ts multivariate distribution models +#' @examples +#' +#' data(edhec) +#' Return.GLM(edhec,4) +#' +#' @export +Return.GLM <- + function (Ra,q=3) + { # @author Brian G. Peterson, Peter Carl + + # Description: + + # Ra return vector + # q Lag Factors + # Function: + R = checkData(Ra, method="xts") + # Get dimensions and labels + columns.a = ncol(R) + columnnames.a = colnames(R) + + clean.GLM <- function(column.R,q=3) { + ma.coeff = as.numeric(arma(edhec[,1],0,q)$theta) + column.glm = ma.coeff[q]*lag(column.R,q) + + return(column.glm) + } + + for(column.a in 1:columns.a) { # for each asset passed in as R + # clean the data and get rid of NAs + column.glma = na.skip(R[,column.a],clean.GLM) + + if(column.a == 1) { glm = column.glma } + else { glm = cbind (glm, column.glma) } + + } + + colnames(glm) = columnnames.a + + # RESULTS: + return(reclass(glm,match.to=Ra)) + + } + +############################################################################### +# 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: Return.GLM.R 2163 2012-07-16 00:30:19Z braverock $ +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/UnsmoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/UnsmoothReturn.R 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,36 @@ +UnSmoothReturn<- + function(R = NULL,q, ...) + { + columns = 1 + columnnames = NULL + #Error handling if R is not NULL + if(!is.null(R)){ + x = checkData(R) + columns = ncol(x) + n = nrow(x) + count = q + x=edhec + columns = ncol(x) + columnnames = colnames(x) + + # Calculate AutoCorrelation Coefficient + for(column in 1:columns) { # for each asset passed in as R + y = checkData(edhec[,column], method="vector", na.rm = TRUE) + + acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7] + values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6)) + + if(column == 1) { + result.df = data.frame(Value = values) + colnames(result.df) = columnnames[column] + } + else { + nextcol = data.frame(Value = values) + colnames(nextcol) = columnnames[column] + result.df = cbind(result.df, nextcol) + } + } + return(result.df[1:q,]*R) # Unsmooth Return + + } + } \ No newline at end of file Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.ComparitiveReturn.GLM.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.ComparitiveReturn.GLM.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.ComparitiveReturn.GLM.R 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,76 @@ +#' Compenent Decomposition of Table of Unsmooth Returns for GLM Model +#' +#' Creates a table of comparitive changes in Normality Properties for Third +#' and Fourth Moment Vectors i.e. Skewness and Kurtosis for Orignal and Unsmooth +#' Returns Respectively +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param ci confidence interval, defaults to 95\% +#' @param n number of series lags +#' @param digits number of digits to round results to +#' @author R +#' @keywords ts unsmooth GLM return models +#' +#' @export +table.ComparitiveReturn.GLM <- + function (R, n = 3, digits = 4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # n : Number of lags + # p = Confifence Level + # Output: + # A table of estimates of Moving Average + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + skew = skewness(x) + arma.coeff= arma(x,0,n) + kurt= kurtosis(x) + z = c(skew, + ((sum(arma.coeff$theta^2)^1.5)*(skew/(sum(arma.coeff$theta^3)))), + kurt, + (kurt*(sum(arma.coeff$theta^2)^2-6*(sum(arma.coeff$theta^2)*sum(arma.coeff$theta^2)))/(sum(arma.coeff$theta^4)))) + znames = c( + "Skewness ( Orignal) ", + "Skewness (Unsmooth)", + "Kurtosis (Orignal)", + "Kurtosis (Unsmooth)") + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + + } + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: table.ComparitiveReturn.GLM +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.UnsmoothReturn.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.UnsmoothReturn.R (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Code/table.UnsmoothReturn.R 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,79 @@ +#' Compenent Decomposition of Table of Unsmooth Returns +#' +#' Creates a table of estimates of moving averages for comparison across +#' multiple instruments or funds as well as their standard error and +#' smoothing index +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param ci confidence interval, defaults to 95\% +#' @param n number of series lags +#' @param p confidence level for calculation, default p=.99 +#' @param digits number of digits to round results to +#' @author R +#' @keywords ts smooth return models +#' +#' @export +table.UnsmoothReturn <- + function (R, n = 3, p= 0.95, digits = 4) + {# @author + + # DESCRIPTION: + # Downside Risk Summary: Statistics and Stylized Facts + + # Inputs: + # R: a regular timeseries of returns (rather than prices) + # n : Number of lags + # p = Confifence Level + # Output: + # A table of estimates of Moving Average + + y = checkData(R, method = "xts") + columns = ncol(y) + rows = nrow(y) + columnnames = colnames(y) + rownames = rownames(y) + + # for each column, do the following: + for(column in 1:columns) { + x = y[,column] + + z = c(arma(x,0,2)$theta[1], + arma(x,0,2)$se.theta[1], + arma(x,0,2)$theta[2], + arma(x,0,2)$se.theta[2], + arma(x,0,2)$se.theta[2]) + znames = c( + "Moving Average(1)", + "Std Error of MA(1)", + "Moving Average(2)", + "Std Error of MA(2)", + "Smoothing Invest" + + ) + if(column == 1) { + resultingtable = data.frame(Value = z, row.names = znames) + } + else { + nextcolumn = data.frame(Value = z, row.names = znames) + resultingtable = cbind(resultingtable, nextcolumn) + } + } + colnames(resultingtable) = columnnames + ans = base::round(resultingtable, digits) + ans + + +} + +############################################################################### +# R (http://r-project.org/) +# +# Copyright (c) 2004-2013 +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id: table.UnSmoothReturn.R +# +############################################################################### Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-Graph10.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-Graph10.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-concordance.tex =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-concordance.tex (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV-concordance.tex 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,2 @@ +\Sconcordance{concordance:ACFSTDEV.tex:ACFSTDEV.rnw:% +1 44 1 1 5 1 4 20 1 1 2 1 0 4 1 8 0 1 1 8 0 1 2 1 0 1 2 5 0 1 2 3 1} Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.log =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.log (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/Vignette/ACFSTDEV.log 2013-07-29 10:37:59 UTC (rev 2661) @@ -0,0 +1,358 @@ +This is pdfTeX, Version 3.1415926-2.4-1.40.13 (MiKTeX 2.9) (preloaded format=pdflatex 2013.7.14) 28 JUL 2013 12:50 +entering extended mode +**ACFSTDEV.tex + +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week2\Vignette\ACFSTDEV.tex" +LaTeX2e <2011/06/27> +Babel and hyphenation patterns for english, afrikaans, ancientgreek, ar +abic, armenian, assamese, basque, bengali, bokmal, bulgarian, catalan, coptic, +croatian, czech, danish, dutch, esperanto, estonian, farsi, finnish, french, ga +lician, german, german-x-2012-05-30, greek, gujarati, hindi, hungarian, iceland +ic, indonesian, interlingua, irish, italian, kannada, kurmanji, latin, latvian, + lithuanian, malayalam, marathi, mongolian, mongolianlmc, monogreek, ngerman, n +german-x-2012-05-30, nynorsk, oriya, panjabi, pinyin, polish, portuguese, roman +ian, russian, sanskrit, serbian, slovak, slovenian, spanish, swedish, swissgerm +an, tamil, telugu, turkish, turkmen, ukenglish, ukrainian, uppersorbian, usengl +ishmax, welsh, loaded. +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\article.cls" +Document Class: article 2007/10/19 v1.4h Standard LaTeX document class +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\size12.clo" +File: size12.clo 2007/10/19 v1.4h Standard LaTeX file (size option) +) +\c at part=\count79 +\c at section=\count80 +\c at subsection=\count81 +\c at subsubsection=\count82 +\c at paragraph=\count83 +\c at subparagraph=\count84 +\c at figure=\count85 +\c at table=\count86 +\abovecaptionskip=\skip41 +\belowcaptionskip=\skip42 +\bibindent=\dimen102 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\psnfss\times.sty" +Package: times 2005/04/12 PSNFSS-v9.2a (SPQR) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ltxmisc\url.sty" +\Urlmuskip=\muskip10 +Package: url 2006/04/12 ver 3.3 Verb mode for urls, etc. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.sty" +Package: babel 2008/07/08 v3.8m The Babel package + +************************************* +* Local config file bblopts.cfg used +* +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\bblopts.cfg" +File: bblopts.cfg 2006/07/31 v1.0 MiKTeX 'babel' configuration +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\english.ldf" +Language: english 2005/03/30 v3.3o English support from the babel system + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\babel\babel.def" +File: babel.def 2008/07/08 v3.8m Babel common definitions +\babel at savecnt=\count87 +\U at D=\dimen103 +) +\l at canadian = a dialect from \language\l at american +\l at australian = a dialect from \language\l at british +\l at newzealand = a dialect from \language\l at british +)) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Rd.sty +Package: Rd + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ifthen.sty" +Package: ifthen 2001/05/26 v1.1c Standard LaTeX ifthen package (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\longtable.sty" +Package: longtable 2004/02/01 v4.11 Multi-page Table package (DPC) +\LTleft=\skip43 +\LTright=\skip44 +\LTpre=\skip45 +\LTpost=\skip46 +\LTchunksize=\count88 +\LTcapwidth=\dimen104 +\LT at head=\box26 +\LT at firsthead=\box27 +\LT at foot=\box28 +\LT at lastfoot=\box29 +\LT at cols=\count89 +\LT at rows=\count90 +\c at LT@tables=\count91 +\c at LT@chunks=\count92 +\LT at p@ftn=\toks14 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\bm.sty" +Package: bm 2004/02/26 v1.1c Bold Symbol Support (DPC/FMi) +\symboldoperators=\mathgroup4 +\symboldletters=\mathgroup5 +\symboldsymbols=\mathgroup6 +LaTeX Font Info: Redeclaring math alphabet \mathbf on input line 138. +LaTeX Info: Redefining \bm on input line 204. +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\alltt.sty" +Package: alltt 1997/06/16 v2.0g defines alltt environment +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\tools\verbatim.sty" +Package: verbatim 2003/08/22 v1.5q LaTeX2e package for verbatim enhancements +\every at verbatim=\toks15 +\verbatim at line=\toks16 +\verbatim at in@stream=\read1 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\upquote\upquote.sty" +Package: upquote 2012/04/19 v1.3 upright-quote and grave-accent glyphs in verba +tim + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\textcomp.sty" +Package: textcomp 2005/09/27 v1.99g Standard LaTeX package +Package textcomp Info: Sub-encoding information: +(textcomp) 5 = only ISO-Adobe without \textcurrency +(textcomp) 4 = 5 + \texteuro +(textcomp) 3 = 4 + \textohm +(textcomp) 2 = 3 + \textestimated + \textcurrency +(textcomp) 1 = TS1 - \textcircled - \t +(textcomp) 0 = TS1 (full) +(textcomp) Font families with sub-encoding setting implement +(textcomp) only a restricted character set as indicated. +(textcomp) Family '?' is the default used for unknown fonts. +(textcomp) See the documentation for details. +Package textcomp Info: Setting ? sub-encoding to TS1/1 on input line 71. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\ts1enc.def" +File: ts1enc.def 2001/06/05 v3.0e (jk/car/fm) Standard LaTeX file +) +LaTeX Info: Redefining \oldstylenums on input line 266. +Package textcomp Info: Setting cmr sub-encoding to TS1/0 on input line 281. +Package textcomp Info: Setting cmss sub-encoding to TS1/0 on input line 282. +Package textcomp Info: Setting cmtt sub-encoding to TS1/0 on input line 283. +Package textcomp Info: Setting cmvtt sub-encoding to TS1/0 on input line 284. +Package textcomp Info: Setting cmbr sub-encoding to TS1/0 on input line 285. +Package textcomp Info: Setting cmtl sub-encoding to TS1/0 on input line 286. +Package textcomp Info: Setting ccr sub-encoding to TS1/0 on input line 287. +Package textcomp Info: Setting ptm sub-encoding to TS1/4 on input line 288. +Package textcomp Info: Setting pcr sub-encoding to TS1/4 on input line 289. +Package textcomp Info: Setting phv sub-encoding to TS1/4 on input line 290. +Package textcomp Info: Setting ppl sub-encoding to TS1/3 on input line 291. +Package textcomp Info: Setting pag sub-encoding to TS1/4 on input line 292. +Package textcomp Info: Setting pbk sub-encoding to TS1/4 on input line 293. +Package textcomp Info: Setting pnc sub-encoding to TS1/4 on input line 294. +Package textcomp Info: Setting pzc sub-encoding to TS1/4 on input line 295. +Package textcomp Info: Setting bch sub-encoding to TS1/4 on input line 296. +Package textcomp Info: Setting put sub-encoding to TS1/5 on input line 297. +Package textcomp Info: Setting uag sub-encoding to TS1/5 on input line 298. +Package textcomp Info: Setting ugq sub-encoding to TS1/5 on input line 299. +Package textcomp Info: Setting ul8 sub-encoding to TS1/4 on input line 300. +Package textcomp Info: Setting ul9 sub-encoding to TS1/4 on input line 301. +Package textcomp Info: Setting augie sub-encoding to TS1/5 on input line 302. +Package textcomp Info: Setting dayrom sub-encoding to TS1/3 on input line 303. +Package textcomp Info: Setting dayroms sub-encoding to TS1/3 on input line 304. + +Package textcomp Info: Setting pxr sub-encoding to TS1/0 on input line 305. +Package textcomp Info: Setting pxss sub-encoding to TS1/0 on input line 306. +Package textcomp Info: Setting pxtt sub-encoding to TS1/0 on input line 307. +Package textcomp Info: Setting txr sub-encoding to TS1/0 on input line 308. +Package textcomp Info: Setting txss sub-encoding to TS1/0 on input line 309. +Package textcomp Info: Setting txtt sub-encoding to TS1/0 on input line 310. +Package textcomp Info: Setting lmr sub-encoding to TS1/0 on input line 311. +Package textcomp Info: Setting lmdh sub-encoding to TS1/0 on input line 312. +Package textcomp Info: Setting lmss sub-encoding to TS1/0 on input line 313. +Package textcomp Info: Setting lmssq sub-encoding to TS1/0 on input line 314. +Package textcomp Info: Setting lmvtt sub-encoding to TS1/0 on input line 315. +Package textcomp Info: Setting qhv sub-encoding to TS1/0 on input line 316. +Package textcomp Info: Setting qag sub-encoding to TS1/0 on input line 317. +Package textcomp Info: Setting qbk sub-encoding to TS1/0 on input line 318. +Package textcomp Info: Setting qcr sub-encoding to TS1/0 on input line 319. +Package textcomp Info: Setting qcs sub-encoding to TS1/0 on input line 320. +Package textcomp Info: Setting qpl sub-encoding to TS1/0 on input line 321. +Package textcomp Info: Setting qtm sub-encoding to TS1/0 on input line 322. +Package textcomp Info: Setting qzc sub-encoding to TS1/0 on input line 323. +Package textcomp Info: Setting qhvc sub-encoding to TS1/0 on input line 324. +Package textcomp Info: Setting futs sub-encoding to TS1/4 on input line 325. +Package textcomp Info: Setting futx sub-encoding to TS1/4 on input line 326. +Package textcomp Info: Setting futj sub-encoding to TS1/4 on input line 327. +Package textcomp Info: Setting hlh sub-encoding to TS1/3 on input line 328. +Package textcomp Info: Setting hls sub-encoding to TS1/3 on input line 329. +Package textcomp Info: Setting hlst sub-encoding to TS1/3 on input line 330. +Package textcomp Info: Setting hlct sub-encoding to TS1/5 on input line 331. +Package textcomp Info: Setting hlx sub-encoding to TS1/5 on input line 332. +Package textcomp Info: Setting hlce sub-encoding to TS1/5 on input line 333. +Package textcomp Info: Setting hlcn sub-encoding to TS1/5 on input line 334. +Package textcomp Info: Setting hlcw sub-encoding to TS1/5 on input line 335. +Package textcomp Info: Setting hlcf sub-encoding to TS1/5 on input line 336. +Package textcomp Info: Setting pplx sub-encoding to TS1/3 on input line 337. +Package textcomp Info: Setting pplj sub-encoding to TS1/3 on input line 338. +Package textcomp Info: Setting ptmx sub-encoding to TS1/4 on input line 339. +Package textcomp Info: Setting ptmj sub-encoding to TS1/4 on input line 340. +)) +\ldescriptionwidth=\skip47 + +NOT loading ae NOT loading times NOT loading lmodern) +(C:/PROGRA~1/R/R-30~1.1/share/texmf/tex/latex\Sweave.sty +Package: Sweave + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\graphicx.sty" +Package: graphicx 1999/02/16 v1.0f Enhanced LaTeX Graphics (DPC,SPQR) + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\keyval.sty" +Package: keyval 1999/03/16 v1.13 key=value parser (DPC) +\KV at toks@=\toks17 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\graphics.sty" +Package: graphics 2009/02/05 v1.0o Standard LaTeX Graphics (DPC,SPQR) + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\graphics\trig.sty" +Package: trig 1999/03/16 v1.09 sin cos tan (DPC) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\00miktex\graphics.cfg" +File: graphics.cfg 2007/01/18 v1.5 graphics configuration of teTeX/TeXLive +) +Package graphics Info: Driver file: pdftex.def on input line 91. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\pdftex-def\pdftex.def" +File: pdftex.def 2011/05/27 v0.06d Graphics/color for pdfTeX + +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\oberdiek\infwarerr.sty" +Package: infwarerr 2010/04/08 v1.3 Providing info/warning/error messages (HO) +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\generic\oberdiek\ltxcmds.sty" +Package: ltxcmds 2011/11/09 v1.22 LaTeX kernel commands for general use (HO) +) +\Gread at gobject=\count93 +)) +\Gin at req@height=\dimen105 +\Gin at req@width=\dimen106 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\fancyvrb\fancyvrb.sty" +Package: fancyvrb 2008/02/07 + +Style option: `fancyvrb' v2.7a, with DG/SPQR fixes, and firstline=lastline fix +<2008/02/07> (tvz) +\FV at CodeLineNo=\count94 +\FV at InFile=\read2 +\FV at TabBox=\box30 +\c at FancyVerbLine=\count95 +\FV at StepNumber=\count96 +\FV at OutFile=\write3 +) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +)) +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\ae.sty" +Package: ae 2001/02/12 1.3 Almost European Computer Modern + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\fontenc.sty" +Package: fontenc 2005/09/27 v1.99g Standard LaTeX package + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\base\t1enc.def" +File: t1enc.def 2005/09/27 v1.99g Standard LaTeX file +LaTeX Font Info: Redeclaring font encoding T1 on input line 43. +) +LaTeX Font Info: Try loading font information for T1+aer on input line 100. + +("C:\Program Files (x86)\MiKTeX 2.9\tex\latex\ae\t1aer.fd" +File: t1aer.fd 1997/11/16 Font definitions for T1/aer. +)))) +("C:\Users\shubhankit\Desktop\New folder\pkg\PerformanceAnalytics\sandbox\Shubh +ankit\Week2\Vignette\ACFSTDEV.aux") [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 2661 From noreply at r-forge.r-project.org Mon Jul 29 14:18:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 14:18:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2662 - in pkg/Meucci: . demo man Message-ID: <20130729121832.315EB183AD4@r-forge.r-project.org> Author: xavierv Date: 2013-07-29 14:18:31 +0200 (Mon, 29 Jul 2013) New Revision: 2662 Added: pkg/Meucci/demo/S_EstimateMomentsComboEvaluation.R pkg/Meucci/demo/S_Toeplitz.R pkg/Meucci/demo/S_VolatilityClustering.R Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R pkg/Meucci/man/Central2Raw.Rd pkg/Meucci/man/Cumul2Raw.Rd pkg/Meucci/man/Raw2Central.Rd pkg/Meucci/man/Raw2Cumul.Rd Log: -added two demo scripts from chapter 3 and one from chapter 4. Fixed documentation Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-29 10:37:59 UTC (rev 2661) +++ pkg/Meucci/DESCRIPTION 2013-07-29 12:18:31 UTC (rev 2662) @@ -76,11 +76,7 @@ 'SimulateJumpDiffusionMerton.R' 'BlackScholesCallPrice.R' 'InterExtrapolate.R' - 'Central2Raw.R' 'CentralAndStandardizedStatistics.R' - 'Cumul2Raw.R' - 'Raw2Central.R' - 'Raw2Cumul.R' 'FitExpectationMaximization.R' 'QuantileMixture.R' 'GenerateUniformDrawsOnUnitSphere.R' Modified: pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R =================================================================== --- pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R 2013-07-29 10:37:59 UTC (rev 2661) +++ pkg/Meucci/demo/S_EstimateExpectedValueEvaluation.R 2013-07-29 12:18:31 UTC (rev 2662) @@ -3,7 +3,7 @@ #' #' @references #' \url{http://symmys.com/node/170} -#' See Meucci's script for "S_EigenValueprintersion.R" +#' See Meucci's script for "S_EigenValueDispersion.R" #' #' @author Xavier Valls \email{flamejat@@gmail.com} @@ -21,8 +21,8 @@ i_T = matrix( rlnorm( T, Mu, Sigma ), 1, T); # series generated by "nature": do not know the distribution -G_Hat_1 = function(X) X[ , 1 ] * X[ ,3 ]; # estimator of unknown functional G_1=x(1)*x(3) -G_Hat_2 = function(X) apply( X, 1,mean); # estimator of unknown functional G_1=sample mean +G_Hat_1 = function(X) X[ , 1 ] * X[ , 3 ]; # estimator of unknown functional G_1=x(1)*x(3) +G_Hat_2 = function(X) apply( X, 1, mean ); # estimator of unknown functional G_1=sample mean G1 = G_Hat_1( i_T ); G2 = G_Hat_2( i_T ); @@ -59,19 +59,19 @@ par( mfrow = c(2,1) ); hist(G1, NumBins); points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); -#set(h, 'markersize', 20, 'col', 'r'); + hist(G2, NumBins); points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); -#set(h, 'markersize', 20, 'col', 'r'); + # loss dev.new(); par( mfrow = c(2,1) ); -hist(Loss_G1, NumBins, main = "estimator: x(1)*x(3)"); +hist(Loss_G1, NumBins, main = "loss of estimator: x(1)*x(3)"); -hist(Loss_G2, NumBins, main = "estimator: sample mean" ); +hist(Loss_G2, NumBins, main = "loss of estimator: sample mean" ); ################################################################################################################## @@ -116,13 +116,13 @@ dev.new(); NumBins = round(10*log(nSim)); - par( mfrow = c(2,1) ); - - hist(G1, NumBins); - points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); - - hist(G2, NumBins); - points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); + par( mfrow = c(2,1) ); + + hist(G1, NumBins); + points(G_fX, 0, pch = 21, bg = "red", main = "estimator: x(1)*x(3)"); + + hist(G2, NumBins); + points(G_fX, 0, pch = 21, bg = "red", main = "estimator: sample mean" ); } Added: pkg/Meucci/demo/S_EstimateMomentsComboEvaluation.R =================================================================== --- pkg/Meucci/demo/S_EstimateMomentsComboEvaluation.R (rev 0) +++ pkg/Meucci/demo/S_EstimateMomentsComboEvaluation.R 2013-07-29 12:18:31 UTC (rev 2662) @@ -0,0 +1,209 @@ +#'This script familiarizes the user with the evaluation of an estimator:replicability, loss, error, +#'bias and inefficiency as described in A. Meucci,"Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_EstimateMomentsComboEvaluation.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Set parametesr + +T = 10; +a = 0.5; +m_Y = 0.1; +s_Y = 0.2; +m_Z = 0; +s_Z = 0.15; + +################################################################################################################## +### Plain vanilla estimation + +# functional of the distribution to be estimated +G_fX = a *( m_Y^2 + s_Y^2 - m_Y) + ( 1 - a ) * ( exp( 2 * m_Z + 2 * s_Z ^2) - exp( m_Z + 0.5 * s_Z^2 )); +print(G_fX); + +# series generated by "nature": do not know the distribution +P = runif(T); +i_T = t( matrix (QuantileMixture( P, a, m_Y, s_Y, m_Z, s_Z ) ) ); + +G_Hat_a = function(X) (X[ , 1] - X[ , ncol(X) ]) * X[ , 2 ] * X[ , 2 ]; +G_Hat_b = function(X) apply( X, 1, mean); +G_Hat_c = function(X) 5 + 0 * X[ , 1]; +G_Hat_d = function(X) (dim(X)[1]-1)/dim(X)[1] * apply( X, 1, var) + apply(X, 1, mean)^2 - apply( X, 1, mean); + +Ga = G_Hat_a(i_T); # tentative estimator of unknown functional +Gb = G_Hat_b(i_T); # tentative estimator of unknown functional +Gc = G_Hat_c(i_T); # tentative estimator of unknown functional +Gd = G_Hat_d(i_T); # tentative estimator of unknown functional +print(Ga); +print(Gb); +print(Gc); +print(Gd); + +################################################################################################################## +### replicability vs. "luck" + +# functional of the distribution to be estimated +G_fX = a *( m_Y^2 + s_Y^2 - m_Y ) + ( 1 - a ) * ( exp( 2 * m_Z + 2*s_Z^2 ) - exp( m_Z + 0.5 * s_Z^2 ) ); + +# randomize series generated by "nature" to check replicability +nSim = 10000; +I_T = matrix( NaN, nSim, T); +for( t in 1 : T ) +{ + P = matrix( runif(nSim), nSim, 1); + I_T[ , t ] = QuantileMixture( P, a, m_Y, s_Y, m_Z, s_Z ); +} + +Ga = G_Hat_a(I_T); # tentative estimator of unknown functional +Gb = G_Hat_b(I_T); # tentative estimator of unknown functional +Gc = G_Hat_c(I_T); # tentative estimator of unknown functional +Gd = G_Hat_d(I_T); # tentative estimator of unknown functional + +Loss_Ga = (Ga-G_fX)^2; +Loss_Gb = (Gb-G_fX)^2; +Loss_Gc = (Gc-G_fX)^2; +Loss_Gd = (Gd-G_fX)^2; + +Err_Ga = sqrt(mean(Loss_Ga)); +Err_Gb = sqrt(mean(Loss_Gb)); +Err_Gc = sqrt(mean(Loss_Gc)); +Err_Gd = sqrt(mean(Loss_Gd)); + +Bias_Ga = abs(mean(Ga)-G_fX); +Bias_Gb = abs(mean(Gb)-G_fX); +Bias_Gc = abs(mean(Gc)-G_fX); +Bias_Gd = abs(mean(Gd)-G_fX); + +Ineff_Ga = sd(Ga); +Ineff_Gb = sd(Gb); +Ineff_Gc = sd(Gc); +Ineff_Gd = sd(Gd); + +################################################################################################################## +dev.new(); +NumBins = round(10 * log(nSim)); + +par( mfrow = c(4, 1) ); + +hist( Ga, NumBins, main = "estimator a" ); +points( G_fX, 0, pch = 21, bg = "red" ); + +hist( Gb, NumBins, main = "estimator b", xlim = c(-0.2, 1.2) ); +points( G_fX, 0, pch = 21, bg = "red" ); + +hist( Gc, NumBins, main = "estimator c", xlim = c(-60,60) ); +points( G_fX, 0, pch = 21, bg = "red" ); + +hist( Gd, NumBins, main = "estimator d" ); +points( G_fX, 0, pch = 21, bg = "red" ); + + +#loss +dev.new(); +par( mfrow = c(4, 1) ); + +hist( Loss_Ga, NumBins, main = "Loss of estimator a" ); + +hist( Loss_Gb, NumBins, main = "Loss of estimator b" ); + +hist( Loss_Gc, NumBins, main = "Loss of estimator c", xlim = c(-60,60) ); + +hist( Loss_Gd, NumBins, main = "Loss of estimator d" ); + +################################################################################################################## +### Stress test replicability +m_s = seq( 0, 0.2, 0.02 ); + +Err_Gasq = NULL; Bias_Gasq = NULL; Ineff_Gasq = NULL; +Err_Gbsq = NULL; Bias_Gbsq = NULL; Ineff_Gbsq = NULL; +Err_Gcsq = NULL; Bias_Gcsq = NULL; Ineff_Gcsq = NULL; +Err_Gdsq = NULL; Bias_Gdsq = NULL; Ineff_Gdsq = NULL; + +for( j in 1 : length(m_s) ) +{ + m_Y = m_s[ j ]; + # functional of the distribution to be estimated + G_fX = a * ( m_Y ^ 2 + s_Y^2 - m_Y ) + ( 1 - a ) *( exp( 2 * m_Z + 2 * s_Z^2 ) - exp( m_Z + 0.5 * s_Z^2 ) ); + # randomize series generated by "nature" to check replicability + nSim = 10000; + I_T = matrix( NaN, nSim, T); + for( t in 1 : T ) + { + P = matrix( runif(nSim) ); + I_T[ , t ] = QuantileMixture(P,a,m_Y,s_Y,m_Z,s_Z); + } + + Ga = G_Hat_a(I_T); + Gb = G_Hat_b(I_T); + Gc = G_Hat_c(I_T); + Gd = G_Hat_d(I_T); + + Loss_Ga = (Ga-G_fX)^2; + Loss_Gb = (Gb-G_fX)^2; + Loss_Gc = (Gc-G_fX)^2; + Loss_Gd = (Gd-G_fX)^2; + + Err_Ga = sqrt(mean(Loss_Ga)); + Err_Gb = sqrt(mean(Loss_Gb)); + Err_Gc = sqrt(mean(Loss_Gc)); + Err_Gd = sqrt(mean(Loss_Gd)); + + Bias_Ga = abs(mean(Ga)-G_fX); + Bias_Gb = abs(mean(Gb)-G_fX); + Bias_Gc = abs(mean(Gc)-G_fX); + Bias_Gd = abs(mean(Gd)-G_fX); + + Ineff_Ga = sd(Ga); + Ineff_Gb = sd(Gb); + Ineff_Gc = sd(Gc); + Ineff_Gd = sd(Gd); + + #store results + Err_Gasq = cbind( Err_Gasq, Err_Ga^2 ); ##ok<*AGROW> + Err_Gbsq = cbind( Err_Gbsq, Err_Gb^2 ); + Err_Gcsq = cbind( Err_Gcsq, Err_Gc^2 ); + Err_Gdsq = cbind( Err_Gdsq, Err_Gd^2 ); + + Bias_Gasq = cbind(Bias_Gasq, Bias_Ga^2 ); + Bias_Gbsq = cbind(Bias_Gbsq, Bias_Gb^2 ); + Bias_Gcsq = cbind(Bias_Gcsq, Bias_Gc^2 ); + Bias_Gdsq = cbind(Bias_Gdsq, Bias_Gd^2 ); + + Ineff_Gasq = cbind( Ineff_Gasq, Ineff_Ga^2 ); + Ineff_Gbsq = cbind( Ineff_Gbsq, Ineff_Gb^2 ); + Ineff_Gcsq = cbind( Ineff_Gcsq, Ineff_Gc^2 ); + Ineff_Gdsq = cbind( Ineff_Gdsq, Ineff_Gd^2 ); +} + +################################################################################################################## +dev.new(); +par( mfrow = c(4, 1) ); + + + +b = barplot( Bias_Gasq + Ineff_Gasq, col = "red", main = "stress-test of estimator a" ); +barplot( Ineff_Gasq, col = "blue", add = TRUE); +lines( b, Err_Gasq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); + +b = barplot( Bias_Gbsq + Ineff_Gbsq, col = "red", main = "stress-test of estimator b" ); +barplot( Ineff_Gbsq, col = "blue", add = TRUE); +lines( b, Err_Gbsq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); + +b = barplot( Bias_Gcsq + Ineff_Gcsq, col = "red", main = "stress-test of estimator c" ); +barplot( Ineff_Gcsq, col = "blue", add = TRUE); +lines( b, Err_Gcsq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); + +b = barplot( Bias_Gdsq + Ineff_Gdsq, col = "red", main = "stress-test of estimator d" ); +barplot( Ineff_Gdsq, col = "blue", add = TRUE); +lines( b, Err_Gdsq); +legend( "topleft", 1.9, c( "bias?", "ineff?", "error?" ), col = c( "red","blue", "black" ), + lty=1, lwd=c(5,5,1),bg = "gray90" ); \ No newline at end of file Added: pkg/Meucci/demo/S_Toeplitz.R =================================================================== --- pkg/Meucci/demo/S_Toeplitz.R (rev 0) +++ pkg/Meucci/demo/S_Toeplitz.R 2013-07-29 12:18:31 UTC (rev 2662) @@ -0,0 +1,35 @@ +#' This script shows that the eigenvectors of a Toeplitz matrix have a Fourier basis structure under t-distribution +#' assumptions, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_Toeplitz.R" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + +############################################################################################################### +### Inputs + +N = 200; # dimension of the matrix +Decay = 0.9; # decay factor + +############################################################################################################### +T = diag( 1, N); +for( n in 1 : (N - 1) ) +{ + + T = T + Decay^n * ( cbind( matrix( 0, N, N -( N-n ) ), diag( 1, N , N-n) ) + + cbind( rbind( matrix(0, N-(N-n), N-n ), diag( 1, N-n)), matrix(0, N, N-(N-n) ) )) ; + + +} +eig = eigen( T ); + +############################################################################################################### + +#R sorts the eigen vectors, so the results aren't going to be exactly the same as in MATLAB + +dev.new(); +plot( eig$vectors[ , n ], type = "l", col = runif(1)*100 ); +lines( eig$vectors[ , n-1 ], type = "l", col = runif(1)*100 ); Added: pkg/Meucci/demo/S_VolatilityClustering.R =================================================================== --- pkg/Meucci/demo/S_VolatilityClustering.R (rev 0) +++ pkg/Meucci/demo/S_VolatilityClustering.R 2013-07-29 12:18:31 UTC (rev 2662) @@ -0,0 +1,30 @@ +#' This file generates paths for a volatility clustering, as described in A. Meucci, "Risk and Asset Allocation", +#' Springer, 2005, Chapter 3. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_VolatilityClustering.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +################################################################################################################## +### Input parameters +mu = 0.05; # mean +a = 0.03; +b = 0.96; +s = 0.01; +T = 1000; + +################################################################################################################## +### Simulate path +z = rnorm(T); +s2 = s^2; +eps = array( NaN, T ); +eps[ 1 ] = s2; +for( t in 1 : (T - 1) ) +{ + s2[ t + 1 ] = s^2 + a * ( z[ t ]^2) + b * s2[ t ]; + eps[ t + 1 ] = mu + sqrt( s2[ t + 1] ) * z[ t + 1 ]; +} + +dev.new(); +plot(eps, type = "l", main = "GARCH(1,1) process vs. time", xlab = "", ylab = "" ); Modified: pkg/Meucci/man/Central2Raw.Rd =================================================================== --- pkg/Meucci/man/Central2Raw.Rd 2013-07-29 10:37:59 UTC (rev 2661) +++ pkg/Meucci/man/Central2Raw.Rd 2013-07-29 12:18:31 UTC (rev 2662) @@ -3,18 +3,12 @@ \title{Transforms first n central moments into first n raw moments (first central moment defined as expectation)} \usage{ Central2Raw(mu) - - Central2Raw(mu) } \arguments{ - \item{mu}{a vector of central moments} - \item{mu}{: [vector] (length N corresponding to order N) central moments} } \value{ - mu_ a vector of non-central moments - mu_ : [vector] (length N corresponding to order N) corresponding raw moments } @@ -23,8 +17,6 @@ step 1, we compute the non-central moments. To do so we start with the first non-central moment and apply recursively an identity (formula 20) - - Map central moments into raw moments } \details{ \deqn{ \tilde{ \mu }^{ \big(1\big) }_{X} \equiv \mu @@ -34,14 +26,13 @@ } \author{ Ram Ahluwalia \email{rahluwalia at gmail.com} - - Xavier Valls \email{flamejat at gmail.com} } \references{ A. Meucci - "Exercises in Advanced Risk and Portfolio Management". See page 10. Symmys site containing original MATLAB source code \url{http://www.symmys.com} - \url{http://} See Meucci's script for "Central2Raw.m" + \url{http://symmys.com/node/170} See Meucci's script for + "Central2Raw.m" } Modified: pkg/Meucci/man/Cumul2Raw.Rd =================================================================== --- pkg/Meucci/man/Cumul2Raw.Rd 2013-07-29 10:37:59 UTC (rev 2661) +++ pkg/Meucci/man/Cumul2Raw.Rd 2013-07-29 12:18:31 UTC (rev 2662) @@ -3,28 +3,17 @@ \title{Map cumulative moments into raw moments.} \usage{ Cumul2Raw(ka) - - Cumul2Raw(ka) } \arguments{ \item{ka}{: [vector] (length N corresponding to order N) cumulative moments} - - \item{ka}{: [vector] (length N corresponding to order N) - cumulative moments} } \value{ mu_ : [vector] (length N corresponding to order N) corresponding raw moments - - mu_ : [vector] (length N corresponding to order N) - corresponding raw moments } \description{ step 5 of the projection process: - - Map cumulative moments into raw moments, as described in - A. Meucci "Risk and Asset Allocation", Springer, 2005 } \details{ From the cumulants of Y we compute the raw non-central @@ -38,10 +27,7 @@ \kappa_{Y}^{ \big(k\big) } \tilde{ \mu } ^{n-k}_{Y} } } \author{ - Xavier Valls \email{flamejat at gmail.com} and Ram Ahluwalia - \email{rahluwalia at gmail.com} - - Xavier Valls \email{flamejat at gmail.com} + Ram Ahluwalia \email{rahluwalia at gmail.com} } \references{ \url{http://symmys.com/node/170} See Meucci's script for @@ -51,8 +37,5 @@ Skewness, Kurtosis and All Summary Statistics" - formula (24) Symmys site containing original MATLAB source code \url{http://www.symmys.com/node/136} - - \url{http://symmys.com/node/170} See Meucci's script for - "Cumul2Raw.m" } Modified: pkg/Meucci/man/Raw2Central.Rd =================================================================== --- pkg/Meucci/man/Raw2Central.Rd 2013-07-29 10:37:59 UTC (rev 2661) +++ pkg/Meucci/man/Raw2Central.Rd 2013-07-29 12:18:31 UTC (rev 2662) @@ -3,27 +3,17 @@ \title{Transforms the first n raw moments into the first n central moments} \usage{ Raw2Central(mu_) - - Raw2Central(mu_) } \arguments{ - \item{mu_}{the raw (multi-period) non-central moment of - Y-t} - \item{mu_}{: [vector] (length N corresponding to order N) corresponding raw moments} } \value{ - mu (multi-period) central moment of Y-t - mu : [vector] (length N corresponding to order N) central moments } \description{ step 6 of projection process: - - Map raw moments into central moments, as described in A. - Meucci "Risk and Asset Allocation", Springer, 2005 } \details{ compute multi-period central moments. @@ -37,8 +27,6 @@ } \author{ Ram Ahluwalia \email{rahluwalia at gmail.com} - - Xavier Valls \email{flamejat at gmail.com} } \references{ A. Meucci - "Exercises in Advanced Risk and Portfolio Modified: pkg/Meucci/man/Raw2Cumul.Rd =================================================================== --- pkg/Meucci/man/Raw2Cumul.Rd 2013-07-29 10:37:59 UTC (rev 2661) +++ pkg/Meucci/man/Raw2Cumul.Rd 2013-07-29 12:18:31 UTC (rev 2662) @@ -3,27 +3,18 @@ \title{Transforms raw moments into cumulants} \usage{ Raw2Cumul(mu_) - - Raw2Cumul(mu_) } \arguments{ - \item{mu_}{non-central moments of the invariant X-t} - \item{mu_}{: [vector] (length N corresponding to order N) corresponding raw moments} } \value{ - ka cumulants of X-t - ka : [vector] (length N corresponding to order N) cumulative moments } \description{ Step 3 of the projection process: From the non-central moments of X-t, we compute the cumulants. - - Map raw moments into cumulative moments, as described in - A. Meucci "Risk and Asset Allocation", Springer, 2005 } \details{ This process follows from the Taylor approximations for @@ -38,8 +29,6 @@ } \author{ Ram Ahluwalia \email{rahluwalia at gmail.com} - - Xavier Valls \email{flamejat at gmail.com} } \references{ A. Meucci - "Annualization and General Projection of From noreply at r-forge.r-project.org Mon Jul 29 16:09:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 16:09:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2663 - pkg/PortfolioAnalytics/R Message-ID: <20130729140945.61F67183D96@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 16:09:44 +0200 (Mon, 29 Jul 2013) New Revision: 2663 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: making a few minor revisions/corrections to constraints Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 12:18:31 UTC (rev 2662) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 14:09:44 UTC (rev 2663) @@ -320,6 +320,11 @@ # Get the length of the assets vector nassets <- length(assets) + if(type=="long_only"){ + min <- rep(0, nassets) + max <- rep(1, nassets) + } + # Check that the length of min and max are the same if(hasArg(min) | hasArg(max)) { if (length(min) > 1 & length(max) > 1){ @@ -459,7 +464,7 @@ # Construct group_pos vector if(!is.null(group_pos)){ # Check the length of the group_pos vector - if(length(group_poss) != length(groups)) stop("length of group_pos must be equal to the length of groups") + if(length(group_pos) != length(groups)) stop("length of group_pos must be equal to the length of groups") # Check for negative values in group_pos if(any(group_pos < 0)) stop("all elements of group_pos must be positive") # Elements of group_pos cannot be greater than groups From noreply at r-forge.r-project.org Mon Jul 29 17:47:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 17:47:31 +0200 (CEST) Subject: [Returnanalytics-commits] r2664 - pkg/PortfolioAnalytics/R Message-ID: <20130729154731.8E060184F77@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 17:47:31 +0200 (Mon, 29 Jul 2013) New Revision: 2664 Modified: pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/R/objective.R Log: adding insert_constraints and insert_objectives functions Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 14:09:44 UTC (rev 2663) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 15:47:31 UTC (rev 2664) @@ -824,3 +824,26 @@ # )) # } +#' Insert a list of constraints into the constraints slot of a portfolio object +#' @param portfolio object of class 'portfolio' +#' @param constraints list of constraint objects +#' @author Ross Bennett +#' @export +insert_constraints <- function(portfolio, constraints){ + # Check portfolio object + if (is.null(portfolio) | !is.portfolio(portfolio)){ + stop("you must pass in an object of class portfolio") + } + + # Check that constraints is a list + if(!is.list(constraints)) stop("constraints must be passed in as a list") + + # Check that all objects in the list are of class constraint + for(i in 1:length(constraints)){ + if(!is.constraint(constraints[[i]])) + stop("constraints must be passed in as a list and all objects in constraints must be of class 'constraint'") + } + + portfolio$constraints <- constraints + return(portfolio) +} Modified: pkg/PortfolioAnalytics/R/objective.R =================================================================== --- pkg/PortfolioAnalytics/R/objective.R 2013-07-29 14:09:44 UTC (rev 2663) +++ pkg/PortfolioAnalytics/R/objective.R 2013-07-29 15:47:31 UTC (rev 2664) @@ -24,6 +24,7 @@ objective<-function(name , target=NULL , arguments, enabled=TRUE , ..., multiplier=1, objclass='objective'){ if(!hasArg(name)) stop("you must specify an objective name") if (hasArg(name)) if(is.null(name)) stop("you must specify an objective name") + if (!hasArg(arguments) | is.null(arguments)) arguments<-list() if (!is.list(arguments)) stop("arguments must be passed as a named list") ## now structure and return @@ -383,4 +384,28 @@ Objective$min <- min Objective$max <- max return(Objective) -} # end minmax_objective constructor \ No newline at end of file +} # end minmax_objective constructor + +#' Insert a list of objectives into the objectives slot of a portfolio object +#' @param portfolio object of class 'portfolio' +#' @param objectives list of objective objects +#' @author Ross Bennett +#' @export +insert_objectives <- function(portfolio, objectives){ + # Check portfolio object + if (is.null(portfolio) | !is.portfolio(portfolio)){ + stop("you must pass in an object of class portfolio") + } + + # Check that objectives is a list + if(!is.list(objectives)) stop("objectives must be passed in as a list") + + # Check that all objects in the list are of class objective + for(i in 1:length(objectives)){ + if(!is.objective(objectives[[i]])) + stop("objectives must be passed in as a list and all objects in objectives must be of class 'objective'") + } + + portfolio$objectives <- objectives + return(portfolio) +} \ No newline at end of file From noreply at r-forge.r-project.org Mon Jul 29 17:56:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 17:56:15 +0200 (CEST) Subject: [Returnanalytics-commits] r2665 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130729155615.8C8B918499E@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 17:56:15 +0200 (Mon, 29 Jul 2013) New Revision: 2665 Added: pkg/PortfolioAnalytics/man/insert_constraints.Rd pkg/PortfolioAnalytics/man/insert_objectives.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/R/objective.R pkg/PortfolioAnalytics/man/box_constraint.Rd pkg/PortfolioAnalytics/man/chart.Scatter.DE.Rd pkg/PortfolioAnalytics/man/diversification_constraint.Rd pkg/PortfolioAnalytics/man/group_constraint.Rd pkg/PortfolioAnalytics/man/position_limit_constraint.Rd pkg/PortfolioAnalytics/man/turnover_constraint.Rd pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd Log: updating documentation for constraints Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-29 15:56:15 UTC (rev 2665) @@ -32,6 +32,8 @@ export(get_constraints) export(group_constraint) export(group_fail) +export(insert_constraints) +export(insert_objectives) export(is.constraint) export(is.objective) export(is.portfolio) Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 15:56:15 UTC (rev 2665) @@ -797,7 +797,32 @@ return(constraints) } +#' Insert a list of constraints into the constraints slot of a portfolio object +#' +#' @param portfolio object of class 'portfolio' +#' @param constraints list of constraint objects +#' @author Ross Bennett +#' @export +insert_constraints <- function(portfolio, constraints){ + # Check portfolio object + if (is.null(portfolio) | !is.portfolio(portfolio)){ + stop("you must pass in an object of class portfolio") + } + + # Check that constraints is a list + if(!is.list(constraints)) stop("constraints must be passed in as a list") + + # Check that all objects in the list are of class constraint + for(i in 1:length(constraints)){ + if(!is.constraint(constraints[[i]])) + stop("constraints must be passed in as a list and all objects in constraints must be of class 'constraint'") + } + + portfolio$constraints <- constraints + return(portfolio) +} + # #' constructor for class constraint_ROI # #' # #' @param assets number of assets, or optionally a named vector of assets specifying seed weights @@ -824,26 +849,3 @@ # )) # } -#' Insert a list of constraints into the constraints slot of a portfolio object -#' @param portfolio object of class 'portfolio' -#' @param constraints list of constraint objects -#' @author Ross Bennett -#' @export -insert_constraints <- function(portfolio, constraints){ - # Check portfolio object - if (is.null(portfolio) | !is.portfolio(portfolio)){ - stop("you must pass in an object of class portfolio") - } - - # Check that constraints is a list - if(!is.list(constraints)) stop("constraints must be passed in as a list") - - # Check that all objects in the list are of class constraint - for(i in 1:length(constraints)){ - if(!is.constraint(constraints[[i]])) - stop("constraints must be passed in as a list and all objects in constraints must be of class 'constraint'") - } - - portfolio$constraints <- constraints - return(portfolio) -} Modified: pkg/PortfolioAnalytics/R/objective.R =================================================================== --- pkg/PortfolioAnalytics/R/objective.R 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/R/objective.R 2013-07-29 15:56:15 UTC (rev 2665) @@ -387,6 +387,7 @@ } # end minmax_objective constructor #' Insert a list of objectives into the objectives slot of a portfolio object +#' #' @param portfolio object of class 'portfolio' #' @param objectives list of objective objects #' @author Ross Bennett Modified: pkg/PortfolioAnalytics/man/box_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/box_constraint.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/box_constraint.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,7 +2,7 @@ \alias{box_constraint} \title{constructor for box_constraint.} \usage{ - box_constraint(type, assets, min, max, min_mult, + box_constraint(type = "box", assets, min, max, min_mult, max_mult, enabled = TRUE, message = FALSE, ...) } \arguments{ Modified: pkg/PortfolioAnalytics/man/chart.Scatter.DE.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Scatter.DE.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/chart.Scatter.DE.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,7 +2,7 @@ \alias{chart.Scatter.DE} \title{classic risk return scatter of DEoptim results} \usage{ - chart.Scatter.DE(DE, R = NULL, constraints = NULL, + chart.Scatter.DE(DE, R = NULL, portfolio = NULL, neighbors = NULL, return.col = "mean", risk.col = "ES", ..., element.color = "darkgray", cex.axis = 0.8) } @@ -14,9 +14,8 @@ timeSeries or zoo object of asset returns, used to recalulate the objective function where required} - \item{constraints}{an object of type "constraints" - specifying the constraints for the optimization, see - \code{\link{constraint}}} + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization} \item{neighbors}{set of 'neighbor' portfolios to overplot, see Details in \code{\link{charts.DE}}} Modified: pkg/PortfolioAnalytics/man/diversification_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/diversification_constraint.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,8 +2,8 @@ \alias{diversification_constraint} \title{constructor for diversification_constraint} \usage{ - diversification_constraint(type, div_target, - enabled = TRUE, message = FALSE, ...) + diversification_constraint(type = "diversification", + div_target, enabled = TRUE, message = FALSE, ...) } \arguments{ \item{type}{character type of the constraint} Modified: pkg/PortfolioAnalytics/man/group_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/group_constraint.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,7 +2,7 @@ \alias{group_constraint} \title{constructor for group_constraint} \usage{ - group_constraint(type, assets, groups, + group_constraint(type = "group", assets, groups, group_labels = NULL, group_min, group_max, group_pos = NULL, enabled = TRUE, message = FALSE, ...) } Added: pkg/PortfolioAnalytics/man/insert_constraints.Rd =================================================================== --- pkg/PortfolioAnalytics/man/insert_constraints.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/insert_constraints.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -0,0 +1,19 @@ +\name{insert_constraints} +\alias{insert_constraints} +\title{Insert a list of constraints into the constraints slot of a portfolio object} +\usage{ + insert_constraints(portfolio, constraints) +} +\arguments{ + \item{portfolio}{object of class 'portfolio'} + + \item{constraints}{list of constraint objects} +} +\description{ + Insert a list of constraints into the constraints slot of + a portfolio object +} +\author{ + Ross Bennett +} + Added: pkg/PortfolioAnalytics/man/insert_objectives.Rd =================================================================== --- pkg/PortfolioAnalytics/man/insert_objectives.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/insert_objectives.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -0,0 +1,19 @@ +\name{insert_objectives} +\alias{insert_objectives} +\title{Insert a list of objectives into the objectives slot of a portfolio object} +\usage{ + insert_objectives(portfolio, objectives) +} +\arguments{ + \item{portfolio}{object of class 'portfolio'} + + \item{objectives}{list of objective objects} +} +\description{ + Insert a list of objectives into the objectives slot of a + portfolio object +} +\author{ + Ross Bennett +} + Modified: pkg/PortfolioAnalytics/man/position_limit_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/position_limit_constraint.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,9 +2,10 @@ \alias{position_limit_constraint} \title{constructor for position_limit_constraint} \usage{ - position_limit_constraint(type, assets, max_pos = NULL, - max_pos_long = NULL, max_pos_short = NULL, - enabled = TRUE, message = FALSE, ...) + position_limit_constraint(type = "position_limit", + assets, max_pos = NULL, max_pos_long = NULL, + max_pos_short = NULL, enabled = TRUE, message = FALSE, + ...) } \arguments{ \item{type}{character type of the constraint} Modified: pkg/PortfolioAnalytics/man/turnover_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/turnover_constraint.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,7 +2,7 @@ \alias{turnover_constraint} \title{constructor for turnover_constraint} \usage{ - turnover_constraint(type, turnover_target, + turnover_constraint(type = "turnover", turnover_target, enabled = TRUE, message = FALSE, ...) } \arguments{ Modified: pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd 2013-07-29 15:47:31 UTC (rev 2664) +++ pkg/PortfolioAnalytics/man/weight_sum_constraint.Rd 2013-07-29 15:56:15 UTC (rev 2665) @@ -2,8 +2,8 @@ \alias{weight_sum_constraint} \title{constructor for weight_sum_constraint} \usage{ - weight_sum_constraint(type, min_sum = 0.99, - max_sum = 1.01, enabled = TRUE, ...) + weight_sum_constraint(type = "weight_sum", + min_sum = 0.99, max_sum = 1.01, enabled = TRUE, ...) } \arguments{ \item{type}{character type of the constraint} From noreply at r-forge.r-project.org Mon Jul 29 18:05:40 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 18:05:40 +0200 (CEST) Subject: [Returnanalytics-commits] r2666 - pkg/Meucci/demo Message-ID: <20130729160540.5390618499E@r-forge.r-project.org> Author: xavierv Date: 2013-07-29 18:05:39 +0200 (Mon, 29 Jul 2013) New Revision: 2666 Added: pkg/Meucci/demo/S_TStatApprox.R Log: -added S_TStatApprox demo script Added: pkg/Meucci/demo/S_TStatApprox.R =================================================================== --- pkg/Meucci/demo/S_TStatApprox.R (rev 0) +++ pkg/Meucci/demo/S_TStatApprox.R 2013-07-29 16:05:39 UTC (rev 2666) @@ -0,0 +1,146 @@ +library( mvtnorm ); + +#' Simulate invariants for the regression model, as described in A. Meucci, +#' "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @param mu_x : [scalar] +#' @param sig_x : [scalar] std for x +#' @param nu_f : [scalar] dof for x +#' @param sig_f : [scalar] std for x +#' @param nu_w : [scalar] dof for w +#' @param Sigma_w : [matrix] ( 2 x 2 ) covariance matrix +#' @param nu_w : [scalar] dof for w +#' +#' @return X : [vector] ( J x 1 ) +#' @return F : [vector] ( J x 1 ) +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "GenerateInvariants.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +GenerateInvariants = function( mu_x, sig_x, nu_f, sig_f, nu_w, Sigma_w, J ) +{ + diag_W = 0; + + for( s in 1 : nu_w ) + { + Z = rmvnorm( J, rbind( 0, 0 ), Sigma_w ); + diag_W = diag_W + Z * Z; + } + + a_w = nu_w / 2; + b_w = 2 * diag( Sigma_w ); + a_f = nu_f / 2; + b_f = 2 * sig_f ^ 2; + U_x = pgamma( diag_W[ , 1 ], a_w, b_w[ 1 ] ); + X = qlnorm( U_x, mu_x, sig_x ); + U_f = pgamma( diag_W[ , 2 ], shape = a_w, scale = b_w[ 2 ] ); + F = qgamma( U_f, shape = a_f, scale = b_f ); + + return( list( X = matrix(X), F = matrix(F) ) ); +} + + +#' This script simulates statistics for a regression model and compare it theoretical ones, +#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_TStatApprox.m" +#' + +################################################################################################################## +### Inputs +T = 25; +J = 1500; +mu_x = 0.1 * ( runif(1) - 0.5 ); +sig_x = 0.2 * runif(1); +nu_f = ceiling( 10 * runif(1) ); +sig_f = 0.2 * runif(1); +nu_w = ceiling( 10 * runif(1) ); +dd = matrix( runif(4), 2, 2 ) - 0.5; +Sigma_w = dd %*% t(dd); + +################################################################################################################## +### Compute market features in simulation +GI = GenerateInvariants( mu_x, sig_x, nu_f, sig_f, nu_w, Sigma_w, J ); + +Mu = apply( cbind(GI$X, GI$F), 2, mean ); +Sigma = cov( cbind( GI$X, GI$F ) ); +mu_X = Mu[ 1 ]; +mu_F = Mu[ 2 ]; +sig_X = sqrt( Sigma[ 1, 1 ] ); +sig_F = sqrt( Sigma[ 2, 2 ] ); +rho = Sigma[ 1, 2 ] / sqrt( Sigma[ 1, 1 ] * Sigma[ 2, 2 ] ); + +Alpha = mu_X - mu_F * rho * sig_X / sig_F; +Beta = rho * sig_X / sig_F; +sig = sig_X * sqrt( 1 - rho^2 ); + +################################################################################################################## +### Randomize time series and compute statistics as random variables +mu_X_hat = matrix( 0, 1, J); +sig2_X_hat = matrix( 0, 1, J); +Alpha_hat = matrix( 0, 1, J); +Beta_hat = matrix( 0, 1, J); +sig2_a_hat = matrix( 0, 1, J); +sig2_b_hat = matrix( 0, 1, J); +sig2_U_hat = matrix( 0, 1, J); +Sigma_F = matrix( 0, 2, 2); +for( j in 1 : J ) +{ + GI = GenerateInvariants( mu_x, sig_x, nu_f, sig_f, nu_w, Sigma_w, T ); + + # t-stat for mean + mu_X_hat[ j ] = mean( GI$X ); + sig2_X_hat[ j ] = (dim(GI$X)[1]-1)/dim(GI$X)[1]* var( GI$X); + + # t-stat for regression + Sigma_XF = cbind( mean( GI$X ), mean( GI$X * GI$F ) ); + Sigma_F[ 1, 1 ] = 1; + Sigma_F[ 1, 2 ] = mean( GI$F ); + Sigma_F[ 2, 1 ] = Sigma_F[ 1, 2 ]; + Sigma_F[ 2, 2 ] = mean( GI$F * GI$F ); + inv_Sigma_F = solve(Sigma_F); + sig2_a_hat[ j ] = inv_Sigma_F[ 1, 1 ]; + sig2_b_hat[ j ] = inv_Sigma_F[ 2, 2 ]; + + AB_hat = Sigma_XF %*% inv_Sigma_F; + Alpha_hat[ j ] = AB_hat[ 1 ]; + Beta_hat[ j ] = AB_hat[ 2 ]; + + X_ = Alpha_hat[ j ] + Beta_hat[ j ] * GI$F; + U = GI$X - X_; + sig2_U_hat[ j ] = (dim(U)[1]-1)/dim(U)[1] * var( U ); #MOMENT +} + +t_m = ( mu_X_hat - mu_X ) / sqrt( sig2_X_hat / ( T - 1 ) ); +t_a = ( Alpha_hat - Alpha ) / sqrt( sig2_a_hat * sig2_U_hat / ( T - 2 ) ); +t_b = ( Beta_hat - Beta ) / sqrt( sig2_b_hat * sig2_U_hat / ( T - 2 ) ); + +################################################################################################################## +### Display results +# should be uniform +dev.new(); +par( mfrow = c( 3, 1) ); + +NumBins = round( 10 * log( J ) ); + +U_m = pt( t_m, T-1 ); +hist( U_m, NumBins ); + +U_a= pt( t_a, T-2 ); +hist( U_a, NumBins ); + +U_b = pt( t_b, T-2 ); +hist( U_b, NumBins ); + +# qqplots for comparison +dev.new(); +par( mfrow = c( 1, 3 ) ) +qqplot( t_m, matrix( rt( length( t_m ), T-1 ), dim( t_m ) ) ); +qqplot( t_a, matrix( rt( T-2, length( t_a ) ), dim( t_a ) ) ); +qqplot( t_b, matrix( rt( T-2, length( t_b ) ), dim( t_b ) ) ); + From noreply at r-forge.r-project.org Mon Jul 29 18:42:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 18:42:00 +0200 (CEST) Subject: [Returnanalytics-commits] r2667 - in pkg/PortfolioAnalytics: R man Message-ID: <20130729164200.CF823185349@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 18:42:00 +0200 (Mon, 29 Jul 2013) New Revision: 2667 Modified: pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio.Rd Log: modifying optimize.portfolio to accept constraints and objectives seperately Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 16:05:39 UTC (rev 2666) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-29 16:42:00 UTC (rev 2667) @@ -568,7 +568,7 @@ get_constraints <- function(portfolio){ if(!is.portfolio(portfolio)) stop("portfolio passed in is not of class portfolio") - if(length(pspec$constraints) == 0) stop("No constraints passed in") + if(length(portfolio$constraints) == 0) stop("No constraints passed in") out <- list() out$min_sum <- NA Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-29 16:05:39 UTC (rev 2666) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-29 16:42:00 UTC (rev 2667) @@ -510,7 +510,9 @@ #' If you would like to interface with \code{optimize.portfolio} using matrix formulations, then use \code{ROI_old}. #' #' @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{constraint}}, if using closed for solver, need to pass a \code{\link{constraint_ROI}} object. +#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization +#' @param constraints default=NULL, a list of constraint objects +#' @param objectives default=NULL, a list of objective objects #' @param optimize_method one of "DEoptim", "random", "ROI","ROI_old", "pso", "GenSA". For using \code{ROI_old}, need to use a constraint_ROI object in constraints. For using \code{ROI}, pass standard \code{constratint} object in \code{constraints} argument. Presently, ROI has plugins for \code{quadprog} and \code{Rglpk}. #' @param search_size integer, how many portfolios to test, default 20,000 #' @param trace TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched @@ -527,6 +529,8 @@ optimize.portfolio_v2 <- function( R, portfolio, + constraints=NULL, + objectives=NULL, optimize_method=c("DEoptim","random","ROI","ROI_old","pso","GenSA"), search_size=20000, trace=FALSE, ..., @@ -553,6 +557,16 @@ } T <- nrow(R) + # Check for constraints and objectives passed in separately outside of the portfolio object + if(!is.null(constraints)){ + # Insert the constraints into the portfolio object + portfolio <- insert_constraints(portfolio=portfolio, constraints=constraints) + } + if(!is.null(objectives)){ + # Insert the objectives into the portfolio object + portfolio <- insert_objectives(portfolio=portfolio, objectives=objectives) + } + out <- list() weights <- NULL Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.Rd 2013-07-29 16:05:39 UTC (rev 2666) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.Rd 2013-07-29 16:42:00 UTC (rev 2667) @@ -3,7 +3,8 @@ \alias{optimize.portfolio_v2} \title{version 2 wrapper for constrained optimization of portfolios} \usage{ - optimize.portfolio_v2(R, portfolio, + optimize.portfolio_v2(R, portfolio, constraints = NULL, + objectives = NULL, optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), search_size = 20000, trace = FALSE, ..., rp = NULL, momentFUN = "set.portfolio.moments", message = FALSE) @@ -13,10 +14,14 @@ or zoo object of asset returns} \item{portfolio}{an object of type "portfolio" specifying - the constraints and objectives for the optimization, see - \code{\link{constraint}}, if using closed for solver, - need to pass a \code{\link{constraint_ROI}} object.} + the constraints and objectives for the optimization} + \item{constraints}{default=NULL, a list of constraint + objects} + + \item{objectives}{default=NULL, a list of objective + objects} + \item{optimize_method}{one of "DEoptim", "random", "ROI","ROI_old", "pso", "GenSA". For using \code{ROI_old}, need to use a constraint_ROI object in From noreply at r-forge.r-project.org Mon Jul 29 18:49:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 18:49:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2668 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130729164932.2A902185031@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 18:49:31 +0200 (Mon, 29 Jul 2013) New Revision: 2668 Added: pkg/PortfolioAnalytics/sandbox/testing_separate_constraints_objectives.R Log: adding testing script to sandbox folder to test constraints and objectives that are specified separately Added: pkg/PortfolioAnalytics/sandbox/testing_separate_constraints_objectives.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_separate_constraints_objectives.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_separate_constraints_objectives.R 2013-07-29 16:49:31 UTC (rev 2668) @@ -0,0 +1,100 @@ + +# testing insert_constraints and insert_objectives + +library(PortfolioAnalytics) +data(edhec) +ret <- edhec[, 1:4] +funds <- colnames(ret) + +# We still need a portfolio object, but it does not need constraints and objectives +pspec <- portfolio.spec(assets=funds) + +# Get the assets from the portfolio object +assets <- pspec$assets + +# Note that box constraints are 'portfolio-aware' so we need to know the assets. +# The assets should be a named vector of seed weights. +box1 <- box_constraint(assets=assets, min=0, max=0.65) +# We can specify type="long_only" +box2 <- box_constraint(type="long_only", assets=assets) +# If min_sum and max_sum are not specified, we default to long only +box3 <- box_constraint(assets=assets) + +# We default to min_sum=0.99 and max_sum=1.01 +weight1 <- weight_sum_constraint() +# By specifying type="full_investment", min_sum=1 and max_sum=1. +weight2 <- weight_sum_constraint(type="full_investment") +# By specifying type="active" or type="dollar_neutral", min_sum=0 and max_sum=0. +weight3 <- weight_sum_constraint(type="active") +weight4 <- weight_sum_constraint(type="dollar_neutral") + +# Note that group constraints are 'portfolio-aware' so we need to know the assets. +# The assets should be a named vector of seed weights. +# These are the required arguments to specify group constraints +group1 <- group_constraint(assets=assets, groups=c(2, 2), group_min=0, group_max=0.8) + +# Alternatively, we can also specify labels for the groups with the +# group_labels arg as well as group position limits with group_pos +group2 <- group_constraint(assets=assets, groups=c(2, 2), group_labels=c("Small", "Large"), + group_min=0, group_max=0.8, group_pos=c(2, 1)) + +# We can specify a target turnover as a constraint +to1 <- turnover_constraint(turnover_target=0.3) + +# We can specify a target diversification as a constraint +div1 <- diversification_constraint(div_target=0.8) + +# We can specify the maximum number of positions (non-zero asset weights) +pl1 <- position_limit_constraint(assets=assets, max_pos=3) + +# We can also specify the maximum number of long positions and maximum number +# of short positions +pl2 <- position_limit_constraint(assets=assets, max_pos_long=2, max_pos_short=2) + +foo <- 4 +bar <- "fubar" + +tmp1 <- list(weight1, box1, group1) + +tmp2 <- list(weight2, box2, group2) + +tmp3 <- list(weight1, box1, foo, bar, div1) + +tmp4 <- c(weight3, box1, div1) +tmp5 <- list(weight3, box1, div1) +tmp6 <- list(weight2, box2, group2) + +print.default(insert_constraints(portfolio=pspec, constraints=tmp1)) +print.default(insert_constraints(constraints=tmp1)) +print.default(insert_constraints(portfolio=pspec, constraints=tmp2)) +print.default(insert_constraints(portfolio=pspec, constraints=tmp3)) +print.default(insert_constraints(portfolio=pspec, constraints=tmp4)) +print.default(insert_constraints(portfolio=pspec, constraints=tmp5)) +print.default(insert_constraints(portfolio=pspec, constraints=tmp6)) + +# objective functions +ret1 <- return_objective(name="mean") +ret2 <- return_objective(name="mean", target=0.008) + +risk1 <- portfolio_risk_objective(name="var") +# risk_budget_objective() +to1 <- turnover_objective(name="turnover") +minmax1 <- minmax_objective(name="var", min=0.003, max=0.005) +minmax2 <- minmax_objective(name="mean", min=0.06, max=0.08) + +obj1 <- list(ret1) +obj2 <- list(risk1) +obj3 <- list(ret2, risk1) +obj4 <- list(ret1, foo, risk1) +obj5 <- c(ret1, risk1) +obj6 <- list(ret1, risk1, to1, minmax2) + +print.default(insert_objectives(portfolio=pspec, objectives=obj1)) +print.default(insert_objectives(objectives=obj1)) +print.default(insert_objectives(portfolio=pspec, objectives=obj2)) +print.default(insert_objectives(portfolio=pspec, objectives=obj3)) +print.default(insert_objectives(portfolio=pspec, objectives=obj4)) +print.default(insert_objectives(portfolio=pspec, objectives=obj5)) +print.default(insert_objectives(portfolio=pspec, objectives=obj6)) + + From noreply at r-forge.r-project.org Mon Jul 29 18:52:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 18:52:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2669 - pkg/FactorAnalytics/R Message-ID: <20130729165201.15F64185031@r-forge.r-project.org> Author: chenyian Date: 2013-07-29 18:52:00 +0200 (Mon, 29 Jul 2013) New Revision: 2669 Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r pkg/FactorAnalytics/R/plot.StatFactorModel.r pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r Log: change bar plot colors. Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-29 16:49:31 UTC (rev 2668) +++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-07-29 16:52:00 UTC (rev 2669) @@ -91,9 +91,9 @@ # "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[,asset.name], lwd=2, col="blue") + lines(fitted.z[,asset.name], lwd=2, col="red") abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) + legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","red")) }, "2L"={ # "time series plot of residuals with standard error bands" @@ -164,12 +164,12 @@ switch(which.plot, "1L" = { - factor.names <- colnames(fit.fund$factors) + factor.names <- colnames(fit.fund$factor.returns) # nn <- length(factor.names) par(mfrow=c(n,1)) options(show.error.messages=FALSE) for (i in factor.names[1:n]) { - plot(fit.fund$factors[,i],main=paste(i," Factor Returns",sep="") ) + plot(fit.fund$factor.returns[,i],main=paste(i," Factor Returns",sep="") ) } par(mfrow=c(1,1)) }, @@ -193,7 +193,7 @@ plotcorr(ordered.cor.fm[c(1:n),c(1:n)], col=cm.colors(11)[5*ordered.cor.fm + 6]) }, "5L" = { - cov.factors = var(fit.fund$factors) + cov.factors = var(fit.fund$factor.returns) names = fit.fund$asset.names factor.sd.decomp.list = list() for (i in names) { @@ -207,11 +207,11 @@ } # extract contributions to SD from list cr.sd = sapply(factor.sd.decomp.list, getCSD) - rownames(cr.sd) = c(colnames(fit.fund$factors), "residual") - # create stacked barchart - barplot(cr.sd[,(1:max.show)], main="Factor Contributions to SD", - legend.text=legend.txt, args.legend=list(x="topleft"), - col=c(1:50),...) + rownames(cr.sd) = c(colnames(fit.fund$factor.returns), "residual") + # create stacked barchart + # discard intercept + barplot(cr.sd[-1,(1:max.show)], main="Factor Contributions to SD", + legend.text=legend.txt, args.legend=list(x="topleft"),...) } , "6L" = { factor.es.decomp.list = list() @@ -221,7 +221,7 @@ # idx = which(!is.na(fit.fund$data[,i])) idx <- fit.fund$data[,fit.fund$assetvar] == i asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] - tmpData = cbind(asset.ret, fit.fund$factors, + tmpData = cbind(asset.ret, fit.fund$factor.returns, fit.fund$residuals[,i]/sqrt(fit.fund$resid.variance[i]) ) colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") factor.es.decomp.list[[i]] = @@ -236,10 +236,9 @@ } # report as positive number cr.etl = sapply(factor.es.decomp.list, getCETL) - rownames(cr.etl) = c(colnames(fit.fund$factors), "residual") - barplot(cr.etl[,(1:max.show)], main="Factor Contributions to ES", - legend.text=legend.txt, args.legend=list(x="topleft"), - col=c(1:50),...) + rownames(cr.etl) = c(colnames(fit.fund$factor.returns), "residual") + barplot(cr.etl[-1,(1:max.show)], main="Factor Contributions to ES", + legend.text=legend.txt, args.legend=list(x="topleft"),...) }, "7L" = { factor.VaR.decomp.list = list() @@ -249,7 +248,7 @@ # idx = which(!is.na(fit.fund$data[,i])) idx <- fit.fund$data[,fit.fund$assetvar] == i asset.ret <- fit.fund$data[idx,fit.fund$returnsvar] - tmpData = cbind(asset.ret, fit.fund$factors, + tmpData = cbind(asset.ret, fit.fund$factor.returns, fit.fund$residuals[,i]/sqrt(fit.fund$resid.variance[i]) ) colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual") factor.VaR.decomp.list[[i]] = @@ -265,10 +264,9 @@ } # report as positive number cr.var = sapply(factor.VaR.decomp.list, getCVaR) - rownames(cr.var) = c(colnames(fit.fund$factors), "residual") - barplot(cr.var[,(1:max.show)], main="Factor Contributions to VaR", - legend.text=legend.txt, args.legend=list(x="topleft"), - col=c(1:50),...) + rownames(cr.var) = c(colnames(fit.fund$factor.returns), "residual") + barplot(cr.var[-1,(1:max.show)], main="Factor Contributions to VaR", + legend.text=legend.txt, args.legend=list(x="topleft"),...) }, invisible() ) Modified: pkg/FactorAnalytics/R/plot.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-07-29 16:49:31 UTC (rev 2668) +++ pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-07-29 16:52:00 UTC (rev 2669) @@ -166,9 +166,9 @@ "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") + lines(fitted.z, lwd=2, col="red") abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) + legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","red")) }, "2L" = { @@ -270,9 +270,9 @@ # "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[,asset.name], lwd=2, col="blue") + lines(fitted.z[,asset.name], lwd=2, col="red") abline(h=0) - legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","blue")) + legend(x="bottomleft", legend=c("Actual", "Fitted"), lwd=2, col=c("black","red")) }, "2L"={ # "time series plot of residuals with standard error bands" @@ -397,8 +397,7 @@ rownames(cr.sd) = c(colnames(fit.stat$factors), "residual") # create stacked barchart barplot(cr.sd[,(1:max.show)], main="Factor Contributions to SD", - legend.text=T, args.legend=list(x="topleft"), - col=c(1:50) ) + legend.text=T, args.legend=list(x="topleft")) } , "7L" ={ factor.es.decomp.list = list() @@ -424,8 +423,7 @@ cr.etl = sapply(factor.es.decomp.list, getCETL) rownames(cr.etl) = c(colnames(fit.stat$factors), "residual") barplot(cr.etl[,(1:max.show)], main="Factor Contributions to ES", - legend.text=T, args.legend=list(x="topleft"), - col=c(1:50) ) + legend.text=T, args.legend=list(x="topleft") ) }, "8L" = { factor.VaR.decomp.list = list() @@ -451,8 +449,7 @@ cr.var = sapply(factor.VaR.decomp.list, getCVaR) rownames(cr.var) = c(colnames(fit.stat$factors), "residual") barplot(cr.var[,(1:max.show)], main="Factor Contributions to VaR", - legend.text=T, args.legend=list(x="topleft"), - col=c(1:50) ) + legend.text=T, args.legend=list(x="topleft")) }, invisible() ) Modified: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-07-29 16:49:31 UTC (rev 2668) +++ pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-07-29 16:52:00 UTC (rev 2669) @@ -370,8 +370,7 @@ 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"), - col=c(1:50) ) + legend.text=T, args.legend=list(x="topleft")) }, "6L"={ @@ -416,8 +415,7 @@ 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"), - col=c(1:50) ) + legend.text=T, args.legend=list(x="topleft")) }, "7L" ={ @@ -463,8 +461,7 @@ 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"), - col=c(1:50) ) + legend.text=T, args.legend=list(x="topleft")) }, invisible() ) Modified: pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r 2013-07-29 16:49:31 UTC (rev 2668) +++ pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r 2013-07-29 16:52:00 UTC (rev 2669) @@ -27,7 +27,7 @@ numExposures <- length(exposure.names) numAssets <- length(assets) - f <- fit.fund$factors # T X 3 + f <- fit.fund$factor.returns # T X 3 predictor <- function(data) { From noreply at r-forge.r-project.org Mon Jul 29 18:57:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 18:57:32 +0200 (CEST) Subject: [Returnanalytics-commits] r2670 - in pkg/PortfolioAnalytics: R man Message-ID: <20130729165732.C59DF185031@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 18:57:32 +0200 (Mon, 29 Jul 2013) New Revision: 2670 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd Log: modifying optimize.portfolio.rebalancing to work with separate constraints and objectives Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-29 16:52:00 UTC (rev 2669) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-29 16:57:32 UTC (rev 2670) @@ -984,6 +984,8 @@ #' #' @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 +#' @param constraints default=NULL, a list of constraint objects +#' @param objectives default=NULL, a list of objective objects #' @param optimize_method one of "DEoptim", "random", or "ROI" #' @param search_size integer, how many portfolios to test, default 20,000 #' @param trace TRUE/FALSE if TRUE will attempt to return additional information on the path or portfolios searched @@ -995,11 +997,21 @@ #' @return a list containing the optimal weights, some summary statistics, the function call, and optionally trace information #' @author Kris Boudt, Peter Carl, Brian G. Peterson #' @export -optimize.portfolio.rebalancing <- function(R, portfolio, optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, trailing_periods=NULL) +optimize.portfolio.rebalancing <- function(R, portfolio, constraints=NULL, objectives=NULL, optimize_method=c("DEoptim","random","ROI"), search_size=20000, trace=FALSE, ..., rp=NULL, rebalance_on=NULL, training_period=NULL, trailing_periods=NULL) { stopifnot("package:foreach" %in% search() || require("foreach",quietly=TRUE)) start_t<-Sys.time() + # Check for constraints and objectives passed in separately outside of the portfolio object + if(!is.null(constraints)){ + # Insert the constraints into the portfolio object + portfolio <- insert_constraints(portfolio=portfolio, constraints=constraints) + } + if(!is.null(objectives)){ + # Insert the objectives into the portfolio object + portfolio <- insert_objectives(portfolio=portfolio, objectives=objectives) + } + #store the call for later call <- match.call() if(optimize_method=="random"){ Modified: pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2013-07-29 16:52:00 UTC (rev 2669) +++ pkg/PortfolioAnalytics/man/optimize.portfolio.rebalancing.Rd 2013-07-29 16:57:32 UTC (rev 2670) @@ -3,6 +3,7 @@ \title{portfolio optimization with support for rebalancing or rolling periods} \usage{ optimize.portfolio.rebalancing(R, portfolio, + constraints = NULL, objectives = NULL, optimize_method = c("DEoptim", "random", "ROI"), search_size = 20000, trace = FALSE, ..., rp = NULL, rebalance_on = NULL, training_period = NULL, @@ -15,6 +16,12 @@ \item{portfolio}{an object of type "portfolio" specifying the constraints and objectives for the optimization} + \item{constraints}{default=NULL, a list of constraint + objects} + + \item{objectives}{default=NULL, a list of objective + objects} + \item{optimize_method}{one of "DEoptim", "random", or "ROI"} From noreply at r-forge.r-project.org Mon Jul 29 19:53:19 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 19:53:19 +0200 (CEST) Subject: [Returnanalytics-commits] r2671 - pkg/FactorAnalytics/R Message-ID: <20130729175319.204B8183AD4@r-forge.r-project.org> Author: chenyian Date: 2013-07-29 19:53:18 +0200 (Mon, 29 Jul 2013) New Revision: 2671 Modified: pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r Log: add checkData Modified: pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r 2013-07-29 16:57:32 UTC (rev 2670) +++ pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r 2013-07-29 17:53:18 UTC (rev 2671) @@ -4,6 +4,7 @@ #' function \code{predict.lm}. #' #' @param fit "TimeSeriesFactorModel" 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}. for example newdata and se.fit. #' @author Yi-An Chen. #' @@ -23,11 +24,17 @@ #' @export #' -predict.TimeSeriesFactorModel <- function(fit.macro,...){ -# if (missing(newdata) || is.null(newdata) ) { +predict.TimeSeriesFactorModel <- function(fit.macro,newdata = NULL,...){ + require(PerformanceAnalytics) + + if (missing(newdata) || is.null(newdata) ) { lapply(fit.macro$asset.fit, predict,...) -# } - + } else { + newdata <- checkData(newdata,method = "data.frame") + lapply(fit.macro$asset.fit, predict ,newdata,... ) + } + +} # # if ( !(missing(newdata) && !is.null(newdata) )) { # numAssets <- length(names(fit.macro$asset.fit)) @@ -55,4 +62,3 @@ # } -} \ No newline at end of file From noreply at r-forge.r-project.org Mon Jul 29 19:59:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 19:59:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2672 - in pkg/FactorAnalytics: R man Message-ID: <20130729175933.3A017183AD4@r-forge.r-project.org> Author: chenyian Date: 2013-07-29 19:59:32 +0200 (Mon, 29 Jul 2013) New Revision: 2672 Modified: pkg/FactorAnalytics/R/predict.StatFactorModel.r pkg/FactorAnalytics/man/predict.StatFactorModel.Rd pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd Log: add checkData Modified: pkg/FactorAnalytics/R/predict.StatFactorModel.r =================================================================== --- pkg/FactorAnalytics/R/predict.StatFactorModel.r 2013-07-29 17:53:18 UTC (rev 2671) +++ pkg/FactorAnalytics/R/predict.StatFactorModel.r 2013-07-29 17:59:32 UTC (rev 2672) @@ -3,7 +3,8 @@ #' Generic function of predict method for fitStatisticalFactorModel. It utilizes #' function \code{predict.lm}. #' -#' @param fit "StatFactorModel" object created by fitStatisticalFactorModel. +#' @param fit.stat "StatFactorModel" object created by fitStatisticalFactorModel. +#' @param newdata a vector, matrix, data.frame, xts, timeSeries or zoo object to be coerced. #' @param ... Any other arguments used in \code{predict.lm}. For example like newdata and fit.se. #' @author Yi-An Chen. #' ' @@ -17,6 +18,12 @@ #' -predict.StatFactorModel <- function(fit,...){ - lapply(fit$asset.fit, predict,...) +predict.StatFactorModel <- function(fit.stat,newdata = NULL,...){ + + if (missing(newdata) || is.null(newdata) ) { + lapply(fit.stat$asset.fit, predict,...) + } else { + newdata <- checkData(newdata,method = "data.frame") + lapply(fit.stat$asset.fit, predict ,newdata,... ) + } } \ No newline at end of file Modified: pkg/FactorAnalytics/man/predict.StatFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.StatFactorModel.Rd 2013-07-29 17:53:18 UTC (rev 2671) +++ pkg/FactorAnalytics/man/predict.StatFactorModel.Rd 2013-07-29 17:59:32 UTC (rev 2672) @@ -2,12 +2,15 @@ \alias{predict.StatFactorModel} \title{predict method for StatFactorModel object.} \usage{ - predict.StatFactorModel(fit, ...) + predict.StatFactorModel(fit.stat, newdata = NULL, ...) } \arguments{ - \item{fit}{"StatFactorModel" object created by + \item{fit.stat}{"StatFactorModel" object created by fitStatisticalFactorModel.} + \item{newdata}{a vector, matrix, data.frame, xts, + timeSeries or zoo object to be coerced.} + \item{...}{Any other arguments used in \code{predict.lm}. For example like newdata and fit.se.} } Modified: pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd =================================================================== --- pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2013-07-29 17:53:18 UTC (rev 2671) +++ pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd 2013-07-29 17:59:32 UTC (rev 2672) @@ -2,12 +2,16 @@ \alias{predict.TimeSeriesFactorModel} \title{predict method for TimeSeriesModel object.} \usage{ - predict.TimeSeriesFactorModel(fit.macro, ...) + predict.TimeSeriesFactorModel(fit.macro, newdata = NULL, + ...) } \arguments{ \item{fit}{"TimeSeriesFactorModel" 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}. for example newdata and se.fit.} } From noreply at r-forge.r-project.org Mon Jul 29 23:32:17 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 23:32:17 +0200 (CEST) Subject: [Returnanalytics-commits] r2673 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130729213217.2AE371848BF@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 23:32:16 +0200 (Mon, 29 Jul 2013) New Revision: 2673 Added: pkg/PortfolioAnalytics/man/extractWeights.Rd pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.rebalancing.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/extractstats.R Log: making extractWeights a generic method to work on objects created from optimize.portfolio as well as optimize.portfolio.rebalancing Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-29 17:59:32 UTC (rev 2672) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-29 21:32:16 UTC (rev 2673) @@ -26,7 +26,9 @@ export(extractStats.optimize.portfolio.random) export(extractStats.optimize.portfolio.ROI) export(extractStats) -export(extractWeights.rebal) +export(extractWeights.optimize.portfolio.rebalancing) +export(extractWeights.optimize.portfolio) +export(extractWeights) export(fn_map) export(generatesequence) export(get_constraints) Modified: pkg/PortfolioAnalytics/R/extractstats.R =================================================================== --- pkg/PortfolioAnalytics/R/extractstats.R 2013-07-29 17:59:32 UTC (rev 2672) +++ pkg/PortfolioAnalytics/R/extractstats.R 2013-07-29 21:32:16 UTC (rev 2673) @@ -151,8 +151,35 @@ return(result) } -#' extract time series of weights from output of optimize.portfolio +#' extract weights from a portfolio run via \code{optimize.portfolio} or \code{optimize.portfolio.rebalancing} #' +#' This function will dispatch to the appropriate class handler based on the +#' input class of the optimize.portfolio or optimize.portfolio.rebalancing output object +#' +#' @param object list returned by optimize.portfolio +#' @param ... any other passthru parameters +#' @seealso \code{\link{optimize.portfolio}}, \code{\link{optimize.portfolio.rebalancing}} +#' @export +extractWeights <- function (object, ...){ + UseMethod('extractWeights') +} + +#' extract weights from output of optimize.portfolio +#' +#' @param object object of type optimize.portfolio to extract weights from +#' @seealso +#' \code{\link{optimize.portfolio}} +#' @author Ross Bennett +#' @export +extractWeights.optimize.portfolio <- function(object){ + if(!inherits(object, "optimize.portfolio")){ + stop("object must be of class 'optimize.portfolio'") + } + return(object$weights) +} + +#' extract time series of weights from output of optimize.portfolio.rebalancing +#' #' \code{\link{optimize.portfolio.rebalancing}} outputs a list of #' \code{\link{optimize.portfolio}} objects, one for each rebalancing period #' @@ -163,8 +190,13 @@ #' @seealso #' \code{\link{optimize.portfolio.rebalancing}} #' @export -extractWeights.rebal <- function(RebalResults, ...){ +extractWeights.optimize.portfolio.rebalancing <- function(RebalResults, ...){ # @TODO: add a class check for the input object +# FIXED + if(!inherits(RebalResults, "optimize.portfolio.rebalancing")){ + stop("Object passed in must be of class 'optimize.portfolio.rebalancing'") + } + numColumns = length(RebalResults[[1]]$weights) numRows = length(RebalResults) Added: pkg/PortfolioAnalytics/man/extractWeights.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractWeights.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extractWeights.Rd 2013-07-29 21:32:16 UTC (rev 2673) @@ -0,0 +1,22 @@ +\name{extractWeights} +\alias{extractWeights} +\title{extract weights from a portfolio run via \code{optimize.portfolio} or \code{optimize.portfolio.rebalancing}} +\usage{ + extractWeights(object, ...) +} +\arguments{ + \item{object}{list returned by optimize.portfolio} + + \item{...}{any other passthru parameters} +} +\description{ + This function will dispatch to the appropriate class + handler based on the input class of the + optimize.portfolio or optimize.portfolio.rebalancing + output object +} +\seealso{ + \code{\link{optimize.portfolio}}, + \code{\link{optimize.portfolio.rebalancing}} +} + Added: pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.Rd 2013-07-29 21:32:16 UTC (rev 2673) @@ -0,0 +1,20 @@ +\name{extractWeights.optimize.portfolio} +\alias{extractWeights.optimize.portfolio} +\title{extract weights from output of optimize.portfolio} +\usage{ + extractWeights.optimize.portfolio(object) +} +\arguments{ + \item{object}{object of type optimize.portfolio to + extract weights from} +} +\description{ + extract weights from output of optimize.portfolio +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{optimize.portfolio}} +} + Added: pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.rebalancing.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.rebalancing.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/extractWeights.optimize.portfolio.rebalancing.Rd 2013-07-29 21:32:16 UTC (rev 2673) @@ -0,0 +1,26 @@ +\name{extractWeights.optimize.portfolio.rebalancing} +\alias{extractWeights.optimize.portfolio.rebalancing} +\title{extract time series of weights from output of optimize.portfolio.rebalancing} +\usage{ + extractWeights.optimize.portfolio.rebalancing(RebalResults, + ...) +} +\arguments{ + \item{RebalResults}{object of type + optimize.portfolio.rebalancing to extract weights from} + + \item{...}{any other passthru parameters} +} +\description{ + \code{\link{optimize.portfolio.rebalancing}} outputs a + list of \code{\link{optimize.portfolio}} objects, one for + each rebalancing period +} +\details{ + The output list is indexed by the dates of the + rebalancing periods, as determined by \code{endpoints} +} +\seealso{ + \code{\link{optimize.portfolio.rebalancing}} +} + From noreply at r-forge.r-project.org Mon Jul 29 23:42:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 29 Jul 2013 23:42:04 +0200 (CEST) Subject: [Returnanalytics-commits] r2674 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130729214204.2CD76184DD4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-29 23:42:03 +0200 (Mon, 29 Jul 2013) New Revision: 2674 Added: pkg/PortfolioAnalytics/sandbox/testing_maxret_ROI.R Log: Adding test script for maximizing return using optimize_method=ROI. Demonstrates specifying constraints and objectives as part of the portfolio object and separately then running optimize.portfolio and optimize.portfolio.rebalancing for out of sample backtest. Added: pkg/PortfolioAnalytics/sandbox/testing_maxret_ROI.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_maxret_ROI.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_maxret_ROI.R 2013-07-29 21:42:03 UTC (rev 2674) @@ -0,0 +1,56 @@ +library(PortfolioAnalytics) +library(foreach) +library(iterators) +library(quadprog) +library(Rglpk) +library(ROI) +require(ROI.plugin.glpk) +require(ROI.plugin.quadprog) + + +data(edhec) +ret <- edhec[, 1:4] +funds <- colnames(ret) + +##### Method 1 ##### +# Set up portfolio object with constraints and objectives to maximize return +# using the portfolio object to add constraints and objectives +pspec1 <- portfolio.spec(assets=funds) +pspec1 <- add.constraint(portfolio=pspec1, type="full_investment") +pspec1 <- add.constraint(portfolio=pspec1, type="box", min=0, max=0.65) +pspec1 <- add.objective(portfolio=pspec1, type="return", name="mean") + +opt1 <- optimize.portfolio(R=ret, portfolio=pspec1, optimize_method="ROI") + +##### Method 2 ##### +# Set up portfolio object with constraints and objective to maximize return +# using separate constraint and objective objects +pspec2 <- portfolio.spec(assets=funds) +weight_constr <- weight_sum_constraint(min_sum=1, max_sum=1) +box_constr <- box_constraint(assets=pspec2$assets, min=0, max=0.65) +ret_obj <- return_objective(name="mean") +cset <- list(weight_constr, box_constr) +obj <- list(ret_obj) + +opt2 <- optimize.portfolio(R=ret, portfolio=pspec2, constraints=cset, + objectives=obj, optimize_method="ROI") + +all.equal(extractWeights(opt1), extractWeights(opt2)) + +##### Method 1 Backtesting ##### +opt_rebal1 <- optimize.portfolio.rebalancing(R=ret, portfolio=pspec1, + optimize_method="ROI", + rebalance_on="months") +class(opt_rebal1) +inherits(opt_rebal1, "optimize.portfolio.rebalancing") +wts1 <- extractWeights(opt_rebal1) + +##### Method 2 Backtesting ##### +opt_rebal2 <- optimize.portfolio.rebalancing(R=ret, portfolio=pspec2, + constraints=cset, + objectives=obj, + optimize_method="ROI", + rebalance_on="months") +wts2 <- extractWeights(opt_rebal2) +all.equal(wts1, wts2) + From noreply at r-forge.r-project.org Tue Jul 30 01:03:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 01:03:54 +0200 (CEST) Subject: [Returnanalytics-commits] r2675 - pkg/PortfolioAnalytics/R Message-ID: <20130729230354.671F4184DEE@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-30 01:03:53 +0200 (Tue, 30 Jul 2013) New Revision: 2675 Modified: pkg/PortfolioAnalytics/R/charts.RP.R Log: modifying chart.Weights.Rp to work with new interface Modified: pkg/PortfolioAnalytics/R/charts.RP.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.RP.R 2013-07-29 21:42:03 UTC (rev 2674) +++ pkg/PortfolioAnalytics/R/charts.RP.R 2013-07-29 23:03:53 UTC (rev 2675) @@ -29,61 +29,67 @@ #' @seealso \code{\link{optimize.portfolio}} #' @export chart.Weights.RP <- function(RP, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){ -# Specific to the output of the random portfolio code with constraints - # @TODO: check that RP is of the correct class - columnnames = names(RP$weights) - numassets = length(columnnames) - - if(is.null(xlab)) - minmargin = 3 - else - minmargin = 5 - if(main=="") topmargin=1 else topmargin=4 - if(las > 1) {# set the bottom border to accommodate labels - bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab - if(bottommargin > 10 ) { - bottommargin<-10 - columnnames<-substr(columnnames,1,19) - # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels - } + # Specific to the output of the random portfolio code with constraints + # @TODO: check that RP is of the correct class + # FIXED + if(!inherits(RP, "optimize.portfolio.random")){ + stop("RP must be of class 'optimize.portfolio.random'") + } + columnnames = names(RP$weights) + numassets = length(columnnames) + + constraints <- get_constraints(RP$portfolio) + + if(is.null(xlab)) + minmargin = 3 + else + minmargin = 5 + if(main=="") topmargin=1 else topmargin=4 + if(las > 1) {# set the bottom border to accommodate labels + bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab + if(bottommargin > 10 ) { + bottommargin<-10 + columnnames<-substr(columnnames,1,19) + # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels } - else { - bottommargin = minmargin + } + else { + bottommargin = minmargin + } + par(mar = c(bottommargin, 4, topmargin, 2) +.1) + plot(RP$random_portfolios[1,], type="b", col="orange", axes=FALSE, xlab='', ylim=c(0,max(constraints$max)), ylab="Weights", main=main, ...) + points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24) + points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25) + if(!is.null(neighbors)){ + if(is.vector(neighbors)){ + xtract=extractStats(RP) + weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot + if(length(neighbors)==1){ + # overplot nearby portfolios defined by 'out' + orderx = order(xtract[,"out"]) + subsetx = head(xtract[orderx,], n=neighbors) + for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue") + } else{ + # assume we have a vector of portfolio numbers + subsetx = xtract[neighbors,weightcols] + for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue") + } } - par(mar = c(bottommargin, 4, topmargin, 2) +.1) - plot(RP$random_portfolios[1,], type="b", col="orange", axes=FALSE, xlab='', ylim=c(0,max(RP$constraints$max)), ylab="Weights", main=main, ...) - points(RP$constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24) - points(RP$constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25) - if(!is.null(neighbors)){ - if(is.vector(neighbors)){ - xtract=extractStats(RP) - weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot - if(length(neighbors)==1){ - # overplot nearby portfolios defined by 'out' - orderx = order(xtract[,"out"]) - subsetx = head(xtract[orderx,], n=neighbors) - for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue") - } else{ - # assume we have a vector of portfolio numbers - subsetx = xtract[neighbors,weightcols] - for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue") - } - } - if(is.matrix(neighbors) | is.data.frame(neighbors)){ - # the user has likely passed in a matrix containing calculated values for risk.col and return.col - nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot - for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue") - # note that here we need to get weight cols separately from the matrix, not from xtract - # also note the need for as.numeric. points() doesn't like matrix inputs - } + if(is.matrix(neighbors) | is.data.frame(neighbors)){ + # the user has likely passed in a matrix containing calculated values for risk.col and return.col + nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot + for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue") + # note that here we need to get weight cols separately from the matrix, not from xtract + # also note the need for as.numeric. points() doesn't like matrix inputs } - - points(RP$random_portfolios[1,], type="b", col="orange", pch=16) # to overprint neighbors - points(RP$weights, type="b", col="blue", pch=16) - axis(2, cex.axis = cex.axis, col = element.color) - axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis = cex.axis, col = element.color) - box(col = element.color) - + } + + points(RP$random_portfolios[1,], type="b", col="orange", pch=16) # to overprint neighbors + points(RP$weights, type="b", col="blue", pch=16) + axis(2, cex.axis = cex.axis, col = element.color) + axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis = cex.axis, col = element.color) + box(col = element.color) + } #' classic risk return scatter of random portfolios From noreply at r-forge.r-project.org Tue Jul 30 10:16:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 10:16:20 +0200 (CEST) Subject: [Returnanalytics-commits] r2676 - pkg/Meucci/demo Message-ID: <20130730081620.206AF18417D@r-forge.r-project.org> Author: xavierv Date: 2013-07-30 10:16:19 +0200 (Tue, 30 Jul 2013) New Revision: 2676 Added: pkg/Meucci/demo/S_MaximumLikelihood.R Log: - added S_MaximumLikelihood demo script from chapter 4 of the book Added: pkg/Meucci/demo/S_MaximumLikelihood.R =================================================================== --- pkg/Meucci/demo/S_MaximumLikelihood.R (rev 0) +++ pkg/Meucci/demo/S_MaximumLikelihood.R 2013-07-30 08:16:19 UTC (rev 2676) @@ -0,0 +1,113 @@ +#' This script performs ML under a non-standard parametric set of distributions, as described in A. Meucci, +#' "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_MaximumLikelihood.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +## Parametric pdf used in the ML estimation +fparam = function( x, th ) +{ + + + m = th; + + if( th <= 0 ) + { + s = sqrt(th^2); + nu = 1; + f = 1 / s * dt((x-m) / s, nu); + } else + { + s = sqrt((th - 0.01) ^ 2); + f = dlnorm(x, m, s); + } + + return( f ); +} + + +qparam = function( p, th ) +{ + ## Parametric inverse cdf used in the ML estimation + m = th; + + if( th <= 0 ) + { + s = sqrt(th^2); + nu = 1; + q = m + s * qt(p, nu); + } else + { + s = sqrt((th - 0.01) ^ 2); + q = qlnorm(p, m, s); + } + + return( q ); +} + + +########################################################################################################## +### Load data +load( "../data/timeSeries.Rda"); + +########################################################################################################## +### inputs +p = 0.01; +Theta = cbind( seq( -0.04, -0.01, 0.001 ), 0.02, 0.03 ); + +########################################################################################################## +### check invariance +T = length(TimeSeries$i_T); +PerformIidAnalysis( 1:T, TimeSeries$i_T, "Invariance Analysis" ); + +########################################################################################################## +### ML-estimate parameters +nTheta = length(Theta); +Store_LL = matrix( NaN, nTheta, 1); # preallocation for speed +for( s in 1 : nTheta ) +{ + print(s); + theta = Theta[ s ]; + # compute log-likelihood + LL = 0; + for( t in 1 : T ) + { + x_t = TimeSeries$i_T[ t ]; + LL = LL + log( fparam( x_t, theta ) ); + } + Store_LL[ s ] = LL; +} + +# compute log-likelihood faster (if likelihood function is vectorized) +Store_LL_fast = matrix( NaN, nTheta, 1); # preallocation for speed +for( s in 1 : nTheta ) +{ + print(s); + Store_LL_fast[ s ] = sum( log ( fparam( TimeSeries$i_T, Theta[ s ] ) ) ); +} + +# comparison +print( cbind( Store_LL, Store_LL_fast ) ); + +# determine the maximum likelihood +Max_Index = which.max( Store_LL ); +# and the corresponding estimator +theta_ML = Theta[ Max_Index ]; +print(theta_ML); + +# display the LL value for range of parameters +dev.new(); +plot( Theta, Store_LL, type = "o"); + +# compute MLE-implied quantile +Q_ML = qparam( p, theta_ML ); + +# compute sample quantile +Q_NP = quantile( TimeSeries$i_T, p ); + +# comparison of quantiles +print(cbind( Q_ML, Q_NP )); + From noreply at r-forge.r-project.org Tue Jul 30 11:04:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 11:04:11 +0200 (CEST) Subject: [Returnanalytics-commits] r2677 - pkg/Meucci/data Message-ID: <20130730090411.29CAE18548B@r-forge.r-project.org> Author: xavierv Date: 2013-07-30 11:04:10 +0200 (Tue, 30 Jul 2013) New Revision: 2677 Added: pkg/Meucci/data/timeSeries.Rda pkg/Meucci/data/usSwapRates.Rda Log: - added two data files for chapter 4 Added: pkg/Meucci/data/timeSeries.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/timeSeries.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/Meucci/data/usSwapRates.Rda =================================================================== (Binary files differ) Property changes on: pkg/Meucci/data/usSwapRates.Rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Tue Jul 30 11:54:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 11:54:10 +0200 (CEST) Subject: [Returnanalytics-commits] r2678 - in pkg/Meucci: . R demo man Message-ID: <20130730095410.763F2184B52@r-forge.r-project.org> Author: xavierv Date: 2013-07-30 11:54:10 +0200 (Tue, 30 Jul 2013) New Revision: 2678 Added: pkg/Meucci/R/MleRecursionForStudentT.R pkg/Meucci/demo/S_FitSwapToStudentT.R pkg/Meucci/man/MleRecursionForStudentT.Rd Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/NAMESPACE Log: - added S_FitSwapToStudentT demo script from chapter 4 and its associated function Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-30 09:04:10 UTC (rev 2677) +++ pkg/Meucci/DESCRIPTION 2013-07-30 09:54:10 UTC (rev 2678) @@ -84,3 +84,4 @@ 'RandNormalInverseWishart.R' 'FitMultivariateGarch.R' 'MvnRnd.R' + 'MleRecursionForStudentT.R' Modified: pkg/Meucci/NAMESPACE =================================================================== --- pkg/Meucci/NAMESPACE 2013-07-30 09:04:10 UTC (rev 2677) +++ pkg/Meucci/NAMESPACE 2013-07-30 09:54:10 UTC (rev 2678) @@ -23,6 +23,7 @@ export(LognormalCopulaPdf) export(LognormalMoments2Parameters) export(LognormalParam2Statistics) +export(MleRecursionForStudentT) export(MvnRnd) export(NoisyObservations) export(NormalCopulaPdf) Added: pkg/Meucci/R/MleRecursionForStudentT.R =================================================================== --- pkg/Meucci/R/MleRecursionForStudentT.R (rev 0) +++ pkg/Meucci/R/MleRecursionForStudentT.R 2013-07-30 09:54:10 UTC (rev 2678) @@ -0,0 +1,57 @@ +#' Compute recursively the ML estimators of location and scatter of a multivariate Student t distribution with +#' given degrees of freedom, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005. +#' +#' @param x : [matrix] (T x N) observations +#' @param Nu : [scalar] degrees of freedom parameter +#' @param Tolerance : [scalar] tolerance parameter. Default: 10^(-10) +#' +#' @return Mu : [vector] (N x 1) mean +#' @return Sigma : [matrix] (N x N) covariance +#' +#' @references +#' \url{http://} +#' See Meucci's script for "MleRecursionForStudentT.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @export + +MleRecursionForStudentT = function(x, Nu, Tolerance = 10^(-10) ) +{ + + T = nrow( x ); + N = ncol( x ); + Ones_N = matrix( 1, 1, N ); # fixed for fast matrix operation + Ones_T = matrix( 1, T, 1 ); # fixed for fast matrix operation + + # initialize variables + w = matrix( 1, T, 1 ); + Mu = matrix( 0, N, 1 ); + Sigma = matrix( 0, N, N ); + + Error = 10^6; + # start main loop + while( Error > Tolerance ) + { + + # update + Mu_Old = Mu; + Sigma_Old = Sigma; + + # Step 1 + W = w %*% Ones_N; + Mu = matrix( apply( W * x, 2, sum ) ) / sum( w ); + + x_c = x - Ones_T %*% t(Mu); + Sigma = t( W * x_c ) %*% x_c / T; + + # Step 2 + InvS = solve(Sigma); + Ma2 = apply( ( x_c %*% InvS ) * x_c, 1, sum ); + w = ( Nu + N) / ( Nu + Ma2 ); + + # convergence + Error = sum( diag( (Sigma - Sigma_Old) ^2) ) / N + t(Mu - Mu_Old) %*% ( Mu - Mu_Old ) / N; + } + + return( list( Mu = Mu, Sigma = Sigma) ); +} \ No newline at end of file Added: pkg/Meucci/demo/S_FitSwapToStudentT.R =================================================================== --- pkg/Meucci/demo/S_FitSwapToStudentT.R (rev 0) +++ pkg/Meucci/demo/S_FitSwapToStudentT.R 2013-07-30 09:54:10 UTC (rev 2678) @@ -0,0 +1,47 @@ +#' This script demonstrates the recursive ML estimation of the location and scatter parameters of a multivariate +#' Student t distribution, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 4. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_FitSwapToStudentT.m" +#' +#' TO DO: Change colors from TwoDimEllipsoid in each iteration +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + +################################################################################################################## +### Load data +load( "../data/usSwapRates.Rda" ); + +################################################################################################################## +### Inputs +ChooseRates = c( 1, 2 ); # 1=2yr; 2=5yr; 3=10yr + +Y = cbind( UsSwapRates[ , 1 ], UsSwapRates[ , 3 ] ); +X = Y[ -1, ] - Y[ -nrow( Y ), ]; + +Nus = c( 3, 100 ); + +################################################################################################################# +### Computations +Tolerance = 10^(-10); +Estimate = array( list() , length(Nus)); +for( q in 1 : length(Nus) ) +{ + Estimate[[q]] = MleRecursionForStudentT( X, Nus[ q ], Tolerance ); +} + +################################################################################################################# +### Figures +dev.new(); +h = plot( X[ , 1 ], X[ , 2 ], bg = "blue", xlab = colnames(UsSwapRates)[1], ylab = colnames(UsSwapRates)[3]); + +for( q in 1 : length(Nus) ) +{ + M = Estimate[[ q ]]$Mu; + S = Estimate[[ q ]]$Sigma * Nus[ q ] / ( Nus[ q ] - 2); + dd = TwoDimEllipsoid( M, S, 2, 0, 0 ); + #set(dd, 'color', 0.7*[rand() rand() rand()]); +} + + Added: pkg/Meucci/man/MleRecursionForStudentT.Rd =================================================================== --- pkg/Meucci/man/MleRecursionForStudentT.Rd (rev 0) +++ pkg/Meucci/man/MleRecursionForStudentT.Rd 2013-07-30 09:54:10 UTC (rev 2678) @@ -0,0 +1,34 @@ +\name{MleRecursionForStudentT} +\alias{MleRecursionForStudentT} +\title{Compute recursively the ML estimators of location and scatter of a multivariate Student t distribution with +given degrees of freedom, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.} +\usage{ + MleRecursionForStudentT(x, Nu, Tolerance = 10^(-10)) +} +\arguments{ + \item{x}{: [matrix] (T x N) observations} + + \item{Nu}{: [scalar] degrees of freedom parameter} + + \item{Tolerance}{: [scalar] tolerance parameter. Default: + 10^(-10)} +} +\value{ + Mu : [vector] (N x 1) mean + + Sigma : [matrix] (N x N) covariance +} +\description{ + Compute recursively the ML estimators of location and + scatter of a multivariate Student t distribution with + given degrees of freedom, as described in A. Meucci, + "Risk and Asset Allocation", Springer, 2005. +} +\author{ + Xavier Valls \email{flamejat at gmail.com} +} +\references{ + \url{http://} See Meucci's script for + "MleRecursionForStudentT.m" +} + From noreply at r-forge.r-project.org Tue Jul 30 13:47:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 13:47:45 +0200 (CEST) Subject: [Returnanalytics-commits] r2679 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130730114745.CCE071800C9@r-forge.r-project.org> Author: pulkit Date: 2013-07-30 13:47:45 +0200 (Tue, 30 Jul 2013) New Revision: 2679 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R Log: Vignette for rolling economic drawdown Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R 2013-07-30 09:54:10 UTC (rev 2678) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R 2013-07-30 11:47:45 UTC (rev 2679) @@ -51,7 +51,8 @@ rf = checkData(Rf) columns = ncol(x) columnnames = colnames(x) - sharpe = SharpeRatio.annualized(x,rf) + sharpe = SharpeRatio.annualized(x,Rf) + sd = StdDev.annualized(R) dynamicPort<-function(x){ factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta*gamma) Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-30 09:54:10 UTC (rev 2678) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-30 11:47:45 UTC (rev 2679) @@ -76,7 +76,7 @@ dynamicPort<-function(x,column){ if(type == "calibrated"){ if(asset == "one"){ - mu = mean(x[,column]) + mu = mean(x) factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2) xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0) } @@ -128,6 +128,7 @@ xt = column.xt else xt = merge(xt, column.xt) } + print(xt) colnames(xt) = columnnames xt = reclass(xt, x) return(xt) Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw (rev 0) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw 2013-07-30 11:47:45 UTC (rev 2679) @@ -0,0 +1,177 @@ +\documentclass[12pt,letterpaper,english]{article} +\usepackage{times} +\usepackage[T1]{fontenc} +\IfFileExists{url.sty}{\usepackage{url}} + {\newcommand{\url}{\texttt}} + +\usepackage{babel} +\usepackage{Rd} + +\usepackage{Sweave} +\SweaveOpts{engine=R,eps = FALSE} +%\VignetteIndexEntry{Rolling Economic Drawdown} +%\VignetteDepends{PerformanceAnalytics} +%\VignetteKeywords{Drawdown,risk,portfolio} +%\VignettePackage{PerformanceAnalytics} + +\begin{document} +\SweaveOpts{concordance=TRUE} + +\title{ Rolling Economic Drawdown Controlled Optimal Strategy } + +% \keywords{Drawdown,risk,portfolio} + +\makeatletter +\makeatother +\maketitle + +\begin{abstract} + +Drawdown based stopouts is a framework for informing the decision of stopping a portfolio manager or investment strategy once it has reached the drawdown or time under water limit associated with a certain confidence limit. + +\end{abstract} + +<>= +library(PerformanceAnalytics) +data(edhec) +@ + +<>= +source("/home/pulkit/workspace/GSOC/PerformanceAnalytics/R/na.skip.R") +@ + + +<>= +source("redd.R") +@ + +<>= +source("edd.R") +@ + +<>= +source("REM.R") +@ + + +<>= +source("REDDCOPS.R") +@ + + +<>= +source("EDDCOPS.R") +@ +\section{ Rolling Economic Max } +Rolling Economic Max at time t, looking back at portfolio Wealth history +for a rolling window of length H is given by: + +\deqn{REM(t,h)=\max_{t-H \leq s}\[(1+r_f)^{t-s}W_s\]} + +Here rf is the average realized risk free rate over a period of length t-s. If the risk free rate is changing. This is used to compound. + +\deqn{ \prod_{i=s}^{t}(1+r_{i}{\triangle}t)} + + +here \eqn{r_i} denotes the risk free interest rate during \eqn{i^{th}} discrete +time interval \eqn{{\triangle}t}. + + +\subsection{Usage of the function} + +The Return Series ,risk free rate of return , lookback priod and the type of cumulative return is taken as the input. The Return Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns. + +<<>>= +data(edhec) +head(rollEconomicMax(edhec,0.08,100)) +@ + + + +\section{ Rolling Economic Drawdown } + +To calculate the rolling economic drawdown cumulative +return and rolling economic max is calculated for each point. The Return series,risk +free return(rf) and the lookback period(h) is taken as the input. +Rolling Economic Drawdown is given by the equation. + +\deqn{REDD(t,h)=1-\frac{W_t}/{REM(t,H)}} + +Here REM stands for Rolling Economic Max + +\subsection{Usage} + +The Return Series ,risk free return and the type of cumulative return is taken as the input. The Return Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns. + + +<<>>= +data(edhec) +head(rollDrawdown(edhec,0.08,100)) +@ + + +\section{ Rolling Economic Drawdown Controlled Optimal Strategy } + +The Rolling Economic Drawdown Controlled Optimal Portfolio Strategy(REDD-COPS) has +the portfolio fraction allocated to single risky asset as: + +\deqn{x_t = Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} + +The risk free asset accounts for the rest of the portfolio allocation \eqn{x_f = 1 - x_t}. + +For two risky assets in REDD-COPS,dynamic asset allocation weights are : + +\deqn{\left[{\begin{array}{c} x_1 \\ + x_2 + \end{array}}\right] = \frac{1}{1-{\rho}^2}\left[\begin{array{c} (\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) \\ +(\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) +\end{array}}\right].Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} + +The portion of the risk free asset is \eqn{x_f = 1 - x_1 - x_2}. +\iffalse +\subsection{Usage} + +The Return series ,drawdown limit, risk free rate and the lookback period , the number of assets and the type of REDD-COPS is taken as the input. + + +<<>>= +data(edhec) +head(REDDCOPS(edhec,delta = 0.1,Rf = 0,h = 40)) +@ + +\section{ Economic Drawdown } + +To calculate the economic drawdown cumulative +return and economic max is calculated for each point. The Return series,risk +free return(rf) and the lookback period(h) is taken as the input. +Economic Drawdown is given by the equation + +\deqn{EDD(t)=1-\frac{W_t}/{EM(t)}} + +Here EM stands for Economic Max. + +\subsection{ Usage} + +The Return Series ,risk free return and the type of cumulative return is taken as the input. The Return Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns. + +<<>>= +data(edhec) +head(EDDCOPS(edhec,delta = 0.1,gamma = 0.7,Rf = 0)) +@ + +\section{ Economic Drawdown Controlled Optimal Strategy } +The Economic Drawdown Controlled Optimal Portfolio Strategy(EDD-COPS) has +the portfolio fraction allocated to single risky asset as: + +\deqn{x_t = Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-EDD(t)}{1-EDD(t)}\biggr]\right\}} + +The risk free asset accounts for the rest of the portfolio allocation \eqn{x_f = 1 - x_t}. + +\subsection{Usage} +<<>>= +data(edhec) +head(EDDCOPS(edhec,delta = 0.1,gamma = 0.7,Rf = 0)) +@ +\fi + +\end{document} From noreply at r-forge.r-project.org Tue Jul 30 17:06:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 17:06:33 +0200 (CEST) Subject: [Returnanalytics-commits] r2680 - pkg/PerformanceAnalytics/sandbox/pulkit/week5 Message-ID: <20130730150633.7B96E183BC3@r-forge.r-project.org> Author: pulkit Date: 2013-07-30 17:06:33 +0200 (Tue, 30 Jul 2013) New Revision: 2680 Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.pdf Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw Log: REDD COPS vignette Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-30 11:47:45 UTC (rev 2679) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-30 15:06:33 UTC (rev 2680) @@ -11,11 +11,11 @@ #' #' For two risky assets in REDD-COPS,dynamic asset allocation weights are : #' -#' \deqn{\left[{\begin{array}{c} x_1 \\ -#' x_2 -#' \end{array}}\right] = \frac{1}{1-{\rho}^2}\left[\begin{array{c} (\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) \\ -#'(\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) -#'\end{array}}\right].Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} +#'\deqn{\left[\begin{array}{c} x_1 \\ x_2 \end{array}\right] = \frac{1}{1-{\rho}^2} +#' \left[\begin{array}{c} (\lambda_1 + {1/2}\sigma_1 - \rho.(\lambda_2 + {1/2}\sigma_2 +#' )/\sigma_1) \\ (\lambda_1 + {1/2}\sigma_1 - \rho(\lambda_2 + {1/2}\sigma_2)/\sigma_ +#' 1) \end{array}\right] Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta +#' .\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} #' #'The portion of the risk free asset is \eqn{x_f = 1 - x_1 - x_2}. #' Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw 2013-07-30 11:47:45 UTC (rev 2679) +++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw 2013-07-30 15:06:33 UTC (rev 2680) @@ -121,14 +121,11 @@ For two risky assets in REDD-COPS,dynamic asset allocation weights are : -\deqn{\left[{\begin{array}{c} x_1 \\ - x_2 - \end{array}}\right] = \frac{1}{1-{\rho}^2}\left[\begin{array{c} (\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) \\ -(\lambda_1 + {1/2}*\sigma_1 - \rho.(\lambda_2 + {1/2}.\sigma_2)/\sigma_1) -\end{array}}\right].Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} +\deqn{\left[\begin{array}{c} x_1 \\ x_2 \end{array}\right] = \frac{1}{1-{\rho}^2} +\left[\begin{array}{c} (\lambda_1 + {1/2}\sigma_1 - \rho.(\lambda_2 + {1/2}\sigma_2)/\sigma_1) \\ (\lambda_1 + {1/2}\sigma_1 - \rho(\lambda_2 + {1/2}\sigma_2)/\sigma_1) \end{array}\right] Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-REDD(t,h)}{1-REDD(t,h)}\biggr]\right\}} The portion of the risk free asset is \eqn{x_f = 1 - x_1 - x_2}. -\iffalse + \subsection{Usage} The Return series ,drawdown limit, risk free rate and the lookback period , the number of assets and the type of REDD-COPS is taken as the input. @@ -146,7 +143,7 @@ free return(rf) and the lookback period(h) is taken as the input. Economic Drawdown is given by the equation -\deqn{EDD(t)=1-\frac{W_t}/{EM(t)}} +\deqn{EDD(t)=1-\frac{W_t}{EM(t)}} Here EM stands for Economic Max. @@ -172,6 +169,5 @@ data(edhec) head(EDDCOPS(edhec,delta = 0.1,gamma = 0.7,Rf = 0)) @ -\fi \end{document} Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Tue Jul 30 19:43:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 19:43:49 +0200 (CEST) Subject: [Returnanalytics-commits] r2681 - in pkg/Meucci: . R demo Message-ID: <20130730174349.ABBD8180FDE@r-forge.r-project.org> Author: xavierv Date: 2013-07-30 19:43:49 +0200 (Tue, 30 Jul 2013) New Revision: 2681 Added: pkg/Meucci/demo/S_ExtremeValueTheory.R Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/R/MvnRnd.R pkg/Meucci/demo/S_BivariateSample.R pkg/Meucci/demo/S_CallsProjectionPricing.R pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R pkg/Meucci/demo/S_EllipticalNDim.R pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R pkg/Meucci/demo/S_TStatApprox.R pkg/Meucci/demo/S_Wishart.R pkg/Meucci/demo/S_WishartLocationDispersion.R Log: - added last demo script remaning from chapter 5 Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/DESCRIPTION 2013-07-30 17:43:49 UTC (rev 2681) @@ -33,8 +33,7 @@ R.utils, mvtnorm, dlm, - quadprog, - signal + quadprog Suggests: limSolve, Matrix, @@ -48,6 +47,8 @@ expm, latticeExtra, scatterplot3d, + signal, + fExtremes License: GPL URL: http://r-forge.r-project.org/projects/returnanalytics/ Copyright: (c) 2012 Modified: pkg/Meucci/R/MvnRnd.R =================================================================== --- pkg/Meucci/R/MvnRnd.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/R/MvnRnd.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -20,10 +20,10 @@ return( X = X ) # # compute sample covariance: NOTE defined as "cov(Y,1)", not as "cov(Y)" - # S_ = cov( Y , 1 ) + # S_ = cov( Y ) # # # solve Riccati equation using Schur method - # zerosMatrix = matrix( rep( 0 , length( N * N ) ) , nrow = N ) + # zerosMatrix = matrix( 0 , N , N ); # # define the Hamiltonian matrix # H1 = cbind( zerosMatrix , -1*S_ ) # H2 = cbind( -S , zerosMatrix ) Modified: pkg/Meucci/demo/S_BivariateSample.R =================================================================== --- pkg/Meucci/demo/S_BivariateSample.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_BivariateSample.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,6 +1,3 @@ -library(mvtnorm); -library(latticeExtra); - #' This script generates draws from a bivariate distribution with different marginals, #' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2. #' @@ -10,6 +7,8 @@ #' #' @author Xavier Valls \email{flamejat@@gmail.com} +if ( !require( "latticeExtra" ) ) stop("latticeExtra package installation required for this script") + ################################################################################################################### ### input parameters Modified: pkg/Meucci/demo/S_CallsProjectionPricing.R =================================================================== --- pkg/Meucci/demo/S_CallsProjectionPricing.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_CallsProjectionPricing.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,6 +1,3 @@ -library(mvtnorm); -library(pracma); - #'This script projects the distribution of the market invariants for the derivatives market #'Then it computes the distribution of prices at the investment horizon as described in A. Meucci, #'"Risk and Asset Allocation", Springer, 2005, Chapter 3. @@ -9,9 +6,8 @@ #' \url{http://symmys.com/node/170} #' See Meucci's script for "S_CallsProjectionPricing.m" #' -#' @author Xavier Valls \email{flamejat@@gmail.com} +#' @author Xavier Valls \email{flamejat@@gmail.com} - ################################################################################################################## ### Load data Modified: pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R =================================================================== --- pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,4 +1,3 @@ -library(mvtnorm); #'This script displays the cdf of the copula of a normal distribution, as described #' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2. #' Modified: pkg/Meucci/demo/S_EllipticalNDim.R =================================================================== --- pkg/Meucci/demo/S_EllipticalNDim.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_EllipticalNDim.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,4 +1,3 @@ -library(mvtnorm); #'This script decomposes the N-variate normal distribution into its radial and uniform components #' then it uses the uniform component to generate an elliptical distribution with location parameter #' Mu and dispersion parameter Sigma, as described in A. Meucci, "Risk and Asset Allocation", Added: pkg/Meucci/demo/S_ExtremeValueTheory.R =================================================================== --- pkg/Meucci/demo/S_ExtremeValueTheory.R (rev 0) +++ pkg/Meucci/demo/S_ExtremeValueTheory.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -0,0 +1,55 @@ +#' This script computes the quantile (VaR) : +#' - analytically, under the Student t assumption for the market. +#' - in simulations, using the sample quantile. +#' - using the extreme value theory approximation +#' Described in A. Meucci,"Risk and Asset Allocation",Springer, 2005, Chapter 5. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ExtremeValueTheory.m" +# +#' @author Xavier Valls \email{flamejat@@gmail.com} + +if ( !require( "fExtremes" ) ) stop("fExtremes package installation required for this script") +################################################################################################################## +### Market parameters (student t distribution) +m = 1; +s = 2; +nu = 7; +nSim = 10000; + +th = 0.95; # EVT threshold +c = seq( th , 0.999, 0.001 ); # confidence range for quantiles + +################################################################################################################### +### Analytical +Q_an = m + s * qt(1 - c, nu); + +################################################################################################################### +### Simulations +# generate objective's scenarios +X = rt( nSim/2, nu); +X = rbind( X, -X ); # symmetrize simulations +Psi = m + s * X; +Q_simul = quantile( Psi, (1 - c)); + +################################################################################################################### +### EVT approximation +psi_hat = quantile(Psi, (1 - th)); +Excess = psi_hat - Psi[ Psi < psi_hat ]; +xi_v = gpdFit(Excess); +xi = xi_v at fit$par.ests[1]; +v = xi_v at fit$par.ests[2]; + + +Fpsi_hat = 1 - th; +Q_EVT = psi_hat + v / xi * ( 1 - ( ( 1 - c ) / Fpsi_hat ) ^ ( -xi ) ); + +################################################################################################################### +### Plots +dev.new(); +plot(c, Q_an, type = "l", xlab = "confidence, c", ylab = "quantile based satisfaction, Q_c(\alpha)" ); +lines(c, Q_simul, col = "green" ); +lines(c, Q_EVT, col = "red" ); +legend( "bottomleft", 1.9, c( "exact", "simulations", "EVT" ), col = c( "black","green", "red" ), + lty=1, bg = "gray90" ); Modified: pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R =================================================================== --- pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -10,6 +10,8 @@ #' @author Xavier Valls \email{flamejat@@gmail.com} #' @export +if ( !require( "scatterplot3d" ) ) stop("scatterplot3d package installation required for this script") + ################################################################################################################# ### Input Modified: pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R =================================================================== --- pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,5 +1,3 @@ -library(scatterplot3d); - #' This script script shows that the pdf of the r-th order statistics of a tudent t random variable, #' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2. #' @@ -10,6 +8,8 @@ #' @author Xavier Valls \email{flamejat@@gmail.com} #' @export +if ( !require( "scatterplot3d" ) ) stop("scatterplot3d package installation required for this script") + ################################################################################################################# ### Input mu = 0; Modified: pkg/Meucci/demo/S_TStatApprox.R =================================================================== --- pkg/Meucci/demo/S_TStatApprox.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_TStatApprox.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,5 +1,3 @@ -library( mvtnorm ); - #' Simulate invariants for the regression model, as described in A. Meucci, #' "Risk and Asset Allocation", Springer, 2005, Chapter 4. #' Modified: pkg/Meucci/demo/S_Wishart.R =================================================================== --- pkg/Meucci/demo/S_Wishart.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_Wishart.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -10,9 +10,7 @@ #' @author Xavier Valls \email{flamejat@@gmail.com} #' @export - -library(scatterplot3d); - +if ( !require( "scatterplot3d" ) ) stop("scatterplot3d package installation required for this script") ################################################################################################################### ### Set inputs s = c( 1, 1 ); # variances Modified: pkg/Meucci/demo/S_WishartLocationDispersion.R =================================================================== --- pkg/Meucci/demo/S_WishartLocationDispersion.R 2013-07-30 15:06:33 UTC (rev 2680) +++ pkg/Meucci/demo/S_WishartLocationDispersion.R 2013-07-30 17:43:49 UTC (rev 2681) @@ -1,6 +1,3 @@ -library(mvtnorm); -library(psych); - #' This script computes the location-dispersion ellipsoid of the normalized (unit variance, zero expectation) #' first diagonal and off-diagonal elements of a 2x2 Wishart distribution as a function of the inputs, #' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2. From noreply at r-forge.r-project.org Tue Jul 30 21:27:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 30 Jul 2013 21:27:01 +0200 (CEST) Subject: [Returnanalytics-commits] r2682 - pkg/PortfolioAnalytics/R Message-ID: <20130730192701.9A159185512@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-30 21:27:01 +0200 (Tue, 30 Jul 2013) New Revision: 2682 Added: pkg/PortfolioAnalytics/R/charts.ROI.R Log: adding plotting methods for optimize.portfolio output objects with optimize_method=ROI Added: pkg/PortfolioAnalytics/R/charts.ROI.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.ROI.R (rev 0) +++ pkg/PortfolioAnalytics/R/charts.ROI.R 2013-07-30 19:27:01 UTC (rev 2682) @@ -0,0 +1,227 @@ + +#' boxplot of the weights in the portfolio +#' +#' @param ROI object created by \code{\link{optimize.portfolio}} +#' @param neighbors set of 'neighbor' portfolios to overplot +#' @param 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.} +#' } +#' @param xlab a title for the x axis: see \code{\link{title}} +#' @param cex.lab The magnification to be used for x and y labels relative to the current setting of \code{cex} +#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex} +#' @param element.color color for the default plot lines +#' @param ... any other passthru parameters +#' @param main an overall title for the plot: see \code{\link{title}} +#' @seealso \code{\link{optimize.portfolio}} +#' @author Ross Bennett +#' @export +chart.Weights.ROI <- function(ROI, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){ + + if(!inherits(ROI, "optimize.portfolio.ROI")) stop("ROI must be of class 'optimize.portfolio.ROI'") + + columnnames = names(ROI$weights) + numassets = length(columnnames) + + constraints <- get_constraints(ROI$portfolio) + + if(is.null(xlab)) + minmargin = 3 + else + minmargin = 5 + if(main=="") topmargin=1 else topmargin=4 + if(las > 1) {# set the bottom border to accommodate labels + bottommargin = max(c(minmargin, (strwidth(columnnames,units="in"))/par("cin")[1])) * cex.lab + if(bottommargin > 10 ) { + bottommargin<-10 + columnnames<-substr(columnnames,1,19) + # par(srt=45) #TODO figure out how to use text() and srt to rotate long labels + } + } + else { + bottommargin = minmargin + } + par(mar = c(bottommargin, 4, topmargin, 2) +.1) + plot(ROI$weights, type="b", col="blue", axes=FALSE, xlab='', ylim=c(0,max(constraints$max)), ylab="Weights", main=main, pch=16, ...) + points(constraints$min, type="b", col="darkgray", lty="solid", lwd=2, pch=24) + points(constraints$max, type="b", col="darkgray", lty="solid", lwd=2, pch=25) + # if(!is.null(neighbors)){ + # if(is.vector(neighbors)){ + # xtract=extractStats(ROI) + # weightcols<-grep('w\\.',colnames(xtract)) #need \\. to get the dot + # if(length(neighbors)==1){ + # # overplot nearby portfolios defined by 'out' + # orderx = order(xtract[,"out"]) + # subsetx = head(xtract[orderx,], n=neighbors) + # for(i in 1:neighbors) points(subsetx[i,weightcols], type="b", col="lightblue") + # } else{ + # # assume we have a vector of portfolio numbers + # subsetx = xtract[neighbors,weightcols] + # for(i in 1:length(neighbors)) points(subsetx[i,], type="b", col="lightblue") + # } + # } + # if(is.matrix(neighbors) | is.data.frame(neighbors)){ + # # the user has likely passed in a matrix containing calculated values for risk.col and return.col + # nbweights<-grep('w\\.',colnames(neighbors)) #need \\. to get the dot + # for(i in 1:nrow(neighbors)) points(as.numeric(neighbors[i,nbweights]), type="b", col="lightblue") + # # note that here we need to get weight cols separately from the matrix, not from xtract + # # also note the need for as.numeric. points() doesn't like matrix inputs + # } + # } + # points(ROI$weights, type="b", col="blue", pch=16) + axis(2, cex.axis = cex.axis, col = element.color) + axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis = cex.axis, col = element.color) + box(col = element.color) +} + +#' classic risk return scatter of random portfolios +#' +#' The ROI optimizers do not store the portfolio weights like DEoptim or random +#' portfolios so we will generate random portfolios for the scatter plot. +#' +#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights +#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights +#' +#' @param ROI object created by \code{\link{optimize.portfolio}} +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric +#' @param rp set of weights generated by \code{\link{random_portfolio}} +#' @param portfolio pass in a different portfolio object used in set.portfolio.moments +#' @param return.col string matching the objective of a 'return' objective, on vertical axis +#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis +#' @param ... any other passthru parameters +#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex} +#' @param element.color color for the default plot scatter points +#' @seealso \code{\link{optimize.portfolio}} +#' @author Ross Bennett +#' @export +chart.Scatter.ROI <- function(ROI, R, rp=NULL, portfolio=NULL, return.col="mean", risk.col="StdDev", ..., element.color = "darkgray", cex.axis=0.8, main=""){ + + # If the user does not pass in rp, then we will generate random portfolios + if(is.null(rp)){ + if(!hasArg(permutations)) permutations <- 2000 + rp <- random_portfolios(portfolio=ROI$portfolio, permutations=permutations) + } + + # Get the optimal weights from the output of optimize.portfolio + wts <- ROI$weights + + nargs <- list(...) + if(length(nargs)==0) nargs <- NULL + if (length('...')==0 | is.null('...')) { + # rm('...') + nargs <- NULL + } + + # Allow the user to pass in a different portfolio object used in set.portfolio.moments + if(is.null(portfolio)) portfolio <- ROI$portfolio + + nargs <- set.portfolio.moments(R=R, portfolio=portfolio, momentargs=nargs) + + nargs$R <- R + nargs$weights <- wts + + rp <- rbind(wts, rp) + + # Match the return.col arg to a function + switch(return.col, + mean =, + median = { + returnFUN = match.fun(return.col) + nargs$x <- ( R %*% wts ) #do the multivariate mean/median with Kroneker product + } + ) + + if(is.function(returnFUN)){ + returnpoints <- rep(0, nrow(rp)) + .formals <- formals(returnFUN) + onames <- names(.formals) + for(i in 1:nrow(rp)){ + nargs$weights <- rp[i,] + nargs$x <- R %*% rp[i,] + dargs <- nargs + pm <- pmatch(names(dargs), onames, nomatch = 0L) + names(dargs[pm > 0L]) <- onames[pm] + .formals[pm] <- dargs[pm > 0L] + returnpoints[i] <- do.call(returnFUN, .formals) + } + } + + # match the risk.col arg to a function + switch(risk.col, + sd =, + StdDev = { + riskFUN = match.fun(StdDev) + }, + mVaR =, + VaR = { + riskFUN = match.fun(VaR) + if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single' + if(is.null(nargs$invert)) nargs$invert = FALSE + }, + es =, + mES =, + CVaR =, + cVaR =, + ES = { + riskFUN = match.fun(ES) + if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single' + if(is.null(nargs$invert)) nargs$invert = FALSE + } + ) + + if(is.function(riskFUN)){ + riskpoints <- rep(0, nrow(rp)) + .formals <- formals(riskFUN) + onames <- names(.formals) + for(i in 1:nrow(rp)){ + nargs$weights <- rp[i,] + dargs <- nargs + pm <- pmatch(names(dargs), onames, nomatch = 0L) + names(dargs[pm > 0L]) <- onames[pm] + .formals[pm] <- dargs[pm > 0L] + riskpoints[i] <- do.call(riskFUN, .formals) + } + } + plot(x=riskpoints, y=returnpoints, xlab=risk.col, ylab=return.col, col="darkgray", axes=FALSE, main=main) + points(x=riskpoints[1], y=returnpoints[1], col="blue", pch=16) # optimal + axis(1, cex.axis = cex.axis, col = element.color) + axis(2, cex.axis = cex.axis, col = element.color) + box(col = element.color) +} + +#' scatter and weights chart for portfolios +#' +#' The ROI optimizers do not store the portfolio weights like DEoptim or random +#' portfolios so we will generate random portfolios for the scatter plot. +#' +#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights +#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights +#' +#' @param ROI object created by \code{\link{optimize.portfolio}} +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric +#' @param rp set of weights generated by \code{\link{random_portfolio}} +#' @param portfolio pass in a different portfolio object used in set.portfolio.moments +#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis +#' @param return.col string matching the objective of a 'return' objective, on vertical axis +#' @param ... any other passthru parameters +#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex} +#' @param element.color color for the default plot scatter points +#' @param neighbors set of 'neighbor' portfolios to overplot +#' @param main an overall title for the plot: see \code{\link{title}} +#' @seealso \code{\link{optimize.portfolio}} +#' @author Ross Bennett +#' @export +charts.ROI <- function(ROI, R, rp=NULL, portfolio=NULL, risk.col="StdDev", return.col="mean", + cex.axis=0.8, element.color="darkgray", neighbors=NULL, main="ROI.Portfolios", ...){ + # Specific to the output of the optimize_method=ROI + op <- par(no.readonly=TRUE) + layout(matrix(c(1,2)),height=c(2,1.5),width=1) + par(mar=c(4,4,4,2)) + chart.Scatter.ROI(ROI, R, rp=rp, portfolio=NULL, return.col=return.col, risk.col=risk.col, ..., element.color=element.color, cex.axis=cex.axis, main=main) + par(mar=c(2,4,0,2)) + chart.Weights.ROI(ROI, neighbors=neighbors, ..., main="", las=3, xlab=NULL, cex.lab=1, element.color=element.color, cex.axis=ce.axis) + par(op) +} From noreply at r-forge.r-project.org Wed Jul 31 18:08:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 18:08:57 +0200 (CEST) Subject: [Returnanalytics-commits] r2683 - in pkg/Meucci: . R demo man Message-ID: <20130731160857.396E11848DC@r-forge.r-project.org> Author: xavierv Date: 2013-07-31 18:08:56 +0200 (Wed, 31 Jul 2013) New Revision: 2683 Added: pkg/Meucci/demo/S_ExactMeanAndCovariance.R Modified: pkg/Meucci/DESCRIPTION pkg/Meucci/R/MvnRnd.R pkg/Meucci/man/MvnRnd.Rd Log: - added S_ExactMeanAndCovariance demo script and MvRnd function Modified: pkg/Meucci/DESCRIPTION =================================================================== --- pkg/Meucci/DESCRIPTION 2013-07-30 19:27:01 UTC (rev 2682) +++ pkg/Meucci/DESCRIPTION 2013-07-31 16:08:56 UTC (rev 2683) @@ -48,7 +48,8 @@ latticeExtra, scatterplot3d, signal, - fExtremes + fExtremes, + QZ License: GPL URL: http://r-forge.r-project.org/projects/returnanalytics/ Copyright: (c) 2012 Modified: pkg/Meucci/R/MvnRnd.R =================================================================== --- pkg/Meucci/R/MvnRnd.R 2013-07-30 19:27:01 UTC (rev 2682) +++ pkg/Meucci/R/MvnRnd.R 2013-07-31 16:08:56 UTC (rev 2683) @@ -1,44 +1,47 @@ -#' Generates normal simulations whose sample moments match the population moments +if ( !require( "QZ" ) ) stop("QZ package installation required for this script") + +#' Generate normal simulations whose sample moments match the population moments, +#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005. +#' +#' @param M : [vector] (N x 1) expectation +#' @param S : [matrix] (N x N) covariance matrix +#' @param J : [scalar] number of draws (even number) +#' +#' @return X : [matrix] (J x N) of drawsF_U : [vector] (J x 1) PDF values #' -#' Adapted from file 'MvnRnd.m'. Most recent version of article and code available at http://www.symmys.com/node/162 -#' see A. Meucci - "Simulations with Exact Means and Covariances", Risk, July 2009 +#' @references +#' \url{http://symmys.com/node/170}, \url{http://www.symmys.com/node/162}{A. Meucci - "Simulations with Exact Means and Covariances", Risk, July 2009} +#' See Meucci's script for "MvnRnd.m" #' -#' @param M a numeric indicating the sample first moment of the distribution -#' @param S a covariance matrix -#' @param J a numeric indicating the number of trials -#' -#' @author Ram Ahluwalia \email{rahluwalia@@gmail.com} -#' @references -#' \url{http://www.symmys.com} -#' TODO: Add Schur decomposition. Right now function is only sampling from mvrnorm so sample moments do no match population moments -#' I have sample code commented out below to implement this correctly but I require a function that returns the unitaryMatrix from a Schur decomposition +#' @author Xavier Valls \email{flamejat@@gmail.com} and Ram Ahluwalia \email{rahluwalia@@gmail.com} #' @export -MvnRnd = function( M , S , J ) + +MvnRnd = function( M, S, J ) { - library(MASS) - X = MASS::mvrnorm( n = J , mu = M , Sigma = S ) # Todo: need to swap with Meucci function and Schur method - return( X = X ) - - # # compute sample covariance: NOTE defined as "cov(Y,1)", not as "cov(Y)" - # S_ = cov( Y ) - # - # # solve Riccati equation using Schur method - # zerosMatrix = matrix( 0 , N , N ); - # # define the Hamiltonian matrix - # H1 = cbind( zerosMatrix , -1*S_ ) - # H2 = cbind( -S , zerosMatrix ) - # H = rbind( H1 , H2 ) - # # perform its Schur decomposition. - # # TODO: check that the result returns real eigenvalues on the diagonal. ?Schur seems to give an example with real eigenvalues - # schurDecomp = Schur( H ) - # T = SchurDecomp - # # U_ = unitaryMatrix??? TODO: Find a function in R that returns the unitaryMatrix from a Schur decomposition - # # U = ordschur(U_,T_,'lhp') - # # U_lu = U(1:N,1:N) - # # U_ld = U(N+1:end,1:N) - # # B = U_ld/U_lu - # - # # affine transformation to match mean and covariances - # # X = Y%*%B + repmat(M', J , 1 ) - # + N = length(M); + + # generate antithetic variables (mean = 0) + Y = rmvnorm( J/2, matrix( 0, N ), S ); + Y = rbind( Y, -Y ); + + # compute sample covariance: NOTE defined as "cov(Y,1)", not as "cov(Y)" + S_ = ( dim(Y)[1] - 1 )/ dim(Y)[1] * cov( Y ); + + # solve Riccati equation using Schur method + H = rbind( cbind( matrix( 0, N, N ), -S ), cbind( -S, matrix( 0, N, N ) ) ); + + #Schur = Schur( H ); + #U = ordschur(U_,T_,'lhp'); + + U = ordqz( H, keyword = "lhp" )$Q; + + U_lu = U[ 1:N, 1:N ]; + U_ld = U[ (N+1):nrow(U), 1:N ]; + + B = U_ld %*% solve( U_lu ); + + # affine transformation to match mean and covariances + X = Y %*% B + kronecker( matrix( 1, J, 1 ), t( M ) ); + + return( X ); } \ No newline at end of file Added: pkg/Meucci/demo/S_ExactMeanAndCovariance.R =================================================================== --- pkg/Meucci/demo/S_ExactMeanAndCovariance.R (rev 0) +++ pkg/Meucci/demo/S_ExactMeanAndCovariance.R 2013-07-31 16:08:56 UTC (rev 2683) @@ -0,0 +1,41 @@ +#' Generate draws from a multivariate normal with matching mean and covariance, as described +#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2. +#' +#' @references +#' \url{http://symmys.com/node/170} +#' See Meucci's script for "S_ExactMeanAndCovariance.m" +#' +#' @author Xavier Valls \email{flamejat@@gmail.com} + + +######################################################################################################## +### Inputs +N = 20; # dimension (number of risk factors) +J = 200; # number of simulations + +######################################################################################################## +### Generate desired population moments: + +# vector of expected values M +M = matrix(runif( N ) -0.5); +# covariance matrix S +A = matrix( runif( N * N ), c( N, N )) - 0.5; +S = A %*% t( A ); + +# generate sample of size J from multivariate normal N(M,S) +#X = mvnrnd(M, S, J); # no match between sample and population moments (built-in) function +X = MvnRnd( M, S, J ); # exact match between sample and population moments + +######################################################################################################## +### Compute sample moments and errors +M_ = matrix( apply( X, 2, mean )); #apply +S_ = ( dim( X )[1] - 1 )/ dim( X )[1] * cov( X ); + +######################################################################################################## +### Check errors +Err_M = max( abs( M - M_ ) ) / max( abs( M ) ); +Err_S = max( max( abs( S - S_) ) )/ max( max( abs( S ) ) ); + +print(Err_M); +print(Err_S); + Modified: pkg/Meucci/man/MvnRnd.Rd =================================================================== --- pkg/Meucci/man/MvnRnd.Rd 2013-07-30 19:27:01 UTC (rev 2682) +++ pkg/Meucci/man/MvnRnd.Rd 2013-07-31 16:08:56 UTC (rev 2683) @@ -1,33 +1,34 @@ -\name{MvnRnd} -\alias{MvnRnd} -\title{Generates normal simulations whose sample moments match the population moments} -\usage{ - MvnRnd(M, S, J) -} -\arguments{ - \item{M}{a numeric indicating the sample first moment of - the distribution} - - \item{S}{a covariance matrix} - - \item{J}{a numeric indicating the number of trials} -} -\description{ - Adapted from file 'MvnRnd.m'. Most recent version of - article and code available at - http://www.symmys.com/node/162 see A. Meucci - - "Simulations with Exact Means and Covariances", Risk, - July 2009 -} -\author{ - Ram Ahluwalia \email{rahluwalia at gmail.com} -} -\references{ - \url{http://www.symmys.com} TODO: Add Schur - decomposition. Right now function is only sampling from - mvrnorm so sample moments do no match population moments - I have sample code commented out below to implement this - correctly but I require a function that returns the - unitaryMatrix from a Schur decomposition -} - +\name{MvnRnd} +\alias{MvnRnd} +\title{Generate normal simulations whose sample moments match the population moments, +as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.} +\usage{ + MvnRnd(M, S, J) +} +\arguments{ + \item{M}{: [vector] (N x 1) expectation} + + \item{S}{: [matrix] (N x N) covariance matrix} + + \item{J}{: [scalar] number of draws (even number)} +} +\value{ + X : [matrix] (J x N) of drawsF_U : [vector] (J x 1) PDF + values +} +\description{ + Generate normal simulations whose sample moments match + the population moments, as described in A. Meucci, "Risk + and Asset Allocation", Springer, 2005. +} +\author{ + Xavier Valls \email{flamejat at gmail.com} and Ram Ahluwalia + \email{rahluwalia at gmail.com} +} +\references{ + \url{http://symmys.com/node/170}, + \url{http://www.symmys.com/node/162}{A. Meucci - + "Simulations with Exact Means and Covariances", Risk, + July 2009} See Meucci's script for "MvnRnd.m" +} + From noreply at r-forge.r-project.org Wed Jul 31 18:54:17 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 18:54:17 +0200 (CEST) Subject: [Returnanalytics-commits] r2684 - in pkg/PortfolioAnalytics: . R man Message-ID: <20130731165417.D1A171848DC@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-31 18:54:17 +0200 (Wed, 31 Jul 2013) New Revision: 2684 Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/man/constraint.Rd Log: modifying constraints and removing alias to maintain backwards compatibility with v1 constraint Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2013-07-31 16:08:56 UTC (rev 2683) +++ pkg/PortfolioAnalytics/DESCRIPTION 2013-07-31 16:54:17 UTC (rev 2684) @@ -46,3 +46,4 @@ 'constraintsFUN.R' 'constraint_fn_map.R' 'optFUN.R' + 'charts.ROI.R' Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-31 16:08:56 UTC (rev 2683) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-31 16:54:17 UTC (rev 2684) @@ -5,17 +5,19 @@ export(box_constraint) export(CCCgarch.MM) export(chart.Scatter.DE) +export(chart.Scatter.ROI) export(chart.Scatter.RP) export(chart.Weights.DE) +export(chart.Weights.ROI) export(chart.Weights.RP) export(charts.DE) +export(charts.ROI) export(charts.RP) export(constrained_group_tmp) export(constrained_objective_v1) export(constrained_objective_v2) export(constrained_objective) export(constraint_ROI) -export(constraint_v1) export(constraint_v2) export(constraint) export(diversification_constraint) Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-31 16:08:56 UTC (rev 2683) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-31 16:54:17 UTC (rev 2684) @@ -25,7 +25,7 @@ #' @examples #' exconstr <- constraint(assets=10, min_sum=1, max_sum=1, min=.01, max=.35, weight_seq=generatesequence()) #' @export -constraint_v1 <- function(assets=NULL, ... ,min,max,min_mult,max_mult,min_sum=.99,max_sum=1.01,weight_seq=NULL) +constraint <- function(assets=NULL, ... ,min,max,min_mult,max_mult,min_sum=.99,max_sum=1.01,weight_seq=NULL) { # based on GPL R-Forge pkg roi by Stefan Thuessel,Kurt Hornik,David Meyer if (hasArg(min) & hasArg(max)) { if (is.null(assets) & (!length(min)>1) & (!length(max)>1)) { @@ -176,8 +176,8 @@ } # Alias constraint_v2 to constraint -#' @export -constraint <- constraint_v2 +# @export +# constraint <- constraint_v2 #' General interface for adding and/or updating optimization constraints. #' @@ -397,7 +397,7 @@ max[which(tmp_max < max)] <- tmp_max[which(tmp_max < max)] } - Constraint <- constraint(type=type, enabled=enabled, constrclass="box_constraint", ...) + Constraint <- constraint_v2(type=type, enabled=enabled, constrclass="box_constraint", ...) Constraint$min <- min Constraint$max <- max return(Constraint) @@ -473,7 +473,7 @@ } } - Constraint <- constraint(type, enabled=enabled, constrclass="group_constraint", ...) + Constraint <- constraint_v2(type, enabled=enabled, constrclass="group_constraint", ...) Constraint$groups <- groups Constraint$group_labels <- group_labels Constraint$cLO <- group_min @@ -531,7 +531,7 @@ min_sum <- 0 } ) - Constraint <- constraint(type, enabled=enabled, constrclass="weight_sum_constraint", ...) + Constraint <- constraint_v2(type, enabled=enabled, constrclass="weight_sum_constraint", ...) Constraint$min_sum <- min_sum Constraint$max_sum <- max_sum return(Constraint) @@ -652,7 +652,7 @@ #' pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.6) #' @export turnover_constraint <- function(type="turnover", turnover_target, enabled=TRUE, message=FALSE, ...){ - Constraint <- constraint(type, enabled=enabled, constrclass="turnover_constraint", ...) + Constraint <- constraint_v2(type, enabled=enabled, constrclass="turnover_constraint", ...) Constraint$turnover_target <- turnover_target return(Constraint) } @@ -676,7 +676,7 @@ #' pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7) #' @export diversification_constraint <- function(type="diversification", div_target, enabled=TRUE, message=FALSE, ...){ - Constraint <- constraint(type, enabled=enabled, constrclass="diversification_constraint", ...) + Constraint <- constraint_v2(type, enabled=enabled, constrclass="diversification_constraint", ...) Constraint$div_target <- div_target return(Constraint) } @@ -741,7 +741,7 @@ # coerce to integer max_pos_short <- as.integer(max_pos_short) } - Constraint <- constraint(type, enabled=enabled, constrclass="position_limit_constraint", ...) + Constraint <- constraint_v2(type, enabled=enabled, constrclass="position_limit_constraint", ...) Constraint$max_pos <- max_pos Constraint$max_pos_long <- max_pos_long Constraint$max_pos_short <- max_pos_short Modified: pkg/PortfolioAnalytics/man/constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/constraint.Rd 2013-07-31 16:08:56 UTC (rev 2683) +++ pkg/PortfolioAnalytics/man/constraint.Rd 2013-07-31 16:54:17 UTC (rev 2684) @@ -1,12 +1,44 @@ -\name{constraint_v2} +\name{constraint} \alias{constraint} \alias{constraint_v2} -\title{constructor for class v2_constraint} +\title{constructor for class constraint} \usage{ + constraint(assets = NULL, ..., min, max, min_mult, + max_mult, min_sum = 0.99, max_sum = 1.01, + weight_seq = NULL) + constraint_v2(type, enabled = TRUE, ..., constrclass = "v2_constraint") } \arguments{ + \item{assets}{number of assets, or optionally a named + vector of assets specifying seed weights} + + \item{...}{any other passthru parameters} + + \item{min}{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 seed weight in + \code{assets}} + + \item{max_mult}{numeric or named vector specifying + maximum multiplier box constraint from seed weight in + \code{assets}} + + \item{min_sum}{minimum sum of all asset weights, default + .99} + + \item{max_sum}{maximum sum of all asset weights, default + 1.01} + + \item{weight_seq}{seed sequence of weights, see + \code{\link{generatesequence}}} + \item{type}{character type of the constraint to add or update, currently 'weight_sum', 'box', or 'group'} @@ -19,9 +51,16 @@ class} } \description{ + constructor for class constraint + constructor for class v2_constraint } +\examples{ +exconstr <- constraint(assets=10, min_sum=1, max_sum=1, min=.01, max=.35, weight_seq=generatesequence()) +} \author{ + Peter Carl and Brian G. Peterson + Ross Bennett } From noreply at r-forge.r-project.org Wed Jul 31 19:20:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 19:20:39 +0200 (CEST) Subject: [Returnanalytics-commits] r2685 - pkg/PortfolioAnalytics/R Message-ID: <20130731172039.1A1811848DC@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-31 19:20:38 +0200 (Wed, 31 Jul 2013) New Revision: 2685 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/R/random_portfolios.R Log: modifying v1 of random portfolios and optimize.portfolio for backwards compatibility Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-31 16:54:17 UTC (rev 2684) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-31 17:20:38 UTC (rev 2685) @@ -73,7 +73,7 @@ search_size=20000, trace=FALSE, ..., rp=NULL, - momentFUN='set.portfolio.moments' + momentFUN='set.portfolio.moments_v1' ) { optimize_method=optimize_method[1] @@ -203,13 +203,13 @@ if(hasArg(eps)) eps=match.call(expand.dots=TRUE)$eps else eps = 0.01 rpconstraint<-constraint(assets=length(lower), min_sum=constraints$min_sum-eps, max_sum=constraints$max_sum+eps, min=lower, max=upper, weight_seq=generatesequence()) - rp<- random_portfolios(rpconstraints=rpconstraint,permutations=NP) + rp <- random_portfolios_v1(rpconstraints=rpconstraint,permutations=NP) DEcformals$initialpop=rp } controlDE <- do.call(DEoptim.control,DEcformals) # minw = try(DEoptim( constrained_objective , lower = lower[1:N] , upper = upper[1:N] , control = controlDE, R=R, constraints=constraints, ...=...)) # add ,silent=TRUE here? - minw = try(DEoptim( constrained_objective , lower = lower[1:N] , upper = upper[1:N] , control = controlDE, R=R, constraints=constraints, nargs = dotargs , ...=...)) # add ,silent=TRUE here? + minw = try(DEoptim( constrained_objective_v1 , lower = lower[1:N] , upper = upper[1:N] , control = controlDE, R=R, constraints=constraints, nargs = dotargs , ...=...)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } if(is.null(minw)){ @@ -223,7 +223,7 @@ weights <- normalize_weights(weights) names(weights) = colnames(R) - out = list(weights=weights, objective_measures=constrained_objective(w=weights,R=R,constraints,trace=TRUE)$objective_measures,out=minw$optim$bestval, call=call) + out = list(weights=weights, objective_measures=constrained_objective_v1(w=weights,R=R,constraints,trace=TRUE)$objective_measures,out=minw$optim$bestval, call=call) if (isTRUE(trace)){ out$DEoutput=minw out$DEoptim_objective_results<-try(get('.objectivestorage',pos='.GlobalEnv'),silent=TRUE) @@ -236,15 +236,15 @@ if(optimize_method=="random"){ #' call random_portfolios() with constraints and search_size to create matrix of portfolios if(missing(rp) | is.null(rp)){ - rp<-random_portfolios(rpconstraints=constraints,permutations=search_size) + rp<-random_portfolios_v1(rpconstraints=constraints,permutations=search_size) } #' store matrix in out if trace=TRUE if (isTRUE(trace)) out$random_portfolios<-rp #' write foreach loop to call constrained_objective() with each portfolio if ("package:foreach" %in% search() & !hasArg(parallel)){ - rp_objective_results<-foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective(w=rp[ii,],R,constraints,trace=trace,...=dotargs) + rp_objective_results<-foreach(ii=1:nrow(rp), .errorhandling='pass') %dopar% constrained_objective_v1(w=rp[ii,],R,constraints,trace=trace,...=dotargs) } else { - rp_objective_results<-apply(rp, 1, constrained_objective, R=R, constraints=constraints, trace=trace, ...=dotargs) + rp_objective_results<-apply(rp, 1, constrained_objective_v1, R=R, constraints=constraints, trace=trace, ...=dotargs) } #' if trace=TRUE , store results of foreach in out$random_results if(isTRUE(trace)) out$random_portfolio_objective_results<-rp_objective_results @@ -267,7 +267,7 @@ } #' re-call constrained_objective on the best portfolio, as above in DEoptim, with trace=TRUE to get results for out list out$weights<-min_objective_weights - out$objective_measures<-try(constrained_objective(w=min_objective_weights,R=R,constraints,trace=TRUE)$objective_measures) + out$objective_measures<-try(constrained_objective_v1(w=min_objective_weights,R=R,constraints,trace=TRUE)$objective_measures) out$call<-call #' construct out list to be as similar as possible to DEoptim list, within reason @@ -391,7 +391,7 @@ upper <- constraints$max lower <- constraints$min - minw = try(psoptim( par = rep(NA, N), fn = constrained_objective , R=R, constraints=constraints, + minw = try(psoptim( par = rep(NA, N), fn = constrained_objective_v1 , R=R, constraints=constraints, lower = lower[1:N] , upper = upper[1:N] , control = controlPSO)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } @@ -405,7 +405,7 @@ names(weights) <- colnames(R) out = list(weights=weights, - objective_measures=constrained_objective(w=weights,R=R,constraints,trace=TRUE)$objective_measures, + objective_measures=constrained_objective_v1(w=weights,R=R,constraints,trace=TRUE)$objective_measures, out=minw$value, call=call) if (isTRUE(trace)){ @@ -437,7 +437,7 @@ lower <- constraints$min minw = try(GenSA( par = rep(1/N, N), lower = lower[1:N] , upper = upper[1:N], control = controlGenSA, - fn = constrained_objective , R=R, constraints=constraints)) # add ,silent=TRUE here? + fn = constrained_objective_v1 , R=R, constraints=constraints)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } if(is.null(minw)){ @@ -450,7 +450,7 @@ names(weights) <- colnames(R) out = list(weights=weights, - objective_measures=constrained_objective(w=weights,R=R,constraints,trace=TRUE)$objective_measures, + objective_measures=constrained_objective_v1(w=weights,R=R,constraints,trace=TRUE)$objective_measures, out=minw$value, call=call) if (isTRUE(trace)){ Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-31 16:54:17 UTC (rev 2684) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-07-31 17:20:38 UTC (rev 2685) @@ -184,7 +184,7 @@ # rownames(result)[2]<-"equal.weight" i <- 3 while (i<=permutations) { - result[i,] <- as.matrix(randomize_portfolio(rpconstraints=rpconstraints, ...)) + result[i,] <- as.matrix(randomize_portfolio_v1(rpconstraints=rpconstraints, ...)) if(i==permutations) { result = unique(result) i = nrow(result) From noreply at r-forge.r-project.org Wed Jul 31 20:54:23 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 20:54:23 +0200 (CEST) Subject: [Returnanalytics-commits] r2686 - in pkg/PortfolioAnalytics: . R man sandbox Message-ID: <20130731185423.D88E81853A5@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-31 20:54:23 +0200 (Wed, 31 Jul 2013) New Revision: 2686 Added: pkg/PortfolioAnalytics/man/update_constraint_v1tov2.Rd pkg/PortfolioAnalytics/sandbox/testing_back_compat.R Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd Log: Modifying constraints and optimize.portfolio for backwards compatibility. Also added simple testing script using v1_constraint object with optimize.portfolio. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-07-31 17:20:38 UTC (rev 2685) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-31 18:54:23 UTC (rev 2686) @@ -86,5 +86,6 @@ export(txfrm_group_constraint) export(txfrm_position_limit_constraint) export(txfrm_weight_sum_constraint) +export(update_constraint_v1tov2) export(update.constraint) export(weight_sum_constraint) Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-07-31 17:20:38 UTC (rev 2685) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-07-31 18:54:23 UTC (rev 2686) @@ -822,6 +822,47 @@ return(portfolio) } +#' Helper function to update v1_constraint objects to v2 specification in the portfolio object +#' +#' The function takes the constraints and objectives specified in the v1_constraint +#' object and updates the portfolio object with those constraints and objectives. This +#' function is used inside optimize.portfolio to maintain backwards compatibility +#' if the user passes in a v1_constraint object for the constraint arg in +#' optimize.portfolio. +#' +#' @param portfolio portfolio object passed into optimize.portfolio +#' @param v1_constraint object of type v1_constraint passed into optimize.portfolio +#' @return portfolio object containing constraints and objectives from v1_constraint +#' @author Ross Bennett +#' @seealso \code{\link{portfolio.spec}}, \code{\link{add.constraint}} +#' @export +update_constraint_v1tov2 <- function(portfolio, v1_constraint){ + if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'") + if(!inherits(v1_constraint, "v1_constraint")) stop("v1_constraint object must be of class 'v1_constraint'") + # Put the assets and weight_seq into slots in portfolio object + portfolio$assets <- v1_constraint$assets + portfolio$weight_seq <- v1_constraint$weight_seq + + # The v1_constraint object supported 3 constraint types (weight_sum, box, and group) + # Add weight_sum/leverage constraints from v1_constraint to portfolio + if(!is.null(v1_constraint$min_sum) & !is.null(v1_constraint$max_sum)){ + portfolio <- add.constraint(portfolio=portfolio, type='weight_sum', min_sum=v1_constraint$min_sum, max_sum=v1_constraint$max_sum) + } + # Add box constraints from v1_constraint to portfolio + if(!is.null(v1_constraint$min) & !is.null(v1_constraint$max)){ + portfolio <- add.constraint(portfolio=portfolio, type='box', min=v1_constraint$min, max=v1_constraint$max) + } + # Add group constraints from v1_constraint to portfolio + if(!is.null(v1_constraint$groups) & !is.null(v1_constraint$cLO) & !is.null(v1_constraint$cUP)){ + portfolio <- add.constraint(portfolio=portfolio, type='group', groups=v1_constraint$groups, group_min=v1_constraint$cLO, group_max=v1_constraint$cUP) + } + + # Put the objectives from v1_constraint into the objectives slot in the portfolio + # object. This overwrites what might already be in portfolio$objectives assuming + # the user is using the v1_constraint object to specify the objectives + portfolio$objectives <- v1_constraint$objectives + return(portfolio) +} # #' constructor for class constraint_ROI # #' Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-07-31 17:20:38 UTC (rev 2685) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-07-31 18:54:23 UTC (rev 2686) @@ -61,7 +61,7 @@ # Applying box constraints bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) - + print(bnds) # set up initial A matrix for leverage constraints Amat <- rbind(rep(1, N), rep(1, N)) dir.vec <- c(">=","<=") Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-31 17:20:38 UTC (rev 2685) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-31 18:54:23 UTC (rev 2686) @@ -559,8 +559,14 @@ # Check for constraints and objectives passed in separately outside of the portfolio object if(!is.null(constraints)){ - # Insert the constraints into the portfolio object - portfolio <- insert_constraints(portfolio=portfolio, constraints=constraints) + if(inherits(constraints, "v1_constraint")){ + warning("constraint object passed in is a 'v1_constraint' object, updating to v2 specification") + portfolio <- update_constraint_v1tov2(portfolio=portfolio, v1_constraint=constraints) + } + if(!inherits(constraints, "v1_constraint")){ + # Insert the constraints into the portfolio object + portfolio <- insert_constraints(portfolio=portfolio, constraints=constraints) + } } if(!is.null(objectives)){ # Insert the objectives into the portfolio object Modified: pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd =================================================================== --- pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd 2013-07-31 17:20:38 UTC (rev 2685) +++ pkg/PortfolioAnalytics/man/optimize.portfolio_v1.Rd 2013-07-31 18:54:23 UTC (rev 2686) @@ -5,7 +5,7 @@ optimize.portfolio_v1(R, constraints, optimize_method = c("DEoptim", "random", "ROI", "ROI_old", "pso", "GenSA"), search_size = 20000, trace = FALSE, ..., rp = NULL, - momentFUN = "set.portfolio.moments") + momentFUN = "set.portfolio.moments_v1") } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries Added: pkg/PortfolioAnalytics/man/update_constraint_v1tov2.Rd =================================================================== --- pkg/PortfolioAnalytics/man/update_constraint_v1tov2.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/update_constraint_v1tov2.Rd 2013-07-31 18:54:23 UTC (rev 2686) @@ -0,0 +1,34 @@ +\name{update_constraint_v1tov2} +\alias{update_constraint_v1tov2} +\title{Helper function to update v1_constraint objects to v2 specification in the portfolio object} +\usage{ + update_constraint_v1tov2(portfolio, v1_constraint) +} +\arguments{ + \item{portfolio}{portfolio object passed into + optimize.portfolio} + + \item{v1_constraint}{object of type v1_constraint passed + into optimize.portfolio} +} +\value{ + portfolio object containing constraints and objectives + from v1_constraint +} +\description{ + The function takes the constraints and objectives + specified in the v1_constraint object and updates the + portfolio object with those constraints and objectives. + This function is used inside optimize.portfolio to + maintain backwards compatibility if the user passes in a + v1_constraint object for the constraint arg in + optimize.portfolio. +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{portfolio.spec}}, + \code{\link{add.constraint}} +} + Added: pkg/PortfolioAnalytics/sandbox/testing_back_compat.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_back_compat.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/testing_back_compat.R 2013-07-31 18:54:23 UTC (rev 2686) @@ -0,0 +1,35 @@ +library(PortfolioAnalytics) +library(DEoptim) + +data(edhec) +ret <- edhec[, 1:4] +funds <- colnames(ret) + +# Set up constraint object using v1 +gen.constr <- constraint(assets=funds, min=0, max=0.55, min_sum=0.99, max_sum=1, weight_seq=generatesequence(min=0, max=0.55, by=0.002)) + +# Add an objective. Note the use of add.objective_v1 +gen.constr <- add.objective_v1(constraints=gen.constr, type="return", name="mean", enabled=TRUE) + +# Random +optrpv1 <- optimize.portfolio_v1(R=ret, constraints=gen.constr, optimize_method="random", search_size=2000) +optrpv1 + +# DEoptim +optdev1 <- optimize.portfolio_v1(R=ret, constraints=gen.constr, optimize_method="DEoptim", search_size=2000) +optdev1 + +# When using optimize.portfolio, the user will see that he needs to pass in a +# portfolio object, so the user will likely just create a portfolio object and +# then pass in the v1_constraint object +pspec <- portfolio.spec(assets=funds) + +# This uses the new portfolio object and 'v2' of optimize.portfolio. The user +# can pass a v1_constraint object in for the constraints arg, but still needs to +# pass in a portfolio object so that it can be updated with the constraints and +# objectives from the v1_constraint object +optrp <- optimize.portfolio(R=ret, portfolio=pspec, constraints=gen.constr, optimize_method="random", search_size=2000) +optrp + +optde <- optimize.portfolio(R=ret, portfolio=pspec, constraints=gen.constr, optimize_method="DEoptim", search_size=2000, traceDE=5) +optde From noreply at r-forge.r-project.org Wed Jul 31 22:12:52 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 22:12:52 +0200 (CEST) Subject: [Returnanalytics-commits] r2687 - pkg/PortfolioAnalytics/R Message-ID: <20130731201252.38EBF1846B3@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-31 22:12:51 +0200 (Wed, 31 Jul 2013) New Revision: 2687 Modified: pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: modifying the way moments is calculated in optimize.portfolio for optimize_method=ROI Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-07-31 18:54:23 UTC (rev 2686) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-07-31 20:12:51 UTC (rev 2687) @@ -1,6 +1,7 @@ ##### GMV and QU QP Function ##### gmv_opt <- function(R, constraints, moments, lambda, target){ + N <- ncol(R) # Applying box constraints bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), @@ -57,11 +58,12 @@ ##### Maximize Return LP Function ##### maxret_opt <- function(R, moments, constraints, target){ + N <- ncol(R) # Applying box constraints bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) - print(bnds) + # set up initial A matrix for leverage constraints Amat <- rbind(rep(1, N), rep(1, N)) dir.vec <- c(">=","<=") @@ -95,12 +97,14 @@ # set up the linear objective ROI_objective <- L_objective(L=-moments$mean) + # objL <- -moments$mean # set up the optimization problem and solve opt.prob <- OP(objective=ROI_objective, - constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), - bounds=bnds) + constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), + bounds=bnds) roi.result <- ROI_solve(x=opt.prob, solver="glpk") + # roi.result <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir.vec, rhs=rhs.vec, bounds=bnds) # The Rglpk solvers status returns an an integer with status information # about the solution returned: 0 if the optimal solution was found, a @@ -121,6 +125,7 @@ ##### Maximize Return MILP Function ##### maxret_milp_opt <- function(R, constraints, moments, target){ + N <- ncol(R) max_pos <- constraints$max_pos @@ -205,6 +210,7 @@ ##### Minimize ETL LP Function ##### etl_opt <- function(R, constraints, moments, target, alpha){ + N <- ncol(R) T <- nrow(R) # Applying box constraints Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-31 18:54:23 UTC (rev 2686) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-31 20:12:51 UTC (rev 2687) @@ -304,7 +304,13 @@ if(objective$enabled){ if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR"))) stop("ROI only solves mean, var, or sample CVaR type business objectives, choose a different optimize_method.") - moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) + # I'm not sure what changed, but moments$mean used to be a vector of the column means + # now it is a scalar value of the mean of the entire R object + if(objective$name == "mean"){ + moments[[objective$name]] <- try(as.vector(apply(R, 2, "mean", na.rm=TRUE)), silent=TRUE) + } else { + moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) + } target <- ifelse(!is.null(objective$target),objective$target, target) alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha) lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, 1) @@ -775,7 +781,13 @@ if(objective$enabled){ if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR", objective$name == "ES", objective$name == "ETL"))) stop("ROI only solves mean, var, or sample ETL/ES/CVaR type business objectives, choose a different optimize_method.") - moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) + # I'm not sure what changed, but moments$mean used to be a vector of the column means + # now it is a scalar value of the mean of the entire R object + if(objective$name == "mean"){ + moments[[objective$name]] <- try(as.vector(apply(R, 2, "mean", na.rm=TRUE)), silent=TRUE) + } else { + moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) + } target <- ifelse(!is.null(objective$target), objective$target, target) alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha) lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, lambda) From noreply at r-forge.r-project.org Wed Jul 31 22:20:36 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 22:20:36 +0200 (CEST) Subject: [Returnanalytics-commits] r2688 - pkg/PortfolioAnalytics/sandbox Message-ID: <20130731202036.C673C185263@r-forge.r-project.org> Author: rossbennett34 Date: 2013-07-31 22:20:36 +0200 (Wed, 31 Jul 2013) New Revision: 2688 Modified: pkg/PortfolioAnalytics/sandbox/testing_back_compat.R Log: Modified test for backwards compatibility to include ROI as optimize_method Modified: pkg/PortfolioAnalytics/sandbox/testing_back_compat.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/testing_back_compat.R 2013-07-31 20:12:51 UTC (rev 2687) +++ pkg/PortfolioAnalytics/sandbox/testing_back_compat.R 2013-07-31 20:20:36 UTC (rev 2688) @@ -1,5 +1,7 @@ library(PortfolioAnalytics) library(DEoptim) +library(ROI) +require(ROI.plugin.glpk) data(edhec) ret <- edhec[, 1:4] @@ -19,6 +21,10 @@ optdev1 <- optimize.portfolio_v1(R=ret, constraints=gen.constr, optimize_method="DEoptim", search_size=2000) optdev1 +# ROI +optroiv1 <- optimize.portfolio_v1(R=ret, constraints=gen.constr, optimize_method="ROI") +optroiv1 + # When using optimize.portfolio, the user will see that he needs to pass in a # portfolio object, so the user will likely just create a portfolio object and # then pass in the v1_constraint object @@ -28,8 +34,15 @@ # can pass a v1_constraint object in for the constraints arg, but still needs to # pass in a portfolio object so that it can be updated with the constraints and # objectives from the v1_constraint object + +# Random optrp <- optimize.portfolio(R=ret, portfolio=pspec, constraints=gen.constr, optimize_method="random", search_size=2000) optrp +# DEoptim optde <- optimize.portfolio(R=ret, portfolio=pspec, constraints=gen.constr, optimize_method="DEoptim", search_size=2000, traceDE=5) optde + +# ROI +optroi <- optimize.portfolio(R=ret, portfolio=pspec, constraints=gen.constr, optimize_method="ROI") +optroi From noreply at r-forge.r-project.org Wed Jul 31 22:30:18 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 31 Jul 2013 22:30:18 +0200 (CEST) Subject: [Returnanalytics-commits] r2689 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: Week1/Vignette Week4/Code Week6-7 Week6-7/Code Week6-7/Literature Week6-7/Vignette Message-ID: <20130731203018.62838185263@r-forge.r-project.org> Author: shubhanm Date: 2013-07-31 22:30:18 +0200 (Wed, 31 Jul 2013) New Revision: 2689 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/lmi.R pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Literature/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Literature/Zelisis.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Literature/sandwich-OOP.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/HACintegrated-hac-kweights.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/HACintegrated-hac-plot.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/HACintegrated-hc-plot.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/HACintegrated.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/HACintegrated.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Vignette/HACintegrated.tex Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-Graph1.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-Graph10.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.log pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/Code/AcarSim.R Log: Week 6-7 : Code lmi.R : support of lm function with HAC and HC methods Vignette in Beginning stage.... Improving code readability of previous week codes Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-Graph1.pdf =================================================================== (Binary files differ) Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite-Graph10.pdf =================================================================== (Binary files differ) Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.log =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.log 2013-07-31 20:20:36 UTC (rev 2688) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.log 2013-07-31 20:30:18 UTC (rev 2689) @@ -1,4 +1,4 @@ -This is pdfTeX, Version 3.1415926-2.4-1.40.13 (MiKTeX 2.9) (preloaded format=pdflatex 2013.7.14) 27 JUL 2013 17:38 +This is pdfTeX, Version 3.1415926-2.4-1.40.13 (MiKTeX 2.9) (preloaded format=pdflatex 2013.7.14) 30 JUL 2013 09:40 entering extended mode **OkunevWhite.tex @@ -366,7 +366,7 @@ cm/cmsy10.pfb> -Output written on OkunevWhite.pdf (5 pages, 174544 bytes). +Output written on OkunevWhite.pdf (5 pages, 174408 bytes). PDF statistics: 85 PDF objects out of 1000 (max. 8388607) 0 named destinations out of 1000 (max. 500000) Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.pdf =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.pdf 2013-07-31 20:20:36 UTC (rev 2688) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/Vignette/OkunevWhite.pdf 2013-07-31 20:30:18 UTC (rev 2689) @@ -8,24 +8,27 @@ endstream endobj 4 0 obj << -/Length 2105 +/Length 2106 /Filter /FlateDecode >> stream -x???n???}?B??F ??!? I??H $@?\????L??????\??Dm?"}?9?9??w????s??Y??W?;X????Up&??????????&y|??O?k??????$??r??@???3~???,??[olH9{\????????????`??j?\m\???b???q?'?????}??o??u=/~A????y??g]lq??PE,'?? ?9r???U??P???i???/??I>1[??KY?23???H??L?VYeH?????6???b?????B? - ?????490???9>z????- @/(????????-?Y??G}5z -Gi~GZ????? ???Q??h?PY?+rA?????(|??9? -ln;???6?7<<]??,;q?xk5Z?e?,as???[?"y??7\}????vB?6:/iA??? +V?Z?&-?????x??P(?I?@????)XMl,u????G|?R3????{Q??%?4=??U? -2?C?3?#r??#:? ??I_??h?(?u????G?q?6???1:;E??????????.s%???????e1?S?.???5?Fa??Uj?nW?X??_?????d?=2?%M?D????!2?x????6*???"&$?^? ??8???Y>??X?y>?+E2U(:@@s?:??>?3???1w? ??R:5? +?????????????a?O gW????P,b?v????p??www? -#?*??3??a?_2LH????|?6ql??N?V???=|?)???Os?? ?>???TCk?X)#Q?I? -h?Bl?u??"????,?????y??/?N????T???g:028?Rw?????C?2-+?A}m??1@<uK}?-[?/?\??HX??HX??y ?[ork?v7T?V?o?,P??N?aH????m?????Ph?? B?0?-?i???/?????Z?&_???c???t??p1??R???????y??*k$?l,????????%??m? ;??????u??yk*?r5?]8???\m?????l??e?z?F^^??X??M??^?f???pU?K??v?????D???>??%?????s?V???0}???????j??L??<nA?K>?[?.??? ?F#?rK??0?e?????aW?2??\a?{???nD,??vP??N?^/ ??S?????w?[ -??&j????.?o'3 -?^xt+??1???K^[Xf?8)????*? ???????4Sl?~P?P?D??!>?1y??"F??:?G???c??]?%?????b?S???%1 ?????AO??(m???B??_zQ?????#J????}??}?7??? +*?}E.???????o{9G???m?;2??????K??e'No?F???l?%lnZ>uk[$o???k???6?" ???Zt????I???? u?m?E?VN?Bv'?4I +???Ckt?s?{>N&;?$?t5J?Y ++?K,s????2?????AaN:?z?0H6O%???B?=n5 ?V??uR'Z???q?`?4?z???p???R?Mc?LX??A?qrd??4cV?r?8?Q[?????g?L?B?)?? ?&?SV?w???27?p?\?+?U6?V+???g???e?s?? +%_?{?????.????????z????#?D??5??s +y?T???R??D???Hcz???1t?Z^??.h? ??s?(u?B????[?w)F?^?C ???a????jH6?\??o5j? `?S/???m?S?m?Z?hOF1b&?1?&*(?bw?1????3?*ZZ?????????2& endstream endobj 3 0 obj << @@ -194,8 +197,8 @@ endobj 29 0 obj << -/CreationDate (D:20130727173826) -/ModDate (D:20130727173826) +/CreationDate (D:20130730094017) +/ModDate (D:20130730094017) /Title (R Graphics Output) /Producer (R 3.0.1) /Creator (R) @@ -342,8 +345,8 @@ endobj 39 0 obj << -/CreationDate (D:20130727173827) -/ModDate (D:20130727173827) +/CreationDate (D:20130730094018) +/ModDate (D:20130730094018) /Title (R Graphics Output) /Producer (R 3.0.1) /Creator (R) @@ -1046,162 +1049,157 @@ /FontFile 68 0 R >> endobj 70 0 obj << -/Length1 2287 -/Length2 16196 +/Length1 2269 +/Length2 16076 /Length3 0 -/Length 17554 +/Length 17423 /Filter /FlateDecode >> stream -x???P??? -???0????{p?????????]?{p?K???d?????-??Y-??^O????)?? ????l?????"r?L?FFzFFfX22U 'k??fX2u?????-??D??N?6QC??89;[???5??????????`fd??O??7@???? G???:??????;X??;????Jc*?_?!?????-@???h?~???5@??????????NN?? ?????6??vf?T?W 's?2???4?n oh??3zX2??????v;S'WC ??`ma ?u|?p?5:??H??????@ ?G=?????Mda?W???????????????P??wrs????4?v?{?7t1??64z??rC????????s4v??wr?w????"?o?w??lMD?ll??N?????p???????Z????z?L-lML7a?l??fk??(%?O?? ??? ?`cdd??b??n?? ??U???9?~??;???????7??0????t4t??????v?/?eb?X;??f?????@?????;X???g? ??????t????????O?_???$!++!G?w??? ???@????adc4~?`??{??[???vI??~v?DT?G?w??p??/[ -??U??f??{.???V????:K?g?5?E ?D????? -i??v5g??P:???W4K???s????Z?*?c76)?>? -?????A?4??gI???h?????M?$&?J?]y?{??K=r? nJl,pt????6???D P?Y????nR??F?? - o -??l?p\??s?=?)1?>Q?*?c$??????????#??? ->Gc??4^YCol?B4?o???2?R????J4??6$5{!?1?r?Mm?~~m?i7??7?hb???L???wP???# -G???> ????'?$?KFn+K?"???n??1Uf?A{?+?}X??6z?Z??Pue.??BI????f???1???????QC7??b^)C??4*{???]???1?????#??['?ie+?????????q5???r?i???:? -z?? -,???????cg?}?????d?Ku;N?S????{x?{?a? -?????5?x????????vq?~???_E??;v????g??? ?y????/? -????hN?cF???x@???C .?D??_?????,/??B?IW9?t/?mX??8A???%&???!??(?S?Q**y?!?~??k??^?? }?????tH??%/O???h?????T??XK?;h?P??4?T??zC????d?oi??p?o G?? x?|???1B??is -???m?d??O?!u??(?,(????zM??y39q??????[n???l at p??X=s?L+? ???]Bk==?Q??&??\?mS????0????????^?r???\???;??V??????|?KX??3P??3??$+\S>?J"?S?x?}??{??o????1@?,??/??%+JlX?|m?'?T?'0k??K1???@%?-??? -2??1????H?WW?p ?????h???/??????k??W?D?@? -PB?????Px -+?????Y<(A4?,?~?F?r??=??b?$??I&???????x(??? r11??&cd,??{tx????t?::??%R??J9?u?#???^????}Q??U?????HlM&B?]Qv??m)?L?bR?f?????J?cF??]k/? ??D??F?&'???y]?Mj"?z?5????k????h??@?/??j????/ ??9?1?@???lvV8???^???2fm??F?z??????+D?n?)?????5?6?_????Gy??M>.L36? -=??QJH7?????l1_????N?????9??R1?#AI i?]?E?]D?qX?`?!??u?A?????????T???l?-xa?{X ?2??n% @?G?|!???T????Z?C(C????????a ??????????Y???6???]??z?kk??@2???7!??"?^L????O -?M???y????.x??p??Ezdh -?????k????h???y?=T.r?/????M8?6???:|l???l?J??' ?`?xX??~ -????????}pE ??????i-5???>*/W9s4|F??~oic -???C?z????t?ms?l???IT?F?So Q??????0????R???ro?1??aq4?????4$?????K?KD -J=??_i??3o3?4??D??H??h?????zL???????it? ->E???U}???Y??t4??0?C`??Bd?T?}T'???w???[??'B????l ???sL??$O?|?-? ???e\???Ur????P??e~??u9=?G?Ya?J???~r???45???7?hF/????" ?(?Ay???c??;??????@??5?=?yS?!dx?hnSc?E?'???O??jC????|??_;?D]???y,/j? +a? -T?u?4!k??]?70_Dj??v???}~:K?Rr"N?s?\???0 ??x?Lq<??Y?a?U\%m??EkO????ov M ?J??????+#?#??C???BO?y)\??????68L?-???U????4???&?nl2???9?? ?p?,?#?+}?_?????X??o?b??2??4??8+9?O???Y?s???+Su?a[]Jn???z? ??z?x?jY?7??2?? ?k???bl??U -S?z~1?E??N~???ip.v?1?r1????$I?9e0h.?Y?O,?7???????1t?{J?_?X??{U?@????~ R?? -08?? -?3???|????~?A???????i!?K>c??????$~??cV/??#?ftk????Iz???:z???TV;??/?????Fp??????D?smd-(?K?^K0V%pt?kP??}s9sSr??ly=G]?}7B?G?}*e??o???6??$?? -Ri!\?? ???~????x?>??qB????~????????u? ?w??_?8X ???S?)r) -?K?O??m#N? ??;???!??}r???^?"?@?+j??p+??-?M???C??;O`L%????D????"R??.Y????ol??6??i???V*??|N?f#?w?`??Ds??d??:?~ $????_MF??M&?p???~z?p?? ????????1????TT[P$u??Cc??.ckG?]?????+????U??M?:l)m??v?T???a?E?C?????q>?\?C'??iZ -??E???????3(???? ??pxj??tQM%S???W??????????? -?^???M? ?~n????????n1\yM?)?6?D?nT??????=z?????\??i???k?/)?:???f??p????~?&6?|???????6Y??d?+???=?[????Y X??N -\X?_?P^????*t?*f??????????*6????????k9?????u??????i?ZW??o??1?cCC.Be??&.??t -'p?*?!??/?p6?? ?o??P?`^?%/ ?????Oh??U?E?z.???6I?F)???1?OH???>'X??2+fRx?T[???#?????%*9<)?b,???+?W?????;? )?e?]?k'??2??????????;??b?7,???!??i??d?1?T???#?}??A??P????????L-?x?h?f????^0???B??3g -?p? -?E??????\?u~ ??J?? 9RgD?N??nw???zQ???"?% ??S?????5??X1?h?{????+|???_J?|; ??[?Y???9= ?mD??y???^q????"???PQ,2?4??X ??Dx1?????v;?????W??????Y+#r???????, '??g??^???????|?o?Q?;??????????[??2??????????????????????e/??M? -?0 C?????"??:?~??P???^?T????????t?W???zJ?wn???E?@???pD??Pk}? -?e??L??@? K -?[".????&k?>??e;??W?Y??-?A??????raj?$?vs??z???o(??O???D?????-?`?2=6?T??Oq%?5?~0???w????BK???j{??{ ?=???;r?U(:d??U?!?J???(??a????$??????(?j?X????V?*?QCP?O??????M?1F?A???????M???j??????> -B??85 -L,5??\,?;????D?^??k@?q??????????L?>?i}?V3?O!???>}????Xn?o#8#y?????A???????_ 0???-d?Gd?Yh(????Z`??? ???f?5??p?Y_#??VJU????8aa? eE?K???.y?U7?a???ZV?_?,?? ?.??????jCE???d????p?G}.?e5-??z??????F?S???x????P]?,c??ga??W????c?i"??,?a:? Yt??P??Z.??;j^ V?J???y?AE?1j??????Yd??ZS?N???????t7???:>=???$^ } -????h????s?2?(?;6r??u?@??????e,/???R??$5?re???~z??}????D?>?n??uU??E_???+Mi< 8x??p?B??@?f?&?a?@???? -Ij~???8r??' -???(?.????S??[f>S\l?6???y????l8?E7 ?8?v?i?y??\6??}?X??????? F???U??????w???"vH?NA???I+ -?Z??![??hv?Rb???c??C?MKF?H~-? C?=?e"M??????+??????3U5???U??>`????)~+?.6=,??~?0{;???V?????'???:?????????y%t?????tK??eKq?_~`o??^]??J? ??q???>L????fDT??8?Z??????N????y?9g? -?b?kU2?? -????LlM?JYG\?n}?XB(??Eg:????C?????H?s??4g ?uB?q??o?j????31J??7SC^!??>??N??L???Y??O?yy?1w=???{`_?Am??&???????i?H>9)1???:?h?#????.????@?1#e?b?!?u??M???h7??t3???y1 -9?? ???u?????????? A?j??Z???A??? +?'2??.Y=RZ??\t??s?lfh??.<?V?3???v??8 J?h???????z?$)? ?dtFv??K 2Y?" ??E?=???+?h???J?????????P -?r????8?qN?? -??a??? ?]????????Z?*??O?BtLw7?y?X?? ?d?89???ys?? ??i?????z+?h3??"X?t?`p??? s??P??5????;?D????{??`98`x?K?[??WVMP???@? -??^D&???`??????Uo??i?r4???;F?W=???"??????A??\{???g?????r?+ W?_? *????F?Y?q?V?????c???????j-0?|??IL?6?'9????????Q??m??8"\)9?c?+???f))??e?^?k?@?R??-???z?M7????|?????d????g%q}?B??o??}??M?????H?/??p?f?(O??_p*V~A??????!??????.?0??????>M??z?I?e????\?*? ??v?????}C qQ??????wG??#Nd??????\?>????LG)????1????3?*fs3????ZW???m]i?? -+?wMP?????t2????|?x|b???m? ??;R -}?uB?a??%\Y[?0f?)??>(!?=A"?c??+?p????????? n/{.p??????}???9?1 -???+??0????rx?????:?3?????J?m?,Zb?%??vb?sX??Sk/????O?> ??X?V=??b?????t??%??? -?pc6??@??lToF?g???} -?"???~?K????0v{??? ????????[????&xtX?2 at l~??m????????*???-|??$???-? ????????E???????????/|-??L{)Y}?1????????~???#?????xq??T?FZ??{??R??\uM?9o`??x??Y??????!P?k???r??y+R? -??h?????Dt? z_8???a?????Q3??????rdI??A?????????F -?????h -ko?.???6?yX.v?4???8????ke ;0_?????????6??a?????+?.?bNb/?^?X???9f??B?L ??bWvG?^ -u?O1?'D??o?p??O3?????n???f/?????+E?)?#???5e?:Wu???H???!?g@s?{?'z?m?1Q???1???a??t??_3?AN?< M???K????j?x???????]???e???????!hwy?a???xLi??x????????x8??d? ???????c???)?`?3?i????? -??\X`?2???~?J??5,OR? -??k????;?Gwx?4??b????C???#8a?a?x?"=*??>Yd??KE?g???gEw?????NIa?YMq6???P??? 7?????????????????????[??']F??r??p??)?`??%??T%N?"???^?7?c?????k???Y??R>?? ?>??w^??I????5 ????66??G??????5?8????w????#?#???$????????&ZG??? -???4?J~?`??!??'K?i??Z8?V|??0?l 3K?gr???"@???3????K2?-?"??????Y??82'??|??;?pfdu??v???S?A??ud?[/?@t?WE?T2?Nc??c?xB???Z?F????????}=???????& ?WL?????+??????q ??PX????%?tBh??e??g?????RaL@ t9?N|5Dt?}????C??ISy?? -"???0???^??-?q???W+&????=4????????j ?2'%u???i|. P?$??@*??sN8??????'??T???W??#[???`F??? -??~??n??? ?*d2[??a`??q??bt?!t?+J07h??1W??(?? -7?~C????k:`???7??????I??H?p'??r???????R?`???5RT_"?}30??g?L???@e??e?2{?\?g???????[???1"*Wk}??N?{2s~??b???hXRm*(??lJ? ?????L|?=????I?T8<# -tG|?B?@;?????Y??JluC=???zs?????a???b??CE?z???)?nG?G Q?N?&??Kjb??R ??S?h????&y??I??e"X"??Q?|??h?%X?68*?????XmBe? -?f? -?????C'??+??r?+??W??? ????L{:'$?? E??? ?6)O???/t?????~"?43 ??y?xE>?Vp?R?fb???N?????be8??G?O?? -?y???????v?r?U?)d?\? -?S???9?l?S??3T??#?b.L???LH#??eX?"???!????????{?(????&?i1???_?@?0V????T.K?`*3?U???Y?62???.?FY ?W:cTSJ%???]?@?v]??????b -??c?PF????????$? j????1??:????4x??????j??????d???????/? ???;4???g,$!1??h8?????d??\???Z~??yq?@5vok?e?o?L??? ,W -????k???????[\??_&k[???1??{???????gS [?S??d?????????$?$Z??V??,?>hY?)?|?W$(5???tD????GDF?(??1t?????)?3-???.-????8P,h???El?ZDA_??r2????(????p,?a?j0??,???l?`??_?",U? ?wk?a v?gB??w? -M???%W??H%???:O?#7?m?3Gn??eW?C?_W?U, -w????rW?@(??????"? -sTD~}]?sBAQ??I?)?? >?_D????t???NuC???????9O??????a?pE?K+?X;:?9??$??,:????nP?????5r?ZZn?]????g???? ?v?z??????]~J??? +???KhOp6 ?t???????kE[??Xm???c??f?h?14?D??A???n?;??????9?*N? -{}?w:?,W?4?l -??:^??3s7?^n????^F??$?z,zU??I???.x??? ??(??Vs?????K[_s?qH??Vr?Uv'??v?}???????mV9:0n?>?T_???6???AN?4Q?s,i????p#1Q?+V?B?Xy~v??? -(????G?;???P>? ??}q???q{??8??p??P(???2?.E????= ??aD???????laK???4w+???@N -???????????Zem???hn????\\??????? >}??,4F^?.??*?;??(ID?qB???95?aDEp?z????\C???|WR???0??2??O?w??z???+u???D?T????>?Q+1p??+???ssp???????3???!?n?????????>?K?~\?.G2.??>w;????u??????\c?r?z?Z?????"`??H?7o??7?j?????7M6;%? -I??c????8??e_?F??H?Y7?=??D oC?:?????u]kY??? ?#????[ A?laz???????%>?????? ?X6#?1^A?"!s?????5bQ?9?e?%;m?????|?/gq??}? ??=???Z???d??v???'???1??n?,??K_??V?P?* -??9EKK?"??????&G???[ ??#(???sg*??6???G?4??Buic?R???Us? ???????!t;?jS????? -2HM?b??? ?+>??V?S???k?z?[?*CN??+??b??h???q????????m[???+t???l???0?9\??cKr["????:Z?:T??]r??????? -'P???????L5?g??,Z]#w???d &oZ????{??Q? gNy\? j?[Q ???????|J??K???:?)?o?n??>?Y?>?[?1+?? -?r?[?nG??U??? ?[/? X??7Q??D?ZG?7v???hy"????-4??O???r\??)??????jY????'????? -?a??:?s1?-%8?????a\?^??Oui????9??????\q?>9s<+??^H?_25" 4~?s5?9??%.?.???T?]7'?>y???eZ?A?? w?????L?D?A??y??????_???!??>8??Aw:????V??"e~fN?!a}? ? Ks??e??*?:Fb" /h? ??b?????*??-<-+?h?? ??T???7??Q??Ja.??t?? L?E?0??g??5??PH???$&?A?*??????y?3f -?\'O???t?|??Y??W???>????C??(Y?eB??$ ?ei??x?? ??????????????pVX]???s??]??p????? -"??A??m?5q5?-???3\?{Isk???h??!??? ??S~uG%4?;????i37???-?????Q???q???Jlx???????#????c??????$k?'d$onL?\~?T???????Am3m2???????D?? ????y???????u??? ???+???vh??????x????wX?nJ?????6??V$?? ????? ?;L?m??'??n2?? ??z???????y???+>?VM\`U!?i???e6?#7????vcz??????2[???@?;?a6??? F??JcI???^Q)???V133W?v?tK??|o?p??S?z^?#??????k??2?-n=?n?{?FP??p????????#P'E,_#??.????=l.?d???<#&??Q???W??B?????Lf??2e%%u??M????YO%B?'????l?z?@??j 1+?h??I?k???t??!?`?&'e??5 -?????????U?w2 ????k8?s@?g??Pg??i?(?@[{???!-??0)???I?j"&jK?????#?N??O?]??O,????R???sl??S?Z?~???A????y????[???PVs?u?$ Z ??(???%M???>H?E?Y???%TpB?X??5C1?4???,DR?nb??????q?h?7? ??m??6O???a?C?? -2k?????&???????j[?"?:??MT?.???%?< Nj????;?????f? 5 -fS?)v??9??P?Xx!7>-?fp0x}???"?????jko?^:*A??r???(,{hL?$??.a?`e??L(@?IP8??K?P??i??g?? x??v{???????_3?0?????I?8?/EU????6xo??q ???Z?f?s????}??kR???????J??&uO???????Q????J??M"???s?Y????nH?l????@eh???^?????????_?e?c??6sD? ?????1:8p&?M*=?8?????x?3?8??t???A???G+#?S????HB)??>?GB?%???k??6z5SUX?:?"??? ?G???t??????~rv?O????c??*??5??^????;???? -^/,??v??6C????`8? +?n?3????a?? ?w?-ePf??%?;?E??@\?3@????s0?7?ut`p0??]"?o??.?Y??XY?`?'jf4|o???????q????Y?.????Q???? (%????????`gbb??f?@WCS????n????????xy??????z??`=???G{'??????`??Ff?????5??w1??o?>|{3W?&???1?~??O?}??l?-????5_FU%aU99??+??NX???A???gagpsq8??^??????S?_R}?rc?C(eml???????? ????????o9??U??l?;??????????????f??????????_j?????j}+3K? ?7????*dm?o???????dY???????J9??_??????h? n? +4R0s44?{??3?wzK3k??????g +?????????????y??>??T??s???b??6F??????oo?????^,????5????Fk?w?{y^c{????0????????E?LF????(??%? V???`???????E\?? +?;????????(?A?y??q?#???=k???=????????????????XY????wF???J?z??9?o???????wBcc?????dg? +??????8???????_????O??????h?/?w??2q????c?/???'????????1???m??~?}??K?????????;??h??G?????????=I??????i???m-????.?????? ???y?G???[h?~??C??{ ??)?{??M?????s???????????b?/??&:? ?7??_?= ?M????_????_??i??~gr???n?????k?=m?????*? +4?]^?1?h^?q_+??B???7K???JM??l?????D]???i+?4????+Fu#?B??q??????????n????W??)??????|ze??;OU? ?6?.i?\;'.D?|?{?~ ??????????5????g??T"??J??? ???I?? >???rE????E??|#?????:?b-???b?~?w_?Tfq??!???&?A???>J??Z?(-??K?????Jd???@z?????y??VB|???6q???:???;??tR\O????R~?;??s?a????McD???b7 ???ni?????OI??+f???{?\?????????? +j????XN?c0F? ??7???9?C>????o?????9j^V?il? ?? +0?>?,B;???.r??]^J?\?+9Q????l?L??F%?W????xL???'?,???k"??U????3??YS_R^f)Ry?}???????w&N?}??1 +??Wi??????~=!?X)TP?R>??P?px??/?"?a?M>#CG?A??\?VLj}????B? ?PM/??r???<3??5+????t????+?9?3? +?_??:???7??s?%7???'T?>?>?h&?4 ?????????F??????3C?&%?n??B???:{-?zP17???? ?fI????!]k?yz +?&???'M????k???-U1????)C??h??6?=c?o?????%z?!???X[dx???????m?JgG6?PgO?V?h??@}?DO'P ??{?t;??f???M?????r?z?F1???^??O?L??QV???4?(?&?J3V@?M?fB??-???_?Q?G???????eq??r?4? ???*z?r?g?c??d??@x?????dUtN??????????r??4W?Q????[???s}??*?o?????G?#??s>? 3????0,??MS9??D[?*??;? +????C??V??+?PQ?(:?a+1????Ru +???? ??}?q==???8??GS?Sb8???p???B|?SYRp_????K???R9???@0~?Q??w0???????gL)m+gvi]????x? D??H,???????4?4?????P??]?.???F=o?? sctL?2,/?t????D,ut???V??????7?o0?u__??s['?\?n|?Jyr????='??'?e?%8?{$?V +????????s???s#7?e?P???j_P"?"???? =????[u?q??W??8'S?kz4???T?e??}H??K??=TbU?B?????g#?NE8?? ???&??\(??=??\,??Q#4??>?x??G????r?d6/Sv`???\?}?d?T?| 4?V??$?e~Qpl?[????RW}?Qy?????_?Z???Z4??}???,%??q_\\dh?-{??g?2I? *???k?,?\eg?_R?HhX??|d2^?@?? +?4??????;'?bx2?:?>????n?NH??}oe???/$??`Lo]r\??M?T6hiB12 ,M?B:J6`7B????a?E?SQ6}?Y?t?????K +?0?3Ff+??>xB?L;F?* +3?????/o?7:?h(??>?????_?[??^?.D5 at y?,?G +?[??8?7j- f??o???U??????.?2?7?O?y5?MF ?:????Lb??t?/?h8??f??@?/??t??E???o??m?.F?H?l???h(??&??!??T????2?[?}?k????w??F????]??}R??!???Q?r]_?l?????T? +>???F???F?1bT?T????/%@???bv}J?????R?N????h6D?F\?G?YMJ?????Z&????u???A???!????r??? q? ???d?f? ?^??5U??rt??? +?]?n?i? + ?.???r??:?!?$0?W?X?.???*M2#Q? ??3}??-[? f?? ?b?.J`?????? ????M?,&?? +??9J??V? +? +?S??.W??p?}?H6????]07?~e ????D?#/B?)'T????e???SM?u|? +?????m%[????g?? ?K.?zA*Zt401>5??"?????/{l??D? ?Y?k?;nYL?e?J??????U?i?d???x'~??k?R&???*?H5???B9?VIcJ??!??>s?{?[W#|??j?nM??rI[???2???.???At?/=???w2?U??????????????O?????(??o??5??s???B<P?)?3;7??9???}?wx[??d??>???d? ????L???Wt?`=??K?O???>?7? ?Y??????? ????AE%?Y~????j)R+??`?0??Q???"??o????*?6?E/?9?( +$??????JU@@?x[0?9%RnG??B??6???o???4??kW?)?x>???? +?Y????Q? ???Ip.?CI%?Gv2}6?al??? "??=?V????{??@????|v ?y???,Q[?????B?U0zJ?Z???u 3.r[X/"uq?nh?N???T\??r? +g?MF),B8??G L???K?O??0 QJ.???^?uL??O??n??? |K3?X?n??s?A7!??R +'U????e4Q??]e2?i-?Q4?&7?K?V???"\??Ch??????1:(c??%??f??-,?I??e*8? m?Z0???{?LV4??lHO] R?? \l?.3Z?>H?8? K"Q??6???PU+??$??1L?????????m<+?'??7s??N??=????~?;'???k??Z?? ?P?B,?Ki?\j???n+?0r1m?????B?;y??# 9A?MD^?????-??o?eWj??????????? O?yXd#?,f?ie?Y???z??"?C???G?~??????4?M???xLm?wy?Z???P6?D?W?WV???etE??WP? ??????+??[&?hs?u?f?(}?{?W??J??ifQ????l?r??U<?#?K??????9???v+?i???z?c?v?aF??y??????}?d???r?>z???x_?????5?,/?l:?????Lp?,??N]ZZ{i}#}l??V?X???~q"B????k#4`?V!????7?W??r? ??Y+?&i)b?A?????n#?e??????O>+s3c?+$???4/_k+{?O;1??o???+???&?_Y?????Xd??????h??8??.R?.?&????p@??L???G???????`???????_??Qt??3F ;N??71ZO?t +1V0???-?????%F??s???Z??&??????cT???????B??????(?B+`tB?? "?#v?y???71?!'?/?G??{Hd??Y?I????!??L;???G?Y~Z??Z??n????Y?S??g??D??70??z?(?Ia?q?q?E%??e7????0Fd(?Qw.?@??????T? z ???? ?z??>??G??1????$k??U?b??/??????|-??r0?K??????=???axV??j?\w?d?W-?H?$ +?E??????|?u~??R:?0? Rgx?V??vw???fq??F??2?~?S?qL?e????YX1?(?F[?#{???+??????|{ qG?;cYjMx??\?qV"*K-[>;???fiV?kl?????7z??f#>???N.?a?????9\-p?NJV????HK]?+lJvJ??CGP?H?%Lx?0??g?????????i?? +?.????>???r?[???zF????a?;???*????E????&????&??0D?"?LR?????.c?:??e=???? +Y??-?A???7?7???NI???fv Ov????L?b^?x???O)8}?-??L?Xs??U>q?FwN? Author: rossbennett34 Date: 2013-07-31 22:51:16 +0200 (Wed, 31 Jul 2013) New Revision: 2690 Added: pkg/PortfolioAnalytics/man/chart.Scatter.ROI.Rd pkg/PortfolioAnalytics/man/chart.Weights.ROI.Rd pkg/PortfolioAnalytics/man/charts.ROI.Rd Modified: pkg/PortfolioAnalytics/R/charts.ROI.R Log: adding plot method and documentation for ROI charts Modified: pkg/PortfolioAnalytics/R/charts.ROI.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.ROI.R 2013-07-31 20:30:18 UTC (rev 2689) +++ pkg/PortfolioAnalytics/R/charts.ROI.R 2013-07-31 20:51:16 UTC (rev 2690) @@ -220,8 +220,34 @@ op <- par(no.readonly=TRUE) layout(matrix(c(1,2)),height=c(2,1.5),width=1) par(mar=c(4,4,4,2)) - chart.Scatter.ROI(ROI, R, rp=rp, portfolio=NULL, return.col=return.col, risk.col=risk.col, ..., element.color=element.color, cex.axis=cex.axis, main=main) + chart.Scatter.ROI(ROI, R, rp=rp, portfolio=portfolio, return.col=return.col, risk.col=risk.col, ..., element.color=element.color, cex.axis=cex.axis, main=main) par(mar=c(2,4,0,2)) chart.Weights.ROI(ROI, neighbors=neighbors, ..., main="", las=3, xlab=NULL, cex.lab=1, element.color=element.color, cex.axis=ce.axis) par(op) } + +#' scatter and weights chart for portfolios +#' +#' The ROI optimizers do not store the portfolio weights like DEoptim or random +#' portfolios so we will generate random portfolios for the scatter plot. +#' +#' \code{return.col} must be the name of a function used to compute the return metric on the random portfolio weights +#' \code{risk.col} must be the name of a function used to compute the risk metric on the random portfolio weights +#' +#' @param ROI object created by \code{\link{optimize.portfolio}} +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns, used to recalulate the risk and return metric +#' @param rp set of weights generated by \code{\link{random_portfolio}} +#' @param portfolio pass in a different portfolio object used in set.portfolio.moments +#' @param risk.col string matching the objective of a 'risk' objective, on horizontal axis +#' @param return.col string matching the objective of a 'return' objective, on vertical axis +#' @param ... any other passthru parameters +#' @param cex.axis The magnification to be used for axis annotation relative to the current setting of \code{cex} +#' @param element.color color for the default plot scatter points +#' @param neighbors set of 'neighbor' portfolios to overplot +#' @param main an overall title for the plot: see \code{\link{title}} +#' @seealso \code{\link{optimize.portfolio}} +#' @author Ross Bennett +#' @export +plot.optimize.portfolio.ROI <- function(ROI, R, rp=NULL, portfolio=NULL, risk.col="StdDev", return.col="mean", element.color="darkgray", neighbors=NULL, main="ROI.Portfolios", ...){ + charts.ROI(ROI=ROI, R=R, rp=rp, portfolio=portfolio, risk.col=risk.col, return.col=return.col, main=main, ...) +} Added: pkg/PortfolioAnalytics/man/chart.Scatter.ROI.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Scatter.ROI.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/chart.Scatter.ROI.Rd 2013-07-31 20:51:16 UTC (rev 2690) @@ -0,0 +1,54 @@ +\name{chart.Scatter.ROI} +\alias{chart.Scatter.ROI} +\title{classic risk return scatter of random portfolios} +\usage{ + chart.Scatter.ROI(ROI, R, rp = NULL, portfolio = NULL, + return.col = "mean", risk.col = "StdDev", ..., + element.color = "darkgray", cex.axis = 0.8, main = "") +} +\arguments{ + \item{ROI}{object created by + \code{\link{optimize.portfolio}}} + + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns, used to recalulate the + risk and return metric} + + \item{rp}{set of weights generated by + \code{\link{random_portfolio}}} + + \item{portfolio}{pass in a different portfolio object + used in set.portfolio.moments} + + \item{return.col}{string matching the objective of a + 'return' objective, on vertical axis} + + \item{risk.col}{string matching the objective of a 'risk' + objective, on horizontal axis} + + \item{...}{any other passthru parameters} + + \item{cex.axis}{The magnification to be used for axis + annotation relative to the current setting of \code{cex}} + + \item{element.color}{color for the default plot scatter + points} +} +\description{ + The ROI optimizers do not store the portfolio weights + like DEoptim or random portfolios so we will generate + random portfolios for the scatter plot. +} +\details{ + \code{return.col} must be the name of a function used to + compute the return metric on the random portfolio weights + \code{risk.col} must be the name of a function used to + compute the risk metric on the random portfolio weights +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{optimize.portfolio}} +} + Added: pkg/PortfolioAnalytics/man/chart.Weights.ROI.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Weights.ROI.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/chart.Weights.ROI.Rd 2013-07-31 20:51:16 UTC (rev 2690) @@ -0,0 +1,47 @@ +\name{chart.Weights.ROI} +\alias{chart.Weights.ROI} +\title{boxplot of the weights in the portfolio} +\usage{ + chart.Weights.ROI(ROI, neighbors = NULL, ..., + main = "Weights", las = 3, xlab = NULL, cex.lab = 1, + element.color = "darkgray", cex.axis = 0.8) +} +\arguments{ + \item{ROI}{object created by + \code{\link{optimize.portfolio}}} + + \item{neighbors}{set of 'neighbor' portfolios to + overplot} + + \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{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.axis}{The magnification to be used for axis + annotation relative to the current setting of \code{cex}} + + \item{element.color}{color for the default plot lines} + + \item{...}{any other passthru parameters} + + \item{main}{an overall title for the plot: see + \code{\link{title}}} +} +\description{ + boxplot of the weights in the portfolio +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{optimize.portfolio}} +} + Added: pkg/PortfolioAnalytics/man/charts.ROI.Rd =================================================================== --- pkg/PortfolioAnalytics/man/charts.ROI.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/charts.ROI.Rd 2013-07-31 20:51:16 UTC (rev 2690) @@ -0,0 +1,61 @@ +\name{charts.ROI} +\alias{charts.ROI} +\title{scatter and weights chart for portfolios} +\usage{ + charts.ROI(ROI, R, rp = NULL, portfolio = NULL, + risk.col = "StdDev", return.col = "mean", + cex.axis = 0.8, element.color = "darkgray", + neighbors = NULL, main = "ROI.Portfolios", ...) +} +\arguments{ + \item{ROI}{object created by + \code{\link{optimize.portfolio}}} + + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns, used to recalulate the + risk and return metric} + + \item{rp}{set of weights generated by + \code{\link{random_portfolio}}} + + \item{portfolio}{pass in a different portfolio object + used in set.portfolio.moments} + + \item{risk.col}{string matching the objective of a 'risk' + objective, on horizontal axis} + + \item{return.col}{string matching the objective of a + 'return' objective, on vertical axis} + + \item{...}{any other passthru parameters} + + \item{cex.axis}{The magnification to be used for axis + annotation relative to the current setting of \code{cex}} + + \item{element.color}{color for the default plot scatter + points} + + \item{neighbors}{set of 'neighbor' portfolios to + overplot} + + \item{main}{an overall title for the plot: see + \code{\link{title}}} +} +\description{ + The ROI optimizers do not store the portfolio weights + like DEoptim or random portfolios so we will generate + random portfolios for the scatter plot. +} +\details{ + \code{return.col} must be the name of a function used to + compute the return metric on the random portfolio weights + \code{risk.col} must be the name of a function used to + compute the risk metric on the random portfolio weights +} +\author{ + Ross Bennett +} +\seealso{ + \code{\link{optimize.portfolio}} +} +