R/mod_portfolio.R

In risktoollib/RTLappStrat: Asset Strategy

#' portfolio UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_portfolio_ui <- function(id){
  ns <- NS(id)
  tagList(
    shiny::fluidPage(
      shiny::fluidRow(
        shiny::column(12,
                      tags$h5(tags$span(style = "color:aqua;font-style: italic;font-size:0.8em", "This tab allows you to assess the portfolio risk impact of trading different assets.")),
                      tags$ul(
                        tags$li(tags$span(style = "color:lime;font-size:0.8em", "Units are in percentages of assets in the portfolio.")),
                        tags$li(tags$span(style = "color:lime;font-size:0.8em", "Say you have a tank TOP commitment of 300kbs and a pipe TOP of 10 kbds. The weights would be 0.5/0.5 based on 30 days in a month.")),
                      ),
        )
      ),
      shiny::fluidRow(
        shiny::column(3,
                      tags$h4(tags$span(style = "color:lime;font-style: italic;font-size:0.8em", "Amend Asset Weights:")),
                      DT::DTOutput(ns("portwts"),width = "250px"),
        ),
        shiny::column(9,
                      plotly::plotlyOutput(ns("optimPort"),height = "800px"),
                      )
      )
    )

  )
}

#' portfolio Server Functions
#'
#' @noRd
mod_portfolio_server <- function(id, r){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    expRet <- Risk <- NULL

    x <- shiny::reactiveValues(wts = NULL)

    shiny::observe({
      x$wts <- dplyr::tibble(asset = r$assets, weight = 1/length(r$assets))
    })

    # editable table UI for asset weights
    output$portwts <- DT::renderDT({
      x$wts
    },
    selection = 'none',
    editable = list(target = "all", disable = list(columns = c(0))),
    extensions = 'Responsive',
    options = list(dom = 't'),
    rownames = FALSE)

    shiny::observeEvent(input$portwts_cell_edit, {
      x$wts <- DT::editData(
        data = x$wts,
        info = input$portwts_cell_edit,
        proxy = "portwts",
        rownames = FALSE
      )
    })

    output$optimPort <- plotly::renderPlotly({
      tmp <- lapply(X = names(r$npv),function(x) {r$npv[[x]] %>% dplyr::select(-t) %>% colSums(.)})
      names(tmp) <- names(r$npv)

      portnpv <- function(wts = c(.25,.25,.25,.25)) {
        for (i in 1:length(wts)) {
          tmp[[i]] <- tmp[[i]] * wts[i]
        }
        tmp[["all"]] <- NULL
        x <- Reduce("+",tmp)
        ave <- mean(x)
        pos <- x[x >= ave]
        posProb <- length(pos)/length(x)
        neg <- x[x < ave]
        dplyr::tibble(desc = toString(paste0(r$assets,":",round(wts,2))),
                      expRet = ave,
                      Risk = stats::sd(x),
                      SharpeRatio = expRet/Risk,
                      Omega = (mean(pos) - ave) * posProb / (abs((mean(neg) - ave)) * (1 - posProb)))
      }

      wts <- lapply(1:2500, function(x) {
          wts <- stats::runif(n = length(r$assets))
          wts/sum(wts)
        })
      ports <- do.call(rbind,lapply(wts, portnpv))

        p <- ports %>% plotly::plot_ly(
          x = ~ Risk,
          y = ~ expRet,
          color = ~ SharpeRatio,
          text = ~ desc,
          hoverinfo = 'text',
          showlegend = F,
          type = "scatter",
          mode = "markers"
        )
        p %>%
          plotly::add_markers(
            data = portnpv(x$wts$weight),
            x = ~ Risk,
            y = ~ expRet,
            marker = list(size = 12, color = "red")
          ) %>%
          plotly::layout(
            title = list(text = "Minimum Variance Portfolios (NPV dollars)", x = 0),
            xaxis = list(title = "Risk"),
            yaxis = list(title = "Return")
          )

    })

    output$top <- shiny::renderTable({
      browser()
    })

  })
}

## To be copied in the UI
# mod_portfolio_ui("portfolio_1")

## To be copied in the server
# mod_portfolio_server("portfolio_1")