wips

app/logic/constant.R

@@ -14,7 +14,7 @@ filter_crispy_outliers <- TRUE
 
 # 1st january of the next year is the default expiration date for the equity portfolio
 # in order to just pick 1 row out of the crispy data
-equity_portfolio_expiration_date <- paste0(as.character(as.numeric(format(Sys.Date(), "%Y"))+1), "-01-01")
+equity_portfolio_expiration_date <- paste0(as.character(as.numeric(format(Sys.Date(), "%Y")) + 1), "-01-01")
 
 # Must be ordered from "less granular" to "more granular"
 max_trisk_granularity <- list(

app/logic/data_load.R

@@ -1,5 +1,4 @@
 box::use(
-
   app/logic/cloud_logic[
     get_data_from_postgres
   ]

app/logic/data_write.R

@@ -26,7 +26,6 @@ append_st_results_to_backend_data <- function(
 
     # If the file exists, read the existing data, otherwise set the existing data to NULL
     if (file.exists(fpath)) {
-
       persistent_data <- arrow::read_parquet(fpath)
     } else {
       persistent_data <- NULL

app/logic/plots/exposure_change_plot.R

@@ -11,19 +11,20 @@ pipeline_exposure_change_plot <- function(
     x_var = "ald_sector",
     y_exposure_var = "exposure_value_usd",
     y_value_loss_var = "crispy_value_loss",
-    facet_var=NULL) {
+    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)
+    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=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
+    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)
@@ -43,7 +44,7 @@ draw_exposure_change_plot <- function(
     x_var,
     y_exposure_var,
     y_value_loss_var,
-    facet_var=NULL) {
+    facet_var = NULL) {
   plot_bar_color <-
     r2dii.colours::palette_1in1000_plot |>
     dplyr::filter(.data$label == "grey") |>
@@ -82,11 +83,10 @@ draw_exposure_change_plot <- function(
     ) +
     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") 
-
-    }
+  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

@@ -1,66 +1,65 @@
+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
+  )
 
-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)
+  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::filter(.data$pd_type != "difference") |>
-  dplyr::select_at(c(facet_var, "term", "pd_type", "pd_value")) 
+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::filter(.data$pd_type != "difference") |>
+    dplyr::select_at(c(facet_var, "term", "pd_type", "pd_value"))
 
-return(data_pd_term)
+  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)
+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::scale_y_continuous(labels = scales::percent_format(scale=100)) +
-        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")
+  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::scale_y_continuous(labels = scales::percent_format(scale = 100)) +
+    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)
+  return(pd_term_plot)
 }

app/logic/plots/trisk_lineplot.R

@@ -12,14 +12,15 @@ pipeline_trisk_line_plot <- function(
   linecolor <- dplyr::intersect(colnames(trajectories_data), linecolor)
 
   data_trisk_line_plot <- prepare_for_trisk_line_plot(
-    trajectories_data=trajectories_data, 
-    facet_var=facet_var, 
-    linecolor=linecolor)
+    trajectories_data = trajectories_data,
+    facet_var = facet_var,
+    linecolor = linecolor
+  )
 
   trisk_line_plot <- draw_trisk_line_plot(
     data_trisk_line_plot,
-    x_var = x_var, 
-    facet_var = facet_var, 
+    x_var = x_var,
+    facet_var = facet_var,
     linecolor = linecolor
   )
 
@@ -28,16 +29,16 @@ pipeline_trisk_line_plot <- function(
 
 prepare_for_trisk_line_plot <- function(trajectories_data, facet_var, linecolor) {
   # Preprocessing to calculate percentages of the maximum value
-data_trisk_line_plot <- trajectories_data |>
+  data_trisk_line_plot <- trajectories_data |>
     tidyr::pivot_longer(
-        cols = dplyr::starts_with("production_"),
-        names_to = "scenario",
-        values_to = "production"
+      cols = dplyr::starts_with("production_"),
+      names_to = "scenario",
+      values_to = "production"
     ) |>
     dplyr::group_by_at(c("year", linecolor, facet_var)) |>
     dplyr::mutate(
-        max_production = max(production, na.rm = TRUE),
-        production_pct = production / max_production * 100
+      max_production = max(production, na.rm = TRUE),
+      production_pct = production/max_production * 100
     ) |>
     dplyr::ungroup()
 
@@ -51,39 +52,41 @@ draw_trisk_line_plot <- function(
     facet_var,
     linecolor) {
   facets_colors <- r2dii.colours::palette_2dii_plot[seq_along(unique(data_trisk_line_plot[[linecolor]])), ]$hex
-trisk_line_plot <- ggplot(
-        data_trisk_line_plot, 
-        aes(
-            x = !!rlang::sym(x_var), 
-            y = production_pct, 
-            color = !!rlang::sym(linecolor),
-            linetype = scenario)
-    ) +
+  trisk_line_plot <- ggplot(
+    data_trisk_line_plot,
+    aes(
+      x = !!rlang::sym(x_var),
+      y = production_pct,
+      color = !!rlang::sym(linecolor),
+      linetype = scenario
+    )
+  ) +
     ggplot2::geom_line() +
     # ggplot2::geom_point(size = 0.1) +
-    ggplot2::scale_y_continuous(labels = scales::percent_format(scale=1)) +
+    ggplot2::scale_y_continuous(labels = scales::percent_format(scale = 1)) +
     ggplot2::scale_linetype_manual(values = c(
-        "production_baseline_scenario" = "dashed", 
-        "production_target_scenario" = "solid", 
-        "production_shock_scenario" = "dotted")) +
+      "production_baseline_scenario" = "dashed",
+      "production_target_scenario" = "solid",
+      "production_shock_scenario" = "dotted"
+    )) +
     ggplot2::labs(
-        x = "Year",
-        y = "Production as a percentage of the maximum",
-        linetype = "Scenario"
+      x = "Year",
+      y = "Production as a percentage of the maximum",
+      linetype = "Scenario"
     ) +
     ggplot2::scale_color_manual(values = facets_colors) +
     r2dii.plot::theme_2dii() +
     ggplot2::theme(
-        panel.background = ggplot2::element_blank(),
-        panel.grid.major = ggplot2::element_blank(),
-        panel.grid.minor = ggplot2::element_blank(),
-        panel.grid.major.y = ggplot2::element_blank(),
-        strip.background = ggplot2::element_blank()
+      panel.background = ggplot2::element_blank(),
+      panel.grid.major = ggplot2::element_blank(),
+      panel.grid.minor = ggplot2::element_blank(),
+      panel.grid.major.y = ggplot2::element_blank(),
+      strip.background = ggplot2::element_blank()
     ) +
     ggplot2::facet_wrap(
-        stats::as.formula(paste("~", paste(facet_var, collapse = "+"))), 
-        scales = "free_y", 
-        ncol = 1
+      stats::as.formula(paste("~", paste(facet_var, collapse = "+"))),
+      scales = "free_y",
+      ncol = 1
     )
 
 

app/logic/renamings.R

@@ -1,7 +1,7 @@
 RENAMING_SCENARIOS <- c(
   "GECO2021_CurPol" = "GECO CurPol",
   "IPR2023Automotive_baseline" = "IPR Automotive baseline",
-  "IPR2023Automotive_FPS"="IPR2023 Automotive FPS",
+  "IPR2023Automotive_FPS" = "IPR2023 Automotive FPS",
   "NGFS2023REMIND_NDC" = "REMIND NDC",
   "NGFS2023MESSAGE_NDC" = "MESSAGE NDC",
   "NGFS2023GCAM_NDC" = "GCAM NDC",
@@ -97,10 +97,12 @@ rename_string_vector <- function(string_vector, words_class, dev_to_ux = TRUE) {
 
     if (dev_to_ux) {
       if (!all(string_vector %in% names(RENAMING))) {
-        print(paste(collapse="/n",
-        "WARNING: ",
+        print(paste(
+          collapse = "/n",
+          "WARNING: ",
           string_vector[!string_vector %in% names(RENAMING)],
-           "are not renamed in app/logic/renamings.R"))
+          "are not renamed in app/logic/renamings.R"
+        ))
       }
 
       string_vector <- unname(RENAMING[string_vector])

app/logic/trisk_button_logic.R

@@ -71,7 +71,6 @@ trisk_generator <- function(
         max_trisk_granularity
       )
       run_id <- check_if_run_exists(trisk_run_params, backend_trisk_run_folder)
-
     } else {
       run_id <- NULL
     }

app/main.R

@@ -158,7 +158,6 @@ ui <- function(id) {
 #' @export
 server <- function(id) {
   moduleServer(id, function(input, output, session) {
-
     possible_trisk_combinations <- r2dii.climate.stress.test::get_scenario_geography_x_ald_sector(trisk_input_path)
 
     # the TRISK runs are generated In the sidebar module
@@ -167,7 +166,7 @@ server <- function(id) {
       max_trisk_granularity = max_trisk_granularity, # constant
       possible_trisk_combinations = possible_trisk_combinations, # computed constant
       backend_trisk_run_folder = backend_trisk_run_folder, # constant
-      trisk_input_path=trisk_input_path, # constant
+      trisk_input_path = trisk_input_path, # constant
       available_vars = available_vars, # constant
       hide_vars = hide_vars, # constant
       use_ald_sector = use_ald_sector # constant

app/view/crispy_equities.R

@@ -8,9 +8,9 @@ box::use(
 )
 
 box::use(
-  app / view / portfolio / portfolio_analysis,
-  app / view / modules / plots_equities,
-  app / view / modules / plots_trajectories,
+  app/view/portfolio/portfolio_analysis,
+  app/view/modules/plots_equities,
+  app/view/modules/plots_trajectories,
 )
 
 ####### UI
@@ -67,7 +67,7 @@ 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