Add maps for all countries (#142)

* Add maps for all countries

* refactor

* refactor

* refactor

* refactor

* refactor

* refactor

* refactor

* Resolve test

Author: kalashsinghal

.Rbuildignore

@@ -1,3 +1,5 @@
+^renv$
+^renv\.lock$
 ^tiltPlot\.Rproj$
 ^\.Rproj\.user$
 ^README\.Rmd$

.Rprofile

@@ -0,0 +1 @@
+source("renv/activate.R")

NAMESPACE

@@ -26,7 +26,10 @@ importFrom(dplyr,inner_join)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n)
+importFrom(dplyr,n_distinct)
+importFrom(dplyr,pick)
 importFrom(dplyr,pull)
+importFrom(dplyr,rename)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
 importFrom(dplyr,summarize)
@@ -87,6 +90,8 @@ importFrom(tibble,tibble)
 importFrom(tibble,tribble)
 importFrom(tidyr,drop_na)
 importFrom(tidyr,pivot_wider)
+importFrom(tidyselect,all_of)
+importFrom(tidyselect,everything)
 importFrom(tidyselect,matches)
 importFrom(tiltIndicator,example_data_factory)
 importFrom(tiltIndicatorAfter,profile_emissions)

R/bar_plot_emission_profile.R

@@ -72,7 +72,7 @@ prepare_bar_plot_emission_profile <- function(data, grouping_emission, mode, sce
     group_by(.data[[risk_category]], .data$grouping_emission) |>
     summarise(total_mode = sum(.data[[mode]])) |>
     group_by(.data$grouping_emission) |>
-    mutate(proportion = total_mode / sum(total_mode))
+    mutate(proportion = .data$total_mode / sum(.data$total_mode))
 
   data
 }

R/bar_plot_emission_profile_financial.R

@@ -17,7 +17,10 @@
 #'
 #' @examples
 #' grouping_emission <- c("all", "unit", "isic_4digit")
-#' bar_plot_emission_profile_financial(financial, grouping_emission, "equal_weight", risk_category = "emission_category")
+#' bar_plot_emission_profile_financial(financial, grouping_emission,
+#'   "equal_weight",
+#'   risk_category = "emission_category"
+#' )
 bar_plot_emission_profile_financial <- function(data,
                                                 grouping_emission = grouping_emission(),
                                                 mode = c(

R/example_data.R

@@ -27,6 +27,7 @@ default_without_financial <- function(company_name = "a",
                                       grouping_emission = "all",
                                       scenario = "1.5C RPS",
                                       year = 2030,
+                                      product = c("a", "b", "c"),
                                       emissions_profile_equal_weight = 0.1,
                                       emissions_profile_worst_case = 0.1,
                                       emissions_profile_best_case = 0.1) {
@@ -36,6 +37,7 @@ default_without_financial <- function(company_name = "a",
     grouping_emission = grouping_emission,
     scenario = scenario,
     year = year,
+    product = product,
     emissions_profile_equal_weight = emissions_profile_equal_weight,
     emissions_profile_worst_case = emissions_profile_worst_case,
     emissions_profile_best_case = emissions_profile_best_case

R/map_region_risk.R

@@ -8,8 +8,6 @@
 #' It can be one of "all", "unit" or "tilt_sector", "unit_tilt_sector",
 #' "isic_4digit" or "unit_isic_4digit". If nothing is chosen, "all" is the
 #' default mode.
-#' @param mode The mode to plot. It can be one of "equal_weight", "worst_case"
-#' or "best_case". If nothing is chosen, "equal_weight" is the default mode.
 #' @param scenario A character vector: `r toString(scenarios())`.
 #' @param year A character vector: `r toString(years())`.
 #' @param risk_category A character vector.
@@ -23,18 +21,15 @@
 #'   map_region_risk(without_financial, country_code = "DE", benchmark = "unit")
 #' })
 map_region_risk <- function(data,
-                            # TODO: plot for other countries
-                            country_code = c("DE"),
+                            country_code = c("DE", "AT", "FR", "NL", "ES"),
                             grouping_emission = grouping_emission(),
-                            mode = modes(),
                             scenario = scenarios(),
                             year = years(),
                             risk_category = risk_category()) {
   prepared_data <- prepare_geo_data(
     data,
     country_code,
     grouping_emission,
-    mode,
     scenario,
     year,
     risk_category
@@ -49,3 +44,4 @@ map_region_risk <- function(data,
     coord_sf() +
     theme_tiltplot()
 }
+

R/plot_sankey.R

@@ -1,6 +1,8 @@
 #' Create a sankey plot with financial data
 #'
 #' @inheritParams map_region_risk
+#' @param mode The mode to plot. It can be one of "equal_weight", "worst_case"
+#' or "best_case". If nothing is chosen, "equal_weight" is the default mode.
 #' @param with_company Logical. If TRUE, will plot a node with the company name.
 #' If FALSE, will plot without the company name node.
 #'

R/prepare_geo_data.R

@@ -8,17 +8,13 @@
 #' @noRd
 #'
 prepare_geo_data <- function(data,
-                             country_code = c("DE"),
+                             country_code = c("DE", "AT", "FR", "NL", "ES"),
                              grouping_emission = grouping_emission(),
-                             mode = modes(),
                              scenario = scenarios(),
                              year = years(),
                              risk_category = risk_category()) {
-  grouping_emission <- arg_match(grouping_emission)
   risk_category <- arg_match(risk_category)
   country_code <- arg_match(country_code)
-  scenario <- arg_match(scenario)
-  year <- year
 
   crucial <- c(
     aka("risk_category"),
@@ -32,10 +28,11 @@ prepare_geo_data <- function(data,
 
   shp_0 <- get_eurostat_geospatial(
     resolution = 10,
-    nuts_level = 3,
-    year = 2016,
+    nuts_level = "all",
+    year = 2021,
     crs = 3035
-  )
+  ) |>
+    filter(!(geo %in% c("FRY10", "FRY20", "FRY30", "FRY40", "FRY50")))
 
   # filter for the specified country
   shp_1 <- shp_0 |>
@@ -46,29 +43,41 @@ prepare_geo_data <- function(data,
 
   # merge to have zip codes with NUTS file
   shp_1 <- shp_1 |>
-    inner_join(nuts_de, by = "geo") |>
-    mutate(postcode = as.character(postcode))
+    inner_join(nuts_all, by = "geo")
+
+  filtered_geo_data <- data
+
+  # Apply filtering only if the corresponding argument is not NULL
+  if (!is.null(grouping_emission)) {
+    filtered_geo_data <- filtered_geo_data |>
+      filter(.data$grouping_emission == .env$grouping_emission)
+  }
+
+  if (!is.null(scenario)) {
+    filtered_geo_data <- filtered_geo_data |>
+      filter(.data$scenario == .env$scenario)
+  }
+
+  if (!is.null(year)) {
+    filtered_geo_data <- filtered_geo_data |>
+      filter(.data$year == .env$year)
+  }
 
   # merge shapefile with financial data
-  geo <- data |>
-    filter(
-      .data$grouping_emission == .env$grouping_emission,
-      .data$scenario == .env$scenario,
-      .data$year == .env$year
-    ) |>
+  geo <- filtered_geo_data |>
+    distinct() |>
     left_join(shp_1, by = "postcode") |>
     st_as_sf()
 
-  aggregated_data <- aggregate_geo(geo, mode, risk_category)
+  aggregated_data <- aggregate_geo(geo, risk_category)
 
   list(shp_1, aggregated_data)
 }
 
 #' Aggregate Geo Data
 #'
-#' @param geo A data frame containing geographical data.
-#' @param mode The mode to plot. It can be one of "equal_weight", "worst_case"
-#' or "best_case". If nothing is chosen, "equal_weight" is the default mode.
+#' @param geo_example A data frame containing geographical data.
+#' @param risk_category The risk category.
 #'
 #' @return A data frame with aggregated data, with the colors proportional to
 #' the risks.
@@ -78,21 +87,21 @@ prepare_geo_data <- function(data,
 #' library(tibble)
 #'
 #' # Create a sample geo_data tibble
-#' geo <- tibble(
-#'   postcode = c("1", "2", "3"),
+#' geo_example <- tibble(
+#'   geo = c("1", "2", "3"),
 #'   company_name = c("A", "B", "C"),
 #'   emission_profile = factor(c("low", "medium", "high"),
 #'     levels = c("low", "medium", "high")
 #'   )
 #' )
 #'
-#' aggregate_geo(geo, mode = "emissions_profile_worst_case", risk_category = "emission_category")
-aggregate_geo <- function(geo, mode, risk_category) {
-  aggregated_data <- geo |>
-    group_by(.data$postcode, .data[[risk_category]]) |>
-    summarise(total_mode = sum(.data[[mode]])) |>
-    group_by(.data$postcode) |>
-    mutate(proportion = total_mode / sum(total_mode)) |>
+#' aggregate_geo(geo_example, risk_category = "emission_category")
+aggregate_geo <- function(geo_data, risk_category) {
+  aggregated_data <- geo_data |>
+    group_by(.data$geo, .data[[risk_category]]) |>
+    summarise(total_mode = n_distinct(.data$product, na.rm = TRUE)) |>
+    group_by(.data$geo) |>
+    mutate(proportion = .data$total_mode / sum(.data$total_mode, na.rm = TRUE)) |>
     ungroup()
 
   # Pivot
@@ -102,13 +111,13 @@ aggregate_geo <- function(geo, mode, risk_category) {
 
   # Calculate color row by row
   aggregated_data <- aggregated_data |>
-    group_by(.data$postcode) |>
+    group_by(.data$geo) |>
     summarise(
       total_mode = add(.data$total_mode),
       geometry = first(.data$geometry),
-      low = add(.data$low),
-      medium = add(.data$medium),
-      high = add(.data$high)
+      low = if ("low" %in% names(pick(everything()))) add(.data$low) else 0.0,
+      medium = if ("medium" %in% names(pick(everything()))) add(.data$medium) else 0.0,
+      high = if ("high" %in% names(pick(everything()))) add(.data$high) else 0.0
     ) |>
     mutate(color = pmap(list(.data$high, .data$medium, .data$low), custom_gradient_color))
   aggregated_data