From 49b8ac876745d1c3799312465dbdaa47bcbcc5a7 Mon Sep 17 00:00:00 2001 From: Enrico Schumann Date: Sun, 28 Jul 2024 10:13:17 +0200 Subject: [PATCH] [unit_prices] Add arguments 'round.price' and 'round.units' --- ChangeLog | 5 ++++ DESCRIPTION | 2 +- NEWS | 7 +++-- R/unit_prices.R | 50 +++++++++++++++++++++++--------- inst/tinytest/test_unit_prices.R | 18 ++++++++++++ man/unit_prices.Rd | 18 +++++++++--- 6 files changed, 79 insertions(+), 21 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1bf8d12..0f533b8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2024-07-28 Enrico Schumann + + * R/unit_prices.R (unit_prices): add arguments + 'round.price' and 'round.units' + 2024-07-24 Enrico Schumann * R/unit_prices.R (unit_prices): refactor function diff --git a/DESCRIPTION b/DESCRIPTION index d868913..232d192 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: PMwR Type: Package Title: Portfolio Management with R Version: 0.19-6 -Date: 2024-07-24 +Date: 2024-07-28 Maintainer: Enrico Schumann Authors@R: person(given = "Enrico", family = "Schumann", role = c("aut", "cre"), diff --git a/NEWS b/NEWS index 5582112..97ccae3 100644 --- a/NEWS +++ b/NEWS @@ -1,12 +1,13 @@ -v0.19-6 (2024-07-24; not released yet) +v0.19-6 (2024-07-28; not released yet) o 'unit_prices': rename argument 'initial.shares' to - 'initial.units', and support its use + 'initial.units', and support its use. The function also + gains arguments 'round.price' and 'round.units'. o 'returns' now issues a warning when there are NAs in series and argument 'na.rm' is not explicitly set. This warning will be removed when the default of 'na.rm' is - set to TRUE in a not-too-distant future version. + set to FALSE in a not-too-distant future version. o .... diff --git a/R/unit_prices.R b/R/unit_prices.R index a9b2648..97d0914 100644 --- a/R/unit_prices.R +++ b/R/unit_prices.R @@ -4,7 +4,9 @@ unit_prices <- function(NAV, cashflows, initial.price, initial.units = 0, - cf.included = TRUE) { + cf.included = TRUE, + round.price = NULL, + round.units = NULL) { if (inherits(NAV, "zoo")) NAV <- data.frame(timestamp = index(NAV), NAV) @@ -22,7 +24,7 @@ unit_prices <- function(NAV, cashflows, T <- sort(unique(cashflows[[1L]])) price <- numeric(length(T)) - shares <- numeric(nrow(cashflows)) + NA + units <- numeric(nrow(cashflows)) + NA S <- initial.units t.NAV <- match(T, NAV[[1]]) @@ -31,6 +33,25 @@ unit_prices <- function(NAV, cashflows, paste(cashflows[[1]][is.na(t.NAV)], collapse = ", ")) } + + + ## rounding + do.round.price <- !is.null(round.price) + if (is.numeric(round.price)) { + fun_price <- function(x, amount = NULL, ...) + round(x, round.price) + } else + fun_price <- round.price + + ## rounding + do.round.units <- !is.null(round.units) + if (is.numeric(round.units)) { + fun_units <- function(x, amount = NULL, ...) + round(x, round.units) + } else + fun_units <- round.units + + if (missing(initial.price) && initial.units == 0) initial.price <- 100 @@ -38,32 +59,35 @@ unit_prices <- function(NAV, cashflows, cf.t <- cashflows[[1L]] == t scf <- sum(cashflows[[2]][cf.t]) if (t == T[1L] && initial.units == 0) - ## FIXME if NAV.t[1] != cf.t[1] , should - ## the initial unit-price be adjusted to - ## reflect the performance of the NAV? p <- initial.price else p <- (NAV[[2L]][t.NAV[t == T]] - cf.included*scf)/S + if (do.round.price) + p <- fun_price(p, cashflows[[2]][cf.t]) + dS <- cashflows[[2]][cf.t]/p - shares[cf.t] <- dS + if (do.round.units) + dS <- fun_units(dS, cashflows[[2]][cf.t]) + + units[cf.t] <- dS price[t == T] <- p S <- S + sum(dS) } - total.shares <- numeric(nrow(NAV)) - total.shares[t.NAV] <- tapply(shares, cashflows[[1L]], sum) - total.shares[1L] <- total.shares[1L] + initial.units - total.shares <- cumsum(total.shares) + total.units <- numeric(nrow(NAV)) + total.units[t.NAV] <- tapply(units, cashflows[[1L]], sum) + total.units[1L] <- total.units[1L] + initial.units + total.units <- cumsum(total.units) res <- NAV colnames(res) <- c("timestamp", "NAV") - p <- NAV[[2L]]/total.shares + p <- NAV[[2L]]/total.units p[t.NAV] <- price res <- cbind(res, data.frame(price = p, - units = total.shares, + units = total.units, stringsAsFactors = FALSE)) colnames(cashflows) <- if (ncol(cashflows) == 3L) @@ -71,6 +95,6 @@ unit_prices <- function(NAV, cashflows, else c("timestamp", "cashflow") attr(res, "transactions") <- cbind(cashflows, - units = shares) + units = units) res } diff --git a/inst/tinytest/test_unit_prices.R b/inst/tinytest/test_unit_prices.R index beb159f..5cb35cf 100644 --- a/inst/tinytest/test_unit_prices.R +++ b/inst/tinytest/test_unit_prices.R @@ -166,3 +166,21 @@ res <- unit_prices(NAV, attr(res, "transactions") expect_equivalent(res$price, c(20, 20, 202/200*20)) expect_equivalent(res$units, c(9, 10, 10)) + +## -- rounding + +NAV <- data.frame(timestamp = 1, + NAV = 150) +cf <- data.frame(timestamp = 1, amount = 55) +res <- unit_prices(NAV = NAV, cashflows = cf, + initial.units = 100) +attr(res, "transactions") + +res.r <- unit_prices(NAV = NAV, cashflows = cf, + initial.units = 100, + round.units = 4) +attr(res.r, "transactions") +new.units <- 55/(95/100) +expect_equivalent(res.r$units, round(100+new.units, 4)) +expect_equivalent(attr(res.r, "transactions")$units, round(new.units, 4)) +expect_equivalent(attr(res , "transactions")$units, new.units) diff --git a/man/unit_prices.Rd b/man/unit_prices.Rd index d724b20..a0dca8c 100644 --- a/man/unit_prices.Rd +++ b/man/unit_prices.Rd @@ -8,10 +8,10 @@ (units). } \usage{ -unit_prices(NAV, - cashflows, +unit_prices(NAV, cashflows, initial.price, initial.units = 0, - cf.included = TRUE) + cf.included = TRUE, + round.price = NULL, round.units = NULL) } \arguments{ \item{NAV}{% @@ -39,6 +39,14 @@ unit_prices(NAV, default), it is assumed that the NAV series at the time of the cashflow already includes the cashflow. } + \item{round.price}{% + round unit prices: \code{NULL} (no rounding) or an + integer + } + \item{round.units}{% + round number of units: \code{NULL} (no rounding) or an + integer + } } \details{% @@ -47,7 +55,9 @@ unit_prices(NAV, The function may be used to compute the returns for a portfolio with external cashflows, i.e. what is usually - called time-weighted returns. + called time-weighted returns. Note that 'cashflows' can + also comprise other positions that are added or removed + from the portfolio without affecting performance. } \value{% -- 2.45.2