#' Apply a risk or return function to a set of weights
#'
#' This function is used to calculate risk or return metrics given a matrix of
#' weights and is primarily used as a convenience function used in chart.Scatter functions
#'
#' @param R xts object of asset returns
#' @param weights a matrix of weights generated from random_portfolios or \code{optimize.portfolio}
#' @param FUN name of a function
#' @param arguments named list of arguments to FUN
#' @author Ross Bennett
#' @export
applyFUN <- function(R, weights, FUN="mean", arguments){
nargs <- arguments
moments <- function(R){
momentargs <- list()
momentargs$mu <- matrix(as.vector(apply(R, 2, "mean")), ncol = 1)
momentargs$sigma <- cov(R)
momentargs$m3 <- PerformanceAnalytics::M3.MM(R)
momentargs$m4 <- PerformanceAnalytics::M4.MM(R)
return(momentargs)
}
nargs <- c(nargs, moments(R))
nargs$R <- R
#nargs$invert=FALSE
# match the FUN arg to a risk or return function
switch(FUN,
mean = {
fun = match.fun(mean)
},
sd =,
StdDev = {
fun = match.fun(StdDev)
},
mVaR =,
VaR = {
fun = match.fun(VaR)
if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
if(is.null(nargs$invert)) nargs$invert = FALSE
},
es =,
mES =,
CVaR =,
cVaR =,
ETL=,
mETL=,
ES = {
fun = match.fun(ES)
if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
if(is.null(nargs$invert)) nargs$invert = FALSE
},
# CSM = {
# fun = match.fun(CSM)
# if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
# if(is.null(nargs$invert)) nargs$invert = FALSE
# },
{ # see 'S Programming p. 67 for this matching
fun <- try(match.fun(FUN))
}
) # end switch block
if(!is.null(nrow(weights))){
# case for matrix of weights
out <- rep(0, nrow(weights))
.formals <- formals(fun)
onames <- names(.formals)
for(i in 1:nrow(weights)){
nargs$weights <- as.numeric(weights[i,])
nargs$x <- R %*% as.numeric(weights[i,])
dargs <- nargs
pm <- pmatch(names(dargs), onames, nomatch = 0L)
names(dargs[pm > 0L]) <- onames[pm]
.formals[pm] <- dargs[pm > 0L]
out[i] <- try(do.call(fun, .formals))
}
} else {
# case for single vector of weights
.formals <- formals(fun)
onames <- names(.formals)
nargs$weights <- as.numeric(weights)
nargs$x <- R %*% as.numeric(weights)
dargs <- nargs
pm <- pmatch(names(dargs), onames, nomatch = 0L)
names(dargs[pm > 0L]) <- onames[pm]
.formals[pm] <- dargs[pm > 0L]
out <- try(do.call(fun, .formals))
}
return(out)
}
#' Apply a risk or return function to asset returns
#'
#' This function is used to calculate risk or return metrics given a matrix of
#' asset returns and will be used for a risk-reward scatter plot of the assets
#'
#' @param R xts object of asset returns
#' @param FUN name of function
#' @param arguments named list of arguments to FUN
#' @author Ross Bennett
#' @export
scatterFUN <- function(R, FUN, arguments=NULL){
if(is.null(arguments)){
nargs <- list()
} else{
nargs <- arguments
}
# match the FUN arg to a risk or return function
switch(FUN,
mean = {
return(as.numeric(apply(R, 2, mean)))
#fun = match.fun(mean)
#nargs$x = R
},
var = {
return(as.numeric(apply(R, 2, var)))
#fun = match.fun(mean)
#nargs$x = R
},
sd =,
StdDev = {
fun = match.fun(StdDev)
},
mVaR =,
VaR = {
fun = match.fun(VaR)
if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
if(is.null(nargs$invert)) nargs$invert = FALSE
},
es =,
mES =,
CVaR =,
cVaR =,
ETL =,
mETL =,
ES = {
fun = match.fun(ES)
if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
if(is.null(nargs$invert)) nargs$invert = FALSE
},
# CSM = {
# fun = match.fun(CSM)
# if(is.null(nargs$portfolio_method)) nargs$portfolio_method='single'
# if(is.null(nargs$invert)) nargs$invert = FALSE
# },
{ # see 'S Programming p. 67 for this matching
fun <- try(match.fun(FUN))
}
) # end switch block
# calculate FUN on R
out <- rep(0, ncol(R))
.formals <- formals(fun)
onames <- names(.formals)
for(i in 1:ncol(R)){
nargs$R <- R[, i]
dargs <- nargs
pm <- pmatch(names(dargs), onames, nomatch = 0L)
names(dargs[pm > 0L]) <- onames[pm]
.formals[pm] <- dargs[pm > 0L]
out[i] <- try(do.call(fun, .formals))
}
return(out)
}
###############################################################################
# R (https://r-project.org/) Numeric Methods for Optimization of Portfolios
#
# Copyright (c) 2004-2021 Brian G. Peterson, Peter Carl, Ross Bennett, Kris Boudt
#
# This library is distributed under the terms of the GNU Public License (GPL)
# for full details see the file COPYING
#
# $Id$
#
###############################################################################
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.