From fa58ade9d2e4cf972b899976af7ae57c34d54e5d Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sat, 9 Mar 2024 19:13:38 +0000 Subject: [PATCH 01/25] Test can optionally ouptput co2* columns --- tests/testthat/test-profile.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/tests/testthat/test-profile.R b/tests/testthat/test-profile.R index 14d3ce6..3860974 100644 --- a/tests/testthat/test-profile.R +++ b/tests/testthat/test-profile.R @@ -259,3 +259,32 @@ test_that("with `order = 'rev'` the chunks work in reverse order", { expect_equal(actual, rev(as.character(1:3))) }) + +test_that("can optionally output `co2_*` columns", { + tmp_cache <- local_tempfile() + local_options(list( + tiltIndicatorAfter.output_co2_footprint = TRUE, + tiltWorkflows.chunks = 3, + tiltWorkflows.cache_dir = tmp_cache + )) + + companies <- read_csv(toy_emissions_profile_any_companies()) + co2 <- read_csv(toy_emissions_profile_products_ecoinvent()) + europages_companies <- read_csv(toy_europages_companies()) + ecoinvent_activities <- read_csv(toy_ecoinvent_activities()) + ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) + isic_name <- read_csv(toy_isic_name()) + + out <- profile_emissions( + companies, + co2, + europages_companies, + ecoinvent_activities, + ecoinvent_europages, + isic_name + ) + + expect_true(hasName(unnest_product(out), "co2_footprint")) + expect_true(hasName(unnest_company(out), "co2_avg")) +}) + From 4028ac6686f3c0f218dc78535e40dd1b74797c0c Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sat, 9 Mar 2024 21:31:28 +0000 Subject: [PATCH 02/25] wip --- R/map_chunks.R | 13 ++++++++++++- tests/testthat/test-profile.R | 2 +- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index d26f721..e7e6ad7 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -9,12 +9,19 @@ map_chunks <- function(data, nest_chunk(.by = .by, chunks = chunks) |> add_file(cache_path(parent, cache_dir = dir_create(cache_dir))) + op <- extract_options("tiltIndicatorAfter") + job |> pick_undone() |> dchunkr::order_rows(.fun = order) |> select("data", "file") |> future_pwalk( - \(data, file) .f(data, ...) |> write_rds(file), + function(data, file) { + # Pass options https://github.com/HenrikBengtsson/future/issues/134 + withr::local_options(op) + .f(data, ...) |> + write_rds(file) + }, .progress = TRUE, .options = furrr::furrr_options(seed = TRUE) ) @@ -25,3 +32,7 @@ map_chunks <- function(data, rm_namespace <- function(x) { gsub("^.*::(.*)$", "\\1", x) } + +extract_options <- function(pattern) { + options()[grep(pattern, names(options()), value = TRUE)] +} diff --git a/tests/testthat/test-profile.R b/tests/testthat/test-profile.R index 3860974..f469e57 100644 --- a/tests/testthat/test-profile.R +++ b/tests/testthat/test-profile.R @@ -275,7 +275,7 @@ test_that("can optionally output `co2_*` columns", { ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) isic_name <- read_csv(toy_isic_name()) - out <- profile_emissions( + out <- tiltWorkflows::profile_emissions( companies, co2, europages_companies, From cfa95eb9459468eca6881b470dd77c639ab9a850 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sat, 9 Mar 2024 21:37:26 +0000 Subject: [PATCH 03/25] wip --- tests/testthat/test-profile.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-profile.R b/tests/testthat/test-profile.R index f469e57..e39cea7 100644 --- a/tests/testthat/test-profile.R +++ b/tests/testthat/test-profile.R @@ -287,4 +287,3 @@ test_that("can optionally output `co2_*` columns", { expect_true(hasName(unnest_product(out), "co2_footprint")) expect_true(hasName(unnest_company(out), "co2_avg")) }) - From 68531f1caafbbe5fb90f03f52e3d7c92d6e6e1b5 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 14:18:43 +0000 Subject: [PATCH 04/25] Handle missmatch --- R/map_chunks.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index e7e6ad7..165917b 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -34,5 +34,9 @@ rm_namespace <- function(x) { } extract_options <- function(pattern) { - options()[grep(pattern, names(options()), value = TRUE)] + out <- options()[grep(pattern, names(options()), value = TRUE)] + if (rlang::is_empty(out)) { + return(options()) + } + out } From 123176c7ac736fe881a88e09bb8e80eff6cb2e0e Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 14:42:17 +0000 Subject: [PATCH 05/25] warn --- R/map_chunks.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/map_chunks.R b/R/map_chunks.R index 165917b..d7960ae 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -36,6 +36,11 @@ rm_namespace <- function(x) { extract_options <- function(pattern) { out <- options()[grep(pattern, names(options()), value = TRUE)] if (rlang::is_empty(out)) { + rlang::warn(c( + glue::glue("The pattern '{pattern}' matched no option."), + i = "Do you need to fix a typo?", + v = "Returning the original `options()`." + )) return(options()) } out From 766d87ac391c0524cfa306a3e30bc476f6d874bb Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 14:45:54 +0000 Subject: [PATCH 06/25] refactor --- R/map_chunks.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index d7960ae..6332555 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -3,14 +3,13 @@ map_chunks <- function(data, .by, chunks, cache_dir, - order = "identity") { + order = "identity", + op = extract_options("tiltIndicatorAfter")) { parent <- rm_namespace(deparse(substitute(.f))) job <- data |> nest_chunk(.by = .by, chunks = chunks) |> add_file(cache_path(parent, cache_dir = dir_create(cache_dir))) - op <- extract_options("tiltIndicatorAfter") - job |> pick_undone() |> dchunkr::order_rows(.fun = order) |> From 4f21414a8deae504f7891ab3cc6fd83c2b30f4e6 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 14:47:53 +0000 Subject: [PATCH 07/25] wip --- R/map_chunks.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index 6332555..90c6726 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -4,7 +4,7 @@ map_chunks <- function(data, chunks, cache_dir, order = "identity", - op = extract_options("tiltIndicatorAfter")) { + options = extract_options("tiltIndicatorAfter")) { parent <- rm_namespace(deparse(substitute(.f))) job <- data |> nest_chunk(.by = .by, chunks = chunks) |> @@ -17,7 +17,7 @@ map_chunks <- function(data, future_pwalk( function(data, file) { # Pass options https://github.com/HenrikBengtsson/future/issues/134 - withr::local_options(op) + withr::local_options(options) .f(data, ...) |> write_rds(file) }, From 22783fd84c9d32bf41ae166b49469bd024d68ed6 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 14:55:17 +0000 Subject: [PATCH 08/25] refactor --- R/map_chunks.R | 15 +-------------- R/profile.R | 10 ++++++++++ R/utils.R | 18 ++++++++++++++++++ 3 files changed, 29 insertions(+), 14 deletions(-) create mode 100644 R/utils.R diff --git a/R/map_chunks.R b/R/map_chunks.R index 90c6726..a8ab864 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -4,7 +4,7 @@ map_chunks <- function(data, chunks, cache_dir, order = "identity", - options = extract_options("tiltIndicatorAfter")) { + options = NULL) { parent <- rm_namespace(deparse(substitute(.f))) job <- data |> nest_chunk(.by = .by, chunks = chunks) |> @@ -31,16 +31,3 @@ map_chunks <- function(data, rm_namespace <- function(x) { gsub("^.*::(.*)$", "\\1", x) } - -extract_options <- function(pattern) { - out <- options()[grep(pattern, names(options()), value = TRUE)] - if (rlang::is_empty(out)) { - rlang::warn(c( - glue::glue("The pattern '{pattern}' matched no option."), - i = "Do you need to fix a typo?", - v = "Returning the original `options()`." - )) - return(options()) - } - out -} diff --git a/R/profile.R b/R/profile.R index 2cbeb48..18e8c61 100644 --- a/R/profile.R +++ b/R/profile.R @@ -35,11 +35,14 @@ profile_emissions <- function(companies, high_threshold = high_threshold ) } else { + options <- extract_options("tiltIndicatorAfter") + map_chunks( companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, + options = tiltIndicatorAfter_options(), .by = "companies_id", .f = tiltIndicatorAfter::profile_emissions, co2 = co2, @@ -92,12 +95,15 @@ profile_emissions_upstream <- function(companies, high_threshold = high_threshold ) } else { + options <- extract_options("tiltIndicatorAfter") + map_chunks( companies, .by = "companies_id", chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, + options = tiltIndicatorAfter_options(), .f = tiltIndicatorAfter::profile_emissions_upstream, co2 = co2, europages_companies = europages_companies, @@ -148,12 +154,15 @@ profile_sector <- function(companies, high_threshold = high_threshold ) } else { + options <- extract_options("tiltIndicatorAfter") + map_chunks( companies, .by = "companies_id", chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, + options = tiltIndicatorAfter_options(), .f = tiltIndicatorAfter::profile_sector, scenarios = scenarios, europages_companies = europages_companies, @@ -213,6 +222,7 @@ profile_sector_upstream <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, + options = tiltIndicatorAfter_options(), .f = tiltIndicatorAfter::profile_sector_upstream, scenarios = scenarios, inputs = inputs, diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..7c7c201 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,18 @@ +extract_options <- function(pattern) { + out <- options()[grep(pattern, names(options()), value = TRUE)] + if (rlang::is_empty(out)) { + rlang::warn(c( + glue::glue("The pattern '{pattern}' matched no option."), + i = "Do you need to fix a typo?", + v = "Returning the original `options()`." + )) + return(options()) + } + out +} + +tiltIndicatorAfter_options <- function() { + extract_options("tiltIndicatorAfter") +} + + From eb3a5e7495eb8c52a1cb8d90d2a956d8667ac307 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 15:01:33 +0000 Subject: [PATCH 09/25] refactor --- R/profile.R | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/R/profile.R b/R/profile.R index 18e8c61..8c9cc5d 100644 --- a/R/profile.R +++ b/R/profile.R @@ -35,15 +35,13 @@ profile_emissions <- function(companies, high_threshold = high_threshold ) } else { - options <- extract_options("tiltIndicatorAfter") - map_chunks( companies, + .by = "companies_id", chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, options = tiltIndicatorAfter_options(), - .by = "companies_id", .f = tiltIndicatorAfter::profile_emissions, co2 = co2, europages_companies = europages_companies, @@ -95,8 +93,6 @@ profile_emissions_upstream <- function(companies, high_threshold = high_threshold ) } else { - options <- extract_options("tiltIndicatorAfter") - map_chunks( companies, .by = "companies_id", @@ -154,8 +150,6 @@ profile_sector <- function(companies, high_threshold = high_threshold ) } else { - options <- extract_options("tiltIndicatorAfter") - map_chunks( companies, .by = "companies_id", From a1474f3880380aa84f2d2e63fe157ec718a15fc5 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 15:14:36 +0000 Subject: [PATCH 10/25] wip --- R/profile.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/profile.R b/R/profile.R index 8c9cc5d..b5ff61c 100644 --- a/R/profile.R +++ b/R/profile.R @@ -1,3 +1,13 @@ +customized <- function(f, options) { + force(f) + force(options) + + function(...) { + withr::local_options(options) + f(...) + } +} + #' @export #' @keywords internal #' @inherit tiltIndicatorAfter::profile_emissions From c9c9d5cf4923f0a1041b4e355d4af39721285191 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 15:18:59 +0000 Subject: [PATCH 11/25] refactor --- R/profile.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/profile.R b/R/profile.R index b5ff61c..ef9da2f 100644 --- a/R/profile.R +++ b/R/profile.R @@ -1,4 +1,4 @@ -customized <- function(f, options) { +customized_with <- function(f, options) { force(f) force(options) @@ -51,8 +51,8 @@ profile_emissions <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - options = tiltIndicatorAfter_options(), - .f = tiltIndicatorAfter::profile_emissions, + .f = tiltIndicatorAfter::profile_emissions |> + customized_with(tiltIndicatorAfter_options()), co2 = co2, europages_companies = europages_companies, ecoinvent_activities = ecoinvent_activities, @@ -109,8 +109,8 @@ profile_emissions_upstream <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - options = tiltIndicatorAfter_options(), - .f = tiltIndicatorAfter::profile_emissions_upstream, + .f = tiltIndicatorAfter::profile_emissions_upstream |> + customized_with(tiltIndicatorAfter_options()), co2 = co2, europages_companies = europages_companies, ecoinvent_activities = ecoinvent_activities, @@ -166,8 +166,8 @@ profile_sector <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - options = tiltIndicatorAfter_options(), - .f = tiltIndicatorAfter::profile_sector, + .f = tiltIndicatorAfter::profile_sector |> + customized_with(tiltIndicatorAfter_options()), scenarios = scenarios, europages_companies = europages_companies, ecoinvent_activities = ecoinvent_activities, @@ -226,8 +226,8 @@ profile_sector_upstream <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - options = tiltIndicatorAfter_options(), - .f = tiltIndicatorAfter::profile_sector_upstream, + .f = tiltIndicatorAfter::profile_sector_upstream |> + customized_with(tiltIndicatorAfter_options()), scenarios = scenarios, inputs = inputs, europages_companies = europages_companies, From 26de58c522deb93e27ef4b43dbcc7aa1836045df Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 15:20:40 +0000 Subject: [PATCH 12/25] wip --- R/map_chunks.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index a8ab864..6d73ffd 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -3,8 +3,7 @@ map_chunks <- function(data, .by, chunks, cache_dir, - order = "identity", - options = NULL) { + order = "identity") { parent <- rm_namespace(deparse(substitute(.f))) job <- data |> nest_chunk(.by = .by, chunks = chunks) |> @@ -16,8 +15,6 @@ map_chunks <- function(data, select("data", "file") |> future_pwalk( function(data, file) { - # Pass options https://github.com/HenrikBengtsson/future/issues/134 - withr::local_options(options) .f(data, ...) |> write_rds(file) }, From a6256201d0dd028fcc1ceebc774bf7ae90973e78 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 16:02:15 +0000 Subject: [PATCH 13/25] wip --- R/utils-devel.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/R/utils-devel.R b/R/utils-devel.R index 8d36820..33480d4 100644 --- a/R/utils-devel.R +++ b/R/utils-devel.R @@ -101,3 +101,24 @@ use_workflow_index <- function(index = 1) { wf <- workflows() use_workflow(wf[[index]]) } + +#' @examples +#' # DANGER +#' # cache_delete() +#' # system("rm output -rf") +#' +#' withr::local_options(list(tiltIndicatorAfter.output_co2_footprint = TRUE)) +#' run_workflow("profile_emissions.Rmd") +#' +#' readr::read_csv("output/emissions_profile_at_product_level.csv") |> +#' hasName("co2_footprint") |> +#' stopifnot() +#' readr::read_csv("output/emissions_profile_at_company_level.csv") |> +#' hasName("co2_avg") |> +#' stopifnot() +#' @noRd +run_workflow <- function(template) { + use_workflow(template, open = FALSE) + knitr::purl(template, documentation = 2L) + source(fs::path_ext_set(template, ".R")) +} From 5658cebb40e971078d9a19f5d54ba5dfd9cb28eb Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 16:10:45 +0000 Subject: [PATCH 14/25] Revert --- R/map_chunks.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index 6d73ffd..d26f721 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -14,10 +14,7 @@ map_chunks <- function(data, dchunkr::order_rows(.fun = order) |> select("data", "file") |> future_pwalk( - function(data, file) { - .f(data, ...) |> - write_rds(file) - }, + \(data, file) .f(data, ...) |> write_rds(file), .progress = TRUE, .options = furrr::furrr_options(seed = TRUE) ) From a5562fe5365df723f58687d032ce908ab3c63040 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 20:36:09 +0000 Subject: [PATCH 15/25] Remove warning --- R/utils.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/utils.R b/R/utils.R index 7c7c201..29a0b77 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,11 +1,6 @@ extract_options <- function(pattern) { out <- options()[grep(pattern, names(options()), value = TRUE)] if (rlang::is_empty(out)) { - rlang::warn(c( - glue::glue("The pattern '{pattern}' matched no option."), - i = "Do you need to fix a typo?", - v = "Returning the original `options()`." - )) return(options()) } out From 521c1860c17030aeeb951e0b88ee5aa979b8a7b1 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 20:36:32 +0000 Subject: [PATCH 16/25] Redocument --- man/profile_emissions.Rd | 14 +++++++++++--- man/profile_emissions_upstream.Rd | 14 +++++++++++--- 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/man/profile_emissions.Rd b/man/profile_emissions.Rd index c0f7542..40e5542 100644 --- a/man/profile_emissions.Rd +++ b/man/profile_emissions.Rd @@ -37,6 +37,12 @@ profile products.} } \value{ A data frame with the column \code{companies_id}, and the nested columns\code{product} and \code{company} holding the outputs at product and company level. Unnesting \code{product} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}. Unnesting \code{company} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}, \code{value}. + +The columns \code{co2e_lower} and \code{co2e_upper} show the lowest and highest value +of \code{co2_footprint} within the group to which the product was compared, plus +some randomness. Therefore, every benchmark can have different \code{co2e_lower} +and \code{co2e_upper}, because every benchmark can contain a different set of +products. } \description{ These functions wrap the output of the corresponding function in @@ -44,12 +50,14 @@ These functions wrap the output of the corresponding function in } \examples{ library(tiltToyData) +library(withr) library(readr, warn.conflicts = FALSE) -options(readr.show_col_types = FALSE) +local_seed(1) +local_options(readr.show_col_types = FALSE) companies <- read_csv(toy_emissions_profile_any_companies()) -products <- read_csv(toy_emissions_profile_products()) +products <- read_csv(toy_emissions_profile_products_ecoinvent()) europages_companies <- read_csv(toy_europages_companies()) ecoinvent_activities <- read_csv(toy_ecoinvent_activities()) ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) @@ -70,7 +78,7 @@ result |> unnest_company() -inputs <- read_csv(toy_emissions_profile_upstream_products()) +inputs <- read_csv(toy_emissions_profile_upstream_products_ecoinvent()) ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs()) result <- profile_emissions_upstream( diff --git a/man/profile_emissions_upstream.Rd b/man/profile_emissions_upstream.Rd index 8d7e0b6..1042047 100644 --- a/man/profile_emissions_upstream.Rd +++ b/man/profile_emissions_upstream.Rd @@ -40,6 +40,12 @@ profile products.} } \value{ A data frame with the column \code{companies_id}, and the nested columns\code{product} and \code{company} holding the outputs at product and company level. Unnesting \code{product} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}. Unnesting \code{company} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}, \code{value}. + +The columns \code{co2e_lower} and \code{co2e_upper} show the lowest and highest value +of \code{co2_footprint} within the group to which the product was compared, plus +some randomness. Therefore, every benchmark can have different \code{co2e_lower} +and \code{co2e_upper}, because every benchmark can contain a different set of +products. } \description{ These functions wrap the output of the corresponding function in @@ -47,12 +53,14 @@ These functions wrap the output of the corresponding function in } \examples{ library(tiltToyData) +library(withr) library(readr, warn.conflicts = FALSE) -options(readr.show_col_types = FALSE) +local_seed(1) +local_options(readr.show_col_types = FALSE) companies <- read_csv(toy_emissions_profile_any_companies()) -products <- read_csv(toy_emissions_profile_products()) +products <- read_csv(toy_emissions_profile_products_ecoinvent()) europages_companies <- read_csv(toy_europages_companies()) ecoinvent_activities <- read_csv(toy_ecoinvent_activities()) ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) @@ -73,7 +81,7 @@ result |> unnest_company() -inputs <- read_csv(toy_emissions_profile_upstream_products()) +inputs <- read_csv(toy_emissions_profile_upstream_products_ecoinvent()) ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs()) result <- profile_emissions_upstream( From fc2941c7088bc2b18b4e38b423b98eb1bdfb2b47 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 20:43:50 +0000 Subject: [PATCH 17/25] refactor --- R/utils-devel.R | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/R/utils-devel.R b/R/utils-devel.R index 33480d4..83d7333 100644 --- a/R/utils-devel.R +++ b/R/utils-devel.R @@ -102,21 +102,19 @@ use_workflow_index <- function(index = 1) { use_workflow(wf[[index]]) } -#' @examples -#' # DANGER -#' # cache_delete() -#' # system("rm output -rf") -#' -#' withr::local_options(list(tiltIndicatorAfter.output_co2_footprint = TRUE)) -#' run_workflow("profile_emissions.Rmd") -#' -#' readr::read_csv("output/emissions_profile_at_product_level.csv") |> -#' hasName("co2_footprint") |> -#' stopifnot() -#' readr::read_csv("output/emissions_profile_at_company_level.csv") |> -#' hasName("co2_avg") |> -#' stopifnot() -#' @noRd +# # DANGER +# # cache_delete() +# # system("rm output -rf") +# +# withr::local_options(list(tiltIndicatorAfter.output_co2_footprint = TRUE)) +# run_workflow("profile_emissions.Rmd") +# +# readr::read_csv("output/emissions_profile_at_product_level.csv") |> +# hasName("co2_footprint") |> +# stopifnot() +# readr::read_csv("output/emissions_profile_at_company_level.csv") |> +# hasName("co2_avg") |> +# stopifnot() run_workflow <- function(template) { use_workflow(template, open = FALSE) knitr::purl(template, documentation = 2L) From b1ca3b10caca7575416d608e64e6fcca98ad9b2c Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 20:52:55 +0000 Subject: [PATCH 18/25] revert-man --- man/profile_emissions.Rd | 14 +++----------- man/profile_emissions_upstream.Rd | 14 +++----------- 2 files changed, 6 insertions(+), 22 deletions(-) diff --git a/man/profile_emissions.Rd b/man/profile_emissions.Rd index 40e5542..c0f7542 100644 --- a/man/profile_emissions.Rd +++ b/man/profile_emissions.Rd @@ -37,12 +37,6 @@ profile products.} } \value{ A data frame with the column \code{companies_id}, and the nested columns\code{product} and \code{company} holding the outputs at product and company level. Unnesting \code{product} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}. Unnesting \code{company} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}, \code{value}. - -The columns \code{co2e_lower} and \code{co2e_upper} show the lowest and highest value -of \code{co2_footprint} within the group to which the product was compared, plus -some randomness. Therefore, every benchmark can have different \code{co2e_lower} -and \code{co2e_upper}, because every benchmark can contain a different set of -products. } \description{ These functions wrap the output of the corresponding function in @@ -50,14 +44,12 @@ These functions wrap the output of the corresponding function in } \examples{ library(tiltToyData) -library(withr) library(readr, warn.conflicts = FALSE) -local_seed(1) -local_options(readr.show_col_types = FALSE) +options(readr.show_col_types = FALSE) companies <- read_csv(toy_emissions_profile_any_companies()) -products <- read_csv(toy_emissions_profile_products_ecoinvent()) +products <- read_csv(toy_emissions_profile_products()) europages_companies <- read_csv(toy_europages_companies()) ecoinvent_activities <- read_csv(toy_ecoinvent_activities()) ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) @@ -78,7 +70,7 @@ result |> unnest_company() -inputs <- read_csv(toy_emissions_profile_upstream_products_ecoinvent()) +inputs <- read_csv(toy_emissions_profile_upstream_products()) ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs()) result <- profile_emissions_upstream( diff --git a/man/profile_emissions_upstream.Rd b/man/profile_emissions_upstream.Rd index 1042047..8d7e0b6 100644 --- a/man/profile_emissions_upstream.Rd +++ b/man/profile_emissions_upstream.Rd @@ -40,12 +40,6 @@ profile products.} } \value{ A data frame with the column \code{companies_id}, and the nested columns\code{product} and \code{company} holding the outputs at product and company level. Unnesting \code{product} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}. Unnesting \code{company} yields a data frame with at least columns \code{companies_id}, \code{grouped_by}, \code{risk_category}, \code{value}. - -The columns \code{co2e_lower} and \code{co2e_upper} show the lowest and highest value -of \code{co2_footprint} within the group to which the product was compared, plus -some randomness. Therefore, every benchmark can have different \code{co2e_lower} -and \code{co2e_upper}, because every benchmark can contain a different set of -products. } \description{ These functions wrap the output of the corresponding function in @@ -53,14 +47,12 @@ These functions wrap the output of the corresponding function in } \examples{ library(tiltToyData) -library(withr) library(readr, warn.conflicts = FALSE) -local_seed(1) -local_options(readr.show_col_types = FALSE) +options(readr.show_col_types = FALSE) companies <- read_csv(toy_emissions_profile_any_companies()) -products <- read_csv(toy_emissions_profile_products_ecoinvent()) +products <- read_csv(toy_emissions_profile_products()) europages_companies <- read_csv(toy_europages_companies()) ecoinvent_activities <- read_csv(toy_ecoinvent_activities()) ecoinvent_europages <- read_csv(toy_ecoinvent_europages()) @@ -81,7 +73,7 @@ result |> unnest_company() -inputs <- read_csv(toy_emissions_profile_upstream_products_ecoinvent()) +inputs <- read_csv(toy_emissions_profile_upstream_products()) ecoinvent_inputs <- read_csv(toy_ecoinvent_inputs()) result <- profile_emissions_upstream( From a80c213553a452e729662be882d2cda7b108feff Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 23:17:23 +0000 Subject: [PATCH 19/25] Revert This reverts commit 26de58c522deb93e27ef4b43dbcc7aa1836045df. --- R/map_chunks.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/map_chunks.R b/R/map_chunks.R index d26f721..a8ab864 100644 --- a/R/map_chunks.R +++ b/R/map_chunks.R @@ -3,7 +3,8 @@ map_chunks <- function(data, .by, chunks, cache_dir, - order = "identity") { + order = "identity", + options = NULL) { parent <- rm_namespace(deparse(substitute(.f))) job <- data |> nest_chunk(.by = .by, chunks = chunks) |> @@ -14,7 +15,12 @@ map_chunks <- function(data, dchunkr::order_rows(.fun = order) |> select("data", "file") |> future_pwalk( - \(data, file) .f(data, ...) |> write_rds(file), + function(data, file) { + # Pass options https://github.com/HenrikBengtsson/future/issues/134 + withr::local_options(options) + .f(data, ...) |> + write_rds(file) + }, .progress = TRUE, .options = furrr::furrr_options(seed = TRUE) ) From 21cbe15f84dd0667ea7dde0aa7a1f304712eaa19 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 23:18:49 +0000 Subject: [PATCH 20/25] Revert --- R/profile.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/profile.R b/R/profile.R index ef9da2f..b5ff61c 100644 --- a/R/profile.R +++ b/R/profile.R @@ -1,4 +1,4 @@ -customized_with <- function(f, options) { +customized <- function(f, options) { force(f) force(options) @@ -51,8 +51,8 @@ profile_emissions <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - .f = tiltIndicatorAfter::profile_emissions |> - customized_with(tiltIndicatorAfter_options()), + options = tiltIndicatorAfter_options(), + .f = tiltIndicatorAfter::profile_emissions, co2 = co2, europages_companies = europages_companies, ecoinvent_activities = ecoinvent_activities, @@ -109,8 +109,8 @@ profile_emissions_upstream <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - .f = tiltIndicatorAfter::profile_emissions_upstream |> - customized_with(tiltIndicatorAfter_options()), + options = tiltIndicatorAfter_options(), + .f = tiltIndicatorAfter::profile_emissions_upstream, co2 = co2, europages_companies = europages_companies, ecoinvent_activities = ecoinvent_activities, @@ -166,8 +166,8 @@ profile_sector <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - .f = tiltIndicatorAfter::profile_sector |> - customized_with(tiltIndicatorAfter_options()), + options = tiltIndicatorAfter_options(), + .f = tiltIndicatorAfter::profile_sector, scenarios = scenarios, europages_companies = europages_companies, ecoinvent_activities = ecoinvent_activities, @@ -226,8 +226,8 @@ profile_sector_upstream <- function(companies, chunks = handle_chunks(companies), cache_dir = cache_dir, order = order, - .f = tiltIndicatorAfter::profile_sector_upstream |> - customized_with(tiltIndicatorAfter_options()), + options = tiltIndicatorAfter_options(), + .f = tiltIndicatorAfter::profile_sector_upstream, scenarios = scenarios, inputs = inputs, europages_companies = europages_companies, From f1b7f901e99b830d4f4fbc5940c6f6865f56cd52 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 23:55:29 +0000 Subject: [PATCH 21/25] Polish internal example --- R/utils-devel.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/utils-devel.R b/R/utils-devel.R index 83d7333..e2b716f 100644 --- a/R/utils-devel.R +++ b/R/utils-devel.R @@ -102,7 +102,8 @@ use_workflow_index <- function(index = 1) { use_workflow(wf[[index]]) } -# # DANGER +# devtools::load_all() +# # # DANGER # # cache_delete() # # system("rm output -rf") # From 5b1a7cd421ff8cca1df42565e9efba91d6ccada9 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Sun, 10 Mar 2024 23:55:41 +0000 Subject: [PATCH 22/25] Simpler option --- R/utils.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/utils.R b/R/utils.R index 29a0b77..d5e55ad 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,9 +1,5 @@ extract_options <- function(pattern) { - out <- options()[grep(pattern, names(options()), value = TRUE)] - if (rlang::is_empty(out)) { - return(options()) - } - out + options()[grep(pattern, names(options()), value = TRUE)] } tiltIndicatorAfter_options <- function() { From e2e48d080cc2b9a17579916ef2b5f7949d4e2426 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Mon, 11 Mar 2024 00:14:26 +0000 Subject: [PATCH 23/25] Remove customized_with() --- R/profile.R | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/R/profile.R b/R/profile.R index b5ff61c..8c9cc5d 100644 --- a/R/profile.R +++ b/R/profile.R @@ -1,13 +1,3 @@ -customized <- function(f, options) { - force(f) - force(options) - - function(...) { - withr::local_options(options) - f(...) - } -} - #' @export #' @keywords internal #' @inherit tiltIndicatorAfter::profile_emissions From cf2c6494b106e0cd02ac15cd6ddfdd7f172d68eb Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Mon, 11 Mar 2024 00:16:46 +0000 Subject: [PATCH 24/25] Remove run_workflow() --- R/utils-devel.R | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/R/utils-devel.R b/R/utils-devel.R index e2b716f..8d36820 100644 --- a/R/utils-devel.R +++ b/R/utils-devel.R @@ -101,23 +101,3 @@ use_workflow_index <- function(index = 1) { wf <- workflows() use_workflow(wf[[index]]) } - -# devtools::load_all() -# # # DANGER -# # cache_delete() -# # system("rm output -rf") -# -# withr::local_options(list(tiltIndicatorAfter.output_co2_footprint = TRUE)) -# run_workflow("profile_emissions.Rmd") -# -# readr::read_csv("output/emissions_profile_at_product_level.csv") |> -# hasName("co2_footprint") |> -# stopifnot() -# readr::read_csv("output/emissions_profile_at_company_level.csv") |> -# hasName("co2_avg") |> -# stopifnot() -run_workflow <- function(template) { - use_workflow(template, open = FALSE) - knitr::purl(template, documentation = 2L) - source(fs::path_ext_set(template, ".R")) -} From 92ad4abeb1761481a0667b03cdaec631d08fd798 Mon Sep 17 00:00:00 2001 From: Mauro Lepore Date: Mon, 11 Mar 2024 00:17:28 +0000 Subject: [PATCH 25/25] style --- R/utils.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index d5e55ad..3ba7763 100644 --- a/R/utils.R +++ b/R/utils.R @@ -5,5 +5,3 @@ extract_options <- function(pattern) { tiltIndicatorAfter_options <- function() { extract_options("tiltIndicatorAfter") } - -