-
Notifications
You must be signed in to change notification settings - Fork 1
/
emissions_profile_any_at_product_level.R
96 lines (80 loc) · 2.4 KB
/
emissions_profile_any_at_product_level.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
emissions_profile_any_at_product_level <- function(companies,
co2,
low_threshold = 1 / 3,
high_threshold = 2 / 3) {
co2 <- sanitize_co2(co2)
x <- list(companies = companies, co2 = co2)
epa_check(x)
.companies <- prepare_companies(companies)
.co2 <- prepare_co2(co2, low_threshold, high_threshold)
.co2 |>
epa_add_values_to_categorize() |>
add_risk_category(low_threshold, high_threshold) |>
join_companies(.companies) |>
epa_select_cols_at_product_level() |>
polish_output(cols_at_product_level())
}
epa_check <- function(x) {
stop_if_has_0_rows(x$companies)
stop_if_has_0_rows(x$co2)
crucial <- c(aka("id"))
walk(crucial, ~ check_matches_name(x$companies, .x))
crucial <- c(aka("co2footprint"), aka("tsector"), aka("isic"))
walk(crucial, ~ check_matches_name(x$co2, .x))
check_has_no_na(x$co2, find_co2_footprint(x$co2))
check_is_character(pull_isic(x$co2))
check_string_lengh(pull_isic(x$co2), 4L)
check_rowid(x)
}
check_has_no_na <- function(data, name) {
if (anyNA(data[[name]])) {
abort(c(
glue("The column '{name}' can't have missing values."),
i = glue("Remove them with `dplyr::filter(data, !is.na({name}))`.")
))
}
invisible(data)
}
check_is_character <- function(x) {
vec_assert(x, character())
}
epa_add_values_to_categorize <- function(data) {
add_rank <- function(data, .by) {
if (identical(.by, "all")) .by <- NULL
mutate(
data,
values_to_categorize = rank_proportion(.data[[find_co2_footprint(data)]]),
.by = all_of(.by)
)
}
benchmarks <- set_names(epa_benchmarks(), flat_benchmarks())
map_df(benchmarks, ~ add_rank(data, .x), .id = "grouped_by")
}
epa_benchmarks <- function() {
list(
"all",
"isic_sec",
"tilt_sec",
"unit",
c("unit", "isic_sec"),
c("unit", "tilt_sec")
)
}
flat_benchmarks <- function() {
map_chr(epa_benchmarks(), ~ paste(.x, collapse = "_"))
}
rank_proportion <- function(x) {
rank(x) / length(x)
}
find_co2_footprint <- function(co2, pattern = aka("co2footprint")) {
extract_name(co2, pattern)
}
epa_select_cols_at_product_level <- function(data) {
data |>
select(
ends_with(rowid()),
all_of(cols_at_product_level()),
ends_with(aka("uid")),
find_co2_footprint(data)
)
}