# R/plop.R In quarks: Simple Methods for Calculating and Backtesting Value at Risk and Expected Shortfall

#### Documented in plop

#' Profit & Loss operator function
#'
#' Calculates portfolio returns or losses by assigning weights
#'
#' @param x a numeric matrix of asset returns or losses
#' @param wts a numeric vector or matrix containing the portfolio
#' weights; portfolio value is standardized to 1 on any observation unit;
#' sum of weights should not exceed 1 (row-wise for matrices); by default
#' the portfolio is equally weighted over time and across all assets; if a
#' vector is passed to \code{wts} the portfolio is equally weighted over time
#' @param approxim controls if a first-order approximation for the calculation
#' of returns or losses is used; default is \code{1} (first-order
#' approximation is employed)
#'
#' @export
#'
#' @return Returns a list with the following elements:
#' \describe{
#' \item{pl}{Weighted portfolio returns or losses}
#' \item{wts}{Portfolio weights}
#' }
#' @examples
#' # creating portfolio
#' portfol <- cbind(SP500$price.close, DJI$price.close)
#' returns <- apply(portfol, 2, function(x) diff(log(x)))
#' # defining weights and applying the P&L operator function
#' wts <- c(0.4, 0.6)
#' portret <- plop(returns, wts = wts, approxim = 1)
#' portloss <- plop(-returns, wts = wts, approxim = 1)
#' plot.ts(cbind(portret$pl, portloss$pl))
#'
plop <-  function(x, wts = NULL, approxim = c(0, 1)) {
if ((dim(wts)[1] == 1 || is.null(dim(wts)[1])) &&
(!is.null(wts) && sum(wts) > 1)) {
warning("Sum of weights in 'wts' exceeding 1.")
}
if ((dim(wts)[1] > 1 && !is.null(dim(wts)[1])) &&
(!is.null(wts) && rowSums(wts) > 1)) {
warning("Sum of weights in some row(s) of 'wts' exceeding 1.")
}
if (!length(approxim) %in% c(1, 2) || any(is.na(approxim)) ||
!is.numeric(approxim) || !all(approxim %in% c(0, 1))) {
stop("A single integer value must be passed to 'approxim'.",
"Valid choices are 0 or 1.")
}
if (all(approxim == c(0, 1))) approxim = 1
x <- as.matrix(x)
ncol <- dim(x)[2]

if (is.null(wts)) wts <- rep(1 / ncol, ncol)
if (dim(wts)[1] == 1 && is.matrix(wts)) wts <- as.vector(wts)
if (dim(wts)[1] == 1 || is.null(dim(wts)[1])) op <- '%*%'
if (dim(wts)[1] > 1 && !is.null(dim(wts)[1])) op <- '*'

switch(as.character(approxim),
"0" =  {
pl <- rowSums(get(op)(exp(x), wts) - 1)
},
"1" = {
pl <- rowSums(get(op)(x, wts))
})
return(list(pl = pl,
wts = wts))
}


## Try the quarks package in your browser

Any scripts or data that you put into this service are public.

quarks documentation built on Sept. 1, 2022, 1:06 a.m.