-
Notifications
You must be signed in to change notification settings - Fork 1
/
spa.R
102 lines (88 loc) · 2.54 KB
/
spa.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
spa_check <- function(x) {
stop_if_has_0_rows(x$companies)
stop_if_has_0_rows(x$scenarios)
check_matches_name(x$companies, pattern = id_pattern())
crucial <- c(
aka("scenario_type"),
aka("scenario_name"),
aka("xsector"),
aka("xsubsector"),
aka("xyear")
)
check_crucial_names(x$scenarios, crucial)
stop_if_all_sector_and_subsector_are_na_for_some_type(x$scenarios)
check_no_semicolon(x$companies)
check_rowid(x)
}
stop_if_all_sector_and_subsector_are_na_for_some_type <- function(scenarios) {
bad_type <- scenarios |>
summarize(
all_na = all(is.na(.data$sector) & is.na(.data$subsector)), .by = aka("scenario_type")
) |>
filter(.data$all_na) |>
pull(.data$type)
has_bad_type <- !identical(bad_type, character(0))
if (has_bad_type) {
bad <- toString(bad_type)
abort(c(
"Each scenario `type` must have some `sector` and `subsector`.",
x = glue("All `sector` and `subsector` are missing for `type` {bad}."),
i = hint_needs_prep()
))
}
invisible(scenarios)
}
prepare_scenarios <- function(data, low_threshold, high_threshold) {
data |>
mutate(low_threshold = low_threshold, high_threshold = high_threshold) |>
distinct() |>
rename(profile_ranking = aka("co2reduce"))
}
spa_compute_profile_ranking <- function(data, scenarios) {
left_join(
data, scenarios,
by = c(aka("scenario_type"), aka("xsector"), aka("xsubsector")),
relationship = "many-to-many"
)
}
spa_polish_output_at_product_level <- function(data) {
data |>
ungroup() |>
unite(
"grouped_by",
# hack #305
if (hasName(data, aka("scenario_type"))) aka("scenario_type") else NULL,
aka("scenario_name"),
aka("xyear"),
remove = FALSE
) |>
relocate(all_of(cols_at_all_levels()))
}
spa_cols_at_product_level <- function() {
c(
cols_at_product_level(),
aka("tsector"),
aka("scenario_name"),
aka("xyear"),
aka("scenario_type")
)
}
check_no_semicolon <- function(data) {
relevant_cols <- data |>
select(-starts_with("tilt_")) |>
select(ends_with(aka("xsector")))
has_relevant_cols <- ncol(relevant_cols) > 0L
if (!has_relevant_cols) {
return(data)
}
has_semicolon <- any(map_lgl(relevant_cols, ~ any(grepl(";", .x))))
if (!has_semicolon) {
return(data)
}
warn(c(
"The `*sector` columns used to match scenarios shouln't have semicolon ';'.",
x = "Unmatched values of `sector` and `subsector` result in `NA`s.",
i = "Do you need see the evolution of this issue on GitHub (#448)?"
))
data
}