R/plot_position.R

In greatgray/scorecard: GGCM Model Performance Scorecard

#' Produces a plot of \code{blotter} portfolio position over time.
#' Provides cumulative profit and loss, if available, along with
#' position plot and drawdown plot.  Adds buys, sells, positions,
#' and position fill indicators.
#' @param Portfolio the blotter portfolio name
#' @param Symbol the portfolio symbol name to plot
#' @param Dates the subset of dates to plot, or NULL for all
#' @param TA any technical indicator to apply to the return plot, or NULL
#' @param ... passed to chartSeries()
#' @details Modified from \code{blotter::chart.Posn}.
#' @seealso blotter
plot_position <- function (Portfolio, Symbol, Dates = NULL,  ..., TA = NULL) {
  pname <- Portfolio
  Portfolio <- blotter::getPortfolio(pname)
  if (missing(Symbol))
    Symbol <- ls(Portfolio$symbols)[[1]]
  else
    Symbol <- Symbol[1]
  Prices <- get(Symbol)
  if (!quantmod::is.OHLC(Prices)) {
    # removed option to pass a prefer through function call
    prefer <- NULL
    Prices <- quantmod::getPrice(Prices, prefer = prefer)
  }
  freq <- xts::periodicity(Prices)
  mult <- 86400
  switch(
    freq$scale,
    seconds = {
      mult <- 1
    },
    minute = {
      mult <- 60
    },
    hourly = {
      mult <- 3600
    },
    daily = {
      mult <- 86400
    }
  )
  if (!isTRUE(freq$frequency * mult == round(freq$frequency, 0) * mult)) {
    n <- round( (freq$frequency / mult), 0) * mult
  } else {
    n <- mult
  }
  tzero <- xts::xts(0, order.by = zoo::index(Prices[1, ]))
  if (is.null(Dates))
    Dates <- paste(xts::first(zoo::index(Prices)),
                   xts::last(zoo::index(Prices)), sep = "::")
  Portfolio$symbols[[Symbol]]$txn <-
    Portfolio$symbols[[Symbol]]$txn[Dates]
  Portfolio$symbols[[Symbol]]$posPL <-
    Portfolio$symbols[[Symbol]]$posPL[Dates]
  Trades <- Portfolio$symbols[[Symbol]]$txn$Txn.Qty
  Buys <- Portfolio$symbols[[Symbol]]$txn$Txn.Price[which(Trades > 0)]
  Sells <- Portfolio$symbols[[Symbol]]$txn$Txn.Price[which(Trades < 0)]
  Position <- Portfolio$symbols[[Symbol]]$txn$Pos.Qty
  if (nrow(Position) < 1)
    stop("no transactions/positions to chart")
  if (as.POSIXct(xts::first(zoo::index(Prices))) <
      as.POSIXct(xts::first(zoo::index(Position))))
    Position <- rbind(xts::xts(0,
                               order.by = xts::first(zoo::index(Prices) - 1)),
                      Position)
  Positionfill <- na.locf(merge(Position, zoo::index(Prices)))
  CumPL <- cumsum(Portfolio$symbols[[Symbol]]$posPL$Net.Trading.PL)
  if (length(CumPL) > 1)
    CumPL <- stats::na.omit(na.locf(merge(CumPL, zoo::index(Prices))))
  else
    CumPL <- NULL
  if (!is.null(CumPL)) {
    CumMax <- cummax(CumPL)
    Drawdown <- - (CumMax - CumPL)
    Drawdown <-
      rbind(xts::xts(-max(CumPL),
                     order.by = xts::first(zoo::index(Drawdown) - 1)),
            Drawdown)
  } else {
    Drawdown <- NULL
  }
  if (!is.null(Dates))
    Prices <- Prices[Dates]
  quantmod::chart_Series(Prices, name = Symbol, TA = TA, ...)
  if (!is.null(nrow(Buys)) && nrow(Buys) >= 1)
    (quantmod::add_TA(
      Buys,
      pch = 2,
      type = "p",
      col = "green",
      on = 1
    ))
  if (!is.null(nrow(Sells)) && nrow(Sells) >= 1)
    (quantmod::add_TA(
      Sells,
      pch = 6,
      type = "p",
      col = "red",
      on = 1
    ))
  if (nrow(Position) >= 1) {
    (quantmod::add_TA(
      Positionfill,
      type = "s",
      col = "blue",
      lwd = 2
    )) # was type h
    (quantmod::add_TA(
      Position,
      type = "p",
      col = "orange",
      lwd = 2,
      on = 2
    ))
  }
  if (!is.null(CumPL))
    (quantmod::add_TA(CumPL, col = "darkgreen", lwd = 2))
  if (!is.null(Drawdown))
    (quantmod::add_TA(
      Drawdown,
      col = "darkred",
      lwd = 2,
      yaxis = c(0, -max(CumMax))
    ))

  return(quantmod::current.chob())
}