technology_share for target_* is now properly calculated and weighted

NEWS.md

@@ -1,5 +1,8 @@
 # r2dii.analysis (development version)
 
+* `target_market_share()` now correctly outputs target `technology share`, in 
+  line with methodology (@georgeharris2deg #277).
+
 * `target_market_share()` now correctly projects technology share as
   'production / total production' when computing by company, 
   unweighted by relative loan size (@KapitanKombajn #288).

R/summarize_weighted_production.R

@@ -53,37 +53,99 @@
 #'
 #' summarize_weighted_percent_change(master, use_credit_limit = TRUE)
 summarize_weighted_production <- function(data, ..., use_credit_limit = FALSE) {
+  summarize_weighted_production_(data, ..., use_credit_limit = use_credit_limit, with_targets = FALSE)
+}
+
+summarize_weighted_production_ <- function(data, ..., use_credit_limit = FALSE, with_targets = FALSE) {
   stopifnot(is.data.frame(data))
 
-  data %>%
+  old_groups <- dplyr::groups(data)
+
+  crucial <- c("production", "sector_ald", "year", "technology")
+
+  if (with_targets) {
+    crucial <- c(crucial, "production_target")
+  }
+
+  check_crucial_names(data, crucial)
+  walk_(crucial, ~ check_no_value_is_missing(data, .x))
+
+  data <- data %>%
     ungroup() %>%
     add_loan_weight(use_credit_limit = use_credit_limit) %>%
-    add_technology_share() %>%
-    calculate_weighted_loan_metric("production") %>%
-    calculate_weighted_loan_metric("technology_share") %>%
-    group_by(.data$sector_ald, .data$technology, .data$year, ...) %>%
-    summarize(
-      weighted_production = sum(.data$weighted_loan_production),
-      weighted_technology_share = sum(.data$weighted_loan_technology_share)
-    ) %>%
-    # Restore old groups
-    group_by(!!!dplyr::groups(data))
+    add_technology_share()
+
+  if (with_targets) {
+    data %>%
+      add_technology_share_target() %>%
+      calculate_weighted_loan_metric("production") %>%
+      calculate_weighted_loan_metric("technology_share") %>%
+      calculate_weighted_loan_metric("production_target") %>%
+      calculate_weighted_loan_metric("technology_share_target") %>%
+      group_by(
+        .data$sector_ald,
+        .data$technology,
+        .data$year,
+        ...
+      ) %>%
+      summarize(
+        weighted_production = sum(.data$weighted_loan_production),
+        weighted_technology_share = sum(.data$weighted_loan_technology_share),
+        weighted_production_target = sum(.data$weighted_loan_production_target),
+        weighted_technology_share_target = sum(.data$weighted_loan_technology_share_target)
+      ) %>%
+      # Restore old groups
+      group_by(!!!old_groups)
+  } else {
+    data %>%
+      calculate_weighted_loan_metric("production") %>%
+      calculate_weighted_loan_metric("technology_share") %>%
+      group_by(.data$sector_ald, .data$technology, .data$year, ...) %>%
+      summarize(
+        weighted_production = sum(.data$weighted_loan_production),
+        weighted_technology_share = sum(.data$weighted_loan_technology_share)
+      ) %>%
+      # Restore old groups
+      group_by(!!!old_groups)
+  }
+
 }
 
-summarize_unweighted_production <- function(data, ...) {
-  data %>%
+summarize_unweighted_production <- function(data, ..., with_targets = FALSE) {
+  old_groups <- dplyr::groups(data)
+
+  data <- data %>%
     select(-c(
       .data$id_loan,
       .data$loan_size_credit_limit,
       .data$loan_size_outstanding
     )) %>%
     distinct() %>%
-    group_by(.data$sector_ald, .data$technology, .data$year, ...) %>%
-    # FIXME: Confusing: `weighted_production` holds unweighted_production?
-    summarize(weighted_production = .data$production, .groups = "keep") %>%
-    ungroup(.data$technology, .data$tmsr, .data$smsp) %>%
-    mutate(weighted_technology_share = .data$weighted_production / sum(.data$weighted_production)) %>%
-    group_by(!!!dplyr::groups(data))
+    group_by(.data$sector_ald, .data$technology, .data$year, ...)
+
+  # FIXME: Though production here is unweighted, we still name the variables
+  # `weighted_*`. This is to allow easier reshaping of the output data at the
+  # end of `target_market_share()`.
+  if (with_targets) {
+    data %>%
+      summarize(
+        weighted_production = .data$production,
+        weighted_production_target = .data$production_target,
+        .groups = "keep"
+      ) %>%
+      ungroup(.data$technology) %>%
+      mutate(
+        weighted_technology_share = .data$weighted_production / sum(.data$weighted_production),
+        weighted_technology_share_target = .data$weighted_production_target / sum(.data$weighted_production_target)
+      ) %>%
+      group_by(!!!old_groups)
+  } else {
+    data %>%
+      summarize(weighted_production = .data$production, .groups = "keep") %>%
+      ungroup(.data$technology, .data$tmsr, .data$smsp) %>%
+      mutate(weighted_technology_share = .data$weighted_production / sum(.data$weighted_production)) %>%
+      group_by(!!!old_groups)
+  }
 }
 
 #' @rdname summarize_weighted_production
@@ -200,17 +262,19 @@ add_percent_change <- function(data) {
 }
 
 add_technology_share <- function(data) {
-  crucial <- c("production", "sector_ald", "year", "technology")
-
-  check_crucial_names(data, crucial)
-  walk_(crucial, ~ check_no_value_is_missing(data, .x))
-
   data %>%
     group_by(.data$sector_ald, .data$year, .data$scenario, .data$name_ald) %>%
     mutate(technology_share = .data$production / sum(.data$production)) %>%
     group_by(!!!dplyr::groups(data))
 }
 
+add_technology_share_target <- function(data) {
+  data %>%
+    group_by(.data$sector_ald, .data$year, .data$scenario, .data$name_ald) %>%
+    mutate(technology_share_target = .data$production_target / sum(.data$production_target)) %>%
+    group_by(!!!dplyr::groups(data))
+}
+
 check_zero_initial_production <- function(data) {
   companies_with_zero_initial_production <- data %>%
     group_by(.data$technology, .data$name_ald, .data$year) %>%

R/target_market_share.R

@@ -140,58 +140,59 @@ target_market_share <- function(data,
 
   data <- join_ald_scenario(data, ald, scenario, region_isos)
 
-  if (nrow(data) == 0) {
-    return(empty_target_market_share_output())
-  }
-
-  summary_groups <- c(
+  crucial_groups <- c(
+    "id_loan",
+    "loan_size_outstanding",
+    "loan_size_outstanding_currency",
+    "loan_size_credit_limit",
+    "loan_size_credit_limit_currency",
+    "name_ald",
+    "sector_ald",
+    "technology",
+    "year",
     "scenario",
+    "region",
     "tmsr",
     "smsp",
-    "region",
-    "scenario_source",
-    "name_ald"
+    "scenario_source"
   )
 
-  if (weight_production) {
-    data <- summarize_weighted_production(
-      data,
-      !!!rlang::syms(summary_groups),
-      use_credit_limit = use_credit_limit
-    )
-  } else {
-    data <- summarize_unweighted_production(
-      data,
-      !!!rlang::syms(summary_groups)
+  data <- data %>%
+    group_by(!!!rlang::syms(crucial_groups)) %>%
+    summarize(
+      production = sum(.data$production)
     )
+
+  if (nrow(data) == 0) {
+    return(empty_target_market_share_output())
   }
 
   target_groups <- c("sector_ald", "scenario", "region", "name_ald")
 
   data <- data %>%
     group_by(!!!rlang::syms(c(target_groups, "year"))) %>%
-    mutate(sector_weighted_production = sum(.data$weighted_production)) %>%
+    mutate(sector_production = sum(.data$production)) %>%
     arrange(.data$year) %>%
     group_by(!!!rlang::syms(target_groups)) %>%
-    mutate(initial_sector_production = first(.data$sector_weighted_production)) %>%
-    select(-.data$sector_weighted_production)
+    mutate(initial_sector_production = first(.data$sector_production)) %>%
+    select(-.data$sector_production)
 
   data <- data %>%
     group_by(!!!rlang::syms(c(target_groups, "technology", "year"))) %>%
-    mutate(technology_weighted_production = sum(.data$weighted_production)) %>%
+    mutate(technology_production = sum(.data$production)) %>%
     arrange(.data$year) %>%
     group_by(!!!rlang::syms(c(target_groups, "technology"))) %>%
-    mutate(initial_technology_production = first(.data$technology_weighted_production)) %>%
-    select(-.data$technology_weighted_production)
+    mutate(initial_technology_production = first(.data$technology_production)) %>%
+    select(-.data$technology_production)
 
   green_or_brown <- r2dii.data::green_or_brown
   tmsr_or_smsp <- tmsr_or_smsp()
 
   data <- data %>%
     mutate(
-      tmsr_target_weighted_production = .data$initial_technology_production *
+      tmsr_target_production = .data$initial_technology_production *
         .data$tmsr,
-      smsp_target_weighted_production = .data$initial_technology_production +
+      smsp_target_production = .data$initial_technology_production +
         (.data$initial_sector_production * .data$smsp)
     ) %>%
     select(
@@ -204,10 +205,10 @@ target_market_share <- function(data,
     ) %>%
     pivot_longer(
       cols = c(
-        "tmsr_target_weighted_production", "smsp_target_weighted_production"
+        "tmsr_target_production", "smsp_target_production"
       ),
       names_to = "target_name",
-      values_to = "weighted_production_target"
+      values_to = "production_target"
     ) %>%
     left_join(tmsr_or_smsp, by = c(target_name = "which_metric")) %>%
     inner_join(
@@ -220,6 +221,28 @@ target_market_share <- function(data,
     ) %>%
     select(-.data$target_name, -.data$green_or_brown)
 
+  summary_groups <- c(
+    "scenario",
+    "region",
+    "scenario_source",
+    "name_ald"
+  )
+
+  if (weight_production) {
+    data <- summarize_weighted_production_(
+      data,
+      !!!rlang::syms(summary_groups),
+      use_credit_limit = use_credit_limit,
+      with_targets = TRUE
+      )
+  } else {
+    data <- summarize_unweighted_production(
+      data,
+      !!!rlang::syms(summary_groups),
+      with_targets = TRUE
+    )
+  }
+
   if (!by_company) {
     aggregate_company_groups <- c(
       "sector_ald",
@@ -235,7 +258,8 @@ target_market_share <- function(data,
       summarize(
         weighted_production = sum(.data$weighted_production),
         weighted_production_target = sum(.data$weighted_production_target),
-        weighted_technology_share = sum(.data$weighted_technology_share)
+        weighted_technology_share = sum(.data$weighted_technology_share),
+        weighted_technology_share_target = sum(.data$weighted_technology_share_target)
       )
   }
 
@@ -249,14 +273,6 @@ target_market_share <- function(data,
     !!!rlang::syms(reweighting_groups)
   )
 
-  data <- data %>%
-    group_by(!!!rlang::syms(reweighting_groups)) %>%
-    mutate(
-      .x = .data$weighted_production_target,
-      weighted_technology_share_target = .data$.x / sum(.data$.x),
-      .x = NULL
-    )
-
   data <- data %>%
     pivot_wider2(
       names_from = .data$scenario,
@@ -284,7 +300,7 @@ target_market_share <- function(data,
   ald_with_benchmark <- calculate_ald_benchmark(ald, region_isos, by_company)
 
   data %>%
-    rbind(ald_with_benchmark) %>%
+    dplyr::bind_rows(ald_with_benchmark) %>%
     ungroup()
 }
 
@@ -306,8 +322,8 @@ unnest_list_columns <- function(data) {
 tmsr_or_smsp <- function() {
   dplyr::tribble(
     ~which_metric, ~green_or_brown,
-    "tmsr_target_weighted_production", "brown",
-    "smsp_target_weighted_production", "green"
+    "tmsr_target_production", "brown",
+    "smsp_target_production", "green"
   )
 }
 
@@ -397,8 +413,11 @@ reweight_technology_share <- function(data, ...) {
     group_by(...) %>%
     mutate(
       .x = .data$weighted_technology_share,
+      .y = .data$weighted_technology_share_target,
       weighted_technology_share = .data$.x / sum(.data$.x),
-      .x = NULL
+      weighted_technology_share_target = .data$.y / sum(.data$.y),
+      .x = NULL,
+      .y = NULL
     ) %>%
     ungroup()
 }