#' @title Decompose portfolio risk into individual factor contributions and provide tabular report
#'
#' @description Compute the factor contributions to standard deviation (SD), Value-at-Risk (VaR),
#' Expected Tail Loss or Expected Shortfall (ES) of the return of individual asset within a portfolio
#' return of a portfolio based on Euler's theorem, given the fitted factor model.
#'
#' @importFrom lattice barchart
#' @importFrom data.table melt as.data.table
#' @importFrom methods is
#'
#' @param object fit object of class \code{tsfm}, or \code{ffm}.
#' @param p tail probability for calculation. Default is 0.05.
#' @param weights a vector of weights of the assets in the portfolio, names of
#' the vector should match with asset names. Default is NULL, in which case an
#' equal weights will be used.
#' @param risk one of 'Sd' (standard deviation), 'VaR' (Value-at-Risk) or 'ES' (Expected Tail
#' Loss or Expected Shortfall for calculating risk decompositon. Default is 'Sd'
#' @param decomp one of 'FMCR' (factor marginal contribution to risk),
#' 'FCR' 'factor contribution to risk' or 'FPCR' (factor percent contribution to risk).
#' @param digits digits of number in the resulting table. Default is NULL, in which case digtis = 3 will be
#' used for decomp = ( 'FMCR', 'FCR'), digits = 1 will be used for decomp = 'FPCR'. Used only when
#' isPrint = 'TRUE'
#' @param nrowPrint a numerical value deciding number of assets/portfolio in result vector/table to print
#' or plot
#' @param type one of "np" (non-parametric) or "normal" for calculating VaR & Es.
#' Default is "np".
#' @param sliceby one of 'factor' (slice/condition by factor) or 'asset' (slice/condition by asset) or 'riskType'
#' Used only when isPlot = 'TRUE'
#' @param invert a logical variable to change VaR/ES to positive number, default
#' is False and will return positive values.
#' @param layout layout is a numeric vector of length 2 or 3 giving the number of columns, rows, and pages (optional) in a multipanel display.
#' @param stripText.cex a number indicating the amount by which strip text in the plot(s) should be scaled relative to the default. 1=default, 1.5 is 50\% larger, 0.5 is 50\% smaller, etc.
#' @param axis.cex a number indicating the amount by which axis in the plot(s) should be scaled relative to the default. 1=default, 1.5 is 50\% larger, 0.5 is 50\% smaller, etc.
#' @param portfolio.only logical variable to choose if to calculate portfolio only decomposition, in which case multiple risk measures are
#' allowed.
#' @param isPlot logical variable to generate plot or not.
#' @param isPrint logical variable to print numeric output or not.
#' @param use an optional character string giving a method for computing factor
#' covariances in the presence of missing values. This must be (an
#' abbreviation of) one of the strings "everything", "all.obs",
#' "complete.obs", "na.or.complete", or "pairwise.complete.obs". Default is
#' "pairwise.complete.obs".
#' @param ... other optional arguments passed to \code{\link[stats]{quantile}} and
#' optional arguments passed to \code{\link[stats]{cov}}
#'
#' @return A table containing
#' \item{decomp = 'FMCR'}{(N + 1) * (K + 1) matrix of marginal contributions to risk of portfolio
#' return as well assets return, with first row of values for the portfolio and the remaining rows for
#' the assets in the portfolio, with (K + 1) columns containing values for the K risk factors and the
#' residual respectively}
#' \item{decomp = 'FCR'}{(N + 1) * (K + 2) matrix of component contributions to risk of portfolio
#' return as well assets return, with first row of values for the portfolio and the remaining rows for
#' the assets in the portfolio, with first column containing portfolio and asset risk values and remaining
#' (K + 1) columns containing values for the K risk factors and the residual respectively}
#' \item{decomp = 'FPCR'}{(N + 1) * (K + 1) matrix of percentage component contributions to risk
#' of portfolio return as well assets return, with first row of values for the portfolio and the remaining rows for
#' the assets in the portfolio, with (K + 1) columns containing values for the K risk factors and the
#' residual respectively}
#' Where, K is the number of factors, N is the number of assets.
#'
#' @author Douglas Martin, Lingjie Yi
#'
#'
#' @seealso \code{\link{fitTsfm}}, \code{\link{fitFfm}}
#' for the different factor model fitting functions.
#'
#'
#' @examples
#' # Time Series Factor Model
#'
#' data(managers, package = 'PerformanceAnalytics')
#'
#' fit.macro <- fitTsfm(asset.names = colnames(managers[,(1:6)]),
#' factor.names = colnames(managers[,(7:9)]),
#' rf.name = colnames(managers[,10]),
#' data = managers)
#'
#' report <- repRisk(fit.macro, risk = "ES", decomp = 'FPCR',
#' nrowPrint = 10)
#' report
#'
#' # plot
#' repRisk(fit.macro, risk = "ES", decomp = 'FPCR', isPrint = FALSE,
#' isPlot = TRUE)
#'
#' # Fundamental Factor Model
#' data("stocks145scores6")
#' dat = stocks145scores6
#' dat$DATE = zoo::as.yearmon(dat$DATE)
#' dat = dat[dat$DATE >=zoo::as.yearmon("2008-01-01") & dat$DATE <= zoo::as.yearmon("2012-12-31"),]
#'
#'
#' # Load long-only GMV weights for the return data
#' data("wtsStocks145GmvLo")
#' wtsStocks145GmvLo = round(wtsStocks145GmvLo,5)
#'
#' # fit a fundamental factor model
#' exposure.vars = c("SECTOR","ROE","BP","PM12M1M","SIZE","ANNVOL1M", "EP")
#' fit.cross <- fitFfm(data = dat,
#' exposure.vars = exposure.vars,
#' date.var = "DATE",
#' ret.var = "RETURN",
#' asset.var = "TICKER",
#' fit.method="WLS",
#' z.score = "crossSection")
#'
#' repRisk(fit.cross, risk = "Sd", decomp = 'FCR', nrowPrint = 10,
#' digits = 4)
#'
#' # get the factor contributions of risk
#' repRisk(fit.cross, wtsStocks145GmvLo, risk = "Sd", decomp = 'FPCR',
#' nrowPrint = 10)
#'
#' # portfolio only decomposition
#' repRisk(fit.cross, wtsStocks145GmvLo, risk = c("VaR", "ES"), decomp = 'FPCR',
#' portfolio.only = TRUE)
#'
#' # plot
#' repRisk(fit.cross, wtsStocks145GmvLo, risk = "Sd", decomp = 'FPCR',
#' isPrint = FALSE, nrowPrint = 15, isPlot = TRUE, layout = c(4,2))
#' @export
repRisk <- function(object, ...) {
# check input object validity
if(inherits(object, "list"))
{
for(i in 1: length(object))
{
if (!inherits(object[[i]], c("tsfm", "ffm")))
stop("Invalid argument: Object should be of class 'tsfm' or 'ffm'.")
}
UseMethod("repRisk", object[[1]])
}
else
{
if (!inherits(object, c("tsfm", "ffm")))
stop("Invalid argument: Object should be of class 'tsfm' or 'ffm'.")
UseMethod("repRisk")
}
}
# #' @rdname repRisk
# #' @method repRisk list
# #' @importFrom utils head
# #' @export
#
# repRisk.list <- function(object, weights = NULL, risk = c("Sd", "VaR", "ES"),
# decomp = c('FPCR','FCR','FMCR' ), digits = NULL, invert = FALSE,
# nrowPrint = 20, p=0.05, type=c("np","normal"), use="pairwise.complete.obs",
# sliceby = c('factor', 'asset'), isPrint = TRUE, isPlot = FALSE, layout =NULL,
# portfolio.only = FALSE, ...) {
#
# riskReport = function(object,weight, risk,
# decomp, digits,invert,
# nrowPrint, p, type, use,
# sliceby, isPrint, isPlot, layout,
# portfolio.only)
# {
# #return(object$r2)
# if (!inherits(object, c("tsfm", "ffm")))
# stop("Invalid argument: Object should be of class 'tsfm' or 'ffm'.")
# UseMethod("repRisk")
# }
# output.list<- lapply(X = 1:length(object), FUN = function(X){ riskReport(object[[X]],weight, risk,
# decomp, digits,invert,
# nrowPrint, p, type, use,
# sliceby, isPrint, isPlot, layout,
# portfolio.only)})
#
# }
#
#
#' @rdname repRisk
#' @method repRisk tsfm
#' @importFrom utils head
#' @export
repRisk.tsfm <- function(object, weights = NULL, risk = c("Sd", "VaR", "ES"),
decomp = c('FPCR','FCR','FMCR' ), digits = NULL, invert = FALSE,
nrowPrint = 20, p=0.05, type=c("np","normal"), use="pairwise.complete.obs",
sliceby = c('factor', 'asset'), isPrint = TRUE, isPlot = FALSE, layout =NULL,
stripText.cex =1,axis.cex=1,portfolio.only = FALSE, ...) {
# if(inherits(object, "list"))
# {
# output.list<- lapply(X = 1:length(object), FUN = function(X){ riskReport(object[[X]])})
# }
# riskReport = function(object)
# {
# return(object$r2)
# }
# set default for type
type = type[1]
sliceby = sliceby[1]
if(!portfolio.only){
risk = risk[1]
}
decomp = decomp[1]
if (!(type %in% c("np","normal"))) {
stop("Invalid args: type must be 'np' or 'normal' ")
}
if (!prod(risk %in% c("Sd", "VaR", "ES"))) {
stop("Invalid args: risk must be 'Sd', 'VaR' or 'ES' ")
}
if (!prod(decomp %in% c('FPCR','FCR','FMCR' ))) {
stop("Invalid args: decomp must be 'FMCR', 'FCR' or 'FPCR' ")
}
if(!portfolio.only){
if(length(which(risk == "Sd"))){
port.Sd = riskDecomp(object, weights = weights,risk = "Sd", ... )
asset.Sd = riskDecomp(object,risk = "Sd", portDecomp =FALSE, ... )
if(decomp == "FMCR"){
port = port.Sd$mSd
asset = asset.Sd$mSd
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
} else if(decomp == "FCR"){
portRM = port.Sd$portSd
assetRM = asset.Sd$Sd.fm
resultRM = c(portRM, assetRM)
port = port.Sd$cSd
asset = asset.Sd$cSd
result = cbind(resultRM,rbind(port, asset))
rownames(result)[1] = 'Portfolio'
colnames(result)[1] = 'RM'
} else if(decomp == "FPCR"){
port = port.Sd$pcSd
asset = asset.Sd$pcSd
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
}
} else if(length(which(risk == "VaR"))){
port.VaR = riskDecomp(object, risk = "VaR", weights = weights, p = p, type = type, invert = invert, ... )
asset.VaR = riskDecomp(object, p = p, type = type, invert = invert, risk = "VaR", portDecomp =FALSE, ... )
if(decomp == "FMCR"){
port = port.VaR$mVaR
asset = asset.VaR$mVaR
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
} else if(decomp == "FCR"){
portRM = port.VaR$portVaR
assetRM = asset.VaR$VaR.fm
resultRM = c(portRM, assetRM)
port = port.VaR$cVaR
asset = asset.VaR$cVaR
result = cbind(resultRM,rbind(port, asset))
rownames(result)[1] = 'Portfolio'
colnames(result)[1] = 'RM'
} else if(decomp == "FPCR"){
port = port.VaR$pcVaR
asset = asset.VaR$pcVaR
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
}
} else if(length(which(risk == "ES"))){
port.Es = riskDecomp(object, risk = "ES", weights = weights, p = p, type = type, invert = invert, ... )
asset.Es = riskDecomp(object, p = p, type = type, invert = invert,risk = "ES", portDecomp =FALSE, ... )
if(decomp == "FMCR"){
port = port.Es$mES
asset = asset.Es$mES
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
} else if(decomp == "FCR"){
portRM = port.Es$portES
assetRM = asset.Es$ES.fm
resultRM = c(portRM, assetRM)
port = port.Es$cES
asset = asset.Es$cES
result = cbind(resultRM,rbind(port, asset))
rownames(result)[1] = 'Portfolio'
colnames(result)[1] = 'RM'
} else if(decomp == "FPCR"){
port = port.Es$pcES
asset = asset.Es$pcES
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
}
}
if(isPlot){
if(decomp == "FCR"){
result = result[,-1]
}else if(decomp == "FPCR"){
result = result[,-1]
}
if(sliceby == 'factor'){
result = head(result, nrowPrint)
if(is.null(layout)){
n = ncol(result)
l = 3
while(n %% l == 1){
l = l+1
}
layout = c(l,1)
}
print(barchart(result[rev(rownames(result)),], groups = FALSE, main = paste(decomp,"of", risk),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black", cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
}else if(sliceby == 'asset'){
result = head(result, nrowPrint)
result = t(result)
if(is.null(layout)){
n = ncol(result)
l = 3
while(n %% l == 1){
l = l+1
}
layout = c(l,1)
}
print(barchart(result[rev(rownames(result)),], groups = FALSE, main = paste(decomp,"of", risk),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black", cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
}
}
if(isPrint){
if(is.null(digits)){
if(decomp == 'FPCR'){
digits = 1
}else{
digits = 3
}
}
result = head(result, nrowPrint)
result = round(result, digits)
output = list(decomp = result)
names(output) = paste(risk,decomp,sep = '')
return(output)
}
} else{
port.Sd = riskDecomp(object, risk = "Sd", weights = weights, ... )
port.VaR = riskDecomp(object, risk = "VaR", weights = weights, p = p, type = type, invert = invert, ... )
port.Es = riskDecomp(object, risk = "ES", weights = weights, p = p, type = type, invert = invert, ... )
if(decomp == "FMCR"){
Sd = port.Sd$mSd
VaR = port.VaR$mVaR
Es = port.Es$mES
result = rbind(Sd, VaR, Es)
rownames(result) = c('Sd','VaR','ES')
result = result[risk,]
} else if(decomp == "FCR"){
SdRM = port.Sd$portSd
VaRRM = port.VaR$portVaR
EsRM = port.Es$portES
resultRM = c(SdRM, VaRRM, EsRM)
names(resultRM) = c('Sd','VaR','ES')
Sd = port.Sd$cSd
VaR = port.VaR$cVaR
Es = port.Es$cES
result = rbind(Sd, VaR, Es)
rownames(result) = c('Sd','VaR','ES')
result = cbind(resultRM,result)
colnames(result)[1] = 'RM'
result = result[risk,]
} else if(decomp == "FPCR"){
Sd = port.Sd$pcSd
VaR = port.VaR$pcVaR
Es = port.Es$pcES
result = rbind(Sd, VaR, Es)
rownames(result) = c('Sd','VaR','ES')
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
result = result[risk,]
}
if(isPrint){
if(is.null(digits)){
if(decomp == 'FPCR'){
digits = 1
}else{
digits = 3
}
}
result = round(result, digits)
if(type=="normal"){
Type = 'Parametric Normal'
}else{
Type = 'Non-Parametric'
}
output = list(decomp = result)
names(output) = paste('Portfolio',decomp, Type, sep = ' ')
return(output)
}
}
}
#' @rdname repRisk
#' @method repRisk ffm
#' @importFrom utils head
#' @export
repRisk.ffm <- function(object, weights = NULL, risk = c("Sd", "VaR", "ES"),
decomp = c('FMCR', 'FCR', 'FPCR'), digits = NULL, invert = FALSE,
nrowPrint = 20, p=0.05, type=c("np","normal"),
sliceby = c('factor', 'asset', 'riskType'), isPrint = TRUE, isPlot = FALSE, layout =NULL,
stripText.cex =1,axis.cex=1,portfolio.only = FALSE, ...) {
riskReport = function(object,X,mul.port)
{
if(mul.port) weights = weights[[X]]
# set default for type
type = type[1]
sliceby = sliceby[1]
if(!portfolio.only){
risk = risk[1]
}
decomp = decomp[1]
if (!(type %in% c("np","normal"))) {
stop("Invalid args: type must be 'np' or 'normal' ")
}
if (!prod(risk %in% c("Sd", "VaR", "ES"))) {
stop("Invalid args: risk must be 'Sd', 'VaR' or 'ES' ")
}
if (!prod(decomp %in% c( 'FMCR', 'FCR', 'FPCR'))) {
stop("Invalid args: decomp must be 'FMCR', 'FCR' or 'FPCR' ")
}
if(!portfolio.only){
if(length(which(risk == "Sd"))){
port.Sd = riskDecomp(object,risk = "Sd",weights = weights, ... )
asset.Sd = riskDecomp(object,risk = "Sd", portDecomp =FALSE, ... )
if(decomp == "FMCR"){
port = port.Sd$mSd
asset = asset.Sd$mSd
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
} else if(decomp == "FCR"){
portRM = port.Sd$portSd
assetRM = asset.Sd$Sd.fm
resultRM = c(portRM, assetRM)
port = port.Sd$cSd
asset = asset.Sd$cSd
result = cbind(resultRM,rbind(port, asset))
rownames(result)[1] = 'Portfolio'
colnames(result)[1] = 'RM'
} else if(decomp == "FPCR"){
port = port.Sd$pcSd
asset = asset.Sd$pcSd
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
}
} else if(length(which(risk == "VaR"))){
port.VaR = riskDecomp(object, risk = "VaR", weights = weights, p = p, type = type, invert = invert, ... )
asset.VaR = riskDecomp(object,risk = "VaR", portDecomp =FALSE, p = p, type = type, invert = invert, ... )
if(decomp == "FMCR"){
port = port.VaR$mVaR
asset = asset.VaR$mVaR
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
} else if(decomp == "FCR"){
portRM = port.VaR$portVaR
assetRM = asset.VaR$VaR.fm
resultRM = c(portRM, assetRM)
port = port.VaR$cVaR
asset = asset.VaR$cVaR
result = cbind(resultRM,rbind(port, asset))
rownames(result)[1] = 'Portfolio'
colnames(result)[1] = 'RM'
} else if(decomp == "FPCR"){
port = port.VaR$pcVaR
asset = asset.VaR$pcVaR
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
}
} else if(length(which(risk == "ES"))){
port.Es = riskDecomp(object, risk = "ES", weights = weights, p = p, type = type, invert = invert, ... )
asset.Es = riskDecomp(object,risk = "ES", portDecomp =FALSE, p = p, type = type, invert = invert, ... )
if(decomp == "FMCR"){
port = port.Es$mES
asset = asset.Es$mES
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
} else if(decomp == "FCR"){
portRM = port.Es$portES
assetRM = asset.Es$ES.fm
resultRM = c(portRM, assetRM)
port = port.Es$cES
asset = asset.Es$cES
result = cbind(resultRM,rbind(port, asset))
rownames(result)[1] = 'Portfolio'
colnames(result)[1] = 'RM'
} else if(decomp == "FPCR"){
port = port.Es$pcES
asset = asset.Es$pcES
result = rbind(port, asset)
rownames(result)[1] = 'Portfolio'
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
}
}
if(isPlot){
if(decomp == "FCR"){
result = result[,-1]
}else if(decomp == "FPCR"){
result = result[,-1]
}
if(sliceby == 'factor'){
result = head(result, nrowPrint)
if(is.null(layout)){
n = ncol(result)
l = 3
while(n %% l == 1){
l = l+1
}
layout = c(l,1)
}
print(barchart(result[rev(rownames(result)),], groups = FALSE, main = paste(decomp,"of", risk, switch(mul.port, "1" = paste("for port", X), "")),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black", cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
}else if(sliceby == 'asset'){
result = head(result, nrowPrint)
result = t(result)
if(is.null(layout)){
n = ncol(result)
l = 3
while(n %% l == 1){
l = l+1
}
layout = c(l,1)
}
print(barchart(result[rev(rownames(result)),], groups = FALSE, main = paste(decomp,"of", risk, switch(mul.port, "1" = paste("for port", X), "")),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black", cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
}
}
if(isPrint){
if(is.null(digits)){
if(decomp == 'FPCR'){
digits = 1
}else{
digits = 3
}
}
result = head(result, nrowPrint)
result = round(result, digits)
output = list(decomp = result)
names(output) = paste(risk,decomp,sep = '')
return(output)
}
} else{
port.Sd = riskDecomp(object, risk = "Sd", weights = weights, ... )
port.VaR = riskDecomp(object, risk ="VaR", weights = weights, p = p, type = type, invert = invert, ... )
port.Es = riskDecomp(object,risk ="ES", weights = weights, p = p, type = type, invert = invert, ... )
if(decomp == "FMCR"){
Sd = port.Sd$mSd
VaR = port.VaR$mVaR
Es = port.Es$mES
result = rbind(Sd, VaR, Es)
rownames(result) = c('Sd','VaR','ES')
result = result[risk,]
} else if(decomp == "FCR"){
SdRM = port.Sd$portSd
VaRRM = port.VaR$portVaR
EsRM = port.Es$portES
resultRM = c(SdRM, VaRRM, EsRM)
names(resultRM) = c('Sd','VaR','ES')
Sd = port.Sd$cSd
VaR = port.VaR$cVaR
Es = port.Es$cES
result = rbind(Sd, VaR, Es)
rownames(result) = c('Sd','VaR','ES')
result = cbind(resultRM,result)
colnames(result)[1] = 'RM'
result = result[risk,]
} else if(decomp == "FPCR"){
Sd = port.Sd$pcSd
VaR = port.VaR$pcVaR
Es = port.Es$pcES
result = rbind(Sd, VaR, Es)
rownames(result) = c('Sd','VaR','ES')
result = cbind(rowSums(result), result)
colnames(result)[1] = 'Total'
result = result[risk,]
}
if(isPrint){
if(is.null(digits)){
if(decomp == 'FPCR'){
digits = 1
}else{
digits = 3
}
}
result = round(result, digits)
if(type=="normal"){
Type = 'Parametric Normal'
}else{
Type = 'Non-Parametric'
}
output = list(decomp = result)
names(output) = paste('Portfolio',decomp, Type, sep = ' ')
}
if(isPlot & !mul.port){
# single portfolio with multiple risks
if(is(result) == "matrix")
{
result = output[[1]]
result.mat = result[,-1]
# newdata = melt((as.data.table(result.mat)), id.vars = as.factor(rownames(result.mat)))
if(sliceby == "riskType"){
print(barchart(value~Var2|Var1, data = newdata,stack = TRUE, origin =0, main = list(paste("Portfolio", decomp, "Comparison" ), cex = axis.cex),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex,rot=90)),par.strip.text=list(col="black",font=2, cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
}else{
print(barchart(value~Var1|Var2, data = newdata,stack = TRUE, origin =0,main = list(paste("Portfolio", decomp, "Comparison" ), cex = axis.cex),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black",font=2, cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
}
}
else
{
result = result[-1]
result.mat = matrix(result, ncol =1)
rownames(result.mat) = names(result)
colnames(result.mat) = risk
print(barchart(result.mat,stack = TRUE,groups = FALSE, main = list(paste("Portfolio", risk, "Decomposition- ",decomp ), cex = axis.cex),layout = layout,
horizontal = FALSE, scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black",font=2, cex = stripText.cex),ylab = '', xlab = '', as.table = T))
}
}
return(output)
}
}
if(inherits(object, "list"))
{
#check for the lenght of weights
if(length(weights) != length(object)) stop("Error: Number of portfolios and weights do not match")
output.list<- lapply(X = 1:length(object), FUN = function(X){riskReport(object[[X]],X,mul.port = TRUE)})
if(isPlot && portfolio.only)
{
if(length(risk)>1){
# output1 = lapply(X = 1:length(output.list),function(X) output.list[[X]][[1]][i,])
# result.mat= matrix(unlist(output1), ncol = length(output1))
# colnames(result.mat) = unlist(lapply(X=1:length(object), function(X) paste("Portfolio",X)))
# rownames(result.mat) = names(output1[[1]])
result = unlist(output.list, recursive = FALSE, use.names = FALSE)
result.mat = matrix(unlist(result), ncol = length(result))
rownames(result.mat) = rep(unlist(dimnames(result[[1]])[2]), 1, each = length(risk))
colnames(result.mat) = unlist(lapply(X=1:length(object), function(X) paste("P",X)))
risk.type = rep(risk, 0.5*nrow(result.mat))
#result.mat = cbind(result.mat, Risk = factor(risk.type))
result.mat = result.mat[-c(1:length(risk)),]
newdata = data.table::melt(data.table::as.data.table(t(result.mat)),
id.vars = as.factor(colnames(result.mat)))
newdata$risk = factor(rep(risk, ))
print(barchart(value~Var1|Var2*risk, data = newdata, stack = TRUE,
origin = 0,
main = list(paste("Portfolio Risk Comparison- ", decomp),
cex = axis.cex),
layout = layout,
scales=list(y=list(cex=axis.cex),
x=list(cex=axis.cex)),
par.strip.text=list(col="black", font=2, cex = stripText.cex),
ylab = '', xlab = '', as.table = TRUE))
}
else{
result.mat= matrix(unlist(output.list), ncol = length(output.list))
colnames(result.mat) = unlist(lapply(X=1:length(object), function(X) paste("Portfolio",X)))
rownames(result.mat) = names(output.list[[1]][[1]])
#Remove Total
result.mat = result.mat[-1,]
newdata = data.table::melt(data.table::as.data.table(t(result.mat)),
id.vars = as.factor(colnames(result.mat)))
print(barchart(value~Var1|Var2, data = newdata,stack = TRUE, origin =0, main = list(paste("Portfolio Risk Comparison- ",risk,decomp), cex = axis.cex),layout = layout,
scales=list(y=list(cex=axis.cex), x=list(cex=axis.cex)),par.strip.text=list(col="black",font=2, cex = stripText.cex),ylab = '', xlab = '', as.table = TRUE))
# barchart(value~Var1|Var2, data = newdata, stack = TRUE, origin =0, scales = list(y = list(cex = axis.cex)),par.settings = my.settings,
# par.strip.text=list(col="black", cex = stripText.cex), group = Var1,auto.key=list(space="right",points=FALSE, rectangles=TRUE,title="", cex.title=stripText.cex))
}}
}
else
output.list<- riskReport(object,1, mul.port = FALSE)
return(output.list)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.