Skip to content

Commit fb7a172

Browse files
lindadelacombazlindadelacombaz
authored
Adapt the code to the new data set, without financial (#138)
* added new toy data set * added documentation * updated bar plot emission profile * fixed space typo * modified bar plot emission profile + added scenario & year * modified xlim() * new data set to handle NAs * modified map and tests passed * added defining global variables * added documentation * corrected map * changed tests * commented vignette for now * styled * uncommented vignette * updated changelog * removed article * added arguments description * styled * added util function * fixed potential bug * styled * aligned * use tidy style
1 parent a931511 commit fb7a172

30 files changed

+637
-368
lines changed

‎NAMESPACE‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,12 +9,16 @@ export(map_region_risk)
99
export(modes)
1010
export(plot_sankey)
1111
export(scatter_plot_financial)
12+
export(scenarios)
13+
export(scenarios_financial)
1214
export(theme_tiltplot)
15+
export(years)
1316
importFrom(dplyr,arrange)
1417
importFrom(dplyr,bind_rows)
1518
importFrom(dplyr,case_when)
1619
importFrom(dplyr,distinct)
1720
importFrom(dplyr,filter)
21+
importFrom(dplyr,first)
1822
importFrom(dplyr,group_by)
1923
importFrom(dplyr,inner_join)
2024
importFrom(dplyr,left_join)

‎NEWS.md‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,11 @@
11
<!-- NEWS.md is maintained by https://cynkra.github.io/fledge, do not edit -->
22

3+
# tiltPlot 0.0.0.9003 (2024-07-09)
4+
5+
* tiltPlot data fosters a new toy data set without financials (`without_financial`) (#137).
6+
* `bar_plot_emission_profile()` has two new arguments: `scenario` and `year`.
7+
* `map_region_risk()` has two new arguments: `scenario` and `year`.
8+
39
# tiltPlot 0.0.0.9002 (2024-06-04)
410

511
* `bar_plot_emission_profile()` has now modes that the user can choose from (#134).

‎R/bar_plot_emission_profile.R‎

Lines changed: 19 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
#' emission profiles will be plotted. The user can choose from one to several
99
#' benchmark(s) to be plotted.
1010
#' @param mode A character vector: `r toString(modes())`.
11+
#' @param scenario A character vector: `r toString(scenarios())`.
12+
#' @param year A character vector: `r toString(years())`.
1113
#'
1214
#' @return A [ggplot] object.
1315
#'
@@ -18,14 +20,19 @@
1820
#' bar_plot_emission_profile(without_financial, benchmarks)
1921
bar_plot_emission_profile <- function(data,
2022
benchmarks = benchmarks(),
21-
mode = modes()) {
23+
mode = modes(),
24+
scenario = scenarios(),
25+
year = years()) {
2226
benchmarks <- arg_match(benchmarks, multiple = TRUE)
2327
mode <- mode |>
24-
arg_match()
28+
arg_match() |>
29+
switch_mode_emission_profile()
30+
scenario <- arg_match(scenario)
31+
year <- year
2532

2633
data |>
27-
check_bar_plot_emission_profile() |>
28-
prepare_bar_plot_emission_profile(benchmarks, mode) |>
34+
check_bar_plot_emission_profile(mode) |>
35+
prepare_bar_plot_emission_profile(benchmarks = benchmarks, mode = mode, scenario = scenario, year = year) |>
2936
plot_bar_plot_emission_profile_impl()
3037
}
3138

@@ -35,10 +42,10 @@ bar_plot_emission_profile <- function(data,
3542
#'
3643
#' @return A data frame
3744
#' @noRd
38-
check_bar_plot_emission_profile <- function(data) {
45+
check_bar_plot_emission_profile <- function(data, mode) {
3946
crucial <- c(
4047
"benchmark",
41-
modes(),
48+
mode,
4249
aka("risk_category")
4350
)
4451
data |> check_crucial_names(names_matching(data, crucial))
@@ -53,14 +60,16 @@ check_bar_plot_emission_profile <- function(data) {
5360
#' @return A data frame.
5461
#'
5562
#' @noRd
56-
prepare_bar_plot_emission_profile <- function(data, benchmarks, mode) {
57-
risk_var <- names_matching(data, aka("risk_category"))
63+
prepare_bar_plot_emission_profile <- function(data, benchmarks, mode, scenario, year) {
64+
risk_var <- get_colname(data, aka("risk_category"))
5865

5966
data <- data |>
6067
mutate(risk_category_var = as_risk_category(.data[[risk_var]]))
6168

6269
data <- data |>
63-
filter(.data$benchmark %in% benchmarks) |>
70+
filter((.data$benchmark %in% .env$benchmarks &
71+
.data$scenario == .env$scenario &
72+
.data$year == .env$year)) |>
6473
group_by(.data$risk_category_var, .data$benchmark) |>
6574
summarise(total_mode = sum(.data[[mode]])) |>
6675
group_by(.data$benchmark) |>
@@ -80,5 +89,5 @@ plot_bar_plot_emission_profile_impl <- function(data) {
8089
geom_col(position = position_stack(reverse = TRUE), width = width_bar()) +
8190
fill_score_colors() +
8291
theme_tiltplot() +
83-
xlim(0, 1)
92+
xlim(0, NA)
8493
}

‎R/custom_gradient_color.R‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,6 @@ custom_gradient_color <- function(risk_high = 1, risk_medium = 1, risk_low = 1)
2424
# interpolate the colors based on proportions : 1 is highest intensity
2525
final_color <- high_color * risk_high + medium_color * risk_medium + low_color * risk_low
2626

27-
final_color <- do.call(rgb, as.list(final_color))
28-
29-
return(final_color)
27+
final_color <- do.call(rgb, c(as.list(final_color)))
28+
final_color
3029
}

‎R/example_data.R‎

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -25,16 +25,20 @@ default_financial <- function(bank_id = "a",
2525
default_without_financial <- function(company_name = "a",
2626
emission_profile = "medium",
2727
benchmark = "all",
28-
equal_weight = 0.1,
29-
worst_case = 0.1,
30-
best_case = 0.1) {
28+
scenario = "1.5C RPS",
29+
year = 2030,
30+
equal_weight_emission_profile = 0.1,
31+
worst_case_emission_profile = 0.1,
32+
best_case_emission_profile = 0.1) {
3133
tibble(
3234
company_name = company_name,
3335
emission_profile = emission_profile,
3436
benchmark = benchmark,
35-
equal_weight = equal_weight,
36-
worst_case = worst_case,
37-
best_case = best_case
37+
scenario = scenario,
38+
year = year,
39+
equal_weight_emission_profile = equal_weight_emission_profile,
40+
worst_case_emission_profile = worst_case_emission_profile,
41+
best_case_emission_profile = best_case_emission_profile
3842
)
3943
}
4044

‎R/map_region_risk.R‎

Lines changed: 9 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,8 @@
1010
#' default mode.
1111
#' @param mode The mode to plot. It can be one of "equal_weight", "worst_case"
1212
#' or "best_case". If nothing is chosen, "equal_weight" is the default mode.
13+
#' @param scenario A character vector: `r toString(scenarios())`.
14+
#' @param year A character vector: `r toString(years())`.
1315
#'
1416
#' @return A ggplot2 object representing the country data plot.
1517
#' @export
@@ -22,20 +24,17 @@
2224
map_region_risk <- function(data,
2325
# TODO: plot for other countries
2426
country_code = c("DE"),
25-
benchmark = c(
26-
"all",
27-
"isic_4digit",
28-
"tilt_sector",
29-
"unit",
30-
"unit_isic_4digit",
31-
"unit_tilt_sector"
32-
),
33-
mode = c("equal_weight", "worst_case", "best_case")) {
27+
benchmark = benchmarks(),
28+
mode = modes(),
29+
scenario = scenarios(),
30+
year = years()) {
3431
prepared_data <- prepare_geo_data(
3532
data,
3633
country_code,
3734
benchmark,
38-
mode
35+
mode,
36+
scenario,
37+
year
3938
)
4039
shp_1 <- prepared_data[[1]]
4140
aggregated_data <- prepared_data[[2]]

‎R/prepare_geo_data.R‎

Lines changed: 38 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -10,23 +10,27 @@
1010
prepare_geo_data <- function(data,
1111
country_code = c("DE"),
1212
benchmark = benchmarks(),
13-
mode = c(
14-
"equal_weight",
15-
"worst_case",
16-
"best_case"
17-
)) {
13+
mode = modes(),
14+
scenario = scenarios(),
15+
year = years()) {
1816
benchmark <- arg_match(benchmark)
19-
mode <- arg_match(mode)
17+
mode <- mode |>
18+
arg_match() |>
19+
switch_mode_emission_profile()
2020
country_code <- arg_match(country_code)
21+
scenario <- arg_match(scenario)
22+
year <- year
2123

2224
crucial <- c(
2325
aka("risk_category"),
24-
"company_name",
26+
aka("companies_id"),
2527
"postcode",
26-
"benchmark"
28+
"benchmark",
29+
"scenario",
30+
aka("year")
2731
)
2832
data |> check_crucial_names(names_matching(data, crucial))
29-
risk_var <- names_matching(data, aka("risk_category"))
33+
risk_var <- get_colname(data, aka("risk_category"))
3034
data <- data |>
3135
mutate(risk_category_var = as_risk_category(data[[risk_var]]))
3236

@@ -50,7 +54,11 @@ prepare_geo_data <- function(data,
5054

5155
# merge shapefile with financial data
5256
geo <- data |>
53-
filter(benchmark == .env$benchmark) |>
57+
filter(
58+
.data$benchmark == .env$benchmark,
59+
.data$scenario == .env$scenario,
60+
.data$year == .env$year
61+
) |>
5462
left_join(shp_1, by = "postcode") |>
5563
st_as_sf()
5664

@@ -59,7 +67,6 @@ prepare_geo_data <- function(data,
5967
list(shp_1, aggregated_data)
6068
}
6169

62-
6370
#' Aggregate Geo Data
6471
#'
6572
#' @param geo A data frame containing geographical data.
@@ -84,52 +91,28 @@ prepare_geo_data <- function(data,
8491
#'
8592
#' aggregate_geo(geo, mode = "worst_case")
8693
aggregate_geo <- function(geo, mode) {
87-
if (mode %in% c("worst_case", "best_case")) {
88-
aggregated_data <- geo |>
89-
group_by(.data$postcode, .data$company_name) |>
90-
mutate(
91-
# Choose the worst or best risk category and set the others to 0.
92-
proportion = calculate_case_proportions(.data$risk_category_var, mode)
93-
) |>
94-
group_by(.data$postcode, .data$risk_category_var) |>
95-
summarize(proportion = sum(.data$proportion)) |>
96-
ungroup()
97-
} else if (mode == "equal_weight") {
98-
aggregated_data <- geo |>
99-
group_by(.data$postcode, .data$risk_category_var) |>
100-
summarize(count = n()) |>
101-
# Do not group by company here since all of them have equal weights.
102-
group_by(.data$postcode) |>
103-
mutate(proportion = .data$count / sum(.data$count)) |>
104-
ungroup()
105-
}
94+
aggregated_data <- geo |>
95+
group_by(.data$postcode, .data$risk_category_var) |>
96+
summarise(total_mode = sum(.data[[mode]])) |>
97+
group_by(.data$postcode) |>
98+
mutate(proportion = total_mode / sum(total_mode)) |>
99+
ungroup()
106100

107-
# apply custom_gradient_color to each row
101+
# Pivot
108102
aggregated_data <- aggregated_data |>
109103
pivot_wider(names_from = "risk_category_var", values_from = "proportion", values_fill = 0) |>
110-
mutate(color = pmap(list(.data$high, .data$medium, .data$low), custom_gradient_color))
111-
}
104+
filter(.data$total_mode != 0)
112105

113-
#' Calculate Proportions for Worst or Best Case Scenarios
114-
#'
115-
#' @param categories A factor vector of risk categories.
116-
#' @param mode A character string specifying the mode.
117-
#'
118-
#' @return A numeric vector representing the calculated proportions for each
119-
#' category.
120-
#'
121-
#' @examples
122-
#' categories <- as_risk_category(c("low", "medium", "medium", "high"))
123-
#' calculate_case_proportions(categories, mode = "worst_case")
124-
#' @noRd
125-
calculate_case_proportions <- function(categories, mode) {
126-
if (mode == "worst_case") {
127-
extreme_risk <- levels(categories)[max(as.integer(categories))]
128-
} else if (mode == "best_case") {
129-
extreme_risk <- levels(categories)[min(as.integer(categories))]
130-
}
131-
132-
is_extreme <- categories == extreme_risk
133-
proportions <- ifelse(is_extreme, 1 / sum(is_extreme), 0)
134-
proportions
106+
# Calculate color row by row
107+
aggregated_data <- aggregated_data |>
108+
group_by(.data$postcode) |>
109+
summarise(
110+
total_mode = add(.data$total_mode),
111+
geometry = first(.data$geometry),
112+
low = add(.data$low),
113+
medium = add(.data$medium),
114+
high = add(.data$high)
115+
) |>
116+
mutate(color = pmap(list(.data$high, .data$medium, .data$low), custom_gradient_color))
117+
aggregated_data
135118
}

‎R/scatter_plot_financial.R‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -21,13 +21,9 @@
2121
#' )
2222
scatter_plot_financial <- function(data,
2323
benchmarks = benchmarks(),
24-
mode = c(
25-
"equal_weight",
26-
"worst_case",
27-
"best_case"
28-
),
29-
scenario = c("IPR", "WEO"),
30-
year = c(2030, 2050)) {
24+
mode = modes(),
25+
scenario = scenarios_financial(),
26+
year = years()) {
3127
# FIXME: .env$ instead of _arg seems to cause a bug only for benchmarks.
3228
benchmarks_arg <- arg_match(benchmarks, multiple = TRUE)
3329
scenario <- arg_match(scenario)

‎R/tiltPlot-package.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
#' @importFrom dplyr case_when
88
#' @importFrom dplyr distinct
99
#' @importFrom dplyr filter
10+
#' @importFrom dplyr first
1011
#' @importFrom dplyr group_by
1112
#' @importFrom dplyr inner_join
1213
#' @importFrom dplyr left_join

0 commit comments

Comments
 (0)