R/mod_markowitz.R

In risktoollib/RTLappStrat: Asset Strategy

#' markowitz UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#' @noRd
#'
#' @importFrom shiny NS tagList
#' @importFrom rlang :=
mod_markowitz_ui <- function(id){
  ns <- NS(id)
  x <- NULL
  x <- RTLappStrat::assets
  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."))
                    )
      ),
    shiny::fluidRow(
      shiny::column(3,
                    tags$h4(tags$span(style = "color:lime;font-style: italic;font-size:0.8em", "Select Expected Returns:")),
                    shiny::uiOutput(ns("returnsUI"), inline = TRUE),
                    shiny::actionButton(ns("btnExpReturns"), "Update chart")),
        shiny::column(9,
                      plotly::plotlyOutput(ns("arbsplot")),
                      tags$br(),
                      plotly::plotlyOutput(ns("efPort")))
    )
  )
}

#' markowitz Server Functions
#'
#' @noRd
mod_markowitz_server <- function(id, r){
  moduleServer(id,
               function(input, output, session){

                 inputId <- value <- expReturn <-  NULL

                 output$arbsplot <- plotly::renderPlotly({
                   r$arbs %>%
                     tidyr::pivot_longer(-date,names_to = "series", values_to = "value") %>%
                     plotly::plot_ly(x = ~date, y = ~value, name = ~series, type = "scatter", mode = "lines") %>%
                     plotly::layout(title = list(text = "Boxed Variable Cost Abrs", x = 0),
                                    xaxis = list(title = ""),
                                    yaxis = list(title = "Arb levels - $ per bbl")
                                    )
                 })

                 # # Method 1 - dynamic slider UI using utils function with purrr- does not work with namespaces unless it uses tagList
                 # output$assetCosts <- shiny::renderUI({
                 #   ns <- session$ns
                 #   formula <- NULL
                 #   vars <-
                 #     RTLappStrat::assets %>% dplyr::filter(inputId %in% r$assets) %>% dplyr::select(-formula)
                 #   purrr::pmap(vars, uiSliderInput)
                 # })

                 output$returnsUI <- shiny::renderUI({})
                 outputOptions(output, "returnsUI", suspendWhenHidden = FALSE)
                 withProgress(message = "loading page", value = 0.1, {
                   output$returnsUI <- shiny::renderUI({
                     ns <- session$ns
                     formula <- NULL
                     vars <-
                       RTLappStrat::assets %>% dplyr::filter(inputId %in% r$assets) %>% dplyr::select(-formula)
                     sliders <- lapply(1:nrow(vars), function(x) {
                       shiny::sliderInput(
                         inputId = ns(paste0(vars$inputId[x], "return")),
                         label = vars$inputId[x],
                         min = 0,
                         max = vars$expReturn[x] * 3,
                         value = vars$expReturn[x],
                         step = 0.25
                       )
                     })
                     do.call(shiny::tagList, sliders)
                   })
                   setProgress(value = 1 , detail = "Complete")
                 })

                 expectedReturns <- shiny::reactive({
                   tmp <- paste0(r$assets,"return")
                   dynInputs <- function(uipattern) {
                     eval(rlang::parse_expr(paste0("input$", grep(pattern = uipattern, x = names(input), value = TRUE))))
                   }
                   lapply(X = tmp, FUN = dynInputs) %>% unlist()
                 })

                 output$efPort <- plotly::renderPlotly({
                   input$btnExpReturns
                   RTL::efficientFrontier(nsims = 2500, x =  r$arbs, expectedReturns = shiny::isolate(expectedReturns()))$plot %>%
                     plotly::layout(
                       title = list(text = "Minimum Variance Portfolios ($ per bbl)", x = 0),
                       xaxis = list(title = ""),
                       yaxis = list(title = "Arb levels - $ per bbl")
                     )
                 })
  })
}

## To be copied in the UI
# mod_markowitz_ui("markowitz_1")

## To be copied in the server
# mod_markowitz_server("markowitz_1")