Update survey section (#311)

* Use updated plots * Update survey exposures function * Update survey sections * Update tests * Add new dependency * Update examples * Update documentation render_executive_summary
RMI-PACTA · May 8, 2024 · 3ca9fea · 3ca9fea
1 parent a024255
commit 3ca9fea
Show file tree

Hide file tree

Showing 18 changed files with 223 additions and 251 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -34,7 +34,8 @@ Imports:
     stringr,
     tibble,
     tidyr,
-    tidytext
+    tidytext,
+    utils
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3

diff --git a/NAMESPACE b/NAMESPACE
@@ -58,3 +58,4 @@ importFrom(tibble,tibble)
 importFrom(tidyr,pivot_wider)
 importFrom(tidytext,reorder_within)
 importFrom(tidytext,scale_x_reordered)
+importFrom(utils,head)
diff --git a/R/pacta.executive.summary-package.R b/R/pacta.executive.summary-package.R
@@ -25,5 +25,6 @@
 #' @importFrom tidyr pivot_wider
 #' @importFrom tidytext reorder_within
 #' @importFrom tidytext scale_x_reordered
+#' @importFrom utils head
 ## usethis namespace: end
 NULL
diff --git a/R/plot_exposures_survey.R b/R/plot_exposures_survey.R
@@ -15,7 +15,7 @@
 #'
 #' @examples
 #' data <- toy_data_exposures_survey %>%
-#'   dplyr::filter(asset_class == "equity", sector == "coal")
+#'   dplyr::filter(asset_class == "equity", technology == "coal")
 #'
 #' plot_exposures_survey(data)
 plot_exposures_survey <- function(data) {
@@ -34,14 +34,14 @@ plot_exposures_survey <- function(data) {
       aes(
         x = .data$entity,
         y = .data$exposure_perc_aum,
-        fill = .data$sector,
+        fill = .data$technology,
         alpha = .data$entity
       )
     ) +
       geom_bar(stat = "identity") +
       scale_x_discrete(labels = r2dii.plot::to_title) +
       scale_y_continuous(expand = expansion(mult = c(0, .1)), labels = scales::percent) +
-      r2dii.colours::scale_fill_2dii(palette = "pacta", colour_groups = data$sector) +
+      r2dii.colours::scale_fill_2dii(palette = "pacta", colour_groups = data$technology) +
       scale_alpha_discrete(range = c(1, 0.7)) +
       theme_2dii(base_size = 14) +
       theme(
@@ -59,14 +59,14 @@ check_data_exposures_survey <- function(data, env) {
   stopifnot(is.data.frame(data))
   abort_if_missing_names(
     data,
-    c("asset_class", "entity", "sector", "exposure_perc_aum")
+    c("asset_class", "entity", "technology", "exposure_perc_aum")
   )
   abort_if_multiple(data, "asset_class", env)
   abort_if_invalid_values(data, "entity", c("portfolio", "peers"))
   abort_if_invalid_values(
     data,
-    "sector",
-    c("coal", "oil_and_gas")
+    "technology",
+    c("coal", "oil", "gas")
   )
   stopifnot(is.numeric(data$exposure_perc_aum))
   stopifnot((data$exposure_perc_aum <= 1) & (data$exposure_perc_aum >= 0))

diff --git a/R/prep_exposures_survey.R b/R/prep_exposures_survey.R
@@ -10,31 +10,31 @@
 #' @param peers_results_aggregated Data frame that contains pre-wrangled
 #'   aggregate peer group level PACTA results from a PACTA for investors
 #'   analysis.
-#' @param sector Character. Must be of length 1 and either `coal` or
-#'   `oil_and_gas`.
+#' @param technology Character. Must be of length 1 and either `coal` or
+#'   `oil` or `gas`.
 #' @param asset_class Character. Must be of length 1 and either `equity` or
 #'   `bonds`.
 #'
 #' @return data.frame
 #' @export
 prep_exposures_survey <- function(results_portfolio,
                                   peers_results_aggregated,
-                                  sector = c("coal", "oil_and_gas"),
+                                  technology = c("coal", "oil", "gas"),
                                   asset_class = c("equity", "bonds")) {
   if (is.null(results_portfolio)) {
     data_out <- use_toy_data("exposures_survey") %>%
       filter(
         .data$asset_class == .env$asset_class,
-        .data$sector == .env$sector
+        .data$technology == .env$technology
       )
   } else {
     # validate inputs
-    sector <- match.arg(sector)
+    sector <- match.arg(technology)
     asset_class <- match.arg(asset_class)
 
     check_data_prep_exposures_survey(
       asset_class = asset_class,
-      sector = sector
+      technology = technology
     )
 
     # available portfolio asset classes
@@ -44,13 +44,15 @@ prep_exposures_survey <- function(results_portfolio,
     start_year <- min(results_portfolio$year, na.rm = TRUE)
 
     # pick scenario for filtering (no impact on current exposure)
-    scenario_filter <- "1.5C-Unif"
+    scenario_filter <- results_portfolio %>%
+      pull(.data$scenario) %>%
+      head(1)
 
     # combine input data
     data <- results_portfolio %>%
       dplyr::bind_rows(peers_results_aggregated)
 
-    # keep only asset_class avilable in portfolio
+    # keep only asset_class available in portfolio
     data <- data %>%
       dplyr::filter(.data$asset_class %in% available_asset_classes)
 
@@ -68,18 +70,18 @@ prep_exposures_survey <- function(results_portfolio,
     data_out <- data %>%
       dplyr::filter(
         .data$asset_class == .env$asset_class,
-        .data$sector == .env$sector
+        .data$technology == .env$technology
       )
   }
   data_out
 }
 
 check_data_prep_exposures_survey <- function(asset_class,
-                                             sector) {
+                                             technology) {
   if (length(asset_class) != 1) {
     stop("Argument asset_class must be of length 1. Please check your input.")
   }
-  if (length(sector) != 1) {
+  if (length(technology) != 1) {
     stop("Argument sector must be of length 1. Please check your input.")
   }
 }
@@ -95,12 +97,11 @@ wrangle_data_exposures_survey <- function(data) {
       technology = .data$technology_p4b,
       entity = replace(.data$entity, .data$entity == "this_portfolio", "portfolio")
     ) %>%
-    dplyr::select(c("asset_class", "entity", "ald_sector", "plan_carsten")) %>%
+    dplyr::select(c("asset_class", "entity", "technology", "plan_carsten")) %>%
     dplyr::rename(
-      sector = "ald_sector",
       exposure_perc_aum = "plan_carsten"
     ) %>%
-    dplyr::group_by(.data$asset_class, .data$entity, .data$sector) %>%
+    dplyr::group_by(.data$asset_class, .data$entity, .data$technology) %>%
     dplyr::summarise(
       exposure_perc_aum = sum(.data$exposure_perc_aum, na.rm = TRUE),
       .groups = "drop"

diff --git a/R/render_executive_summary.R b/R/render_executive_summary.R
@@ -5,8 +5,6 @@
 #' @param output_dir Character single, valid filepath to a directory where the output will be saved
 #' @param exec_summary_dir Character single, valid filepath to a directory that contains the template, e.g. `system.file("extdata", "PA2022CH_en_exec_summary", package = "pacta.executive.summary")`
 #' @param survey_dir Character single, valid filepath to a directory that contains the survey files for the user
-#' @param real_estate_dir Character single, valid filepath to a directory that contains real estate files for the user
-#' @param real_estate_flag Logical single, whether or not to render the real estate section
 #' @param score_card_dir Character single, valid filepath to a directory that contains score card files for the user
 #' @param file_name Character single, valid filename of the Rmd template file, e.g. "template.Rmd"
 #' @param investor_name Character single string specifying the investor name

diff --git a/data-raw/toy_data_exposures_survey.R b/data-raw/toy_data_exposures_survey.R
@@ -1,14 +1,18 @@
 # styler: off
 toy_data_exposures_survey <- tibble::tribble(
-~asset_class,     ~entity,       ~sector, ~exposure_perc_aum,
+  ~asset_class,     ~entity,     ~technology, ~exposure_perc_aum,
       "equity", "portfolio",        "coal",               0.01,
       "equity",     "peers",        "coal",               0.02,
-      "equity", "portfolio", "oil_and_gas",               0.03,
-      "equity",     "peers", "oil_and_gas",               0.02,
+      "equity", "portfolio",         "oil",               0.03,
+      "equity",     "peers",         "oil",               0.02,
+      "equity", "portfolio",         "gas",               0.05,
+      "equity",     "peers",         "gas",               0.04,
        "bonds", "portfolio",        "coal",               0.03,
        "bonds",     "peers",        "coal",               0.01,
-       "bonds", "portfolio", "oil_and_gas",                0.1,
-       "bonds",     "peers", "oil_and_gas",                0.2
+       "bonds", "portfolio",         "oil",              0.015,
+       "bonds",     "peers",         "oil",              0.025,
+       "bonds", "portfolio",         "gas",               0.03,
+       "bonds",     "peers",         "gas",               0.25
   )
 # styler: on
 

diff --git a/data/toy_data_exposures_survey.rda b/data/toy_data_exposures_survey.rda