# R/paper.R In dispositionEffect: Analysis of Disposition Effect on Financial Portfolios

#### Documented in paper_computepaper_countpaper_durationpaper_totalpaper_value

```#' @name paper_compute
#'
#' @title Papers' estimation
#'
#' @description Compute paper gains and paper losses as either simple counts,
#'   total quantities, expected returns and financial duration.
#'
#' @param portfolio_quantity Numeric vector. The portfolio quantities of assets into the
#'   investor's portfolio.
#' @param portfolio_price Numeric vector. The portfolio prices of assets into the
#'   investor's portfolio.
#' @param market_price Numeric vector. The market prices of assets into the
#'   investor's portfolio.
#' @param datetime_difference Numeric value of time difference between the previous_datetime
#'   and the transaction_datetime, computed through \code{\link{difftime_financial}}.
#'   If NULL, then previous_datetime and transaction_datetime must be specified.
#' @param previous_datetime POSIXct value. The date-time of the last transaction
#'   performed by the investor.
#' @param transaction_datetime POSIXct value. The date-time at which the transaction
#'   is going to occur.
#' @param assets Character vector. The name of assets into the investor's
#'   portfolio but the traded asset.
#' @param allow_short Logical. If TRUE short positions are allowed, otherwise only
#'   long positions are allowed.
#' @param method Character string. The method used to compute papers.
#'   Allowed values are "count", "total", "value", "duration" and "all".
#'
#' @return
#'   The described functions have different return behaviors
#'
#'   * \code{paper_compute} returns a data frame containing the values of
#'   paper gains and paper losses computed by means of the chosen method
#'   on each portfolio assets.
#'
#'   * \code{paper_count} returns a named vector containing the values of
#'   paper gains and paper losses computed using the count method.
#'
#'   * \code{paper_total} returns a named vector containing the values of
#'   paper gains and paper losses computed using the total method.
#'
#'   * \code{paper_value} returns a named vector containing the values of
#'   paper gains and paper losses computed using the value method.
#'
#'   * \code{paper_duration} returns a named vector containing the values
#'   of paper gains and paper losses computed using the duration method.
#'
#'   In particular:
#'
#'   * \code{RG_"method"} contains Realized Gains results
#'   * \code{RL_"method"} contains Realized Losses results
#'   * \code{PG_"method"} contains Paper Gains results
#'   * \code{PL_"method"} contains Paper Losses results
#'
NULL

#' @describeIn paper_compute Computation of paper gains and paper losses as
#'   simple counts (default method).
#' @export
paper_count <- function(portfolio_quantity, portfolio_price, market_price, allow_short = TRUE) {

prz_diff <- market_price - portfolio_price # price difference

if (allow_short) {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 1, "PL_count" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 0, "PL_count" = 1)
} else if (portfolio_quantity < 0 && prz_diff > 0) { # Short - Paper Loss
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 0, "PL_count" = 1)
} else if (portfolio_quantity < 0 && prz_diff < 0) { # Short - Paper Gain
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 1, "PL_count" = 0)
} else {# if portfolio_quantity = 0 or prz_diff = 0
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 0, "PL_count" = 0)
}
} else {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 1, "PL_count" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 0, "PL_count" = 1)
} else {# if portfolio_quantity = 0 or prz_diff = 0
res <- c("RG_count" = 0, "RL_count" = 0, "PG_count" = 0, "PL_count" = 0)
}
}

return(res)

}

#' @describeIn paper_compute Computation of paper gains and paper losses as
#'   total quantity of assets.
#' @export
paper_total <- function(portfolio_quantity, portfolio_price, market_price, allow_short = TRUE) {

prz_diff <- market_price - portfolio_price # price difference

if (allow_short) {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = portfolio_quantity, "PL_total" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = 0, "PL_total" = portfolio_quantity)
} else if (portfolio_quantity < 0 && prz_diff > 0) { # Short - Paper Loss
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = 0, "PL_total" = abs(portfolio_quantity))
} else if (portfolio_quantity < 0 && prz_diff < 0) { # Short - Paper Gain
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = abs(portfolio_quantity), "PL_total" = 0)
} else {# if portfolio_quantity = 0 or prz_diff = 0
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = 0, "PL_total" = 0)
}
} else {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = portfolio_quantity, "PL_total" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = 0, "PL_total" = portfolio_quantity)
} else {# if portfolio_quantity = 0 or prz_diff = 0 or portfolio_quantity < 0 (short)
res <- c("RG_total" = 0, "RL_total" = 0, "PG_total" = 0, "PL_total" = 0)
}
}

return(res)

}

#' @describeIn paper_compute Computation of paper gains and paper losses as
#'   expected return of assets.
#' @export
paper_value <- function(portfolio_quantity,	portfolio_price, market_price, allow_short = TRUE) {

prz_diff <- market_price - portfolio_price # price difference
Er <- prz_diff / portfolio_price # asset expected return

if (allow_short) {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = Er, "PL_value" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = 0, "PL_value" = Er)
} else if (portfolio_quantity < 0 && prz_diff > 0) { # Short - Paper Loss
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = 0, "PL_value" = -Er)
} else if (portfolio_quantity < 0 && prz_diff < 0) { # Short - Paper Gain
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = -Er, "PL_value" = 0)
} else {# if portfolio_quantity = 0 or prz_diff = 0
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = 0, "PL_value" = 0)
}
} else {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = Er, "PL_value" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = 0, "PL_value" = Er)
} else {# if portfolio_quantity = 0 or prz_diff = 0 or portfolio_quantity < 0 (short)
res <- c("RG_value" = 0, "RL_value" = 0, "PG_value" = 0, "PL_value" = 0)
}
}

return(res)

}

#' @describeIn paper_compute Computation of paper gains and paper losses as
#'   financial duration.
#' @export
paper_duration <- function(
portfolio_quantity,
portfolio_price,
market_price,
datetime_difference = NULL,
previous_datetime = NULL,
transaction_datetime = NULL,
allow_short = TRUE
) {

prz_diff <- market_price - portfolio_price # price difference
if (is.null(datetime_difference)) {
dtt_diff <- difftime_financial(previous_datetime, transaction_datetime)
} else {
dtt_diff <- datetime_difference
}

if (allow_short) {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = dtt_diff, "PL_duration" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = 0, "PL_duration" = dtt_diff)
} else if (portfolio_quantity < 0 && prz_diff > 0) { # Short - Paper Loss
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = 0, "PL_duration" = dtt_diff)
} else if (portfolio_quantity < 0 && prz_diff < 0) { # Short - Paper Gain
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = dtt_diff, "PL_duration" = 0)
} else {# if portfolio_quantity = 0 or prz_diff = 0
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = 0, "PL_duration" = 0)
}
} else {
if (portfolio_quantity > 0 && prz_diff > 0) { # Long - Paper Gain
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = dtt_diff, "PL_duration" = 0)
} else if (portfolio_quantity > 0 && prz_diff < 0) { # Long - Paper Loss
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = 0, "PL_duration" = dtt_diff)
} else {# if portfolio_quantity = 0 or prz_diff = 0
res <- c("RG_duration" = 0, "RL_duration" = 0, "PG_duration" = 0, "PL_duration" = 0)
}
}

return(res)

}

#' @describeIn paper_compute Wrapper that calls other paper_. functions to
#'   compute paper gains and paper losses based on the chosen method.
#' @export
paper_compute <- function(
portfolio_quantity,
portfolio_price,
market_price,
previous_datetime,
transaction_datetime,
assets,
allow_short = TRUE,
method = "all"
) {

if (method == "count") {

pgl_count <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_count,
allow_short
)
res_df <- as.data.frame(do.call(rbind, pgl_count))
res_df[["asset"]] <- assets
res_df <- res_df[c(ncol(res_df), 1:(ncol(res_df) - 1))]

} else if (method == "total") {

pgl_total <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_total,
allow_short
)
res_df <- as.data.frame(do.call(rbind, pgl_total))
res_df[["asset"]] <- assets
res_df <- res_df[c(ncol(res_df), 1:(ncol(res_df) - 1))]

} else if (method == "value") {

pgl_value <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_value,
allow_short
)
res_df <- as.data.frame(do.call(rbind, pgl_value))
res_df[["asset"]] <- assets
res_df <- res_df[c(ncol(res_df), 1:(ncol(res_df) - 1))]

} else if (method == "duration") {

dtt_diff <- difftime_financial(previous_datetime, transaction_datetime)
pgl_duration <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_duration,
datetime_difference = dtt_diff, allow_short = allow_short
)
res_df <- as.data.frame(do.call(rbind, pgl_duration))
res_df[["asset"]] <- assets
res_df <- res_df[c(ncol(res_df), 1:(ncol(res_df) - 1))]

} else {# method == "all"

pgl_count <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_count,
allow_short
)
pgl_total <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_total,
allow_short
)
pgl_value <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_value,
allow_short
)
dtt_diff <- difftime_financial(previous_datetime, transaction_datetime)
pgl_duration <- purrr::pmap(
list(portfolio_quantity, portfolio_price, market_price),
paper_duration,
datetime_difference = dtt_diff, allow_short = allow_short
)
res_df <- dplyr::bind_cols(
as.data.frame(do.call(rbind, pgl_count)),
as.data.frame(do.call(rbind, pgl_total)),
as.data.frame(do.call(rbind, pgl_value)),
as.data.frame(do.call(rbind, pgl_duration)),
)
res_df[["asset"]] <- assets
res_df <- res_df[c(ncol(res_df), 1:(ncol(res_df) - 1))]

}

return(res_df)

}
```

## Try the dispositionEffect package in your browser

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

dispositionEffect documentation built on May 30, 2022, 9:05 a.m.