RTLappStrat: Asset Strategy

#' compute UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_compute_ui <- function(id){
  ns <- NS(id)
  shiny::fluidPage(
    shiny::fluidRow(
      shiny::column(
        3,
        shiny::selectizeInput(
          inputId = ns("assets"),
          label = "Select at least two assets",
          choices = c("wc", "edm", "hdy", "usgc"),
          selected = c("wc","edm", "hdy", "usgc"),
          multiple = TRUE
        )
      ),
      shiny::column(
        3,
        shiny::radioButtons(
          ns("term"),
          "Time forward for simulations (years)",
          choices = c(3, 5, 10, 20),
          selected = 5,
          inline = TRUE
        ),
      ),
      shiny::column(
        3,
        shiny::radioButtons(
          ns("nsims"),
          "# Simulations",
          choices = c(250, 500, 1000, 2500),
          selected = 250,
          inline = TRUE
        ),
      ),
    ),
    shiny::fluidRow(
      shiny::column(6,
                    tags$h4(tags$span(style = "color:lime;font-style: italic;font-size:0.8em", "Amend asset simulation parameters:")),
                    tags$h5(tags$span(style = "color:lime;font-style: italic;font-size:0.7em", "  ")),
                    DT::DTOutput(ns("simInputs"))),
      shiny::column(6,
                    tags$h4(tags$span(style = "color:lime;font-style: italic;font-size:0.8em", "Asset simulation correlations: amend symmetrically the cor matrix")),
                    DT::DTOutput(ns("simInputsCor")))
    ))
}

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

                 shiny::observeEvent(c(input$assets, input$term, input$nsims, input$simInputs_cell_edit), {

                   inputId <- value <- formula <- expReturn <- params <- simMultiDat <- payoff <- NULL
                   sim <- npv <- NULL

                   r$assets <- input$assets

                   assetsUsers <- RTLappStrat::assets %>% dplyr::select(inputId, value, formula, expReturn) %>%
                     dplyr::filter(inputId %in% r$assets)
                   tmp <- assetsUsers$inputId

                   # arbs for plot with TOP costs
                   arbs <- RTLappStrat::prices
                   for (i in 1:length(tmp)) {
                     arbs <- arbs %>% dplyr::mutate("{tmp[i]}" := !!rlang::parse_expr(assetsUsers$formula[i]))
                   }
                   r$arbs <- arbs %>% dplyr::select(date,tmp)

                   r$nsims <- as.numeric(input$nsims)
                   r$term <- as.numeric(input$term) * 12
                   simMultiDat <- RTL::simMultivariates(nsims = r$term * r$nsims, x = r$arbs, s0 = NULL)

                   # Completes the asset description with parameter estimations of the OU processes.

                   tmp <- lapply(r$assets, function(x) {r$arbs %>% dplyr::select({{x}}) %>% dplyr::pull({{x}})})
                   parms <- lapply(tmp,RTL::fitOU)
                   ouparms <- names(parms[[1]])
                   parms <- purrr::map_dfr(parms, dplyr::bind_rows)
                   parms$theta <- parms$theta * 12 # required as dt is 1-month. Theta of 12 = means revert in one period
                   parms$inputId <- r$assets

                   r$assetsDesc <- RTLappStrat::assets %>%
                     dplyr::filter(inputId %in% r$assets) %>%
                     dplyr::left_join(parms,by = c("inputId" = "inputId")) %>%
                     dplyr::mutate(dplyr::across(tidyselect::vars_select_helpers$where(is.list),unlist))
                     #dplyr::mutate_at(c(ouparms),unlist)

                   # interactive DT table for custom sim generations
                   ## define object mu, theta, sd
                   simInputs <- r$assetsDesc %>%
                     dplyr::select(inputId,ouparms) %>%
                     dplyr::mutate(dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), ~round(.,2)))
                   r$simInputs <- simInputs

                   ## create output: ensure the input is included in the observeEvent params above
                   output$simInputs <- DT::renderDT({
                     r$simInputs
                     },
                     selection = 'none',
                     editable = list(target = "all"),
                     extensions = 'Responsive',
                     options = list(dom = 't'),
                     rownames = FALSE) # rownames is important as it impacts the column index to update

                   ## Wrap the editData within another observeEvent
                   shiny::observeEvent(input$simInputs_cell_edit, {
                     r$simInputs <- DT::editData(
                       data = r$simInputs,
                       info = input$simInputs_cell_edit,
                       proxy = "simInputs",
                       rownames = FALSE
                     )
                   })

                   ## define object cormatrix
                   r$simInputsCor <- round(simMultiDat$corMat,2)

                   ## create output: ensure the input is included in the observeEvent params above
                   output$simInputsCor <- DT::renderDT({
                     r$simInputsCor
                     },
                     selection = 'none',
                     editable = list(target = "all"),
                     extensions = 'Responsive',
                     options = list(dom = 't'),
                     rownames = FALSE)

                   shiny::observeEvent(input$simInputsCor_cell_edit, {
                     r$simInputsCor <- DT::editData(r$simInputsCor, input$simInputsCor_cell_edit,"simInputsCor",rownames = FALSE)
                   })

                   shiny::observe({
                     if (sum(diag(r$simInputsCor)) != length(diag(r$simInputsCor))) {
                       showModal(modalDialog(
                         title = "IMPORTANT",
                         "The correlation of a variable to itself needs to be 1. Please correct it.",
                         easyClose = TRUE,
                         footer = NULL
                       ))
                     }
                   })

                   # diff processes sims and npv calculations need to be reactive to the inputs
                   shiny::observeEvent(c(r$simInputs,r$simInputsCor),{

                     # Generates a list of multivariate simulations epsilons to feed into diffusion process.
                     ## Technically incorrect as we used the epsilons generated from a multivariate normal to feed into an OU process
                     #browser()
                     coVaR = diag(r$simInputs$sigma) %*% r$simInputsCor %*% diag(r$simInputs$sigma)
                     # catch errors in case users amendments result in non positive definite coVar matrix
                     coVaR <- Matrix::nearPD(coVaR, conv.tol = 1e-03, posd.tol = 1e-03)$mat

                     r$epsilons <- MASS::mvrnorm(n = r$nsims * r$term, mu = rep(0,length(r$assets)), Sigma = coVaR) %>%
                       dplyr::as_tibble(., .name_repair = "minimal")
                     names(r$epsilons) <- r$assets
                     r$epsilons <- split(r$epsilons,1:r$nsims)

                     # Generates diffusion processes using the epsilon
                     diffProcesses <- function(asset = "usgc") {
                       tmp <- r$simInputs %>% dplyr::filter(inputId == asset)
                       eps <- purrr::map(r$epsilons, ~purrr::keep(.x,.p = stringr::str_detect(names(.x),asset)))
                       eps <- as.matrix(do.call(cbind,eps))
                       RTL::simOU(nsims = r$nsims, S0 = tmp$mu, mu = tmp$mu, theta = tmp$theta, sigma = 1,
                                  T2M = r$term/12, dt = 1/12, epsilon = eps)
                     }

                     r$diffProcesses <- lapply(X = r$assets, FUN = diffProcesses)
                     names(r$diffProcesses) <- r$assets

                     # Generate payoffs from assets from diffProcesses

                     assetPayoffs <- function(asset = "edm") {
                       eq <- r$assetsDesc %>% dplyr::filter(inputId == asset) %>% dplyr::pull(payoff)
                       r$diffProcesses[[asset]] %>%
                         dplyr::mutate(dplyr::across(.cols = c(-t), .fns = ~ !!rlang::parse_expr(eq)))
                     }
                     r$diffProcessPayoffs <- lapply(X = r$assets, FUN = assetPayoffs)
                     names(r$diffProcessPayoffs) <- r$assets

                     # Generate summary of joint diffusion by asset
                     payoffSummary <- function(asset = "edm") {
                       r$diffProcesses[[asset]] %>%
                         tidyr::pivot_longer(-t, names_to = "sim", values_to = "value") %>%
                         dplyr::group_by(t) %>%
                         #dplyr::summarise(mean = mean(value), sd = sd(value)) %>%
                         dplyr::mutate(asset = asset)
                     }
                     r$payoffSummary <- lapply(X = r$assets, FUN = payoffSummary)
                     names(r$payoffSummary) <- r$assets
                     r$payoffSummary <- do.call(rbind,r$payoffSummary)

                     # npv@risk

                     ## asset weights
                     assetAllocation <- rep(x = 1/length(r$assets), length(r$assets))
                     names(assetAllocation) <- r$assets

                     ## core npv scenarios & discounting
                     portPayoffs <- function(asset = "wc") {
                       discounts <- stats::spline(RTL::usSwapCurves$times,RTL::usSwapCurves$discounts, xout = r$diffProcessPayoffs[[asset]]$t)$y
                       r$diffProcessPayoffs[[asset]] %>%
                         #dplyr::mutate(dplyr::across(.cols = c(-t),.fns = ~.x * assetAllocation[asset])) %>%
                         dplyr::mutate(dplyr::across(.cols = c(-t),.fns = ~.x * discounts))
                     }

                     tmp <- lapply(X = r$assets, FUN = portPayoffs)
                     names(tmp) <- r$assets
                     tmp[["all"]] <- Reduce("+",tmp) %>%
                       dplyr::mutate(t = t/length(r$assets)) # required as time will also be summed across the number of assets

                     r$npv <- tmp

                     ## summarize npv

                     summaryNpv <- function(asset = "wc") {
                       r$npv[[asset]] %>%
                         dplyr::select(-t) %>%
                         dplyr::mutate(asset = {{asset}}) %>%
                         tidyr::pivot_longer(-asset,names_to = "sim", values_to = "value") %>%
                         dplyr::group_by(sim) %>%
                         dplyr::summarise(npv = sum(value)) %>%
                         dplyr::transmute(asset = {{asset}},sim,npv)
                     }
                     tmp <- lapply(X = names(r$npv), summaryNpv)
                     r$npvSummary <- do.call(rbind,tmp)

                   })

                 })

               })
}

## To be copied in the UI
# mod_compute_ui("compute_1")

## To be copied in the server
# mod_compute_server("compute_1")