wips

app/logic/plots/exposure_change_plot.R

@@ -10,13 +10,20 @@ pipeline_exposure_change_plot <- function(
     analysis_data,
     x_var = "ald_sector",
     y_exposure_var = "exposure_value_usd",
-    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)
+    y_value_loss_var = "crispy_value_loss",
+    facet_var=NULL) {
+  data_exposure_change <- prepare_for_exposure_change_plot(
+    analysis_data=analysis_data, 
+    x_var=x_var, 
+    y_exposure_var=y_exposure_var, 
+    y_value_loss_var=y_value_loss_var)
 
   exposure_change_plot <- draw_exposure_change_plot(
-    data_exposure_change,
-    x_var, y_exposure_var,
-    y_value_loss_var
+    data_exposure_change=data_exposure_change,
+    x_var=x_var, 
+    y_exposure_var=y_exposure_var,
+    y_value_loss_var=y_value_loss_var,
+    facet_var=facet_var
   )
 
   return(exposure_change_plot)
@@ -35,7 +42,8 @@ draw_exposure_change_plot <- function(
     data_exposure_change,
     x_var,
     y_exposure_var,
-    y_value_loss_var) {
+    y_value_loss_var,
+    facet_var=NULL) {
   plot_bar_color <-
     r2dii.colours::palette_1in1000_plot |>
     dplyr::filter(.data$label == "grey") |>
@@ -69,10 +77,16 @@ draw_exposure_change_plot <- function(
     r2dii.plot::theme_2dii() +
     scale_y_continuous(labels = scales::unit_format(unit = "M", scale = 1e-6)) +
     theme(
-      legend.position = "none",
+      # legend.position = "none",
       axis.text.x = element_text(angle = 45, hjust = 1)
     ) +
     labs(title = "Estimated impact of the Shock on Exposure")
 
+    if (!is.null(facet_var)){
+      exposure_change_plot <- exposure_change_plot+
+        ggplot2::facet_grid(stats::as.formula(paste("~", paste(facet_var, collapse = "+"))), scales = "free_y") 
+
+    }
+
   return(exposure_change_plot)
 }

app/logic/plots/pd_term_plot.R

@@ -26,7 +26,7 @@ data_pd_term <- crispy_data_agg |>
   dplyr::mutate(
     pd_type=factor(.data$pd_type, levels = c("baseline", "shock", "difference"))
   )|>
-  dplyr::filter(.data$pd_type != "difference")
+  dplyr::filter(.data$pd_type != "difference") |>
   dplyr::select_at(c(facet_var, "term", "pd_type", "pd_value")) 
 
 return(data_pd_term)

app/logic/plots/trisk_lineplot.R

@@ -60,19 +60,18 @@ trisk_line_plot <- ggplot(
             linetype = scenario)
     ) +
     ggplot2::geom_line() +
-    ggplot2::geom_point(size = 0.1) +
+    # ggplot2::geom_point(size = 0.1) +
     ggplot2::scale_y_continuous(labels = scales::percent_format(scale=1)) +
     ggplot2::scale_linetype_manual(values = c(
         "production_baseline_scenario" = "dashed", 
-        "production_target_scenario" = "dotted", 
-        "production_shock_scenario" = "solid")) +
+        "production_target_scenario" = "solid", 
+        "production_shock_scenario" = "dotted")) +
     ggplot2::labs(
         x = "Year",
         y = "Production as a percentage of the maximum",
         linetype = "Scenario"
     ) +
     ggplot2::scale_color_manual(values = facets_colors) +
-    ggplot2::facet_wrap(stats::as.formula(paste("~", paste(facet_var, collapse = "+"))), scales = "fixed", ncol = 2) +
     r2dii.plot::theme_2dii() +
     ggplot2::theme(
         panel.background = ggplot2::element_blank(),
@@ -84,7 +83,7 @@ trisk_line_plot <- ggplot(
     ggplot2::facet_wrap(
         stats::as.formula(paste("~", paste(facet_var, collapse = "+"))), 
         scales = "free_y", 
-        ncol = 2
+        ncol = 1
     )
 
 

app/logic/renamings.R

@@ -1,4 +1,7 @@
 RENAMING_SCENARIOS <- c(
+  "GECO2021_CurPol" = "GECO CurPol",
+  "IPR2023Automotive_baseline" = "IPR Automotive baseline",
+  "IPR2023Automotive_FPS"="IPR2023 Automotive FPS",
   "NGFS2023REMIND_NDC" = "REMIND NDC",
   "NGFS2023MESSAGE_NDC" = "MESSAGE NDC",
   "NGFS2023GCAM_NDC" = "GCAM NDC",
@@ -83,15 +86,23 @@ rename_string_vector <- function(string_vector, words_class, dev_to_ux = TRUE) {
     return("")
   }
 
-
   renaming_classes <- list(
     "scenarios" = RENAMING_SCENARIOS,
     "analysis_columns" = RENAMING_ANALYSIS_COLUMNS
   )
 
   if (words_class %in% names(renaming_classes)) {
     RENAMING <- renaming_classes[[words_class]]
+
+
     if (dev_to_ux) {
+      if (!all(string_vector %in% names(RENAMING))) {
+        print(paste(collapse="/n",
+        "WARNING: ",
+          string_vector[!string_vector %in% names(RENAMING)],
+           "are not renamed in app/logic/renamings.R"))
+      }
+
       string_vector <- unname(RENAMING[string_vector])
     } else {
       REV_RENAMING <- stats::setNames(names(RENAMING), unname(RENAMING))

app/view/crispy_loans.R

@@ -45,14 +45,16 @@ server <- function(id, perimeter, backend_trisk_run_folder, possible_trisk_combi
 
     display_columns_loans <- c(
       names(max_trisk_granularity),
+      "term",
       "exposure_value_usd",
-      "crispy_perc_value_change",
-      "crispy_value_loss",
       "loss_given_default",
-      "term"
+      "pd_baseline",
+      "expected_loss_baseline",
+      "pd_shock",
+      "expected_loss_shock"
     )
-    editable_columns_names_loans <- c("exposure_value_usd", "loss_given_default", "term")
-    colored_columns_names_loans <- c("crispy_perc_value_change", "crispy_value_loss")
+    editable_columns_names_loans <- c("exposure_value_usd", "loss_given_default")
+    colored_columns_names_loans <- c("pd_baseline", "pd_shock")
 
     out <- portfolio_analysis$server(
       "portfolio_analysis",

app/view/modules/plots_equities.R

@@ -13,8 +13,18 @@ box::use(
 ui <- function(id) {
   ns <- NS(id)
   fluidRow(
-    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")))
+    semantic.dashboard::box(
+      title = "NPV Change", 
+      width = 8, 
+      collapsible = FALSE,
+      plotOutput(ns("crispy_npv_change_plot"))
+      ),
+    semantic.dashboard::box(
+      title = "Exposure Change", 
+      width = 8, 
+      collapsible = FALSE,
+      plotOutput(ns("exposure_change_plot"))
+      )
   )
 }
 

app/view/modules/plots_loans.R

@@ -4,7 +4,7 @@ box::use(
 
 box::use(
   app/logic/plots/pd_term_plot[pipeline_pd_term_plot],
-  app/logic/plots/crispy_npv_change_plot[pipeline_crispy_npv_change_plot]
+  app/logic/plots/exposure_change_plot[draw_exposure_change_plot]
 )
 
 
@@ -13,8 +13,20 @@ box::use(
 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")))
+    # style = "height: 1300px;",
+    semantic.dashboard::box(
+      title = "PD Difference", 
+      width = 8, 
+      collapsible = FALSE,
+      height="1300px",
+      plotOutput(ns("pd_term_plotoutput"))
+      ),
+    semantic.dashboard::box(
+      title = "Expected Loss Baseline and Shock", 
+      width = 8, 
+      collapsible = FALSE,
+      height="1300px",
+      plotOutput(ns("expected_loss_plot_output")))
   )
 }
 
@@ -24,53 +36,71 @@ ui <- function(id) {
 
 server <- function(id, analysis_data_r, crispy_data_agg_r, max_trisk_granularity) {
   moduleServer(id, function(input, output, session) {
-    observeEvent(analysis_data_r(), {
+
+   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
-    )
-
+      expected_loss_plot <- pipeline_expected_loss_plot(
+        analysis_data_r(), 
+        facet_var = granul_top_level
+        )
+      output$expected_loss_plot_output <- renderPlot({
+        expected_loss_plot
+      })
+  }})
 
-prepare_for_el_plot(
-  analysis_data=analysis_data_r(),
-  x_var=granul_top_level
-)
-
+    observeEvent(crispy_data_agg_r(), {
+      if (nrow(crispy_data_agg_r()) > 0) {
+      granul_levels <- dplyr::intersect(colnames(crispy_data_agg_r()), names(max_trisk_granularity))
+      granul_top_level <- names(max_trisk_granularity[granul_levels])[which.max(unlist(max_trisk_granularity[granul_levels]))]
 
       pd_term_plot <- pipeline_pd_term_plot(
-        crispy_data_agg=crispy_user_filtered, 
+        crispy_data_agg=crispy_data_agg_r(), 
         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 |>
+pipeline_expected_loss_plot <- function(
+  analysis_data,
+  facet_var
+){
+
+data_expected_loss_plot <- prepare_for_expected_loss_plot(
+ analysis_data=analysis_data,
+facet_var=facet_var
+)
+
+  expected_loss_plot <- draw_exposure_change_plot(
+    data_expected_loss_plot,
+    x_var="el_type",
+    y_exposure_var = "exposure_value_usd",
+    y_value_loss_var = "el_value",
+    facet_var=facet_var
+    )
+
+}
+
+prepare_for_expected_loss_plot <- function(analysis_data, facet_var) {
+  data_expected_loss_plot <- 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)
+    dplyr::select_at(c(facet_var, "exposure_value_usd", "el_type", "el_value"))
+  return(data_expected_loss_plot)
 }
+
+

app/view/modules/plots_trajectories.R

@@ -12,8 +12,13 @@ box::use(
 ui <- function(id) {
   ns <- NS(id)
   tagList(
-    semantic.dashboard::box(title = "Production Trajectories", width = 16, plotOutput(ns("trisk_line_plot_output"), height = "900px")),
-
+    semantic.dashboard::box(
+      title = "Production Trajectories", 
+      width = 16, 
+      collapsible = FALSE,
+      # height = "900px",
+      plotOutput(ns("trisk_line_plot_output"))
+      )
   )
 }