From noreply at r-forge.r-project.org Fri Nov 1 14:49:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Nov 2013 14:49:46 +0100 (CET) Subject: [Returnanalytics-commits] r3242 - pkg/PortfolioAnalytics/R Message-ID: <20131101134946.83AE4184C34@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-01 14:49:45 +0100 (Fri, 01 Nov 2013) New Revision: 3242 Modified: pkg/PortfolioAnalytics/R/constraints.R Log: adding constraint type for leverage_exposure to be used in MILP and global solvers Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-10-30 21:53:15 UTC (rev 3241) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-11-01 13:49:45 UTC (rev 3242) @@ -352,6 +352,12 @@ message=message, ...=...) }, + # leverage exposure constraint + leverage_exposure = {tmp_constraint <- leverage_exposure_constraint( type=type, + enabled=enabled, + message=message, + ...=...) + }, # Do nothing and return the portfolio object if type is NULL null = {return(portfolio)} ) @@ -730,6 +736,9 @@ if(inherits(constraint, "transaction_cost_constraint")){ out$ptc <- constraint$ptc } + if(inherits(constraint, "leverage_exposure_constraint")){ + out$leverage <- constraint$leverage + } } } @@ -1015,6 +1024,40 @@ return(Constraint) } +#' constructor for leverage_exposure_constraint +#' +#' The leverage_exposure constraint specifies a maximum leverage. This should +#' be used for constructing, for example, 130/30 portfolios or dollar neutral +#' portfolios with 2:1 leverage. For the ROI solvers, this is implemented +#' as a MILP problem and is not supported for problems formulated as a +#' quadratic programming problem. This ma changed in the future if a MIQP +#' solver is added. +#' +#' This function is called by add.constraint when type="leverage_exposure" +#' is specified, see \code{\link{add.constraint}}. +#' +#' @param type character type of the constraint +#' @param leverage maximum leverage 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 diversification constraint +#' an object of class 'diversification_constraint' +#' @author Ross Bennett +#' @seealso \code{\link{add.constraint}} +#' @examples +#' data(edhec) +#' ret <- edhec[, 1:4] +#' +#' pspec <- portfolio.spec(assets=colnames(ret)) +#' +#' pspec <- add.constraint(portfolio=pspec, type="leverage_exposure", leverage=1.6) +#' @export +leverage_exposure_constraint <- function(type="leverage_exposure", leverage=NULL, enabled=TRUE, message=FALSE, ...){ + Constraint <- constraint_v2(type, enabled=enabled, constrclass="leverage_exposure_constraint", ...) + Constraint$leverage <- leverage + return(Constraint) +} + #' function for updating constrints, not well tested, may be broken #' #' can we use the generic update.default function? From noreply at r-forge.r-project.org Sun Nov 3 22:58:09 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 3 Nov 2013 22:58:09 +0100 (CET) Subject: [Returnanalytics-commits] r3243 - pkg/PortfolioAnalytics/R Message-ID: <20131103215809.6D19D1861C4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-03 22:58:08 +0100 (Sun, 03 Nov 2013) New Revision: 3243 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/R/constraints.R pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Adding support for a total exposure/leverage constraint Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-01 13:49:45 UTC (rev 3242) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-03 21:58:08 UTC (rev 3243) @@ -504,6 +504,16 @@ mult <- 1 out <- out + mult * tc } # End transaction cost penalty + + # Add penalty for leverage exposure + # This could potentially be added to random portfolios + if(!is.null(constraints$leverage)){ + if((sum(abs(w)) > constraints$leverage)){ + # only penalize if leverage is exceeded + mult <- 1/100 + out <- out + penalty * mult * abs(sum(abs(w)) - constraints$leverage) + } + } # End leverage exposure penalty nargs <- list(...) if(length(nargs)==0) nargs <- NULL Modified: pkg/PortfolioAnalytics/R/constraints.R =================================================================== --- pkg/PortfolioAnalytics/R/constraints.R 2013-11-01 13:49:45 UTC (rev 3242) +++ pkg/PortfolioAnalytics/R/constraints.R 2013-11-03 21:58:08 UTC (rev 3243) @@ -1206,6 +1206,7 @@ max_pos <- constraints$max_pos max_pos_long <- constraints$max_pos_long max_pos_short <- constraints$max_pos_short + leverage_exposure <- constraints$leverage tolerance <- .Machine$double.eps^0.5 log_vec <- c() @@ -1230,6 +1231,11 @@ if(!is.null(max_pos) | !is.null(max_pos_long) | !is.null(max_pos_short)){ log_vec <- c(log_vec, !pos_limit_fail(weights, max_pos, max_pos_long, max_pos_short)) } + + # check leverage exposure constraints + if(!is.null(leverage_exposure)){ + log_vec <- c(log_vec, sum(abs(weights)) <= leverage_exposure) + } # return TRUE if all constraints are satisfied, FALSE if any constraint is violated return(all(log_vec)) } Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-11-01 13:49:45 UTC (rev 3242) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-11-03 21:58:08 UTC (rev 3243) @@ -205,6 +205,7 @@ 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 @@ -240,87 +241,100 @@ N <- ncol(R) + # position limit constraint max_pos <- constraints$max_pos + if(is.null(max_pos)) max_pos <- N + # leverage exposure constraint + leverage <- constraints$leverage + if(is.null(leverage)) leverage <- 1 + + # upper and lower bounds for box constraints on weights LB <- as.numeric(constraints$min) UB <- as.numeric(constraints$max) - # Check for target return + # The leverage exposure constraint splits the weights into long weights and short weights + + # Add weight sum constraint + Amat <- rbind(c(rep(1, N), rep(-1, N), rep(0, N)), + c(rep(1, N), rep(-1, N), rep(0, N))) + dir <- c("<=", ">=") + rhs <- c(constraints$max_sum, constraints$min_sum) + + # Add leverage exposure constraint + Amat <- rbind(Amat, c(rep(1, 2*N), rep(0, N))) + dir <- c(dir, "==") + rhs <- c(rhs, leverage) + + # Add 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) + tmp_mean <- moments$mean } else { - # No target specified, just maximize - targetcon <- NULL - targetdir <- NULL - targetrhs <- NULL + tmp_mean <- rep(0, N) + target <- 0 } + Amat <- rbind(Amat, c(tmp_mean, -1 * tmp_mean, rep(0, N))) + dir <- c(dir, "==") + rhs <- c(rhs, target) - 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))) + # Add constraints for long and short weights + Amat <- rbind(Amat, cbind(diag(2*N), rbind(-1 * diag(N), diag(N)))) + dir <- c(dir, rep("<=", 2*N)) + rhs <- c(rhs, 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) - for(i in 1:n.groups){ - Amat.group[i, constraints$groups[[i]]] <- 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) - } - - # Add the factor exposures to Amat, dir, and rhs + # Add factor_exposure constraints if(!is.null(constraints$B)){ t.B <- t(constraints$B) zeros <- matrix(data=0, nrow=nrow(t.B), ncol=ncol(t.B)) - Amat <- rbind(Amat, cbind(t.B, zeros), cbind(-t.B, zeros)) - dir <- c(dir, rep(">=", 2 * nrow(t.B))) - rhs <- c(rhs, constraints$lower, -constraints$upper) + Amat <- rbind(Amat, cbind(t.B, -t.B, zeros)) + Amat <- rbind(Amat, cbind(t.B, -t.B, zeros)) + dir <- c(dir, ">=", "<=") + rhs <- c(rhs, constraints$lower, constraints$upper) } - objL <- c(-moments$mean, rep(0, N)) + # include group constraints + if(!is.null(constraints$groups)){ + n.groups <- length(constraints$groups) + Amat.group <- matrix(0, nrow=n.groups, ncol=N) + for(i in 1:n.groups){ + Amat.group[i, constraints$groups[[i]]] <- 1 + } + zeros <- matrix(data=0, nrow=nrow(Amat.group), ncol=ncol(Amat.group)) + Amat <- rbind(Amat, cbind(Amat.group, -Amat.group, zeros)) + Amat <- rbind(Amat, cbind(Amat.group, -Amat.group, zeros)) + dir <- c(dir, rep(">=", n.groups), rep("<=", n.groups)) + rhs <- c(rhs, constraints$cLO, constraints$cUP) + } - # 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 + # Add position limit constraint + zeros <- matrix(data=0, nrow=nrow(Amat), ncol=N) + Amat <- cbind(Amat, zeros) + Amat <- rbind(Amat, c(rep(0, 3*N), rep(1, N))) + dir <- c(dir, "<=") + rhs <- c(rhs, max_pos) - # Set up the types vector with continuous and binary variables - types <- c(rep("C", N), rep("B", N)) + # Bounds on the weights + bnds <- list(lower=list(ind=seq.int(1L, ncol(Amat)), val=rep(0, ncol(Amat))), + upper=list(ind=seq.int(1L, ncol(Amat)), val=c(UB, abs(LB), rep(1, 2*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) + # Objective function + objL <- c(moments$mean, rep(0, 3*N)) - # 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) - } + # Set the types of variables (Continuous and Binary) + types <- c(rep("C", 2*N), rep("B", 2*N)) - weights <- result$solution[1:N] + # Run the optimization + result <- try(Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, types=types, bounds=bnds, max=TRUE), silent=TRUE) + if(inherits(result, "try-error")) stop(paste("No solution found:", result)) + + long_weights <- result$solution[1:N] + short_weights <- result$solution[(N+1):(2*N)] + weights <- long_weights - short_weights 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 + out$out <- result$objval return(out) } @@ -361,7 +375,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, target ,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) @@ -388,7 +402,9 @@ 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") + roi.result <- try(ROI_solve(x=opt.prob, solver="glpk"), silent=TRUE) + if(inherits(x=roi.result, "try-error")) stop(paste("No solution found:", roi.result)) + weights <- roi.result$solution[1:N] names(weights) <- colnames(R) out <- list() @@ -836,6 +852,10 @@ ub_starr <- ub_mean / ub_etl if(is.infinite(ub_starr)) stop("Inf value for STARR, objective value is 0") + # cat("ub_mean", ub_mean, "\n") + # cat("ub_etl", ub_etl, "\n") + # cat("ub_starr", ub_starr, "\n") + # Find the starr at the minimum etl portfolio if(!is.null(constraints$max_pos)){ lb_etl <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=NA, alpha=alpha) @@ -854,7 +874,8 @@ # the lb_* values will be 0 for a dollar-neutral strategy so we need to reset the values if(is.na(lb_starr) | is.infinite(lb_starr)) lb_starr <- 0 - # cat("ub_starr", ub_starr, "\n") + # cat("lb_mean", lb_mean, "\n") + # cat("lb_etl", lb_etl, "\n") # cat("lb_starr", lb_starr, "\n") # want to find the return that maximizes mean / etl @@ -873,12 +894,19 @@ } else { mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) } + print(mid) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) mid_starr <- mid_mean / mid_etl + # the mid_* values MIGHT be 0 for a dollar-neutral strategy so we need to reset the values + # if(is.na(mid_starr) | is.infinite(mid_starr)) mid_starr <- 0 # tmp_starr <- mid_starr + # cat("mid_mean", mid_mean, "\n") + # cat("mid_etl", mid_etl, "\n") + # cat("mid_starr", mid_starr, "\n") + if(mid_starr > ub_starr){ # if mid_starr > ub_starr then mid_starr becomes the new upper bound ub_mean <- mid_mean @@ -893,6 +921,8 @@ mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) mid_starr <- mid_mean / mid_etl + # the mid_* values MIGHT be 0 for a dollar-neutral strategy so we need to reset the values + # if(is.na(mid_starr) | is.infinite(mid_starr)) mid_starr <- 0 } else if(mid_starr > lb_starr){ # if mid_starr > lb_starr then mid_starr becomes the new lower bound lb_mean <- mid_mean @@ -907,6 +937,8 @@ mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) mid_starr <- mid_mean / mid_etl + # the mid_* values MIGHT be 0 for a dollar-neutral strategy so we need to reset the values + # if(is.na(mid_starr) | is.infinite(mid_starr)) mid_starr <- 0 } i <- i + 1 } Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-01 13:49:45 UTC (rev 3242) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-03 21:58:08 UTC (rev 3243) @@ -815,7 +815,7 @@ } if(length(names(moments)) == 1 & "mean" %in% names(moments)) { # Maximize return if the only objective specified is mean - if(!is.null(constraints$max_pos)) { + if(!is.null(constraints$max_pos) | !is.null(constraints$leverage)) { # This is an MILP problem if max_pos is specified as a constraint roi_result <- maxret_milp_opt(R=R, constraints=constraints, moments=moments, target=target) weights <- roi_result$weights From noreply at r-forge.r-project.org Sun Nov 3 23:04:38 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 3 Nov 2013 23:04:38 +0100 (CET) Subject: [Returnanalytics-commits] r3244 - pkg/PortfolioAnalytics/R Message-ID: <20131103220438.37FE31861C4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-03 23:04:37 +0100 (Sun, 03 Nov 2013) New Revision: 3244 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: commenting out a print statement I forgot about in mean_etl_opt Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-11-03 21:58:08 UTC (rev 3243) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-11-03 22:04:37 UTC (rev 3244) @@ -894,7 +894,7 @@ } else { mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) } - print(mid) + # print(mid) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) From noreply at r-forge.r-project.org Tue Nov 5 22:58:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 5 Nov 2013 22:58:22 +0100 (CET) Subject: [Returnanalytics-commits] r3245 - pkg/PortfolioAnalytics/sandbox Message-ID: <20131105215822.A6137184EBD@r-forge.r-project.org> Author: braverock Date: 2013-11-05 22:58:22 +0100 (Tue, 05 Nov 2013) New Revision: 3245 Added: pkg/PortfolioAnalytics/sandbox/GMV_analytical.R pkg/PortfolioAnalytics/sandbox/MSR_analytical.R Log: - analytical solutions to global minimum variance and maximum Sharpe ratio portfolios, contributed by Kyle Balkisoon kyle corporateknights com Added: pkg/PortfolioAnalytics/sandbox/GMV_analytical.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/GMV_analytical.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/GMV_analytical.R 2013-11-05 21:58:22 UTC (rev 3245) @@ -0,0 +1,22 @@ +GMV = function (sigma) { + + #'Global Minimum Variance + #'Calculates the portfolio weights in accordance with a minimum variance strategy. + #'From Goltz, F. & Lodh, A. 2013 "Scientific Beta Efficient Minimum Volatility Indices " EDHEC-Risk Institute Scientific Beta(2013) + #'@Title Global Minimum Variance + #'@author Corporate Knights Inc.: Michael Fong /email{mfong at corporateknights.com}, Kyle Balkissoon /email{kyle at corporateknights.com} + #'@param sigma = Covariance matrix of returns + #' + #' + step1 = sigma + unit_vector = c(rep(1,ncol(step1))) + # Calculate GMV portfolio weight matrix + step2 = (step1)^(-1)%*%unit_vector + step3 = as.numeric(t(unit_vector)%*%(step1)^(-1)%*%unit_vector) + step4 = step2/step3 + # Long-Only Adjustment - Set negative weights to zero + step5 = ifelse(step4<0,0,step4) + # Normalize Weights + step6 = step5/sum(step5) + return(step6) +} \ No newline at end of file Added: pkg/PortfolioAnalytics/sandbox/MSR_analytical.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/MSR_analytical.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/MSR_analytical.R 2013-11-05 21:58:22 UTC (rev 3245) @@ -0,0 +1,24 @@ +MSR = function (sigma,return_estimate,long_only) { + + #'Maximum Sharpe Ratio + #'Calculates the portfolio weights in accordance with a maximum sharpe ratio strategy. + #'From Gautam, K. & Lodh, A. 2013 "Scientific Beta Efficient Maximum Sharpe Ratio Indices " EDHEC-Risk Institute Scientific Beta(2013) + #'@Title Efficient Maximum Sharpe Ratio + #'@author Corporate Knights Inc.: Michael Fong /email{mfong at corporateknights.com}, Kyle Balkissoon /email{kyle at corporateknights.com} + #'@param sigma = Covariance matrix of returns + #'@param return_estimate = vector of expected returns (or) expected returns - risk free rate + #' + #' + step1 = sigma + unit_vector = c(rep(1,ncol(step1))) + #Calculate EMS portfolio weight matrix + step2 = (step1)^(-1)%*%return_estimate + step3 = as.numeric((unit_vector)%*%(step1)^(-1)%*%return_estimate) + step4 = step2/step3 + # Long-Only Adjustment - Set negative weights to zero + if(long_only=='TRUE'){step5 = ifelse(step4<0,0,step4) +}else{step5 = step4} + # Normalize Weights + step6 = step5/sum(step5) + return(t(step6)) +} \ No newline at end of file From noreply at r-forge.r-project.org Fri Nov 8 04:06:30 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 8 Nov 2013 04:06:30 +0100 (CET) Subject: [Returnanalytics-commits] r3246 - pkg/PortfolioAnalytics/demo Message-ID: <20131108030630.4BBFB186506@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-08 04:06:29 +0100 (Fri, 08 Nov 2013) New Revision: 3246 Added: pkg/PortfolioAnalytics/demo/demo_group_constraints.R pkg/PortfolioAnalytics/demo/demo_leverage_exposure_constraint.R pkg/PortfolioAnalytics/demo/demo_max_STARR.R pkg/PortfolioAnalytics/demo/demo_max_Sharpe.R pkg/PortfolioAnalytics/demo/demo_max_quadratic_utility.R pkg/PortfolioAnalytics/demo/demo_max_return.R pkg/PortfolioAnalytics/demo/demo_min_StdDev.R pkg/PortfolioAnalytics/demo/demo_min_expected_shortfall.R pkg/PortfolioAnalytics/demo/demo_risk_budgets.R Modified: pkg/PortfolioAnalytics/demo/00Index Log: Adding demos for specific objectives and constraints. Modified: pkg/PortfolioAnalytics/demo/00Index =================================================================== --- pkg/PortfolioAnalytics/demo/00Index 2013-11-05 21:58:22 UTC (rev 3245) +++ pkg/PortfolioAnalytics/demo/00Index 2013-11-08 03:06:29 UTC (rev 3246) @@ -15,4 +15,13 @@ demo_random_portfolios Demonstrate examples from script.workshop2012.R using random portfolios. demo_proportional_cost Demonstrate how to use proportional transaction cost constraint. demo_return_target Demonstrate how to specify a target return as a constraint or objective. +demo_group_constraints Demonstrate using group constraints. +demo_leverage_exposure_constraint Demonstrate using the leverage exposure constraint to put a constraint on overall portfolio leverage exposure. +demo_max_STARR Demonstrate maximizing STARR as an objective using ROI, DEoptim, and random solvers. +demo_max_Sharpe Demonstrate maximizing sharpe ratio as an objective using ROI, DEoptim, and random solvers. +demo_max_quadratic_utility Demonstrate solving maximum quadratic utility objective with ROI solver. +demo_max_return Demonstrate objective to maximize portfolio mean return. +demo_min_StdDev Demonstrate objective to minimize portfolio standard deviation. +demo_min_expected_shortfall Demonstrate objective to minimize expected shortfall. +demo_risk_budgets Demonstrate using risk budget objectives. Added: pkg/PortfolioAnalytics/demo/demo_group_constraints.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_group_constraints.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_group_constraints.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,58 @@ + +# Examples of solving optimization problems with group constraints + +library(PortfolioAnalytics) + +data(edhec) +R <- edhec[, 1:5] +colnames(R) <- c("CA", "CTAG", "DS", "EM", "EQM") +funds <- colnames(R) + +# Set up portfolio with objectives and constraints +pspec <- portfolio.spec(assets=funds) +pspec <- add.constraint(portfolio=pspec, type="full_investment") +pspec <- add.constraint(portfolio=pspec, type="long_only") +# Add group constraints such that assets 1, 3, and 5 are in a group called +# GroupA and assets 2 and 4 are in a group called Group B. The sum of the +# weights in GroupA must be between 0.05 and 0.7. The sum of the weights in +# GroupB must be between 0.15 and 0.5. +pspec <- add.constraint(portfolio=pspec, type="group", + groups=list(groupA=c(1, 3, 5), + groupB=c(2, 4)), + group_min=c(0.05, 0.15), + group_max=c(0.7, 0.5)) +print(pspec) + + +# Add an objective to minimize portfolio standard deviation +pspec <- add.objective(portfolio=pspec, type="risk", name="StdDev") + +# The examples here use the obective to minimize standard deviation, but any +# supported objective can also be used. + +# Minimizing standard deviation can be formulated as a quadratic programming +# problem and solved very quickly using optimize_method="ROI". Although "StdDev" +# was specified as an objective, the quadratic programming problem uses the +# variance-covariance matrix in the objective function. +minStdDev.ROI <- optimize.portfolio(R=R, portfolio=pspec, optimize_method="ROI") +print(minStdDev.ROI) +extractGroups(minStdDev.ROI) + +# The leverage constraints should be relaxed slightly for random portfolios +# and DEoptim +pspec$constraints[[1]]$min_sum=0.99 +pspec$constraints[[1]]$max_sum=1.01 + +# Solve with random portfolios +# By construction, the random portfolios will be generated to satisfy the +# group constraint. +minStdDev.RP <- optimize.portfolio(R=R, portfolio=pspec, + optimize_method="random", search_size=2500) +print(minStdDev.RP) +extractGroups(minStdDev.RP) + +# Solve with DEoptim +minStdDev.DE <- optimize.portfolio(R=R, portfolio=pspec, + optimize_method="DEoptim", search_size=2500) +print(minStdDev.DE) +extractGroups(minStdDev.DE) Added: pkg/PortfolioAnalytics/demo/demo_leverage_exposure_constraint.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_leverage_exposure_constraint.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_leverage_exposure_constraint.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,52 @@ + +# Examples for solving optimization problems with a leverage exposure constraint + +library(PortfolioAnalytics) + +data(edhec) +R <- edhec[, 1:5] +funds <- colnames(R) + +# Set up an initial portfolio object with basic constraints +init.portf <- portfolio.spec(assets=funds) + +# Add an objective to maximize mean return per unit expected shortfall +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES") + +# The leverage_exposure constraint type is supported for random, DEoptim, pso, +# and GenSA solvers. The following examples use DEoptim for solving the +# optimization problem. + +# Dollar neutral portfolio with max 2:1 leverage constraint +dollar.neutral.portf <- init.portf +dollar.neutral.portf <- add.constraint(portfolio=dollar.neutral.portf, + type="weight_sum", + min_sum=-0.01, max_sum=0.01) +dollar.neutral.portf <- add.constraint(portfolio=dollar.neutral.portf, + type="box", min=-0.5, max=0.5) +dollar.neutral.portf <- add.constraint(portfolio=dollar.neutral.portf, + type="leverage_exposure", leverage=2) +# Run optimization +dollar.neutral.opt <- optimize.portfolio(R=R, portfolio=dollar.neutral.portf, + optimize_method="DEoptim", + search_size=2500) +print(dollar.neutral.opt) + +# Leveraged portfolio with max 1.6:1 leverage constraint +leveraged.portf <- init.portf +leveraged.portf <- add.constraint(portfolio=leveraged.portf, + type="weight_sum", + min_sum=0.99, max_sum=1.01) +leveraged.portf <- add.constraint(portfolio=leveraged.portf, + type="box", min=-0.3, max=0.8) +leveraged.portf <- add.constraint(portfolio=leveraged.portf, + type="leverage_exposure", leverage=1.6) + +# Run optimization +leveraged.opt <- optimize.portfolio(R=R, portfolio=leveraged.portf, + optimize_method="DEoptim", + search_size=2500) +print(leveraged.opt) + + Added: pkg/PortfolioAnalytics/demo/demo_max_STARR.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_max_STARR.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_max_STARR.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,61 @@ +# demo/max_STARR.R + +library(PortfolioAnalytics) + +# Examples of solving optimization problems to maximize mean return per unit ES + +data(edhec) +R <- edhec[, 1:8] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES", + arguments=list(p=0.925)) +print(init.portf) + +# Maximizing STARR Ratio can be formulated as a linear programming +# problem and solved very quickly using optimize_method="ROI". + +# The default action if "mean" and "StdDev" are specified as objectives with +# optimize_method="ROI" is to maximize quadratic utility. If we want to use +# both mean and ES in the objective function, but only minimize ES, we need to +# pass in maxSTARR=FALSE to optimize.portfolio. + +maxSTARR.lo.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", + trace=TRUE) +print(maxSTARR.lo.ROI) + +# Although the maximum STARR Ratio objective can be solved quickly and accurately +# with optimize_method="ROI", it is also possible to solve this optimization +# problem using other solvers such as random portfolios or DEoptim. These +# solvers have the added flexibility of using different methods to calculate +# the Sharpe Ratio (e.g. we could specify annualized measures of risk and +# return or use modified, guassian, or historical ES). + +# For random portfolios and DEoptim, the leverage constraints should be +# relaxed slightly. +init.portf$constraints[[1]]$min_sum=0.99 +init.portf$constraints[[1]]$max_sum=1.01 + +# Use random portfolios +maxSTARR.lo.RP <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(maxSTARR.lo.RP) + +chart.RiskReward(maxSTARR.lo.RP, risk.col="ES", return.col="mean") + +# Use DEoptim +maxSTARR.lo.DE <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="DEoptim", + search_size=5000, + trace=TRUE) +print(maxSTARR.lo.DE) +chart.RiskReward(maxSTARR.lo.DE, risk.col="ES", return.col="mean", + xlim=c(0.01, 0.08), ylim=c(0.004,0.008)) Added: pkg/PortfolioAnalytics/demo/demo_max_Sharpe.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_max_Sharpe.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_max_Sharpe.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,58 @@ + +library(PortfolioAnalytics) + +# Examples of solving optimization problems to maximize mean return per unit StdDev + +data(edhec) +R <- edhec[, 1:8] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") +print(init.portf) + +# Maximizing Sharpe Ratio can be formulated as a quardratic programming +# problem and solved very quickly using optimize_method="ROI". Although "StdDev" +# was specified as an objective, the quadratic programming problem uses the +# variance-covariance matrix in the objective function. + +# The default action if "mean" and "StdDev" are specified as objectives with +# optimize_method="ROI" is to maximize quadratic utility. If we want to maximize +# Sharpe Ratio, we need to pass in maxSR=TRUE to optimize.portfolio. + +maxSR.lo.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", + maxSR=TRUE, trace=TRUE) +print(maxSR.lo.ROI) + +# Although the maximum Sharpe Ratio objective can be solved quickly and accurately +# with optimize_method="ROI", it is also possible to solve this optimization +# problem using other solvers such as random portfolios or DEoptim. These +# solvers have the added flexibility of using different methods to calculate +# the Sharpe Ratio (e.g. we could specify annualized measures of risk and return). + +# For random portfolios and DEoptim, the leverage constraints should be +# relaxed slightly. +init.portf$constraints[[1]]$min_sum=0.99 +init.portf$constraints[[1]]$max_sum=1.01 + +# Use random portfolios +maxSR.lo.RP <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="random", + search_size=2000, + trace=TRUE) +print(maxSR.lo.RP) +chart.RiskReward(maxSR.lo.RP, risk.col="StdDev", return.col="mean") + +# Use DEoptim +maxSR.lo.DE <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="DEoptim", + search_size=2000, + trace=TRUE) +print(maxSR.lo.DE) +chart.RiskReward(maxSR.lo.DE, risk.col="StdDev", return.col="mean") + Added: pkg/PortfolioAnalytics/demo/demo_max_quadratic_utility.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_max_quadratic_utility.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_max_quadratic_utility.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,49 @@ + +library(PortfolioAnalytics) + +# Examples of solving optimization problems to maximize quadratic utility + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +# Here we can set the risk_aversion parameter to control how much risk +# is penalized +init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev", + risk_aversion=4) +print(init.portf) + +# Maximizing quadratic utility can be formulated as a quardratic programming +# problem and solved very quickly using optimize_method="ROI". Although "StdDev" +# was specified as an objective, the quadratic programming problem uses the +# variance-covariance matrix in the objective function. +maxQU.lo.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", trace=TRUE) +print(maxQU.lo.ROI) + +plot(maxQU.lo.ROI, risk.col="StdDev", main=expression("Long Only Max Quadratic Utility" ~ lambda ~"=0.25")) + +# A risk aversion parameter that is very small, will effectively make the term +# that penalizes risk zero and approximates the maximum return. Note that the +# risk_aversion parameter must be non-zero +init.portf$objectives[[2]]$risk_aversion <- 1e-6 + +maxQU.maxret.ROI <- optimize.portfolio(R=R, portfolio=init.portf, optimize_method="ROI", trace=TRUE) +print(maxQU.maxret.ROI) + +plot(maxQU.maxret.ROI, risk.col="StdDev", main=expression("Long Only Max Quadratic Utility" ~ lambda ~"= 1e-6")) + +# A risk aversion parameter that is very large will heavily penalize the risk +# term in the objective function and approximates the minimum variance portfolio. +init.portf$objectives[[2]]$risk_aversion <- 1e6 + +maxQU.minvol.ROI <- optimize.portfolio(R=R, portfolio=init.portf, optimize_method="ROI", trace=TRUE) +print(maxQU.minvol.ROI) + +plot(maxQU.minvol.ROI, risk.col="StdDev", main=expression("Long Only Max Quadratic Utility" ~ lambda ~"= 1e6")) + Added: pkg/PortfolioAnalytics/demo/demo_max_return.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_max_return.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_max_return.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,87 @@ + +library(PortfolioAnalytics) + +# Examples of solving optimization problems to maximize mean return + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +print(init.portf) + +# Maximizing return can be formulated as a linear programming problem and +# solved very quickly using optimize_method="ROI". We are using long_only +# constraints so it is expected that allocation is to the portfolio with the +# highest mean return. +maxret.lo.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", trace=TRUE) +print(maxret.lo.ROI) + +chart.Weights(maxret.lo.ROI, main="Long Only Maximize Return") + +# It is more practical to impose box constraints on the weights of assets. +# Update the second constraint element with box constraints +init.portf <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.3, indexnum=2) + +maxret.box.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", trace=TRUE) +print(maxret.box.ROI) + +chart.Weights(maxret.box.ROI, main="Box Maximize Return") + +# Although the maximum return objective can be solved quickly and accurately +# with optimize_method="ROI", it is also possible to solve this optimization +# problem using other solvers such as random portfolios or DEoptim. + +# For random portfolios, the leverage constraints should be relaxed slightly. +init.portf$constraints[[1]]$min_sum=0.99 +init.portf$constraints[[1]]$max_sum=1.01 + +# Add StdDev as an object with multiplier=0. The multiplier=0 argument means +# that it will not be used in the objective function, but will be calculated +# for each portfolio so that we can plot the optimal portfolio in +# mean-StdDev space. +init.portf <- add.objective(portfolio=init.portf, type="risk", + name="StdDev", multiplier=0) + +# First run the optimization with a wider bound on the box constraints that +# also allows shorting. Then use more restrictive box constraints. This is +# useful to visualize impact of the constraints on the feasible space + +# create a new portfolio called 'port1' by using init.portf and modify the +# box constraints +port1 <- add.constraint(portfolio=init.portf, type="box", + min=-0.3, max=0.8, indexnum=2) + +maxret.box1.RP <- optimize.portfolio(R=R, portfolio=port1, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(maxret.box1.RP) +ploy(maxret.box1.RP, risk.col="StdDev") + +# create a new portfolio called 'port2' by using init.portf and modify the +# box constraints +port2 <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.3, indexnum=2) + +maxret.box2.RP <- optimize.portfolio(R=R, portfolio=port2, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(maxret.box2.RP) +plot(maxret.box2.RP, risk.col="StdDev") + +# Now solve the problem with DEoptim +maxret.box.DE <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="DEoptim", + search_size=5000, + trace=TRUE) +print(maxret.box.DE) +plot(maxret.box.DE, risk.col="StdDev", return.col="mean") Added: pkg/PortfolioAnalytics/demo/demo_min_StdDev.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_min_StdDev.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_min_StdDev.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,89 @@ + +library(PortfolioAnalytics) + +# Examples of solving optimization problems to minimize portfolio standard deviation + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev") +print(init.portf) + +# Minimizing standard deviation can be formulated as a quadratic programming +# problem and solved very quickly using optimize_method="ROI". Although "StdDev" +# was specified as an objective, the quadratic programming problem uses the +# variance-covariance matrix in the objective function. +minStdDev.lo.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", + trace=TRUE) +print(minStdDev.lo.ROI) + +plot(minStdDev.lo.ROI, risk.col="StdDev", main="Long Only Minimize Portfolio StdDev") + +# It is more practical to impose box constraints on the weights of assets. +# Update the second constraint element with box constraints. +init.portf <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.3, indexnum=2) + +minStdDev.box.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", + trace=TRUE) +print(minStdDev.box.ROI) + +chart.Weights(minStdDev.box.ROI, main="Minimize StdDev with Box Constraints") + +# Although the maximum return objective can be solved quickly and accurately +# with optimize_method="ROI", it is also possible to solve this optimization +# problem using other solvers such as random portfolios or DEoptim. + +# For random portfolios, the leverage constraints should be relaxed slightly. +init.portf$constraints[[1]]$min_sum=0.99 +init.portf$constraints[[1]]$max_sum=1.01 + +# Add mean as an object with multiplier=0. The multiplier=0 argument means +# that it will not be used in the objective function, but will be calculated +# for each portfolio so that we can plot the optimal portfolio in +# mean-StdDev space. +init.portf <- add.objective(portfolio=init.portf, type="return", + name="mean", multiplier=0) + +# First run the optimization with a wider bound on the box constraints that +# also allows shorting. Then use more restrictive box constraints. This is +# useful to visualize impact of the constraints on the feasible space + +# create a new portfolio called 'port1' by using init.portf and modify the +# box constraints +port1 <- add.constraint(portfolio=init.portf, type="box", + min=-0.3, max=0.8, indexnum=2) + +minStdDev.box1.RP <- optimize.portfolio(R=R, portfolio=port1, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(minStdDev.box1.RP) +ploy(minStdDev.box1.RP, risk.col="StdDev") + +# create a new portfolio called 'port2' by using init.portf and modify the +# box constraints +port2 <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.3, indexnum=2) + +minStdDev.box2.RP <- optimize.portfolio(R=R, portfolio=port2, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(minStdDev.box2.RP) +plot(minStdDev.box2.RP, risk.col="StdDev") + +# Now solve the problem with DEoptim +minStdDev.box.DE <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="DEoptim", + search_size=5000, + trace=TRUE) +print(minStdDev.box.DE) +plot(minStdDev.box.DE, risk.col="StdDev", return.col="mean") Added: pkg/PortfolioAnalytics/demo/demo_min_expected_shortfall.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_min_expected_shortfall.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_min_expected_shortfall.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,97 @@ + +library(PortfolioAnalytics) + +# Examples of solving optimization problems to minimize expected shortfall (ES) +# The objective can also be specified as "CVaR" and "ETL". + +data(edhec) +R <- edhec[, 1:10] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="full_investment") +init.portf <- add.constraint(portfolio=init.portf, type="long_only") +# Add objective to minimize expected shortfall with a confidence level of +# 0.95. +init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES", + arguments=list(p=0.9)) +print(init.portf) + +# Minimizing expected shortfall can be formulated as a linear programming +# problem and solved very quickly using optimize_method="ROI". The linear +# programming problem is formulated to minimize sample ES. +minES.lo.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", + trace=TRUE) +print(minES.lo.ROI) + +plot(minES.lo.ROI, risk.col="ES", return.col="mean", + main="Long Only Minimize Expected Shortfall") + +# It is more practical to impose box constraints on the weights of assets. +# Update the second constraint element with box constraints. +init.portf <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.3, indexnum=2) + +minES.box.ROI <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="ROI", + trace=TRUE) +print(minES.box.ROI) + +chart.Weights(minES.box.ROI, main="Minimize ES with Box Constraints") + +# Although the minimum ES objective can be solved quickly and accurately +# with optimize_method="ROI", it is also possible to solve this optimization +# problem using other solvers such as random portfolios or DEoptim. These +# solvers have the added flexibility of using different methods to calculate +# ES (e.g. gaussian, modified, or historical). The default is to calculate +# modified ES. + +# For random portfolios and DEoptim, the leverage constraints should be +# relaxed slightly. +init.portf$constraints[[1]]$min_sum=0.99 +init.portf$constraints[[1]]$max_sum=1.01 + +# Add mean as an objective with multiplier=0. The multiplier=0 argument means +# that it will not be used in the objective function, but will be calculated +# for each portfolio so that we can plot the optimal portfolio in +# mean-ES space. +init.portf <- add.objective(portfolio=init.portf, type="return", + name="mean", multiplier=0) + +# First run the optimization with a wider bound on the box constraints that +# also allows shorting. Then use more restrictive box constraints. This is +# useful to visualize impact of the constraints on the feasible space + +# create a new portfolio called 'port1' by using init.portf and modify the +# box constraints +port1 <- add.constraint(portfolio=init.portf, type="box", + min=-0.3, max=0.8, indexnum=2) + +minES.box1.RP <- optimize.portfolio(R=R, portfolio=port1, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(minES.box1.RP) +plot(minES.box1.RP, risk.col="ES", return.col="mean") + +# create a new portfolio called 'port2' by using init.portf and modify the +# box constraints +port2 <- add.constraint(portfolio=init.portf, type="box", + min=0.05, max=0.3, indexnum=2) + +minES.box2.RP <- optimize.portfolio(R=R, portfolio=port2, + optimize_method="random", + search_size=5000, + trace=TRUE) +print(minES.box2.RP) +plot(minES.box2.RP, risk.col="ES", return.col="mean") + +# Now solve the problem with DEoptim +minES.box.DE <- optimize.portfolio(R=R, portfolio=init.portf, + optimize_method="DEoptim", + search_size=5000, + trace=TRUE) +print(minES.box.DE) +plot(minES.box.DE, risk.col="ES", return.col="mean") Added: pkg/PortfolioAnalytics/demo/demo_risk_budgets.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_risk_budgets.R (rev 0) +++ pkg/PortfolioAnalytics/demo/demo_risk_budgets.R 2013-11-08 03:06:29 UTC (rev 3246) @@ -0,0 +1,70 @@ + +library(PortfolioAnalytics) + +# Examples of solving optimization problems using risk budget objectives + +data(edhec) +R <- edhec[, 1:8] +funds <- colnames(R) + +# Construct initial portfolio +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="leverage", + min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="long_only") + +# Portfolio optimization problems with risk budget objectives must be solved +# with DEoptim, random portfolios, pso, or GenSA. + +# Risk budget objectives can be used to place limits on component contribution +# to risk or for equal risk contribution portfolios. Note that there are +# potentially many portfolios that satisfy component ES risk limits so we need +# to have a "sub" objective such as maximizing return, minimizing ES, +# minimizing StdDev, etc. + +# Add objective to maximize mean with limit on component ES risk contribution +# The max_prisk controls the maximum percentage contribution to risk +rbES.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +rbES.portf <- add.objective(portfolio=rbES.portf, type="risk_budget", name="ES", + max_prisk=0.4, arguments=list(p=0.92)) + +# Use DEoptim for optimization +rbES.DE <- optimize.portfolio(R=R, portfolio=rbES.portf, + optimize_method="DEoptim", + search_size=5000, trace=TRUE) +print(rbES.DE) +plot(rbES.DE, xlim=c(0, 0.08), ylim=c(0, 0.01)) +chart.RiskBudget(rbES.DE, risk.type="pct_contrib") + +# Add objective to maximize mean return with equal ES risk contribution +eqES.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +eqES.portf <- add.objective(portfolio=eqES.portf, type="risk_budget", + name="ES", min_concentration=TRUE, arguments=list(p=0.9)) + +# Use random portfolios for optimization +# Use cleaned returns +R.clean <- Return.clean(R=R, method="boudt") +eqES.RP <- optimize.portfolio(R=R.clean, portfolio=eqES.portf, + optimize_method="random", + search_size=2500, trace=TRUE) + +print(eqES.RP) +plot(eqES.RP) +chart.RiskBudget(eqES.RP, risk.type="pct_contrib") + +# Add objective to maximize mean return with limits on StdDev risk contribution +rbStdDev.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +rbStdDev.portf <- add.objective(portfolio=rbStdDev.portf, type="risk_budget", + name="StdDev", max_prisk=0.25) + +# Use DEoptim for optimization +rbStdDev.DE <- optimize.portfolio(R=R, portfolio=rbStdDev.portf, + optimize_method="DEoptim", + search_size=5000, trace=TRUE) + +print(eqES.RP) +plot(eqES.RP) +chart.RiskBudget(eqES.RP, risk.type="pct_contrib") + + + From noreply at r-forge.r-project.org Fri Nov 8 07:38:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 8 Nov 2013 07:38:10 +0100 (CET) Subject: [Returnanalytics-commits] r3247 - pkg/PortfolioAnalytics/R Message-ID: <20131108063810.BE55F186494@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-08 07:38:10 +0100 (Fri, 08 Nov 2013) New Revision: 3247 Modified: pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Adding option for specifying estimated covariance matrix or estimated mean returns for ROI solvers. Modifying optFUN functions to calculate objective measures instead of calling constrained_objective so that the estimates can be used. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-11-08 03:06:29 UTC (rev 3246) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-11-08 06:38:10 UTC (rev 3247) @@ -129,6 +129,23 @@ out <- list() out$weights <- weights out$out <- result$value + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # and moments$var that might be passed in by the user. This will avoid + # the extra call to constrained_objective + if(!all(moments$mean == 0)){ + port.mean <- as.numeric(sum(weights * moments$mean)) + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights)) + names(port.sd) <- "StdDev" + obj_vals[["StdDev"]] <- port.sd + } else { + port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights)) + names(port.sd) <- "StdDev" + obj_vals[["StdDev"]] <- port.sd + } + out$obj_vals <- obj_vals # out$out <- result$objval # ROI # out$call <- call # need to get the call outside of the function return(out) @@ -222,6 +239,14 @@ out <- list() out$weights <- weights out$out <- roi.result$objval + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # that might be passed in by the user. This will avoid + # the extra call to constrained_objective + port.mean <- -roi.result$objval + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + out$obj_vals <- obj_vals # out$call <- call # need to get the call outside of the function return(out) } @@ -334,7 +359,16 @@ out <- list() out$weights <- weights - out$out <- result$objval + out$out <- result$optimum + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # that might be passed in by the user. This will avoid + # the extra call to constrained_objective + + port.mean <- -result$optimum + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + out$obj_vals <- obj_vals return(out) } @@ -410,6 +444,25 @@ out <- list() out$weights <- weights out$out <- roi.result$objval + es_names <- c("ES", "ETL", "CVaR") + es_idx <- which(es_names %in% names(moments)) + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # and moments$var that might be passed in by the user. This will avoid + # the extra call to constrained_objective + if(!all(moments$mean == 0)){ + port.mean <- as.numeric(sum(weights * moments$mean)) + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + port.es <- roi.result$objval + names(port.es) <- es_names[es_idx] + obj_vals[[es_names[es_idx]]] <- port.es + } else { + port.es <- roi.result$objval + names(port.es) <- es_names[es_idx] + obj_vals[[es_names[es_idx]]] <- port.es + } + out$obj_vals <- obj_vals #out$call <- call # add this outside of here, this function doesn't have the call return(out) } @@ -540,6 +593,25 @@ out <- list() out$weights <- weights out$out <- result$optimum + es_names <- c("ES", "ETL", "CVaR") + es_idx <- which(es_names %in% names(moments)) + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # and moments$var that might be passed in by the user. This will avoid + # the extra call to constrained_objective + if(!all(moments$mean == 0)){ + port.mean <- as.numeric(sum(weights * moments$mean)) + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + port.es <- result$optimum + names(port.es) <- es_names[es_idx] + obj_vals[[es_names[es_idx]]] <- port.es + } else { + port.es <- result$optimum + names(port.es) <- es_names[es_idx] + obj_vals[[es_names[es_idx]]] <- port.es + } + out$obj_vals <- obj_vals #out$call <- call # add this outside of here, this function doesn't have the call return(out) } @@ -680,7 +752,24 @@ names(weights) <- colnames(R) out <- list() out$weights <- weights - out$out <- qp.result$val + out$out <- qp.result$value + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # and moments$var that might be passed in by the user. This will avoid + # the extra call to constrained_objective + if(!all(moments$mean == 0)){ + port.mean <- as.numeric(sum(weights * moments$mean)) + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights)) + names(port.sd) <- "StdDev" + obj_vals[["StdDev"]] <- port.sd + } else { + port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights)) + names(port.sd) <- "StdDev" + obj_vals[["StdDev"]] <- port.sd + } + out$obj_vals <- obj_vals return(out) # TODO @@ -803,7 +892,24 @@ names(weights) <- colnames(R) out <- list() out$weights <- weights - out$out <- qp.result$val + out$out <- qp.result$value + obj_vals <- list() + # Calculate the objective values here so that we can use the moments$mean + # and moments$var that might be passed in by the user. This will avoid + # the extra call to constrained_objective + if(!all(moments$mean == 0)){ + port.mean <- as.numeric(sum(weights * moments$mean)) + names(port.mean) <- "mean" + obj_vals[["mean"]] <- port.mean + port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights)) + names(port.sd) <- "StdDev" + obj_vals[["StdDev"]] <- port.sd + } else { + port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights)) + names(port.sd) <- "StdDev" + obj_vals[["StdDev"]] <- port.sd + } + out$obj_vals <- obj_vals return(out) # TODO Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-08 03:06:29 UTC (rev 3246) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-08 06:38:10 UTC (rev 3247) @@ -765,9 +765,19 @@ # 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(Return.clean(R=R, method=clean), 2, "mean", na.rm=TRUE)), silent=TRUE) + if(!is.null(objective$estimate)){ + print("User has specified an estimated mean returns vector") + moments[["mean"]] <- as.vector(objective$estimate) + } else { + moments[["mean"]] <- try(as.vector(apply(Return.clean(R=R, method=clean), 2, "mean", na.rm=TRUE)), silent=TRUE) + } } else if(objective$name %in% c("StdDev", "sd", "var")){ - moments[["var"]] <- try(var(x=Return.clean(R=R, method=clean), na.rm=TRUE), silent=TRUE) + if(!is.null(objective$estimate)){ + print("User has specified an estimated covariance matrix") + moments[["var"]] <- objective$estimate + } else { + moments[["var"]] <- try(var(x=Return.clean(R=R, method=clean), na.rm=TRUE), silent=TRUE) + } } else { moments[[objective$name]] <- try(eval(as.symbol(objective$name))(Return.clean(R=R, method=clean)), silent=TRUE) } @@ -791,13 +801,15 @@ if(!is.null(constraints$turnover_target) & is.null(constraints$ptc)){ qp_result <- gmv_opt_toc(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, init_weights=portfolio$assets) weights <- qp_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + obj_vals <- qp_result$obj_vals out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=qp_result$out, call=call) } if(!is.null(constraints$ptc) & is.null(constraints$turnover_target)){ qp_result <- gmv_opt_ptc(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, init_weights=portfolio$assets) weights <- qp_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + obj_vals <- qp_result$obj_vals out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=qp_result$out, call=call) } } else { @@ -805,11 +817,20 @@ if(hasArg(maxSR)) maxSR=match.call(expand.dots=TRUE)$maxSR else maxSR=FALSE if(maxSR){ target <- max_sr_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + # need to set moments$mean=0 here because quadratic utility and target return is sensitive to returning no solution + tmp_moments_mean <- moments$mean moments$mean <- rep(0, length(moments$mean)) } roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups) weights <- roi_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + obj_vals <- roi_result$obj_vals + if(maxSR){ + # need to recalculate mean here if we are maximizing sharpe ratio + port.mean <- as.numeric(sum(weights * tmp_moments_mean)) + names(port.mean) <- "mean" + obj_vals$mean <- port.mean + } out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call) } } @@ -819,13 +840,15 @@ # This is an MILP problem if max_pos is specified as a constraint roi_result <- maxret_milp_opt(R=R, constraints=constraints, moments=moments, target=target) weights <- roi_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + obj_vals <- roi_result$obj_vals out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call) } else { # Maximize return LP problem roi_result <- maxret_opt(R=R, constraints=constraints, moments=moments, target=target) weights <- roi_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + obj_vals <- roi_result$obj_vals out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call) } } @@ -846,6 +869,7 @@ roi_result <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) weights <- roi_result$weights # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- roi_result$obj_vals # calculate obj_vals based on solver output obj_vals <- list() if(meanetl) obj_vals$mean <- as.numeric(t(weights) %*% moments$mean) @@ -856,7 +880,7 @@ roi_result <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) weights <- roi_result$weights # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures - # calculate obj_vals based on solver output + # obj_vals <- roi_result$obj_vals obj_vals <- list() if(meanetl) obj_vals$mean <- as.numeric(t(weights) %*% moments$mean) obj_vals[[tmpnames[idx]]] <- roi_result$out From noreply at r-forge.r-project.org Fri Nov 8 16:08:47 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 8 Nov 2013 16:08:47 +0100 (CET) Subject: [Returnanalytics-commits] r3248 - pkg/PortfolioAnalytics/sandbox Message-ID: <20131108150847.7FBB1186032@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-08 16:08:47 +0100 (Fri, 08 Nov 2013) New Revision: 3248 Added: pkg/PortfolioAnalytics/sandbox/leverage_example.R Log: Examples demonstrating the differences of specifying a leverage constraint using max_sum compared to leverage_exposure. Added: pkg/PortfolioAnalytics/sandbox/leverage_example.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/leverage_example.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/leverage_example.R 2013-11-08 15:08:47 UTC (rev 3248) @@ -0,0 +1,77 @@ + +# Examples demonstrating the difference of specifying a leverage constraint +# using max_sum compared to leverage_exposure. + +library(PortfolioAnalytics) + +data(edhec) +R <- edhec +funds <- colnames(R) + +# Set up an initial portfolio object with basic constraints +init.portf <- portfolio.spec(assets=funds) + +# Add an objective to maximize mean return per unit expected shortfall +init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") + +# dollar neutral portfolio +dollar.neutral.portf <- init.portf +dollar.neutral.portf <- add.constraint(portfolio=dollar.neutral.portf, + type="weight_sum", + min_sum=-0.01, max_sum=0.01) +dollar.neutral.portf <- add.constraint(portfolio=dollar.neutral.portf, + type="box", min=-0.5, max=0.5) + +# Here is a dollar neutral portfolio with no constraint on leverage +opt1 <- optimize.portfolio(R=R, portfolio=dollar.neutral.portf, + optimize_method="DEoptim", search_size=2000, + trace=TRUE) +sum(opt1$weights) + +# Total portfolio leverage is actually greater than 4 +sum(abs(opt1$weights)) + +# now add the leverage exposure constraint for 2:1 leverage +dollar.neutral.portf <- add.constraint(portfolio=dollar.neutral.portf, + type="leverage_exposure", leverage=2) +# Run optimization +opt2 <- optimize.portfolio(R=R, portfolio=dollar.neutral.portf, + optimize_method="DEoptim", + search_size=2000) +sum(opt2$weights) +sum(abs(opt2$weights)) + +# Leveraged portfolio +leveraged.portf <- init.portf + +# Add a "leverage" constraint using max_sum +leveraged.portf <- add.constraint(portfolio=leveraged.portf, + type="leverage", + min_sum=1.29, max_sum=1.31) +leveraged.portf <- add.constraint(portfolio=leveraged.portf, + type="box", min=-0.3, max=0.6) + +opt3 <- optimize.portfolio(R=R, portfolio=leveraged.portf, + optimize_method="DEoptim", + search_size=2000) +sum(opt3$weights) + +# total portfolio leverage is approximately 3.9 +sum(abs(opt3$weights)) + +# add a leverage exposure constraint +leveraged.portf <- add.constraint(portfolio=leveraged.portf, + type="leverage_exposure", leverage=1.5) + +# change min_sum and max_sum such that the weights sum to 1 +leveraged.portf$constraints[[1]]$min_sum <- 0.99 +leveraged.portf$constraints[[1]]$max_sum <- 1.01 + +# Run optimization +opt4 <- optimize.portfolio(R=R, portfolio=leveraged.portf, + optimize_method="DEoptim", + search_size=2000) +sum(opt4$weights) +# total portfolio leverage is less than 1.5 +sum(abs(opt4$weights)) + From noreply at r-forge.r-project.org Mon Nov 11 00:12:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 11 Nov 2013 00:12:54 +0100 (CET) Subject: [Returnanalytics-commits] r3249 - pkg/PortfolioAnalytics/sandbox/symposium2013 Message-ID: <20131110231254.570A6185FA4@r-forge.r-project.org> Author: peter_carl Date: 2013-11-11 00:12:52 +0100 (Mon, 11 Nov 2013) New Revision: 3249 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R Log: - code cleanup for final slides Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-11-08 15:08:47 UTC (rev 3248) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-11-10 23:12:52 UTC (rev 3249) @@ -481,6 +481,7 @@ # Calculate the objective measures for the vol weight portfolio VolWgt.opt <- volatility.weight(R=R, portfolio=VolWgt.portf) + # REMOVED # ### Evaluate Constrained Concentration to mETL Portfolio - with DE # # registerDoSEQ() # turn off parallelization to keep the trace data @@ -578,11 +579,19 @@ EqWgt.R=Return.rebalancing(R, EqWgt.w) chart.StackedBar(EqWgt.w, colorset=wb13color, gap=0) +VolWgt.w = NULL +for(i in 3:length(dates)){ + x = volatility.weight(R=R[paste0("::",dates[i]),], portfolio=VolWgt.portf) + VolWgt.w = rbind(VolWgt.w, x$weights) +} +VolWgt.w = as.xts(VolWgt.w, order.by=dates[-1:-2]) +VolWgt.R=Return.rebalancing(R, VolWgt.w) + # Equal SD MRCSD.DE.t = optimize.portfolio.rebalancing(R=R, portfolio=MRCSD.portf, optimize_method='DEoptim', - search_size=20000, + search_size=2000, NP=200, initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space trace=FALSE, Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-11-08 15:08:47 UTC (rev 3248) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-11-10 23:12:52 UTC (rev 3249) @@ -192,140 +192,9 @@ dev.off() # -------------------------------------------------------------------- -# Plot efficient frontier of mean-sd? -# -------------------------------------------------------------------- - - -# -------------------------------------------------------------------- -# Plot efficient frontier of mean-mETL? -# -------------------------------------------------------------------- - - -# -------------------------------------------------------------------- -# Plot efficient frontier of Equal Risk -# -------------------------------------------------------------------- - - -# -------------------------------------------------------------------- -# Plot Ex Post scatter of buoy portfolios? -# -------------------------------------------------------------------- -# No. -# -# # Calculate ex post results -# xpost.ret=Return.cumulative(BHportfs["2008-07::2008-09"]) -# xpost.sd=StdDev(BHportfs["2008-07::2008-09"])*sqrt(3) -# xante.ret=xtract[,"pamean.pamean"]/3 -# xante.sd=xtract[,"pasd.pasd"]/sqrt(3) -# -# xpost.obj=NA -# for(i in 1:NROW(RND.weights)){ -# x = Return.portfolio(R=edhec.R["2008-07::2008-09"], weights=RND.weights[i,]) -# y=c(Return.cumulative(x), StdDev(x)*sqrt(3)) -# if(is.na(xpost.obj)) -# xpost.obj=y -# else -# xpost.obj=rbind(xpost.obj,y) -# } -# rownames(xpost.obj)=rownames(RND.weights) -# colnames(xpost.obj)=c("Realized Returns","Realized SD") -# xmin=min(c(xpost.sd,xante.sd)) -# xmax=max(c(xpost.sd,xante.sd)) -# ymin=min(c(xpost.ret,xante.ret)) -# ymax=max(c(xpost.ret,xante.ret)) -# -# CairoPDF(file=paste(resultsdir, dataname, "-Scatter-ExPost-2008-06-30.png", units="in", height=5.5, width=9, res=96) -# par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) -# plot(xpost.sd,xpost.ret, xlab="StdDev", ylab="Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=c(xmin,xmax), ylim=c(ymin,ymax)) -# grid(col = "darkgray") -# points(xpost.obj[,2],xpost.obj[,1], col=tol7qualitative, pch=16, cex=1.5) -# points(xante.sd,xante.ret, col="lightgray", cex=.7) -# points(unlist(RND.objectives[,2])/sqrt(3),unlist(RND.objectives[,1])/3, col=tol7qualitative, pch=16, cex=1.5) -# abline(h = 0, col = "darkgray") -# axis(1, cex.axis = 0.7, col = "darkgray") -# axis(2, cex.axis = 0.7, col = "darkgray") -# box(col = "darkgray") -# legend("topright",legend=rownames(RND.weights), col=tol7qualitative, pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, inset=.02) -# dev.off() - - - -# -------------------------------------------------------------------- -# Ex Post Results Through Time? -# -------------------------------------------------------------------- -# @TODO: revise for this result set -buoys.R=cbind(EqWgt,MeanSD, MeanmETL,MinSD,MinmETL,MRCSD,EqmETL) -CairoPDF(file=paste(resultsdir, dataname, "-Buoy-Cumulative-Returns.png", units="in", height=5.5, width=9, res=96) -op <- par(no.readonly = TRUE) -layout(matrix(c(1, 2)), height = c(2, 1.3), width = 1) -par(mar = c(1, 5, 1, 2)) # c(bottom, left, top, right) -chart.CumReturns(buoys.R["2000::",], main = "", xaxis = FALSE, legend.loc = "topleft", ylab = "Cumulative Return", colorset= tol7qualitative, ylog=TRUE, wealth.index=TRUE, cex.legend=.7, cex.axis=.6, cex.lab=.7) -par(mar = c(4, 5, 0, 2)) -chart.Drawdown(buoys.R["2000::",], main = "", ylab = "Drawdown", colorset = tol7qualitative, cex.axis=.6, cex.lab=.7) -par(op) -dev.off() - - -### APPENDIX SLIDES: - -# -------------------------------------------------------------------- -# Show turnover of the RP portfolios relative to the EqWgt portfolio -# -------------------------------------------------------------------- -turnover = function(w1,w2) {sum(abs(w1-w2))/length(w1)} -# Calculate the turnover matrix for the random portfolio set: -to.matrix<-matrix(nrow=NROW(rp),ncol=NROW(rp)) -for(x in 1:NROW(rp)){ - for(y in 1:NROW(rp)) { - to.matrix[x,y]<-turnover(rp[x,],rp[y,]) - } -} - -CairoPDF(file=paste(resultsdir, dataname, "-Turnover-2008-06-30.pdf", sep=""), height=5.5, width=9) -# postscript(file="TurnoverOf20101231.eps", height=5.5, width=5, paper="special", horizontal=FALSE, onefile=FALSE) -op <- par(no.readonly=TRUE) -layout(matrix(c(1,2)),height=c(4,1.25),width=1) -par(mar=c(5,4,1,2)+.1, cex=1) # c(bottom, left, top, right) -seq.col = heat.colors(11) -## Draw the Scatter chart of combined results -### Get the random portfolios from one of the result sets -x=apply(rp, MARGIN=1,FUN=turnover,w2=rp[1,]) -plot(xtract[,"pasd.pasd"],xtract[,"pamean.pamean"], xlab="Predicted StdDev", ylab="Predicted Mean", col=seq.col[ceiling(x*100)], axes=FALSE, main="", cex=.6, pch=16) -grid(col = "darkgray") -points(RND.objectives[1,2],RND.objectives[1,1], col="blue", pch=19, cex=1.5) -axis(1, cex.axis = 0.7, col = "darkgray") -axis(2, cex.axis = 0.7, col = "darkgray") -box(col = "darkgray") - -# Add legend to bottom panel -par(mar=c(5,5.5,1,3)+.1, cex=0.7) -## Create a histogramed legend for sequential colorsets -## this next bit of code is based on heatmap.2 in gplots package -x=ceiling(x*100) -scale01 <- function(x, low = min(x), high = max(x)) { - return((x - low)/(high - low)) -} -breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(seq.col)+1) -min.raw <- min(x, na.rm = TRUE) -max.raw <- max(x, na.rm = TRUE) -z <- seq(min.raw, max.raw, length = length(seq.col)) -image(z = matrix(z, ncol = 1), col = seq.col, breaks = breaks, xaxt = "n", yaxt = "n") -par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly -lv <- pretty(breaks) -xv <- scale01(as.numeric(lv), min.raw, max.raw) -axis(1, at = xv, labels=sprintf("%s%%", pretty(lv))) -h <- hist(x, plot = FALSE, breaks=breaks) -hx <- scale01(breaks, min(x), max(x)) -hy <- c(h$counts, h$counts[length(h$counts)]) -lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = "blue") -axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy)) -title(ylab="Count") -title(xlab="Degree of Turnover from Equal Weight Portfolio") -par(op) -dev.off() - -# -------------------------------------------------------------------- # Show CONCENTRATION of the RP portfolios # -------------------------------------------------------------------- -# Basically the same chart as above but use HHI instead of turnover calc +# Use HHI CairoPDF(file=paste(resultsdir, dataname, "-ConcPercESContrib.pdf", sep=""), height=5.5, width=9) WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1]) @@ -523,19 +392,105 @@ par(op) dev.off() + +### APPENDIX SLIDES: + # -------------------------------------------------------------------- -# Show weights through time for EqmETL portfolio +# Show weights through time for MRC SD portfolio # -------------------------------------------------------------------- -EqmETL.w = extractWeights(EqmETL.DE.t) -chart.UnStackedBar(EqmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=2) +print(load("results/MRCSD.DE.t-2013-10-17-historical.moments.rda")) +MRCSD.w = extractWeights(MRCSD.DE.t) +CairoPDF(file=paste(resultsdir, dataname, "-weights-SD.pdf", sep=""), height=5.5, width=9) +chart.UnStackedBar(MRCSD.w, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8) +dev.off() # -------------------------------------------------------------------- +# Show percent contribution of MRC SD through time +# -------------------------------------------------------------------- +# Extract perc contrib of mES from results object +x=NULL +for(i in 1:length(names(MRCSD.DE.t))) { + x = rbind(x,MRCSD.DE.t[[i]][["objective_measures"]]$StdDev$pct_contrib_StdDev) +} +x.xts = as.xts(x, order.by=as.POSIXct(names(MRCSD.DE.t))) + colnames(x.xts)=names(MRCmETL.DE.t[[1]][["objective_measures"]]$StdDev$pct_contrib_StdDev) +CairoPDF(file=paste(resultsdir, dataname, "-contribution-SD.pdf", sep=""), height=5.5, width=9) +chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8) +dev.off() + +# -------------------------------------------------------------------- +# Show weights through time for MRC mETL portfolio +# -------------------------------------------------------------------- +print(load("results/MRCmETL.DE.t-2013-10-18-historical.moments.rda")) +MRCmETL.w = extractWeights(MRCmETL.DE.t) +CairoPDF(file=paste(resultsdir, dataname, "-weights-mETL.pdf", sep=""), height=5.5, width=9) +chart.UnStackedBar(MRCmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8) +dev.off() + +# -------------------------------------------------------------------- # Show percent contribution of mETL through time # -------------------------------------------------------------------- # Extract perc contrib of mES from results object x=NULL -for(i in 1:length(names(EqmETL.RND.t))) { - x = rbind(x,EqmETL.RND.t[[i]][["objective_measures"]]$ES$pct_contrib_MES) +for(i in 1:length(names(MRCmETL.DE.t))) { + x = rbind(x,MRCmETL.DE.t[[i]][["objective_measures"]]$ES$pct_contrib_MES) } -x.xts = as.xts(x, order.by=as.POSIXct(names(EqmETL.RND.t))) -chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=2) +x.xts = as.xts(x, order.by=as.POSIXct(names(MRCmETL.DE.t))) +colnames(x.xts)=names(MRCmETL.DE.t[[1]][["objective_measures"]]$ES$pct_contrib_MES) +CairoPDF(file=paste(resultsdir, dataname, "-contribution-mETL.pdf", sep=""), height=5.5, width=9) +chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=3, cex.axis=0.7, cex.names=0.8) +dev.off() + +# -------------------------------------------------------------------- +# Show out-of-sample performance of buoy portfolios +# -------------------------------------------------------------------- + EqWgt.opt$weights +dates=index(R[endpoints(R, on="years")]) +EqWgt.w = xts(matrix(rep(1/NCOL(R),length(dates)*NCOL(R)), ncol=NCOL(R)), order.by=dates) +EqWgt.R = Return.rebalancing(R, EqWgt.w) +MRCSD.R = Return.rebalancing(R, MRCSD.w) +MRCmETL.R = Return.rebalancing(R, MRCmETL.w) +x.R = cbind(EqWgt.R, VolWgt.R, MRCSD.R, MRCmETL.R) +colnames(x.R)=c("Eq Wgt", "Vol Wgt", "MRC SD", "MRC mETL") +CairoPDF(file=paste(resultsdir, dataname, "-OOS-relative-performance.pdf", sep=""), height=5.5, width=9) +chart.RelativePerformance(x.R["2000::",2:4], x.R["2000::",1], colorset=wb13color[c(8,7,11)], lwd=3, legend.loc="bottomleft", main="Performance Relative to Equal Weight") +dev.off() + +table.RiskStats(x.R["2000::"], p=1-1/12) + +R.boudt=Return.clean(R, method="boudt") +# -------------------------------------------------------------------- +# From Inception Mean of constituents +# -------------------------------------------------------------------- +x.mean=apply.fromstart(R,FUN="mean") +x.mean=as.xts(x.mean) +CairoPDF(file=paste(resultsdir, dataname, "-from-inception-mean.pdf", sep=""), height=5.5, width=9) +chart.TimeSeries(x.mean["2000-01::",],legend.loc="topright", colorset=wb13color, pch="", lwd=3, main="From-Inception Mean") +dev.off() + +# -------------------------------------------------------------------- +# From Inception Volatility of constituents +# -------------------------------------------------------------------- +x.vol=apply.fromstart(R,FUN="StdDev") +x.vol=as.xts(x.vol) +CairoPDF(file=paste(resultsdir, dataname, "-from-inception-vol.pdf", sep=""), height=5.5, width=9) +chart.TimeSeries(x.vol["2000-01::",],legend.loc="bottomleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Volatility") +dev.off() + +# -------------------------------------------------------------------- +# From Inception Skewness of constituents +# -------------------------------------------------------------------- +x.skew=apply.fromstart(R,FUN="skewness") +x.skew=as.xts(x.skew) +CairoPDF(file=paste(resultsdir, dataname, "-from-inception-skew.pdf", sep=""), height=5.5, width=9) +chart.TimeSeries(x.skew["2000-01::",],legend.loc="bottomleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Skewness") +dev.off() + +# -------------------------------------------------------------------- +# From Inception Kurtosis of constituents +# -------------------------------------------------------------------- +x.kurt=apply.fromstart(R,FUN="kurtosis") +x.kurt=as.xts(x.kurt) +CairoPDF(file=paste(resultsdir, dataname, "-from-inception-kurt.pdf", sep=""), height=5.5, width=9) +chart.TimeSeries(x.kurt["2000-01::",],legend.loc="topleft", colorset=wb13color, pch="", lwd=3, main="From-Inception Kurtosis") +dev.off() \ No newline at end of file From noreply at r-forge.r-project.org Wed Nov 13 20:06:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Nov 2013 20:06:04 +0100 (CET) Subject: [Returnanalytics-commits] r3250 - pkg/PortfolioAnalytics/R Message-ID: <20131113190605.02DA9185AC4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-13 20:06:02 +0100 (Wed, 13 Nov 2013) New Revision: 3250 Modified: pkg/PortfolioAnalytics/R/random_portfolios.R Log: Modifying the rp sample method to only subset once per loop and use the more efficient sample.int Modified: pkg/PortfolioAnalytics/R/random_portfolios.R =================================================================== --- pkg/PortfolioAnalytics/R/random_portfolios.R 2013-11-10 23:12:52 UTC (rev 3249) +++ pkg/PortfolioAnalytics/R/random_portfolios.R 2013-11-13 19:06:02 UTC (rev 3250) @@ -271,14 +271,15 @@ # 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) - { + tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])] + n_tmp_seq <- length(tmp_seq) + if(n_tmp_seq > 1){ # randomly sample one of the larger weights - tportfolio[cur_index] <- sample(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])], 1) + tportfolio[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)] # 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])] + if(n_tmp_seq == 1){ + tportfolio[cur_index] <- tmp_seq } } i <- i + 1 # increment our counter @@ -287,12 +288,14 @@ # 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) { + tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index])] + n_tmp_seq <- length(tmp_seq) + if(n_tmp_seq > 1) { # randomly sample one of the smaller weights - tportfolio[cur_index] <- sample(weight_seq[(weight_seq <= cur_val) & (weight_seq >= min[cur_index] )], 1) + tportfolio[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)] } 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])] + if(n_tmp_seq == 1){ + tportfolio[cur_index] <- tmp_seq } } i <- i + 1 # increment our counter @@ -427,16 +430,13 @@ 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 + for(i in 3:permutations) { + #result[i,] <- as.matrix(randomize_portfolio_v2(portfolio=portfolio, ...)) + result[i,] <- randomize_portfolio_v2(portfolio=portfolio, ...) } + result <- unique(result) + # i <- nrow(result) + # result <- rbind(result, matrix(nrow=(permutations-i), ncol=length(seed))) colnames(result) <- names(seed) return(result) } From noreply at r-forge.r-project.org Wed Nov 13 20:37:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Nov 2013 20:37:54 +0100 (CET) Subject: [Returnanalytics-commits] r3251 - pkg/PortfolioAnalytics/R Message-ID: <20131113193754.E2C4E185AC4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-13 20:37:54 +0100 (Wed, 13 Nov 2013) New Revision: 3251 Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R Log: Modified rp_transform in inner while loops to only subset once per loop and use sample.int Modified: pkg/PortfolioAnalytics/R/constraint_fn_map.R =================================================================== --- pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-11-13 19:06:02 UTC (rev 3250) +++ pkg/PortfolioAnalytics/R/constraint_fn_map.R 2013-11-13 19:37:54 UTC (rev 3251) @@ -404,13 +404,17 @@ # 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) { + tmp_seq <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])] + n_tmp_seq <- length(tmp_seq) + if (n_tmp_seq > 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) + # tmp_w[cur_index] <- sample(weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])], 1) + tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)] # 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])] + if (n_tmp_seq == 1) { + # tmp_w[cur_index] <- weight_seq[(weight_seq >= cur_val) & (weight_seq <= max[cur_index])] + tmp_w[cur_index] <- tmp_seq } } i=i+1 # increment our counter @@ -423,12 +427,16 @@ # randomly permute and decrease 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 >= tmp_min[cur_index])] ) > 1) { + tmp_seq <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] + n_tmp_seq <- length(tmp_seq) + if (n_tmp_seq > 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) + # tmp_w[cur_index] <- sample(weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] , 1) + tmp_w[cur_index] <- tmp_seq[sample.int(n=n_tmp_seq, size=1L, replace=FALSE, prob=NULL)] } else { - 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])] + if (n_tmp_seq == 1) { + # tmp_w[cur_index] <- weight_seq[(weight_seq <= cur_val) & (weight_seq >= tmp_min[cur_index])] + tmp_w[cur_index] <- tmp_seq } } i=i+1 # increment our counter From noreply at r-forge.r-project.org Thu Nov 14 19:51:44 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 19:51:44 +0100 (CET) Subject: [Returnanalytics-commits] r3252 - pkg/PerformanceAnalytics Message-ID: <20131114185144.EB3C31851DC@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 19:51:44 +0100 (Thu, 14 Nov 2013) New Revision: 3252 Modified: pkg/PerformanceAnalytics/NAMESPACE Log: - added CAPM.dynamic Modified: pkg/PerformanceAnalytics/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/NAMESPACE 2013-11-13 19:37:54 UTC (rev 3251) +++ pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 18:51:44 UTC (rev 3252) @@ -29,6 +29,7 @@ CAPM.beta.bull, CAPM.CML, CAPM.CML.slope, + CAPM.dynamic, CAPM.epsilon, CAPM.jensenAlpha, CAPM.RiskPremium, From noreply at r-forge.r-project.org Thu Nov 14 20:01:27 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:01:27 +0100 (CET) Subject: [Returnanalytics-commits] r3253 - pkg/PerformanceAnalytics Message-ID: <20131114190127.6B5661851DC@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:01:26 +0100 (Thu, 14 Nov 2013) New Revision: 3253 Modified: pkg/PerformanceAnalytics/NAMESPACE Log: - added MarketTiming function Modified: pkg/PerformanceAnalytics/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 18:51:44 UTC (rev 3252) +++ pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 19:01:26 UTC (rev 3253) @@ -61,6 +61,7 @@ kurtosis, M2Sortino, maxDrawdown, + MarketTiming, MartinRatio, MeanAbsoluteDeviation, mean.geometric, From noreply at r-forge.r-project.org Thu Nov 14 20:02:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:02:33 +0100 (CET) Subject: [Returnanalytics-commits] r3254 - in pkg/PerformanceAnalytics: . sandbox/Shubhankit/noniid.sm/man Message-ID: <20131114190233.7A944185C65@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:02:32 +0100 (Thu, 14 Nov 2013) New Revision: 3254 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/man/AcarSim.Rd Modified: pkg/PerformanceAnalytics/NAMESPACE Log: - added Modigliani function Modified: pkg/PerformanceAnalytics/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 19:01:26 UTC (rev 3253) +++ pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 19:02:32 UTC (rev 3254) @@ -68,6 +68,7 @@ mean.LCL, mean.stderr, mean.UCL, + Modigliani, MSquared, MSquaredExcess, NetSelectivity, Copied: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/man/AcarSim.Rd (from rev 3012, pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/man/AcarSim.Rd) =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/man/AcarSim.Rd (rev 0) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/man/AcarSim.Rd 2013-11-14 19:02:32 UTC (rev 3254) @@ -0,0 +1,52 @@ +\name{AcarSim} +\alias{AcarSim} +\title{Acar-Shane Maximum Loss Plot} +\usage{ + AcarSim(R, nsim = 1) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{nsim}{number of simulations input} +} +\description{ + 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 \emph{two to two} by step of + \emph{0.1} . The process has been repeated \bold{six + thousand times}. +} +\details{ + Unfortunately, there is no \bold{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 can be interpreted as the only function of the + ratio mean divided by volatility. \deqn{MD/[\sigma]= Min + (\sum[X(j)])/\sigma = F(\mu/\sigma)} Where j varies from + 1 to n ,which is the number of drawdown's in simulation +} +\examples{ +library(PerformanceAnalytics) +#AcarSim(R) +} +\author{ + Shubhankit Mohan +} +\references{ + Maximum Loss and Maximum Drawdown in Financial + Markets,\emph{International Conference Sponsored by BNP + and Imperial College on: Forecasting Financial Markets, + London, United Kingdom, May 1997} + \url{http://www.intelligenthedgefundinvesting.com/pubs/easj.pdf} +} +\keyword{Drawdown} +\keyword{Loss} +\keyword{Maximum} +\keyword{Simulated} + From noreply at r-forge.r-project.org Thu Nov 14 20:05:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:05:26 +0100 (CET) Subject: [Returnanalytics-commits] r3255 - pkg/PerformanceAnalytics Message-ID: <20131114190526.BD835186637@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:05:26 +0100 (Thu, 14 Nov 2013) New Revision: 3255 Modified: pkg/PerformanceAnalytics/NAMESPACE Log: - added Return.annualized.excess Modified: pkg/PerformanceAnalytics/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 19:02:32 UTC (rev 3254) +++ pkg/PerformanceAnalytics/NAMESPACE 2013-11-14 19:05:26 UTC (rev 3255) @@ -80,6 +80,7 @@ PainRatio, ProspectRatio, Return.annualized, + Return.annualized.excess, Return.calculate, Return.centered, Return.clean, From noreply at r-forge.r-project.org Thu Nov 14 20:08:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:08:37 +0100 (CET) Subject: [Returnanalytics-commits] r3256 - in pkg/PortfolioAnalytics: . R Message-ID: <20131114190838.06CB9186326@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-14 20:08:37 +0100 (Thu, 14 Nov 2013) New Revision: 3256 Added: pkg/PortfolioAnalytics/R/utils.R Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/R/constrained_objective.R Log: Adding modify.args function from quantstrat and using it in constrained_objective to match the arguments for setting the portfolio moments Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2013-11-14 19:05:26 UTC (rev 3255) +++ pkg/PortfolioAnalytics/DESCRIPTION 2013-11-14 19:08:37 UTC (rev 3256) @@ -61,3 +61,5 @@ 'utility.combine.R' 'equal.weight.R' 'inverse.volatility.weight.R' + 'utils.R' + Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-14 19:05:26 UTC (rev 3255) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-14 19:08:37 UTC (rev 3256) @@ -514,16 +514,33 @@ out <- out + penalty * mult * abs(sum(abs(w)) - constraints$leverage) } } # End leverage exposure penalty - - nargs <- list(...) - if(length(nargs)==0) nargs <- NULL - if (length('...')==0 | is.null('...')) { - # rm('...') - nargs <- NULL - } - nargs <- set.portfolio.moments(R, portfolio, momentargs=nargs) + # The "..." are passed in from optimize.portfolio and contain the output of + # the momentFUN. The default is momentFUN=set.portfolio.moments and returns + # moments$mu, moments$sigma, moments$m3, moments$m4, etc. depending on the + # the functions corresponding to portfolio$objective$name. Would it be better + # to make this a formal argument for constrained_objective? + # nargs are used as the arguments for functions corresponding to + # objective$name called in the objective loop later + + momentargs <- eval(substitute(alist(...))) + .formals <- formals(set.portfolio.moments) + .formals <- modify.args(formals=.formals, arglist=alist(momentargs=momentargs), dots=TRUE) + .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) + .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=TRUE) + .formals$... <- NULL + # print(.formals) + nargs <- do.call(set.portfolio.moments, .formals) + + #nargs <- list(...) + #if(length(nargs)==0) nargs <- NULL + #if (length('...')==0 | is.null('...')) { + # # rm('...') + # nargs <- NULL + #} + #nargs <- set.portfolio.moments(R, portfolio, momentargs=nargs) + if(is.null(portfolio$objectives)) { warning("no objectives specified in portfolio") } else{ @@ -537,7 +554,8 @@ switch(objective$name, mean =, median = { - fun = match.fun(objective$name) + fun = match.fun(objective$name) + # would it be better to do crossprod(w, moments$mu)? nargs$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product }, sd =, @@ -596,6 +614,11 @@ } } # TODO do some funky return magic here on try-error + #.formals <- formals(fun) + #.formals <- modify.args(formals=.formals, arglist=objective$arguments, ...=nargs, dots=TRUE) + #print(.formals) + #print(nargs) + tmp_measure <- try((do.call(fun,.formals)), silent=TRUE) if(isTRUE(trace) | isTRUE(storage)) { Added: pkg/PortfolioAnalytics/R/utils.R =================================================================== --- pkg/PortfolioAnalytics/R/utils.R (rev 0) +++ pkg/PortfolioAnalytics/R/utils.R 2013-11-14 19:08:37 UTC (rev 3256) @@ -0,0 +1,52 @@ + +modify.args <- function(formals, arglist, ..., dots=FALSE) +{ + # modify.args function from quantstrat + + # avoid evaluating '...' to make things faster + dots.names <- eval(substitute(alist(...))) + + if(missing(arglist)) + arglist <- NULL + arglist <- c(arglist, dots.names) + + # see 'S Programming' p. 67 for this matching + + # nothing to do if arglist is empty; return formals + if(!length(arglist)) + return(formals) + + argnames <- names(arglist) + if(!is.list(arglist) && !is.null(argnames) && !any(argnames == "")) + stop("'arglist' must be a *named* list, with no names == \"\"") + + .formals <- formals + onames <- names(.formals) + + pm <- pmatch(argnames, onames, nomatch = 0L) + #if(any(pm == 0L)) + # message(paste("some arguments stored for", fun, "do not match")) + names(arglist[pm > 0L]) <- onames[pm] + .formals[pm] <- arglist[pm > 0L] + + # include all elements from arglist if function formals contain '...' + if(dots && !is.null(.formals$...)) { + dotnames <- names(arglist[pm == 0L]) + .formals[dotnames] <- arglist[dotnames] + #.formals$... <- NULL # should we assume we matched them all? + } + .formals +} + +# This is how it is used in quantstrat in applyIndicators() +# # replace default function arguments with indicator$arguments +# .formals <- formals(indicator$name) +# .formals <- modify.args(.formals, indicator$arguments, dots=TRUE) +# # now add arguments from parameters +# .formals <- modify.args(.formals, parameters, dots=TRUE) +# # now add dots +# .formals <- modify.args(.formals, NULL, ..., dots=TRUE) +# # remove ... to avoid matching multiple args +# .formals$`...` <- NULL +# +# tmp_val <- do.call(indicator$name, .formals) From noreply at r-forge.r-project.org Thu Nov 14 20:14:08 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:14:08 +0100 (CET) Subject: [Returnanalytics-commits] r3257 - pkg/PerformanceAnalytics/R Message-ID: <20131114191408.DD6FD183D86@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:14:08 +0100 (Thu, 14 Nov 2013) New Revision: 3257 Modified: pkg/PerformanceAnalytics/R/Return.annualized.excess.R Log: - fixed example to use managers dataset Modified: pkg/PerformanceAnalytics/R/Return.annualized.excess.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.annualized.excess.R 2013-11-14 19:08:37 UTC (rev 3256) +++ pkg/PerformanceAnalytics/R/Return.annualized.excess.R 2013-11-14 19:14:08 UTC (rev 3257) @@ -1,78 +1,77 @@ -#' calculates an annualized excess return for comparing instruments with different -#' length history -#' -#' An average annualized excess return is convenient for comparing excess -#' returns. -#' -#' Annualized returns are useful for comparing two assets. To do so, you must -#' scale your observations to an annual scale by raising the compound return to -#' the number of periods in a year, and taking the root to the number of total -#' observations: -#' \deqn{prod(1+R_{a})^{\frac{scale}{n}}-1=\sqrt[n]{prod(1+R_{a})^{scale}}- -#' 1}{prod(1 + Ra)^(scale/n) - 1} -#' -#' where scale is the number of periods in a year, and n is the total number of -#' periods for which you have observations. -#' -#' Finally having annualized returns for portfolio and benchmark we can compute -#' annualized excess return as difference in the annualized portfolio and -#' benchmark returns in the arithmetic case: -#' \deqn{er = R_{pa} - R_{ba}}{er = Rpa - Rba} -#' -#' and as a geometric difference in the geometric case: -#' \deqn{er = \frac{(1 + R_{pa})}{(1 + R_{ba})} - 1}{er = (1 + Rpa) / (1 + Rba) - 1} -#' -#' @param Rp an xts, vector, matrix, data frame, timeSeries or zoo object of -#' portfolio returns -#' @param Rb an xts, vector, matrix, data frame, timeSeries or zoo object of -#' benchmark returns -#' @param scale number of periods in a year (daily scale = 252, monthly scale = -#' 12, quarterly scale = 4) -#' @param geometric generate geometric (TRUE) or simple (FALSE) excess returns, -#' default TRUE -#' @author Andrii Babii -#' @seealso \code{\link{Return.annualized}}, -#' @references Bacon, Carl. \emph{Practical Portfolio Performance Measurement -#' and Attribution}. Wiley. 2004. p. 206-207 -#' @keywords ts multivariate distribution models -#' @examples -#' -#' data(attrib) -#' Return.annualized.excess(Rp = attrib.returns[, 21], Rb = attrib.returns[, 22]) -#' -#' @export -Return.annualized.excess <- -function (Rp, Rb, scale = NA, geometric = TRUE ) -{ # @author Andrii Babii - Rp = checkData(Rp) - Rb = checkData(Rb) - - Rp = na.omit(Rp) - Rb = na.omit(Rb) - n = nrow(Rp) - if(is.na(scale)) { - freq = periodicity(Rp) - switch(freq$scale, - minute = {stop("Data periodicity too high")}, - hourly = {stop("Data periodicity too high")}, - daily = {scale = 252}, - eekly = {scale = 52}, - monthly = {scale = 12}, - quarterly = {scale = 4}, - yearly = {scale = 1} - ) - } - Rpa = apply(1 + Rp, 2, prod)^(scale/n) - 1 - Rba = apply(1 + Rb, 2, prod)^(scale/n) - 1 - if (geometric) { - # geometric excess returns - result = (1 + Rpa) / (1 + Rba) - 1 - } else { - # arithmetic excess returns - result = Rpa - Rba - } - dim(result) = c(1,NCOL(Rp)) - colnames(result) = colnames(Rp) - rownames(result) = "Annualized Return" - return(result) +#' calculates an annualized excess return for comparing instruments with different +#' length history +#' +#' An average annualized excess return is convenient for comparing excess +#' returns. +#' +#' Annualized returns are useful for comparing two assets. To do so, you must +#' scale your observations to an annual scale by raising the compound return to +#' the number of periods in a year, and taking the root to the number of total +#' observations: +#' \deqn{prod(1+R_{a})^{\frac{scale}{n}}-1=\sqrt[n]{prod(1+R_{a})^{scale}}- +#' 1}{prod(1 + Ra)^(scale/n) - 1} +#' +#' where scale is the number of periods in a year, and n is the total number of +#' periods for which you have observations. +#' +#' Finally having annualized returns for portfolio and benchmark we can compute +#' annualized excess return as difference in the annualized portfolio and +#' benchmark returns in the arithmetic case: +#' \deqn{er = R_{pa} - R_{ba}}{er = Rpa - Rba} +#' +#' and as a geometric difference in the geometric case: +#' \deqn{er = \frac{(1 + R_{pa})}{(1 + R_{ba})} - 1}{er = (1 + Rpa) / (1 + Rba) - 1} +#' +#' @param Rp an xts, vector, matrix, data frame, timeSeries or zoo object of +#' portfolio returns +#' @param Rb an xts, vector, matrix, data frame, timeSeries or zoo object of +#' benchmark returns +#' @param scale number of periods in a year (daily scale = 252, monthly scale = +#' 12, quarterly scale = 4) +#' @param geometric generate geometric (TRUE) or simple (FALSE) excess returns, +#' default TRUE +#' @author Andrii Babii +#' @seealso \code{\link{Return.annualized}}, +#' @references Bacon, Carl. \emph{Practical Portfolio Performance Measurement +#' and Attribution}. Wiley. 2004. p. 206-207 +#' @keywords ts multivariate distribution models +#' @examples +#' data(managers) +#' Return.annualized.excess(Ra = managers[,1], Rb = managers[,8]) +#' +#' @export +Return.annualized.excess <- +function (Rp, Rb, scale = NA, geometric = TRUE ) +{ # @author Andrii Babii + Rp = checkData(Rp) + Rb = checkData(Rb) + + Rp = na.omit(Rp) + Rb = na.omit(Rb) + n = nrow(Rp) + if(is.na(scale)) { + freq = periodicity(Rp) + switch(freq$scale, + minute = {stop("Data periodicity too high")}, + hourly = {stop("Data periodicity too high")}, + daily = {scale = 252}, + eekly = {scale = 52}, + monthly = {scale = 12}, + quarterly = {scale = 4}, + yearly = {scale = 1} + ) + } + Rpa = apply(1 + Rp, 2, prod)^(scale/n) - 1 + Rba = apply(1 + Rb, 2, prod)^(scale/n) - 1 + if (geometric) { + # geometric excess returns + result = (1 + Rpa) / (1 + Rba) - 1 + } else { + # arithmetic excess returns + result = Rpa - Rba + } + dim(result) = c(1,NCOL(Rp)) + colnames(result) = colnames(Rp) + rownames(result) = "Annualized Return" + return(result) } \ No newline at end of file From noreply at r-forge.r-project.org Thu Nov 14 20:29:42 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:29:42 +0100 (CET) Subject: [Returnanalytics-commits] r3258 - pkg/PerformanceAnalytics/R Message-ID: <20131114192942.122ED183D86@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:29:41 +0100 (Thu, 14 Nov 2013) New Revision: 3258 Modified: pkg/PerformanceAnalytics/R/Return.annualized.excess.R Log: - fixed typo Modified: pkg/PerformanceAnalytics/R/Return.annualized.excess.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.annualized.excess.R 2013-11-14 19:14:08 UTC (rev 3257) +++ pkg/PerformanceAnalytics/R/Return.annualized.excess.R 2013-11-14 19:29:41 UTC (rev 3258) @@ -37,7 +37,7 @@ #' @keywords ts multivariate distribution models #' @examples #' data(managers) -#' Return.annualized.excess(Ra = managers[,1], Rb = managers[,8]) +#' Return.annualized.excess(Rp = managers[,1], Rb = managers[,8]) #' #' @export Return.annualized.excess <- From noreply at r-forge.r-project.org Thu Nov 14 20:33:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:33:20 +0100 (CET) Subject: [Returnanalytics-commits] r3259 - pkg/PerformanceAnalytics/man Message-ID: <20131114193321.0E2A8183D86@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:33:20 +0100 (Thu, 14 Nov 2013) New Revision: 3259 Modified: pkg/PerformanceAnalytics/man/CAPM.epsilon.Rd pkg/PerformanceAnalytics/man/CDD.Rd pkg/PerformanceAnalytics/man/Return.annualized.excess.Rd pkg/PerformanceAnalytics/man/SkewnessKurtosisRatio.Rd pkg/PerformanceAnalytics/man/StdDev.annualized.Rd pkg/PerformanceAnalytics/man/centeredmoments.Rd pkg/PerformanceAnalytics/man/chart.ACF.Rd pkg/PerformanceAnalytics/man/chart.TimeSeries.Rd pkg/PerformanceAnalytics/man/chart.VaRSensitivity.Rd pkg/PerformanceAnalytics/man/legend.Rd pkg/PerformanceAnalytics/man/mean.geometric.Rd Log: - re-roxygenized help files Modified: pkg/PerformanceAnalytics/man/CAPM.epsilon.Rd =================================================================== --- pkg/PerformanceAnalytics/man/CAPM.epsilon.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/CAPM.epsilon.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,7 +1,7 @@ \name{CAPM.epsilon} \alias{CAPM.epsilon} +\alias{Regression} \alias{epsilon} -\alias{Regression} \title{Regression epsilon of the return distribution} \usage{ CAPM.epsilon(Ra, Rb, Rf = 0, ...) Modified: pkg/PerformanceAnalytics/man/CDD.Rd =================================================================== --- pkg/PerformanceAnalytics/man/CDD.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/CDD.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,6 +1,6 @@ \name{CDD} +\alias{CDD} \alias{CDaR} -\alias{CDD} \title{Calculate Uryasev's proposed Conditional Drawdown at Risk (CDD or CDaR) measure} \usage{ Modified: pkg/PerformanceAnalytics/man/Return.annualized.excess.Rd =================================================================== --- pkg/PerformanceAnalytics/man/Return.annualized.excess.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/Return.annualized.excess.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,67 +1,67 @@ -\name{Return.annualized.excess} -\alias{Return.annualized.excess} -\title{calculates an annualized excess return for comparing instruments with different -length history} -\usage{ - Return.annualized.excess(Rp, Rb, scale = NA, - geometric = TRUE) -} -\arguments{ - \item{Rp}{an xts, vector, matrix, data frame, timeSeries - or zoo object of portfolio returns} - - \item{Rb}{an xts, vector, matrix, data frame, timeSeries - or zoo object of benchmark returns} - - \item{scale}{number of periods in a year (daily scale = - 252, monthly scale = 12, quarterly scale = 4)} - - \item{geometric}{generate geometric (TRUE) or simple - (FALSE) excess returns, default TRUE} -} -\description{ - An average annualized excess return is convenient for - comparing excess returns. -} -\details{ - Annualized returns are useful for comparing two assets. - To do so, you must scale your observations to an annual - scale by raising the compound return to the number of - periods in a year, and taking the root to the number of - total observations: - \deqn{prod(1+R_{a})^{\frac{scale}{n}}-1=\sqrt[n]{prod(1+R_{a})^{scale}}- - 1}{prod(1 + Ra)^(scale/n) - 1} - - where scale is the number of periods in a year, and n is - the total number of periods for which you have - observations. - - Finally having annualized returns for portfolio and - benchmark we can compute annualized excess return as - difference in the annualized portfolio and benchmark - returns in the arithmetic case: \deqn{er = R_{pa} - - R_{ba}}{er = Rpa - Rba} - - and as a geometric difference in the geometric case: - \deqn{er = \frac{(1 + R_{pa})}{(1 + R_{ba})} - 1}{er = (1 - + Rpa) / (1 + Rba) - 1} -} -\examples{ -data(attrib) -Return.annualized.excess(Rp = attrib.returns[, 21], Rb = attrib.returns[, 22]) -} -\author{ - Andrii Babii -} -\references{ - Bacon, Carl. \emph{Practical Portfolio Performance - Measurement and Attribution}. Wiley. 2004. p. 206-207 -} -\seealso{ - \code{\link{Return.annualized}}, -} -\keyword{distribution} -\keyword{models} -\keyword{multivariate} -\keyword{ts} - +\name{Return.annualized.excess} +\alias{Return.annualized.excess} +\title{calculates an annualized excess return for comparing instruments with different +length history} +\usage{ + Return.annualized.excess(Rp, Rb, scale = NA, + geometric = TRUE) +} +\arguments{ + \item{Rp}{an xts, vector, matrix, data frame, timeSeries + or zoo object of portfolio returns} + + \item{Rb}{an xts, vector, matrix, data frame, timeSeries + or zoo object of benchmark returns} + + \item{scale}{number of periods in a year (daily scale = + 252, monthly scale = 12, quarterly scale = 4)} + + \item{geometric}{generate geometric (TRUE) or simple + (FALSE) excess returns, default TRUE} +} +\description{ + An average annualized excess return is convenient for + comparing excess returns. +} +\details{ + Annualized returns are useful for comparing two assets. + To do so, you must scale your observations to an annual + scale by raising the compound return to the number of + periods in a year, and taking the root to the number of + total observations: + \deqn{prod(1+R_{a})^{\frac{scale}{n}}-1=\sqrt[n]{prod(1+R_{a})^{scale}}- + 1}{prod(1 + Ra)^(scale/n) - 1} + + where scale is the number of periods in a year, and n is + the total number of periods for which you have + observations. + + Finally having annualized returns for portfolio and + benchmark we can compute annualized excess return as + difference in the annualized portfolio and benchmark + returns in the arithmetic case: \deqn{er = R_{pa} - + R_{ba}}{er = Rpa - Rba} + + and as a geometric difference in the geometric case: + \deqn{er = \frac{(1 + R_{pa})}{(1 + R_{ba})} - 1}{er = (1 + + Rpa) / (1 + Rba) - 1} +} +\examples{ +data(managers) +Return.annualized.excess(Rp = managers[,1], Rb = managers[,8]) +} +\author{ + Andrii Babii +} +\references{ + Bacon, Carl. \emph{Practical Portfolio Performance + Measurement and Attribution}. Wiley. 2004. p. 206-207 +} +\seealso{ + \code{\link{Return.annualized}}, +} +\keyword{distribution} +\keyword{models} +\keyword{multivariate} +\keyword{ts} + Modified: pkg/PerformanceAnalytics/man/SkewnessKurtosisRatio.Rd =================================================================== --- pkg/PerformanceAnalytics/man/SkewnessKurtosisRatio.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/SkewnessKurtosisRatio.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,6 +1,6 @@ \name{SkewnessKurtosisRatio} +\alias{Skewness-KurtosisRatio} \alias{SkewnessKurtosisRatio} -\alias{Skewness-KurtosisRatio} \title{Skewness-Kurtosis ratio of the return distribution} \usage{ SkewnessKurtosisRatio(R, ...) Modified: pkg/PerformanceAnalytics/man/StdDev.annualized.Rd =================================================================== --- pkg/PerformanceAnalytics/man/StdDev.annualized.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/StdDev.annualized.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,7 +1,7 @@ \name{StdDev.annualized} +\alias{StdDev.annualized} \alias{sd.annualized} \alias{sd.multiperiod} -\alias{StdDev.annualized} \title{calculate a multiperiod or annualized Standard Deviation} \usage{ StdDev.annualized(x, scale = NA, ...) Modified: pkg/PerformanceAnalytics/man/centeredmoments.Rd =================================================================== --- pkg/PerformanceAnalytics/man/centeredmoments.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/centeredmoments.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,7 +1,7 @@ \name{Return.centered} +\alias{Return.centered} \alias{centeredcomoment} \alias{centeredmoment} -\alias{Return.centered} \title{calculate centered Returns} \usage{ Return.centered(R, ...) Modified: pkg/PerformanceAnalytics/man/chart.ACF.Rd =================================================================== --- pkg/PerformanceAnalytics/man/chart.ACF.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/chart.ACF.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,12 +1,12 @@ -\name{chart.ACFplus} +\name{chart.ACF} \alias{chart.ACF} \alias{chart.ACFplus} \title{Create ACF chart or ACF with PACF two-panel chart} \usage{ - chart.ACFplus(R, maxlag = NULL, elementcolor = "gray", + chart.ACF(R, maxlag = NULL, elementcolor = "gray", main = NULL, ...) - chart.ACF(R, maxlag = NULL, elementcolor = "gray", + chart.ACFplus(R, maxlag = NULL, elementcolor = "gray", main = NULL, ...) } \arguments{ Modified: pkg/PerformanceAnalytics/man/chart.TimeSeries.Rd =================================================================== --- pkg/PerformanceAnalytics/man/chart.TimeSeries.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/chart.TimeSeries.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,23 +1,24 @@ -\name{charts.TimeSeries} +\name{chart.TimeSeries} +\alias{chart.TimeSeries} \alias{charts.TimeSeries} -\alias{chart.TimeSeries} \title{Creates a time series chart with some extensions.} \usage{ - charts.TimeSeries(R, space = 0, main = "Returns", ...) - chart.TimeSeries(R, auto.grid = TRUE, xaxis = TRUE, yaxis = TRUE, yaxis.right = FALSE, type = "l", lty = 1, - lwd = 2, main = NULL, ylab = NULL, xlab = "Date", - date.format.in = "\%Y-\%m-\%d", date.format = NULL, - xlim = NULL, ylim = NULL, element.color = "darkgray", - event.lines = NULL, event.labels = NULL, - period.areas = NULL, event.color = "darkgray", - period.color = "aliceblue", colorset = (1:12), - pch = (1:12), legend.loc = NULL, ylog = FALSE, - cex.axis = 0.8, cex.legend = 0.8, cex.lab = 1, - cex.labels = 0.8, cex.main = 1, major.ticks = "auto", - minor.ticks = TRUE, grid.color = "lightgray", - grid.lty = "dotted", xaxis.labels = NULL, ...) + lwd = 2, las = par("las"), main = NULL, ylab = NULL, + xlab = "", date.format.in = "\%Y-\%m-\%d", + date.format = NULL, xlim = NULL, ylim = NULL, + element.color = "darkgray", event.lines = NULL, + event.labels = NULL, period.areas = NULL, + event.color = "darkgray", period.color = "aliceblue", + colorset = (1:12), pch = (1:12), legend.loc = NULL, + ylog = FALSE, cex.axis = 0.8, cex.legend = 0.8, + cex.lab = 1, cex.labels = 0.8, cex.main = 1, + major.ticks = "auto", minor.ticks = TRUE, + grid.color = "lightgray", grid.lty = "dotted", + xaxis.labels = NULL, ...) + + charts.TimeSeries(R, space = 0, main = "Returns", ...) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries @@ -46,6 +47,9 @@ \item{lwd}{set the line width, same as in \code{\link{plot}}} + \item{las}{set the axis label rotation, same as in + \code{\link{plot}}} + \item{main}{set the chart title, same as in \code{\link{plot}}} Modified: pkg/PerformanceAnalytics/man/chart.VaRSensitivity.Rd =================================================================== --- pkg/PerformanceAnalytics/man/chart.VaRSensitivity.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/chart.VaRSensitivity.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -10,7 +10,7 @@ type = "l", lty = c(1, 2, 4), lwd = 1, colorset = (1:12), pch = (1:12), legend.loc = "bottomleft", cex.legend = 0.8, - main = NULL, ...) + main = NULL, ylim = NULL, ...) } \arguments{ \item{R}{an xts, vector, matrix, data frame, timeSeries @@ -37,6 +37,9 @@ \item{xlab}{set the x-axis label, same as in \code{\link{plot}}} + \item{ylim}{set the y-axis dimensions, same as in + \code{\link{plot}}} + \item{type}{set the chart type, same as in \code{\link{plot}}} Modified: pkg/PerformanceAnalytics/man/legend.Rd =================================================================== --- pkg/PerformanceAnalytics/man/legend.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/legend.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,4 +1,5 @@ \name{legend} +\alias{PerformanceAnalytics.internal} \alias{allsymbols} \alias{bluefocus} \alias{bluemono} @@ -20,7 +21,6 @@ \alias{macro.dates} \alias{macro.labels} \alias{opensymbols} -\alias{PerformanceAnalytics.internal} \alias{rainbow10equal} \alias{rainbow12equal} \alias{rainbow6equal} Modified: pkg/PerformanceAnalytics/man/mean.geometric.Rd =================================================================== --- pkg/PerformanceAnalytics/man/mean.geometric.Rd 2013-11-14 19:29:41 UTC (rev 3258) +++ pkg/PerformanceAnalytics/man/mean.geometric.Rd 2013-11-14 19:33:20 UTC (rev 3259) @@ -1,8 +1,8 @@ \name{mean.geometric} +\alias{mean.LCL} +\alias{mean.UCL} \alias{mean.geometric} -\alias{mean.LCL} \alias{mean.stderr} -\alias{mean.UCL} \alias{mean.utils} \title{calculate attributes relative to the mean of the observation series given, including geometric, stderr, LCL and UCL} From noreply at r-forge.r-project.org Thu Nov 14 20:36:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 14 Nov 2013 20:36:15 +0100 (CET) Subject: [Returnanalytics-commits] r3260 - pkg/PerformanceAnalytics Message-ID: <20131114193615.A0B65184499@r-forge.r-project.org> Author: peter_carl Date: 2013-11-14 20:36:15 +0100 (Thu, 14 Nov 2013) New Revision: 3260 Modified: pkg/PerformanceAnalytics/DESCRIPTION Log: - bumped version to 1.1.2 Modified: pkg/PerformanceAnalytics/DESCRIPTION =================================================================== --- pkg/PerformanceAnalytics/DESCRIPTION 2013-11-14 19:33:20 UTC (rev 3259) +++ pkg/PerformanceAnalytics/DESCRIPTION 2013-11-14 19:36:15 UTC (rev 3260) @@ -1,7 +1,7 @@ Package: PerformanceAnalytics Type: Package Title: Econometric tools for performance and risk analysis. -Version: 1.1.1 +Version: 1.1.2 Date: $Date$ Author: Peter Carl, Brian G. Peterson Maintainer: Brian G. Peterson @@ -36,3 +36,4 @@ Stefan Albrecht, Khahn Nygyen, Jeff Ryan, Josh Ulrich, Sankalp Upadhyay, Tobias Verbeke, H. Felix Wittmann, Ram Ahluwalia + From noreply at r-forge.r-project.org Fri Nov 15 07:12:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Nov 2013 07:12:22 +0100 (CET) Subject: [Returnanalytics-commits] r3261 - pkg/PortfolioAnalytics/R Message-ID: <20131115061222.3EA45185938@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-15 07:12:21 +0100 (Fri, 15 Nov 2013) New Revision: 3261 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Modifying optimize.portfolio to add an argument for testing how moments are passed to constrained_objective. Adding moments as a formal argument to constrained_objective Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-14 19:36:15 UTC (rev 3260) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-15 06:12:21 UTC (rev 3261) @@ -345,7 +345,7 @@ #' @aliases constrained_objective constrained_objective_v1 #' @rdname constrained_objective #' @export -constrained_objective_v2 <- function(w, R, portfolio, ..., trace=FALSE, normalize=TRUE, storage=FALSE) +constrained_objective_v2 <- function(w, R, portfolio, ..., trace=FALSE, normalize=TRUE, storage=FALSE, moments=NULL) { if (ncol(R) > length(w)) { R <- R[ ,1:length(w)] @@ -516,31 +516,36 @@ } # End leverage exposure penalty # The "..." are passed in from optimize.portfolio and contain the output of - # the momentFUN. The default is momentFUN=set.portfolio.moments and returns + # momentFUN. The default is momentFUN=set.portfolio.moments and returns # moments$mu, moments$sigma, moments$m3, moments$m4, etc. depending on the # the functions corresponding to portfolio$objective$name. Would it be better - # to make this a formal argument for constrained_objective? + # to make this a formal argument for constrained_objective? This means that + # we completely avoid evaluating the set.portfolio.moments function. Can we + # trust that all the moments are correctly set in optimize.portfolio through + # momentFUN? - # nargs are used as the arguments for functions corresponding to - # objective$name called in the objective loop later + if(!is.null(moments)){ + nargs <- moments + } else { + # print("calculating moments") + # calculating the moments + # nargs are used as the arguments for functions corresponding to + # objective$name called in the objective loop later + momentargs <- eval(substitute(alist(...))) + .formals <- formals(set.portfolio.moments) + .formals <- modify.args(formals=.formals, arglist=alist(momentargs=momentargs), dots=TRUE) + .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) + .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=TRUE) + .formals$... <- NULL + # print(.formals) + nargs <- do.call(set.portfolio.moments, .formals) + } - momentargs <- eval(substitute(alist(...))) - .formals <- formals(set.portfolio.moments) - .formals <- modify.args(formals=.formals, arglist=alist(momentargs=momentargs), dots=TRUE) - .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) - .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=TRUE) - .formals$... <- NULL - # print(.formals) - nargs <- do.call(set.portfolio.moments, .formals) + # We should avoid modifying nargs in the loop below. + # If we modify nargs with something like nargs$x, nargs is copied and this + # should be avoided because nargs could be large because it contains the moments. + tmp_args <- list() - #nargs <- list(...) - #if(length(nargs)==0) nargs <- NULL - #if (length('...')==0 | is.null('...')) { - # # rm('...') - # nargs <- NULL - #} - #nargs <- set.portfolio.moments(R, portfolio, momentargs=nargs) - if(is.null(portfolio$objectives)) { warning("no objectives specified in portfolio") } else{ @@ -556,7 +561,7 @@ median = { fun = match.fun(objective$name) # would it be better to do crossprod(w, moments$mu)? - nargs$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product + tmp_args$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product }, sd =, var =, @@ -566,7 +571,7 @@ 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(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method) & is.null(nargs$portfolio_method)) tmp_args$portfolio_method='single' if(is.null(objective$arguments$invert)) objective$arguments$invert = FALSE }, es =, @@ -577,7 +582,7 @@ mETL=, 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(!inherits(objective,"risk_budget_objective") & is.null(objective$arguments$portfolio_method) & is.null(nargs$portfolio_method)) tmp_args$portfolio_method='single' if(is.null(objective$arguments$invert)) objective$arguments$invert = FALSE }, turnover = { @@ -587,38 +592,22 @@ 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 + .formals <- formals(fun) + # Add the moments from the nargs object + .formals <- modify.args(formals=.formals, arglist=nargs, dots=TRUE) + # Add anything from tmp_args + .formals <- modify.args(formals=.formals, arglist=tmp_args, dots=TRUE) + # Now add the objective$arguments + .formals <- modify.args(formals=.formals, arglist=objective$arguments, dots=TRUE) + # Add R and weights if necessary + if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) + if("weights" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, weights=w, dots=TRUE) + .formals$... <- NULL + } - #.formals <- formals(fun) - #.formals <- modify.args(formals=.formals, arglist=objective$arguments, ...=nargs, dots=TRUE) - #print(.formals) - #print(nargs) - + # print(.formals) tmp_measure <- try((do.call(fun,.formals)), silent=TRUE) if(isTRUE(trace) | isTRUE(storage)) { Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-14 19:36:15 UTC (rev 3260) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-15 06:12:21 UTC (rev 3261) @@ -443,7 +443,8 @@ trace=FALSE, ..., rp=NULL, momentFUN='set.portfolio.moments', - message=FALSE + message=FALSE, + reuse_moments=TRUE ) { optimize_method <- optimize_method[1] @@ -681,7 +682,11 @@ if ("package:foreach" %in% search() & !hasArg(parallel)){ 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, R=R, portfolio=portfolio, trace=trace, ...=dotargs, normalize=FALSE) + if(reuse_moments){ + rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, normalize=FALSE, moments=dotargs) + } else { + rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, ...=dotargs, normalize=FALSE, moments=NULL) + } } #' if trace=TRUE , store results of foreach in out$random_results if(isTRUE(trace)) out$random_portfolio_objective_results <- rp_objective_results @@ -705,7 +710,11 @@ } #' 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 - obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE)$objective_measures) + if(reuse_moments){ + obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE, moments=dotargs)$objective_measures) + } else { + obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE)$objective_measures) + } out$objective_measures <- obj_vals out$opt_values <- obj_vals out$call <- call @@ -736,7 +745,7 @@ # list of valid objective names for ROI solvers valid_objnames <- c("HHI", "mean", "var", "sd", "StdDev", "CVaR", "ES", "ETL") - + #objnames <- unlist(lapply(portfolio$objectives, function(x) x$name)) for(objective in portfolio$objectives){ if(objective$enabled){ if(!(objective$name %in% valid_objnames)){ @@ -762,19 +771,17 @@ # multiple objectives. if(clean != "none") moments$cleanR <- Return.clean(R=R, method=clean) - # 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 + # Use $mu and $sigma estimates from momentFUN if available, fall back to + # calculating sample mean and variance if(objective$name == "mean"){ - if(!is.null(objective$estimate)){ - print("User has specified an estimated mean returns vector") - moments[["mean"]] <- as.vector(objective$estimate) + if(!is.null(mout$mu)){ + moments[["mean"]] <- as.vector(mout$mu) } else { moments[["mean"]] <- try(as.vector(apply(Return.clean(R=R, method=clean), 2, "mean", na.rm=TRUE)), silent=TRUE) } } else if(objective$name %in% c("StdDev", "sd", "var")){ - if(!is.null(objective$estimate)){ - print("User has specified an estimated covariance matrix") - moments[["var"]] <- objective$estimate + if(!is.null(mout$sigma)){ + moments[["var"]] <- mout$sigma } else { moments[["var"]] <- try(var(x=Return.clean(R=R, method=clean), na.rm=TRUE), silent=TRUE) } @@ -790,6 +797,7 @@ if(!is.null(objective$conc_groups)) conc_groups <- objective$conc_groups else conc_groups <- NULL } } + if("var" %in% names(moments)){ # Minimize variance if the only objective specified is variance # Maximize Quadratic Utility if var and mean are specified as objectives From noreply at r-forge.r-project.org Fri Nov 15 07:16:35 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Nov 2013 07:16:35 +0100 (CET) Subject: [Returnanalytics-commits] r3262 - in pkg/PortfolioAnalytics/sandbox: . benchmarking Message-ID: <20131115061635.D0155185938@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-15 07:16:35 +0100 (Fri, 15 Nov 2013) New Revision: 3262 Added: pkg/PortfolioAnalytics/sandbox/benchmarking/ pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R Log: Adding benchmarking folder and script that profiles and demonstrates the two different ways of passing moments. Added: pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R (rev 0) +++ pkg/PortfolioAnalytics/sandbox/benchmarking/benchmark_opt.R 2013-11-15 06:16:35 UTC (rev 3262) @@ -0,0 +1,57 @@ + + +library(PortfolioAnalytics) +library(rbenchmark) + +data(edhec) +returns <- edhec[,1:10] +funds <- colnames(returns) + +# Add basic constraints and objectives +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="weight_sum", + min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="box", min=0, max=0.45) +# init.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES") + +n_portfolios <- 1000 +rp <- random_portfolios(portfolio=init.portf, + permutations=n_portfolios, + rp_method="sample", + eliminate=FALSE) + +opt1 <- optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=FALSE, trace=TRUE) +opt2 <- optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=TRUE, trace=TRUE) + +all.equal(opt1, opt2) +# Component 6, 10, and 11 do not match +# Component 6 is the call +# Component 10 the elapsed time +# Component 11 the end_t + +# Make sure the results of opt1 and opt2 are equal +all.equal(extractStats(opt1), extractStats(opt2)) + +# benchmark different ways of passing the moments to constrained_objective +benchmark( + reuse=optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=TRUE), + no_reuse=optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=FALSE), + replications=1 +)[,1:4] + +# Rprof runs +# new uses modify.args to evaluate arguments +Rprof(filename="rp_profile_reuse.txt") +optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=TRUE) +Rprof(NULL) + +Rprof(filename="rp_profile_no_reuse.txt") +optimize.portfolio(R=returns, portfolio=init.portf, optimize_method="random", rp=rp, reuse_moments=FALSE) +Rprof(NULL) + +out_reuse <- summaryRprof("rp_profile_reuse.txt") +out_no_reuse <- summaryRprof("rp_profile_no_reuse.txt") + +lapply(out_reuse, head) +lapply(out_no_reuse, head) \ No newline at end of file From noreply at r-forge.r-project.org Fri Nov 15 21:20:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Nov 2013 21:20:24 +0100 (CET) Subject: [Returnanalytics-commits] r3263 - pkg/PortfolioAnalytics/R Message-ID: <20131115202024.1F9CA186190@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-15 21:20:23 +0100 (Fri, 15 Nov 2013) New Revision: 3263 Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Modifying optimize.portfolio to use modify.args for momentFUN and pass moments to constrained_objective. Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-15 06:16:35 UTC (rev 3262) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-11-15 20:20:23 UTC (rev 3263) @@ -443,8 +443,7 @@ trace=FALSE, ..., rp=NULL, momentFUN='set.portfolio.moments', - message=FALSE, - reuse_moments=TRUE + message=FALSE ) { optimize_method <- optimize_method[1] @@ -488,10 +487,8 @@ out <- list() - weights <- NULL + weights <- NULL - dotargs <- list(...) - # Get the constraints from the portfolio object constraints <- get_constraints(portfolio) @@ -504,28 +501,16 @@ # optimize.portfolio. See r2931 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 - .formals <- formals(momentFUN) - onames <- names(.formals) - if (length(.mformals)) { - dargs <- .mformals - pm <- pmatch(names(dargs), onames, nomatch = 0L) - names(dargs[pm > 0L]) <- onames[pm] - .formals[pm] <- dargs[pm > 0L] } - .formals$R <- R - .formals$portfolio <- portfolio + # match the args for momentFUN + .formals <- formals(momentFUN) + .formals <- modify.args(formals=.formals, arglist=NULL, ..., dots=TRUE) + if("R" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, R=R, dots=TRUE) + if("portfolio" %in% names(.formals)) .formals <- modify.args(formals=.formals, arglist=NULL, portfolio=portfolio, dots=TRUE) .formals$... <- NULL - # If no dotargs are passed in, .formals was a pairlist and do.call was failing - if(!inherits(.formals, "list")) .formals <- as.list(.formals) - - mout <- try((do.call(momentFUN, .formals)) ,silent=TRUE) + # call momentFUN + mout <- try(do.call(momentFUN, .formals), silent=TRUE) if(inherits(mout,"try-error")) { message(paste("portfolio moment function failed with message",mout)) } else { @@ -636,7 +621,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, 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, moments = 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)){ @@ -651,7 +636,7 @@ # is it necessary to normalize the weights here? # weights <- normalize_weights(weights) names(weights) <- colnames(R) - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE, moments=dotargs)$objective_measures out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=minw$optim$bestval, call=call) if (isTRUE(trace)){ out$DEoutput <- minw @@ -680,13 +665,9 @@ # 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(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=R, portfolio=portfolio, trace=trace, moments=dotargs, normalize=FALSE) } else { - if(reuse_moments){ - rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, normalize=FALSE, moments=dotargs) - } else { - rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, ...=dotargs, normalize=FALSE, moments=NULL) - } + rp_objective_results <- apply(rp, 1, constrained_objective, R=R, portfolio=portfolio, trace=trace, normalize=FALSE, moments=dotargs) } #' if trace=TRUE , store results of foreach in out$random_results if(isTRUE(trace)) out$random_portfolio_objective_results <- rp_objective_results @@ -710,11 +691,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 - if(reuse_moments){ - obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE, moments=dotargs)$objective_measures) - } else { - obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE)$objective_measures) - } + obj_vals <- try(constrained_objective(w=min_objective_weights, R=R, portfolio=portfolio, trace=TRUE, normalize=FALSE, moments=dotargs)$objective_measures) out$objective_measures <- obj_vals out$opt_values <- obj_vals out$call <- call @@ -921,7 +898,7 @@ upper <- constraints$max lower <- constraints$min - minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective, R=R, portfolio=portfolio, + minw <- try(psoptim( par = rep(NA, N), fn = constrained_objective, R=R, portfolio=portfolio, moments=dotargs, lower = lower[1:N] , upper = upper[1:N] , control = controlPSO)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } @@ -933,7 +910,7 @@ weights <- as.vector( minw$par) weights <- normalize_weights(weights) names(weights) <- colnames(R) - obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures + obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, moments=dotargs)$objective_measures out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, @@ -967,7 +944,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, portfolio=portfolio)) # add ,silent=TRUE here? + fn = constrained_objective , R=R, portfolio=portfolio, moments=dotargs)) # add ,silent=TRUE here? if(inherits(minw,"try-error")) { minw=NULL } if(is.null(minw)){ @@ -978,7 +955,7 @@ weights <- as.vector(minw$par) weights <- normalize_weights(weights) names(weights) <- colnames(R) - obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE)$objective_measures + obj_vals <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, moments=dotargs)$objective_measures out = list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, From noreply at r-forge.r-project.org Fri Nov 15 21:28:47 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 15 Nov 2013 21:28:47 +0100 (CET) Subject: [Returnanalytics-commits] r3264 - pkg/PortfolioAnalytics/R Message-ID: <20131115202847.C6FB11855D5@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-15 21:28:47 +0100 (Fri, 15 Nov 2013) New Revision: 3264 Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R Log: Cleaning up some efficient frontier code Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R =================================================================== --- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-11-15 20:20:23 UTC (rev 3263) +++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-11-15 20:28:47 UTC (rev 3264) @@ -83,10 +83,11 @@ #' @param risk_aversion vector of risk_aversion values to construct the efficient frontier. #' \code{n.portfolios} is ignored if \code{risk_aversion} is specified and the number #' of points along the efficient frontier is equal to the length of \code{risk_aversion}. +#' @param \dots passthru parameters to \code{\link{optimize.portfolio}} #' @return a matrix of objective measure values and weights along the efficient frontier #' @author Ross Bennett #' @export -meanvar.efficient.frontier <- function(portfolio, R, n.portfolios=25, risk_aversion=NULL){ +meanvar.efficient.frontier <- function(portfolio, R, n.portfolios=25, risk_aversion=NULL, ...){ if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'") # step 1: find the minimum return given the constraints # step 2: find the maximum return given the constraints @@ -134,7 +135,7 @@ portfolio$objectives[[var_idx]]$enabled <- FALSE # run the optimization to get the maximum return - tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") + tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ...=...) mean_ret <- colMeans(R) maxret <- sum(extractWeights(tmp) * mean_ret) @@ -152,7 +153,7 @@ # Run the optimization to get the global minimum variance portfolio with the # given constraints. # Do we want to disable the turnover or transaction costs constraints here? - tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") + tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ...=...) stats <- extractStats(tmp) minret <- sum(extractWeights(tmp) * mean_ret) @@ -169,7 +170,7 @@ portfolio$objectives[[mean_idx]]$enabled <- TRUE out <- foreach(i=1:length(risk_aversion), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% { portfolio$objectives[[var_idx]]$risk_aversion <- risk_aversion[i] - extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")) + extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ...=...)) } out <- cbind(out, risk_aversion) colnames(out) <- c(names(stats), "lambda") @@ -178,7 +179,7 @@ portfolio$constraints[[ret_constr_idx]]$enabled <- TRUE out <- foreach(i=1:length(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% { portfolio$constraints[[ret_constr_idx]]$return_target <- ret_seq[i] - opt <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") + opt <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ...=...) c(sum(extractWeights(opt) * mean_ret), extractStats(opt)) } colnames(out) <- c("mean", names(stats)) @@ -197,10 +198,11 @@ #' @param portfolio a portfolio object with constraints and objectives created via \code{\link{portfolio.spec}} #' @param R an xts or matrix of asset returns #' @param n.portfolios number of portfolios to generate the efficient frontier +#' @param \dots passthru parameters to \code{\link{optimize.portfolio}} #' @return a matrix of objective measure values and weights along the efficient frontier #' @author Ross Bennett #' @export -meanetl.efficient.frontier <- function(portfolio, R, n.portfolios=25){ +meanetl.efficient.frontier <- function(portfolio, R, n.portfolios=25, ...){ if(!is.portfolio(portfolio)) stop("portfolio object must be of class 'portfolio'") # step 1: find the minimum return given the constraints # step 2: find the maximum return given the constraints @@ -244,11 +246,11 @@ tportf <- insert_objectives(portfolio, list(ret_obj)) # run the optimization to get the maximum return - tmp <- optimize.portfolio(R=R, portfolio=tportf, optimize_method="ROI") + tmp <- optimize.portfolio(R=R, portfolio=tportf, optimize_method="ROI", ...) maxret <- extractObjectiveMeasures(tmp)$mean # run the optimization to get the return at the min ETL portfolio - tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE) + tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE, ...) stats <- extractStats(tmp) minret <- stats["mean"] @@ -264,7 +266,7 @@ stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE)) out <- foreach(i=1:length(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% { portfolio$objectives[[mean_idx]]$target <- ret_seq[i] - extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE)) + extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE, ...=...)) } colnames(out) <- names(stats) return(structure(out, class="frontier")) @@ -326,14 +328,16 @@ "mean-var" = {frontier <- meanvar.efficient.frontier(portfolio=portfolio, R=R, n.portfolios=n.portfolios, - risk_aversion=risk_aversion) + risk_aversion=risk_aversion, + ...=...) }, "mean-ETL"=, "mean-CVaR"=, "mean-ES"=, "mean-etl" = {frontier <- meanetl.efficient.frontier(portfolio=portfolio, R=R, - n.portfolios=n.portfolios) + n.portfolios=n.portfolios, + ...=...) }, "random" = {tmp <- optimize.portfolio(R=R, portfolio=portfolio, From noreply at r-forge.r-project.org Sat Nov 16 22:10:08 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 16 Nov 2013 22:10:08 +0100 (CET) Subject: [Returnanalytics-commits] r3265 - pkg/PortfolioAnalytics/R Message-ID: <20131116211008.65050184C61@r-forge.r-project.org> Author: rossbennett34 Date: 2013-11-16 22:10:07 +0100 (Sat, 16 Nov 2013) New Revision: 3265 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R pkg/PortfolioAnalytics/R/objectiveFUN.R Log: Calculating mean return more efficiently using weights and moments Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-15 20:28:47 UTC (rev 3264) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-11-16 21:10:07 UTC (rev 3265) @@ -474,7 +474,7 @@ # penalize weights that violate return target constraint if(!is.null(constraints$return_target)){ return_target <- constraints$return_target - mean_return <- mean(R %*% w) + mean_return <- port.mean(weights=w, mu=moments$mu) mult <- 1 out = out + penalty * mult * abs(mean_return - return_target) } # End return constraint penalty @@ -559,8 +559,12 @@ switch(objective$name, mean =, median = { + fun = match.fun(port.mean) + # would it be better to do crossprod(w, moments$mu)? + # tmp_args$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product + }, + median = { fun = match.fun(objective$name) - # would it be better to do crossprod(w, moments$mu)? tmp_args$x <- ( R %*% w ) #do the multivariate mean/median with Kroneker product }, sd =, @@ -596,6 +600,7 @@ if(is.function(fun)){ .formals <- formals(fun) # Add the moments from the nargs object + # nargs contains the moments, these are being evaluated .formals <- modify.args(formals=.formals, arglist=nargs, dots=TRUE) # Add anything from tmp_args .formals <- modify.args(formals=.formals, arglist=tmp_args, dots=TRUE) Modified: pkg/PortfolioAnalytics/R/objectiveFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/objectiveFUN.R 2013-11-15 20:28:47 UTC (rev 3264) +++ pkg/PortfolioAnalytics/R/objectiveFUN.R 2013-11-16 21:10:07 UTC (rev 3265) @@ -63,3 +63,9 @@ return(hhi) } } + +# portfolio mean return +port.mean <- function(weights, mu){ + # t(weights) %*% moments$mu + as.numeric(crossprod(weights, mu)) +} From noreply at r-forge.r-project.org Tue Nov 26 18:41:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 26 Nov 2013 18:41:46 +0100 (CET) Subject: [Returnanalytics-commits] r3266 - pkg/PerformanceAnalytics/R Message-ID: <20131126174146.12B491865A1@r-forge.r-project.org> Author: matthieu_lestel Date: 2013-11-26 18:41:45 +0100 (Tue, 26 Nov 2013) New Revision: 3266 Modified: pkg/PerformanceAnalytics/R/MSquaredExcess.R Log: correction of a bug when risk free rate is not null in MSquaredExcess computation Modified: pkg/PerformanceAnalytics/R/MSquaredExcess.R =================================================================== --- pkg/PerformanceAnalytics/R/MSquaredExcess.R 2013-11-16 21:10:07 UTC (rev 3265) +++ pkg/PerformanceAnalytics/R/MSquaredExcess.R 2013-11-26 17:41:45 UTC (rev 3266) @@ -52,8 +52,8 @@ Rbp = (prod(1 + Rb))^(Period / length(Rb)) - 1 switch(Method, - geometric = {result = (1+MSquared(Ra,Rb))/(1+Rbp) - 1}, - arithmetic = {result = MSquared(Ra,Rb) - Rbp} + geometric = {result = (1+MSquared(Ra,Rb,Rf))/(1+Rbp) - 1}, + arithmetic = {result = MSquared(Ra,Rb,Rf) - Rbp} ) # end switch } else { From noreply at r-forge.r-project.org Tue Nov 26 19:30:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 26 Nov 2013 19:30:45 +0100 (CET) Subject: [Returnanalytics-commits] r3267 - pkg/PerformanceAnalytics/R Message-ID: <20131126183045.AC4A518644C@r-forge.r-project.org> Author: matthieu_lestel Date: 2013-11-26 19:30:45 +0100 (Tue, 26 Nov 2013) New Revision: 3267 Modified: pkg/PerformanceAnalytics/R/DownsideDeviation.R Log: example with MAR at 0.5% instead of 50% Modified: pkg/PerformanceAnalytics/R/DownsideDeviation.R =================================================================== --- pkg/PerformanceAnalytics/R/DownsideDeviation.R 2013-11-26 17:41:45 UTC (rev 3266) +++ pkg/PerformanceAnalytics/R/DownsideDeviation.R 2013-11-26 18:30:45 UTC (rev 3267) @@ -83,9 +83,9 @@ #' #with data used in Bacon 2008 #' #' data(portfolio_bacon) -#' MAR = 0.5 -#' DownsideDeviation(portfolio_bacon[,1], MAR) #expected 0.493 -#' DownsidePotential(portfolio_bacon[,1], MAR) #expected 0.491 +#' MAR = 0.005 +#' DownsideDeviation(portfolio_bacon[,1], MAR) #expected 0.0255 +#' DownsidePotential(portfolio_bacon[,1], MAR) #expected 0.0137 #' #' #with data of managers #' From noreply at r-forge.r-project.org Tue Nov 26 23:19:51 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 26 Nov 2013 23:19:51 +0100 (CET) Subject: [Returnanalytics-commits] r3268 - pkg/PerformanceAnalytics Message-ID: <20131126221951.3EF2F18532E@r-forge.r-project.org> Author: peter_carl Date: 2013-11-26 23:19:50 +0100 (Tue, 26 Nov 2013) New Revision: 3268 Modified: pkg/PerformanceAnalytics/NAMESPACE Log: - added AverageRecovery to namespace Modified: pkg/PerformanceAnalytics/NAMESPACE =================================================================== --- pkg/PerformanceAnalytics/NAMESPACE 2013-11-26 18:30:45 UTC (rev 3267) +++ pkg/PerformanceAnalytics/NAMESPACE 2013-11-26 22:19:50 UTC (rev 3268) @@ -16,6 +16,7 @@ apply.rolling, AppraisalRatio, AverageDrawdown, + AverageRecovery, BernardoLedoitRatio, BetaCoKurtosis, BetaCoSkewness,