Nothing
#' @name portfolio_compute
#'
#' @title Portfolio Compute
#'
#' @description Computation of all the transaction updates and the
#' realized and paper gains and losses for each assets.
#'
#' @param portfolio_transactions Data frame. The investor's transactions data frame.
#' @inheritParams closest_market_price
#' @inheritParams paper_compute
#' @inheritParams difference_in_time
#' @param method Character string containing the method to use to compute
#' realized and paper gains and losses. If "none" nothing is computed but the
#' investor's portfolio updates. Otherwise it has to be one of "count" (default),
#' "total", "value", "duration", or "all".
#' @param exact_market_prices Logical. If TRUE then \code{\link{closest_market_price}}
#' uses exact datetime match to look for the closest price of each asset.
#' It usually speeds up computation by a small degree, but it requires the
#' `market_prices` to have the prices for each transaction asset along each
#' transaction datetimes.
#' @param portfolio_driven_DE Logical. If TRUE the realized and paper gains and
#' losses for the positive (that is when the investor's portfolio value, as
#' computed through \code{\link{evaluate_portfolio}}, is greater than zero)
#' and the negative (that is when the investor's portfolio value, as computed
#' through \code{\link{evaluate_portfolio}}, is smaller than zero) portfolios
#' are returned.
#' @param time_series_DE Logical. If TRUE the time series of disposition effect
#' is computed on 'count' and 'value' methods only.
#' @param assets_time_series_DE Character vector of assets' names as contained
#' into `portfolio_transactions` on which to compute the time series disposition
#' effect.
#' @param verbose Numeric or logical vector of length 2 that allows to control
#' for the function's verbosity.
#' @param progress Logical. If TRUE a progress bar is displayed.
#'
#' @return A data frame containing the investor's
#' portfolio and the values of realized and paper gains and losses
#' computed by means of the chosen method on each portfolio assets.
#'
#' If time_series_DE is set to TRUE, then also time series disposition effect
#' results are returned.
#'
#' @seealso \code{\link{realized_compute}}, \code{\link{paper_compute}},
#' \code{\link{gains_losses}}
#'
#' @export
portfolio_compute <- function(
portfolio_transactions,
market_prices,
method = "count",
allow_short = TRUE,
time_threshold = "0 mins",
exact_market_prices = TRUE,
portfolio_driven_DE = FALSE,
time_series_DE = FALSE,
assets_time_series_DE = NULL,
verbose = c(0, 0),
progress = FALSE
) {
# defensive programming
# check portfolio_transactions column names
trg <- c("investor", "type", "asset", "quantity", "price", "datetime")
chk <- check_values(names(portfolio_transactions), trg)
if (!is.null(chk)) {
stop(paste0("portfolio_transactions must contain columns '", paste(trg, collapse = "', '"), "'.\n",
"Can't find column(s) '", paste(chk, collapse = "', '"), "'. Possibly misspelled column names?\n"),
call. = FALSE)
}
# check market_prices column names
trg <- c("asset", "datetime", "price")
chk <- check_values(names(market_prices), trg)
if (!is.null(chk)) {
stop(paste0("market_prices must contain columns '", paste(trg, collapse = "', '"), "'.\n",
"Can't find column(s) '", paste(chk, collapse = "', '"), "'. Possibly misspelled column names?\n"),
call. = FALSE)
}
# check portfolio_transactions column type values
trg <- c("B", "S")
chk <- check_values(unique(portfolio_transactions$type), trg, no_exception = TRUE, weak_target = TRUE)
if (!is.null(chk$target) | !is.null(chk$input)) {
stop(paste0("Column type of portfolio_transactions should contain 'B' or 'S' only.\n"), call. = FALSE)
}
# check method argument
trg <- c("count", "total", "value", "duration", "all", "none")
chk <- check_values(method, trg, weak_target = TRUE)
if (!is.null(chk)) {
stop(paste0("method should be one of '", paste(trg, collapse = "', '"), "'.\n"), call. = FALSE)
}
# check time_threshold argument
trg <- c("sec", "min", "hour", "day", "week")
chk <- grepl("(sec)|(min)|(hour)|(day)|(week)", time_threshold)
if (!chk) {
stop(paste0("time_threshold units should be one of '", paste(trg, collapse = "', '"), "'.\n"), call. = FALSE)
}
# check method & time_series_DE
if (method %in% c("total", "duration", "none") & time_series_DE) {
warning("time_series_DE computation does not exist for method 'total', 'duration' and 'none'. Forced time_series_DE to FALSE",
call. = FALSE)
time_series_DE <- FALSE
}
# check portfolio_driven_DE & time_series_DE
if (portfolio_driven_DE & time_series_DE) {
warning("time_series_DE computation is not allowed with portfolio_driven_DE. Forced time_series_DE to FALSE",
call. = FALSE)
time_series_DE <- FALSE
}
# check time_series_DE & assets_time_series_DE
if (!time_series_DE & !is.null(assets_time_series_DE)) {
warning("assets_time_series_DE can only be used with time_series_DE set to TRUE. Forced asset_time_series_DE to NULL",
call. = FALSE)
assets_time_series_DE <- NULL
}
# check assets_time_series_DE values
if (!is.null(assets_time_series_DE)) {
trg <- unique(portfolio_transactions$asset)
chk <- check_values(assets_time_series_DE, trg, no_exception = TRUE, weak_target = TRUE)
if (!is.null(chk$target) | !is.null(chk$input)) {
stop(paste0("assets_time_series_DE must contain valid assets' names (present into portfolio_transactions).\n"), call. = FALSE)
}
}
# check exact_market_prices
if (!exact_market_prices) {
message("Note: exact_market_prices set to FALSE, unreliable results may be obtained when
transactions occur with low frequency.\n")
}
# verbosity
verb_lvl1 <- as.logical(verbose[1])
verb_lvl2 <- as.logical(verbose[2])
# global parameters
investor_id <- portfolio_transactions$investor[1]
investor_assets <- sort(unique(portfolio_transactions$asset), method = "radix")
investor_datetimes <- portfolio_transactions$datetime
asset_numtrx <- portfolio_transactions %>%
dplyr::group_by(!!dplyr::sym("asset")) %>%
dplyr::summarise(numtrx = dplyr::n(), .groups = "drop")
if (!is.null(assets_time_series_DE)) {
assets_time_series_DE <- sort(assets_time_series_DE, method = "radix")
}
# investor's initial portfolio (portfolio at time 0):
# an empty df with all the assets traded by the investor
# with qty = NA and prz = NA for all the assets (initial condition)
portfolio <- initializer_portfolio(investor_id, investor_assets)
# initialize the df of computations: RG, RL, PG, PL and other
if (!portfolio_driven_DE) {
results_df <- initializer_realized_and_paper(investor_id, investor_assets, method)
} else {
pos_results_df <- initializer_realized_and_paper(investor_id, investor_assets, method)
neg_results_df <- initializer_realized_and_paper(investor_id, investor_assets, method)
}
# initialize the df of time series DE
if (time_series_DE) {
DE_results_df <- initializer_timeseries_DE(investor_id, assets_time_series_DE, investor_datetimes, method)
}
# progress bar
if (progress) {
# initialize progress bar
pb <- progress::progress_bar$new(
format = ":current [:bar] :percent in :elapsed\n\n",
total = nrow(portfolio_transactions),
clear = FALSE, width = 60, show_after = 0
)
pb$tick(0)
}
for (i in seq_len(nrow(portfolio_transactions))) {
# extract scalars (trx = transaction)
trx_type <- portfolio_transactions[i, ]$type # trx type
trx_asset <- portfolio_transactions[i, ]$asset # trx asset
trx_qty <- portfolio_transactions[i, ]$quantity # trx quantity
trx_prz <- portfolio_transactions[i, ]$price # trx price
trx_dtt <- portfolio_transactions[i, ]$datetime # trx datetime
previous_dtt <- portfolio_transactions[i - 1, ]$datetime
# if it's a sell transaction then consider qty as negative
if (trx_type == "S") {
trx_qty <- trx_qty * -1L
}
# extract assets already into portfolio
ptf_assets <- portfolio[!is.na(portfolio$quantity) & portfolio$quantity != 0, ]$asset
portfolio_adjusted <- portfolio
market_przs <- gainloss_df <- portfolio_value <- NULL
# if method is not "none" and the portfolio is not empty (initial condition),
# then calls closest_market_price, gains_losses and evaluate_portfolio
if (method != "none" & length(ptf_assets) > 0) {
# if the portfolio contains more assets than the traded asset, then extract
# the market prices at transaction_datetime of all the portfolio assets
ptf_assets <- ptf_assets[ptf_assets %!in% trx_asset]
if (length(ptf_assets) > 0) {
# if the market_prices contain the exact datetimes of portfolio transactions
# then exact computation can be performed and the market_prices data frame
# can be sliced rolling forward to speed up computations
if (exact_market_prices) {
market_przs <- closest_market_price(ptf_assets, trx_dtt, market_prices, exact = TRUE)[, -2]
# market_prices <- market_prices[market_prices$datetime >= trx_dtt, ]
} else {
market_przs <- closest_market_price(ptf_assets, trx_dtt, market_prices)[, -2]
}
chk_mp <- check_values(market_przs$asset, ptf_assets)
if (!is.null(chk_mp)) {
warning(paste0("Investor ", investor_id, ", transaction ", i, ", datetime ", trx_dtt, ":\n",
"No market prices available for asset(s) ", paste(chk_mp, collapse = ", "), "\n"),
call. = FALSE)
portfolio_adjusted <- portfolio_adjusted[portfolio_adjusted$asset %!in% chk_mp, ]
}
market_przs <- market_przs[order(factor(market_przs$asset, levels = ptf_assets), method = "radix"), ]
} else {
market_przs <- data.frame("asset" = trx_asset, "price" = trx_prz)
}
# compute RG/RL/PG/PL
if (verb_lvl1) message("Start computing RG/RL/PG/PL..")
gainloss_df <- gains_losses(
portfolio = portfolio_adjusted,
market_prices = market_przs,
transaction_type = trx_type,
transaction_asset = trx_asset,
transaction_quantity = trx_qty,
transaction_price = trx_prz,
transaction_datetime = trx_dtt,
previous_datetime = previous_dtt,
time_threshold = time_threshold,
method = method,
allow_short = allow_short,
verbose = verb_lvl2
)
if (method %in% c("value", "all")) {
chk_gl <- check_gainloss(gainloss_df)
if (!is.null(chk_gl)) {
warning(paste0("Investor ", investor_id, ", transaction ", i, ":\n", chk_gl), call. = FALSE)
}
}
# evaluate global portfolio value
if (verb_lvl1) message("Evaluating global portfolio position..")
portfolio_value <- evaluate_portfolio(
portfolio = portfolio,
market_prices = rbind(market_przs, data.frame("asset" = trx_asset, "price" = trx_prz))
)
}
# update the portfolio
if (verb_lvl1) message(paste0("Updating portfolio.. (", trx_asset, " asset)"))
portfolio <- update_portfolio(portfolio, trx_asset, trx_qty, trx_prz, trx_dtt, trx_type)
# update the results_df
if (method != "none" & !is.null(gainloss_df)) {
if (verb_lvl1) message("Updating realized and paper results..")
if (!portfolio_driven_DE) {
results_df <- update_realized_and_paper(results_df, gainloss_df, method)
} else {
if (portfolio_value >= 0) {
pos_results_df <- update_realized_and_paper(pos_results_df, gainloss_df, method)
} else {
neg_results_df <- update_realized_and_paper(neg_results_df, gainloss_df, method)
}
}
}
# time series disposition effect
if (time_series_DE & i != 1) {
if (verb_lvl1) message("Computing time series DE..")
DE_results_df <- update_timeseries_DE(
timeseries_DE = DE_results_df,
realized_and_paper = results_df,
gainslosses = gainloss_df,
transaction_id = i,
assets_time_series_DE,
method
)
}
if (verb_lvl1) message("Done!")
if (progress) {
pb$tick()
} # update progress bar
rm(
trx_type, trx_asset, trx_qty, trx_prz, trx_dtt, previous_dtt,
ptf_assets, market_przs, gainloss_df, portfolio_value, portfolio_adjusted
)
} # close loop
# compute the mean expected return for RG, RL, PG, and PL value
if (method %in% c("value", "all")) {
if (!portfolio_driven_DE) {
results_df <- update_expectedvalue(results_df, asset_numtrx)
} else {
pos_results_df <- update_expectedvalue(pos_results_df, asset_numtrx)
neg_results_df <- update_expectedvalue(neg_results_df, asset_numtrx)
}
}
# join the dataframes and return a single result dataframe
if (method != "none") {
if (!portfolio_driven_DE) {
final_res <- dplyr::left_join(portfolio, results_df, by = c("investor", "asset"))
} else {
pos_results_df$type <- "positive"
neg_results_df$type <- "negative"
results_df <- dplyr::bind_rows(pos_results_df, neg_results_df)
final_res <- dplyr::left_join(portfolio, results_df, by = c("investor", "asset"))
final_res <- dplyr::relocate(final_res, !!dplyr::sym("type"), .after = !!dplyr::sym("datetime"))
}
} else {
final_res <- portfolio
}
if (time_series_DE) {
final_res <- list("portfolio" = final_res, "timeseries" = DE_results_df)
}
return(final_res) # return the updated portfolio
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.