loan pd plot

app/logic/plots/exposure_change_plot.R

@@ -10,9 +10,8 @@ pipeline_exposure_change_plot <- function(
     analysis_data,
     x_var = "ald_sector",
     y_exposure_var = "exposure_value_usd",
-    y_value_loss_var = "crispy_value_loss",
-    fill_var = "crispy_perc_value_change") {
-  data_exposure_change <- prepare_for_exposure_change_plot(analysis_data, x_var, y_exposure_var, y_value_loss_var, fill_var)
+    y_value_loss_var = "crispy_value_loss") {
+  data_exposure_change <- prepare_for_exposure_change_plot(analysis_data, x_var, y_exposure_var, y_value_loss_var)
 
   exposure_change_plot <- draw_exposure_change_plot(
     data_exposure_change,
@@ -23,10 +22,10 @@ pipeline_exposure_change_plot <- function(
   return(exposure_change_plot)
 }
 
-prepare_for_exposure_change_plot <- function(analysis_data, x_var, y_exposure_var, y_value_loss_var, fill_var) {
+prepare_for_exposure_change_plot <- function(analysis_data, x_var, y_exposure_var, y_value_loss_var) {
   data_exposure_change <- analysis_data |>
     dplyr::select_at(
-      c(x_var, y_exposure_var, y_value_loss_var, fill_var)
+      c(x_var, y_exposure_var, y_value_loss_var)
     )
   return(data_exposure_change)
 }

app/logic/plots/pd_term_plot.R

@@ -0,0 +1,64 @@
+
+pipeline_pd_term_plot <- function(crispy_data_agg, facet_var="ald_sector"){
+    data_pd_term <- prepare_for_pd_term_plot(
+        crispy_data_agg=crispy_data_agg,
+        facet_var=facet_var
+    )
+    pd_term_plot <- draw_pd_term_plot(
+        data_pd_term=data_pd_term,
+        facet_var=facet_var
+        )
+
+    return(pd_term_plot)
+}
+
+
+
+
+prepare_for_pd_term_plot <- function(crispy_data_agg, facet_var){
+data_pd_term <- crispy_data_agg |>
+  tidyr::pivot_longer(
+    cols = tidyr::starts_with("pd_"),
+    names_to = "pd_type",
+    values_to = "pd_value",
+    names_prefix = "pd_"
+  ) |> 
+  dplyr::mutate(
+    pd_type=factor(.data$pd_type, levels = c("baseline", "shock", "difference"))
+  )|>
+  dplyr::select_at(c(facet_var, "term", "pd_type", "pd_value")) 
+
+return(data_pd_term)
+}
+
+
+
+draw_pd_term_plot <- function(data_pd_term, facet_var){
+
+    red_hex_color <- r2dii.colours::palette_1in1000_plot |> 
+        dplyr::filter(.data$label == "red") |> 
+        dplyr::pull(.data$hex)
+    green_hex_color <- r2dii.colours::palette_1in1000_plot |> 
+        dplyr::filter(.data$label == "green") |> 
+        dplyr::pull(.data$hex)
+    grey_hex_color <- r2dii.colours::palette_1in1000_plot |> 
+        dplyr::filter(.data$label == "grey") |> 
+        dplyr::pull(.data$hex)
+
+
+    pd_term_plot <- ggplot2::ggplot(data_pd_term, ggplot2::aes(x = as.factor(term), y = pd_value, fill = pd_value)) +
+        ggplot2::geom_bar(stat = "identity", position = ggplot2::position_dodge()) +
+        ggplot2::facet_grid(stats::as.formula(paste(paste(facet_var, collapse = "+"), "~ pd_type")), scales = "free_y") +
+        ggplot2::scale_fill_gradient2(
+            low = green_hex_color, 
+            high = red_hex_color, 
+            mid = grey_hex_color, 
+            midpoint = 0, 
+            limit = c(min(data_pd_term$pd_value), max(data_pd_term$pd_value)), 
+            space = "Lab") +
+        r2dii.plot::theme_2dii() +
+        ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) +
+        ggplot2::labs(x = "Term", y = "PD Value", fill = "PD Type", title = "PD Values by Term, Type, and Business Unit")
+
+    return(pd_term_plot)
+}

app/view/crispy_equities.R

@@ -9,7 +9,7 @@ box::use(
 
 box::use(
   app / view / portfolio / portfolio_analysis,
-  app / view / modules / plots_equity_change,
+  app / view / modules / plots_equities,
   app / view / modules / plots_trajectories,
 )
 
@@ -26,7 +26,7 @@ ui <- function(id, max_trisk_granularity, available_vars) {
       shiny::tags$div(
         class = "ui stackable grid",
         portfolio_analysis$ui(ns("portfolio_analysis"), title = "Equities portfolio"),
-        plots_equity_change$ui(ns("plots_equity_change")),
+        plots_equities$ui(ns("plots_equities")),
         plots_trajectories$ui(ns("plots_trajectories"))
       )
     )
@@ -57,7 +57,7 @@ server <- function(id, perimeter, backend_trisk_run_folder, max_trisk_granularit
 
     # Manages the porfolio creator module
     # Create analysis data by merging crispy to portfolio, and aggrgating to the appropriate granularity
-    analysis_data_r <- portfolio_analysis$server(
+    out <- portfolio_analysis$server(
       "portfolio_analysis",
       crispy_data_r = crispy_data_r,
       trisk_granularity_r = trisk_granularity_r,
@@ -67,12 +67,15 @@ server <- function(id, perimeter, backend_trisk_run_folder, max_trisk_granularit
       editable_columns_names = editable_columns_names_equities,
       colored_columns_names = colored_columns_names_equities
     )
+
+    analysis_data_r <- out$analysis_data_r
+    crispy_data_agg_r <- out$crispy_data_agg_r
 
     # CONSUME TRISK OUTPUTS =========================
 
     # Generate equity change plots
-    plots_equity_change$server(
-      "plots_equity_change",
+    plots_equities$server(
+      "plots_equities",
       analysis_data_r = analysis_data_r,
       max_trisk_granularity = max_trisk_granularity
     )

app/view/crispy_loans.R

@@ -7,7 +7,8 @@ box::use(
 )
 
 box::use(
-  app / view / portfolio / portfolio_analysis
+  app / view / portfolio / portfolio_analysis,
+  app / view / modules / plots_loans
 )
 
 
@@ -21,7 +22,11 @@ ui <- function(id, max_trisk_granularity, available_vars) {
     class = "pusher container", style = "min-height: 100vh;",
     shiny::div(
       class = "ui segment", style = "min-height: 100vh;",
-      portfolio_analysis$ui(ns("portfolio_analysis"), "Loans Portfolio")
+            shiny::tags$div(
+        class = "ui stackable grid",
+      portfolio_analysis$ui(ns("portfolio_analysis"), "Loans Portfolio"),
+      plots_loans$ui(ns("plots_loans"))
+            )
     )
   )
 }
@@ -49,7 +54,7 @@ server <- function(id, perimeter, backend_trisk_run_folder, possible_trisk_combi
     editable_columns_names_loans <- c("exposure_value_usd", "loss_given_default", "term")
     colored_columns_names_loans <- c("crispy_perc_value_change", "crispy_value_loss")
 
-    analysis_data_r <- portfolio_analysis$server(
+    out <- portfolio_analysis$server(
       "portfolio_analysis",
       crispy_data_r = crispy_data_r,
       trisk_granularity_r = trisk_granularity_r,
@@ -61,25 +66,14 @@ server <- function(id, perimeter, backend_trisk_run_folder, possible_trisk_combi
       editable_rows = TRUE, # Allow adding and deleting rows, and gives access to the company granularity
       possible_trisk_combinations = possible_trisk_combinations
     )
-  })
-}
-
 
+    analysis_data_r <- out$analysis_data_r
+    crispy_data_agg_r <- out$crispy_data_agg_r
 
-
-render_portfolio <- function(output, table_to_display) {
-  output$portfolio_table <- renderDT(
-    {
-      datatable(table_to_display,
-        editable = TRUE,
-        options = list(
-          lengthChange = FALSE, # Remove "Show XXX entries" option
-          paging = FALSE, # Remove pagination
-          searching = FALSE, # Remove search input
-          info = FALSE # Remove "Showing N of X entries"
-        )
+    plots_loans$server("plots_loans",
+      analysis_data_r = analysis_data_r,
+      crispy_data_agg_r = crispy_data_agg_r,
+      max_trisk_granularity = max_trisk_granularity
       )
-    },
-    server = FALSE
-  )
+  })
 }

app/view/modules/plots_equity_change.R → app/view/modules/plots_equities.R

@@ -1,6 +1,5 @@
 box::use(
-  shiny[moduleServer, NS, plotOutput, renderPlot, observeEvent, fluidRow],
-  semantic.dashboard[column, box]
+  shiny[moduleServer, NS, plotOutput, renderPlot, observeEvent, fluidRow]
 )
 
 box::use(
@@ -14,8 +13,8 @@ box::use(
 ui <- function(id) {
   ns <- NS(id)
   fluidRow(
-    box(title = "NPV Change", width = 8, plotOutput(ns("crispy_npv_change_plot"))),
-    box(title = "Exposure Change", width = 8, plotOutput(ns("exposure_change_plot")))
+    semantic.dashboard::box(title = "NPV Change", width = 8, plotOutput(ns("crispy_npv_change_plot"))),
+    semantic.dashboard::box(title = "Exposure Change", width = 8, plotOutput(ns("exposure_change_plot")))
   )
 }
 

app/view/modules/plots_loans.R

@@ -0,0 +1,76 @@
+box::use(
+  shiny[moduleServer, NS, plotOutput, renderPlot, observeEvent, tags]
+)
+
+box::use(
+  app/logic/plots/pd_term_plot[pipeline_pd_term_plot],
+  app/logic/plots/crispy_npv_change_plot[pipeline_crispy_npv_change_plot]
+)
+
+
+####### UI
+
+ui <- function(id) {
+  ns <- NS(id)
+  shiny::fluidRow(
+    semantic.dashboard::box(title = "PD Difference", width = 8, plotOutput(ns("pd_term_plotoutput"))),
+    semantic.dashboard::box(title = "Exposure Change", width = 8, plotOutput(ns("exposure_change_plot")))
+  )
+}
+
+####### Server
+
+
+
+server <- function(id, analysis_data_r, crispy_data_agg_r, max_trisk_granularity) {
+  moduleServer(id, function(input, output, session) {
+    observeEvent(analysis_data_r(), {
+      if (nrow(analysis_data_r()) > 0) {
+      granul_levels <- dplyr::intersect(colnames(analysis_data_r()), names(max_trisk_granularity))
+      granul_top_level <- names(max_trisk_granularity[granul_levels])[which.max(unlist(max_trisk_granularity[granul_levels]))]
+
+      # browser()
+
+crispy_user_filtered <- crispy_data_agg_r() |> 
+  dplyr::inner_join(
+    analysis_data_r() |> dplyr::distinct_at(granul_top_level), 
+    by=granul_top_level
+    )
+
+
+prepare_for_el_plot(
+  analysis_data=analysis_data_r(),
+  x_var=granul_top_level
+)
+
+
+      pd_term_plot <- pipeline_pd_term_plot(
+        crispy_data_agg=crispy_user_filtered, 
+        facet_var=granul_top_level
+      )
+      output$pd_term_plotoutput <- renderPlot({
+        pd_term_plot
+      })
+
+      # crispy_npv_change_plot <- pipeline_crispy_npv_change_plot(analysis_data_r(), x_var = granul_top_level)
+      # output$crispy_npv_change_plot <- renderPlot({
+      #   crispy_npv_change_plot
+      # })
+      }
+    })
+  })
+}
+
+
+
+prepare_for_el_plot <- function(analysis_data, x_var) {
+  data_expected_loss <- analysis_data |>
+    tidyr::pivot_longer(
+      cols = tidyr::starts_with("expected_loss_"),
+      names_to = "el_type",
+      values_to = "el_value",
+      names_prefix = "expected_loss_"
+    ) |> 
+    dplyr::select_at(c(x_var, "exposure_value_usd", "el_type", "el_value"))
+  return(data_expected_loss)
+}

app/view/modules/trisk_button.R

@@ -59,8 +59,8 @@ ui <- function(id) {
     # Fomantic UI styled action button with added custom class for styling
     tags$button(
       id = ns("run_trisk"),
-      class = "ui primary fluid button custom-relief-button", # Added custom class for styling
-      "Run Trisk (double-click to refresh tab values)"
+      class = "ui fluid button ", # Added custom class for styling
+      "Run Trisk (click again when switching tabs to refresh data)"
     )
   )
   )

app/view/params/params_dimensions.R

@@ -32,11 +32,11 @@ ui <- function(id, max_trisk_granularity) {
     shiny.semantic::button(
       ns("granul_1"),
       rename_string_vector(names(which(max_trisk_granularity == 1)), words_class = "analysis_columns"),
-      class = "ui green button fluid"),
+      class = "ui secondary button fluid"),
     shiny.semantic::button(
       ns("granul_2"),
       rename_string_vector(names(which(max_trisk_granularity == 2)), words_class = "analysis_columns"),
-      class = "ui primary button fluid")
+      class = "ui button fluid")
     # ,shiny.semantic::button(
     #   ns("granul_3"), 
     #   rename_string_vector(names(which(max_trisk_granularity == 3)), words_class = "analysis_columns"),
@@ -56,17 +56,17 @@ server <- function(id, max_trisk_granularity) {
 
 
   observeEvent(input$granul_1, {
-    update_class(session$ns("granul_1"), "ui green button fluid")
-    update_class(session$ns("granul_2"), "ui primary button fluid")
+    update_class(session$ns("granul_1"), "ui secondary button fluid")
+    update_class(session$ns("granul_2"), "ui button fluid")
     # update_class(session$ns("granul_3"), "ui primary button fluid")
     trisk_granularity_r(
       get_trisk_granularity(max_trisk_granularity, 1)
     )
   })
 
   observeEvent(input$granul_2, {
-    update_class(session$ns("granul_1"), "ui primary button fluid")
-    update_class(session$ns("granul_2"), "ui green button fluid")
+    update_class(session$ns("granul_1"), "ui button fluid")
+    update_class(session$ns("granul_2"), "ui secondary button fluid")
     # update_class(session$ns("granul_3"), "ui primary button fluid")
     trisk_granularity_r(
       get_trisk_granularity(max_trisk_granularity, 2)