From c6e4d3bec8ffbb7d838343cb696777b51559a6c1 Mon Sep 17 00:00:00 2001 From: Michaja Pehl Date: Wed, 12 Jul 2023 10:37:47 +0200 Subject: [PATCH 1/3] include steel production plot; plot to png --- NAMESPACE | 2 ++ R/EDGE-Industry.R | 82 +++++++++++++++++++++++++++++++++++------------ 2 files changed, 64 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7e66d31c..f2c9a3b6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -133,6 +133,7 @@ importFrom(dplyr,tribble) importFrom(dplyr,ungroup) importFrom(dplyr,vars) importFrom(ggplot2,aes) +importFrom(ggplot2,coord_cartesian) importFrom(ggplot2,expand_limits) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_area) @@ -145,6 +146,7 @@ importFrom(ggplot2,guide_legend) importFrom(ggplot2,labs) importFrom(ggplot2,scale_colour_manual) importFrom(ggplot2,scale_fill_discrete) +importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_manual) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,theme) diff --git a/R/EDGE-Industry.R b/R/EDGE-Industry.R index 49cff3fe..ef3d76fa 100644 --- a/R/EDGE-Industry.R +++ b/R/EDGE-Industry.R @@ -35,20 +35,21 @@ #' @importFrom assertr assert verify within_bounds #' @importFrom broom tidy #' @importFrom car logit -#' @importFrom dplyr %>% case_when between distinct first last n right_join -#' semi_join vars +#' @importFrom dplyr %>% case_when bind_rows between distinct first last n +#' mutate pull right_join select semi_join vars #' @importFrom Hmisc wtd.quantile -#' @importFrom ggplot2 aes expand_limits facet_wrap geom_area geom_line -#' geom_path geom_point ggplot ggsave guide_legend labs scale_colour_manual -#' scale_fill_discrete scale_linetype_manual scale_shape_manual theme -#' theme_minimal +#' @importFrom ggplot2 aes coord_cartesian expand_limits facet_wrap geom_area +#' geom_line geom_path geom_point ggplot ggsave guide_legend labs +#' scale_colour_manual scale_fill_discrete scale_fill_manual +#' scale_linetype_manual scale_shape_manual theme theme_minimal #' @importFrom madrat calcOutput readSource toolGetMapping -#' @importFrom quitte calc_mode df_populate_range duplicate duplicate_ -#' list_to_data_frame madrat_mule magclass_to_tibble order.levels seq_range -#' sum_total_ +#' @importFrom quitte calc_mode character.data.frame df_populate_range duplicate +#' duplicate_ list_to_data_frame madrat_mule magclass_to_tibble order.levels +#' seq_range sum_total_ #' @importFrom readr write_rds #' @importFrom stats nls SSlogis sd -#' @importFrom tidyr pivot_longer pivot_wider +#' @importFrom tibble as_tibble tibble tribble +#' @importFrom tidyr expand_grid pivot_longer pivot_wider #' @importFrom zoo na.approx rollmean #' @rdname EDGE-Industry @@ -1242,6 +1243,47 @@ calcSteel_Projections <- function(subtype = 'production', ) } + if (!is.null(save.plots)) { + + p <- ggplot() + + geom_area( + data = x %>% + as_tibble() %>% + filter('gdp_SSP2EU' == .data$scenario) %>% + left_join(region_mapping, 'iso3c') %>% + full_join( + tibble( + pf = c('ue_steel_primary', 'ue_steel_secondary'), + production = factor(c('Primary Production', + 'Secondary Production'), + rev(c('Primary Production', + 'Secondary Production')))), + + 'pf' + ) %>% + group_by(.data$region, .data$year, .data$production) %>% + summarise(value = sum(.data$value) * 1e3, .groups = 'drop') %>% + sum_total_('region', name = 'World'), + mapping = aes(x = 'year', y = 'value', fill = 'production')) + + facet_wrap(~ region, scales = 'free_y') + + labs(x = NULL, y = 'Mt Steel/year') + + scale_fill_manual(values = c('Primary Production' = 'orange', + 'Secondary Production' = 'yellow'), + name = NULL) + + coord_cartesian(xlim = c(NA, 2100), expand = FALSE) + + theme_minimal() + + theme(legend.position = c(1, 0), + legend.justification = c(1, 0)) + + ggsave(plot = p, filename = '6_Steel_production.png', + device = 'png', path = save.plots, bg = 'white', + width = 18, height = 14, units = 'cm', scale = 1.73) + + write_rds(x = p, + file = file.path(save.plots, + '6_Steel_production.rds')) + } + # return statement ---- return(list(x = x, weight = NULL, @@ -1753,8 +1795,8 @@ calcIndustry_Value_Added <- function(subtype = 'physical', theme(legend.justification = c(1, 0), legend.position = c(1, 0)) - ggsave(plot = p, filename = '04_Steel_VA_regressions_projections.svg', - device = 'svg', path = save.plots, bg = 'white', + ggsave(plot = p, filename = '04_Steel_VA_regressions_projections.png', + device = 'png', path = save.plots, bg = 'white', width = 18, height = 14, units = 'cm', scale = 1.73) write_rds(x = p, @@ -2156,8 +2198,8 @@ calcIndustry_Value_Added <- function(subtype = 'physical', theme_minimal() - ggsave(plot = p, filename = '01_Cement_regression_projection.svg', - device = 'svg', path = save.plots, bg = 'white', + ggsave(plot = p, filename = '01_Cement_regression_projection.png', + device = 'png', path = save.plots, bg = 'white', width = 18, height = 14, units = 'cm', scale = 1.73) write_rds(x = p, @@ -2234,8 +2276,8 @@ calcIndustry_Value_Added <- function(subtype = 'physical', legend.position = c(1, 0)) - ggsave(plot = p, filename = '05a_Cement_VA_regressions_projections.svg', - device = 'svg', path = save.plots, bg = 'white', + ggsave(plot = p, filename = '05a_Cement_VA_regressions_projections.png', + device = 'png', path = save.plots, bg = 'white', width = 18, height = 14, units = 'cm', scale = 1.73) write_rds(x = p, @@ -2467,8 +2509,8 @@ calcIndustry_Value_Added <- function(subtype = 'physical', y = 'per-capita Chemicals Value Added [$/year]') + theme_minimal() - ggsave(plot = p, filename = '02_Chemicals_regression_projection.svg', - device = 'svg', path = save.plots, bg = 'white', + ggsave(plot = p, filename = '02_Chemicals_regression_projection.png', + device = 'png', path = save.plots, bg = 'white', width = 18, height = 14, units = 'cm', scale = 1.73) write_rds(x = p, @@ -2610,8 +2652,8 @@ calcIndustry_Value_Added <- function(subtype = 'physical', theme_minimal() + theme(legend.justification = c(1, 0), legend.position = c(1, 0)) - ggsave(plot = p, filename = '05b_Value_Added_projection.svg', - device = 'svg', path = save.plots, bg = 'white', + ggsave(plot = p, filename = '05b_Value_Added_projection.png', + device = 'png', path = save.plots, bg = 'white', width = 18, height = 14, units = 'cm', scale = 1.73) write_rds(x = p, From 7b2a82a36c073c31700c3fb594a24bc26b26c930 Mon Sep 17 00:00:00 2001 From: Michaja Pehl Date: Thu, 13 Jul 2023 12:41:17 +0200 Subject: [PATCH 2/3] add industry VA regression figure --- R/EDGE-Industry.R | 100 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 95 insertions(+), 5 deletions(-) diff --git a/R/EDGE-Industry.R b/R/EDGE-Industry.R index ef3d76fa..ec783fa9 100644 --- a/R/EDGE-Industry.R +++ b/R/EDGE-Industry.R @@ -32,7 +32,7 @@ #' #' @seealso [`calcOutput()`] #' -#' @importFrom assertr assert verify within_bounds +#' @importFrom assertr assert not_na verify within_bounds #' @importFrom broom tidy #' @importFrom car logit #' @importFrom dplyr %>% case_when bind_rows between distinct first last n @@ -1262,9 +1262,10 @@ calcSteel_Projections <- function(subtype = 'production', 'pf' ) %>% group_by(.data$region, .data$year, .data$production) %>% - summarise(value = sum(.data$value) * 1e3, .groups = 'drop') %>% + summarise(value = sum(.data$value), .groups = 'drop') %>% sum_total_('region', name = 'World'), - mapping = aes(x = 'year', y = 'value', fill = 'production')) + + mapping = aes(x = !!sym('year'), y = !!sym('value') * 1e-3, + fill = !!sym('production'))) + facet_wrap(~ region, scales = 'free_y') + labs(x = NULL, y = 'Mt Steel/year') + scale_fill_manual(values = c('Primary Production' = 'orange', @@ -1459,8 +1460,9 @@ calcIndustry_Value_Added <- function(subtype = 'physical', filter(!.data$censor) %>% duplicate(region = 'World') %>% pivot_longer(c('population', 'GDP', 'manufacturing')) %>% - group_by(.data$region, .data$year, .data$name) %>% + group_by(.data$region, .data$iso3c, .data$year, .data$name) %>% summarise(value = sum(.data$value), .groups = 'drop') %>% + sum_total_('iso3c') %>% pivot_wider() %>% mutate( # mfg.share = .data$manufacturing / .data$GDP, FIXME @@ -1473,7 +1475,8 @@ calcIndustry_Value_Added <- function(subtype = 'physical', nls(formula = manufacturing / population ~ a * exp(b / GDPpC), data = regression_data %>% - filter(.data$region == r), + filter(.data$region == r, + 'Total' != .data$iso3c), start = list(a = 1000, b = -2000), trace = FALSE) %>% tidy() %>% @@ -2520,6 +2523,93 @@ calcIndustry_Value_Added <- function(subtype = 'physical', # ======================================================================== === + if (!is.null(save.plots)) { + d_plot_region_totals <- regression_data %>% + filter('Total' == .data$iso3c) + + d_plot_countries <- regression_data %>% + semi_join( + regression_data %>% + filter('World' != .data$region, + 'Total' != .data$iso3c) %>% + distinct(.data$region, .data$iso3c) %>% + group_by(.data$region) %>% + filter(1 != n()) %>% + ungroup(), + + c('region', 'iso3c') + ) %>% + mutate(GDPpC = .data$GDP / .data$population) + + d_plot_regression <- full_join( + regression_parameters, + + regression_data %>% + select('region', 'GDPpC') %>% + df_populate_range('GDPpC'), + + 'region' + ) %>% + mutate(value = .data$a * exp(.data$b / .data$GDPpC)) + + d_plot_projections <- projected_data %>% + pivot_longer(c('population', 'GDP', 'manufacturing')) %>% + sum_total_('iso3c') %>% + pivot_wider() %>% + filter(.data$scenario %in% names(linetype_scenarios), + 'Total' == .data$iso3c, + between(.data$year, max(d_plot_region_totals$year), 2100)) %>% + mutate(GDPpC = .data$GDP / .data$population) %>% + select('scenario', 'region', 'year', 'GDPpC', 'manufacturing', + 'population') %>% + group_by(.data$region) %>% + filter(.data$GDPpC <= .data$GDPpC[ 'SSP2' == .data$scenario + & 2100 == .data$year]) %>% + ungroup() + + p <- ggplot( + mapping = aes(x = !!sym('GDPpC') / 1000, + y = !!sym('manufacturing') / !!sym('population') / 1000)) + + # plot region totals + geom_point( + data = d_plot_region_totals, + mapping = aes(shape = 'region totals')) + + # # plot regression line + geom_path( + data = d_plot_regression, + mapping = aes(y = !!sym('value') / 1000, colour = 'regression')) + + # # plot projections + geom_path( + data = d_plot_projections, + mapping = aes(colour = 'projection')) + + geom_point( + data = d_plot_projections %>% + filter(.data$year %in% projection_points), + mapping = aes(shape = as.character(!!sym('year'))), + size = 3) + + scale_shape_manual( + values = c('region totals' = 'o', + setNames(rep('x', length(projection_points)), + projection_points)), + name = NULL) + + scale_colour_manual(values = c('regression' = 'red', + 'projection' = 'black'), + name = NULL) + + facet_wrap(vars(!!sym('region')), scales = 'free') + + expand_limits(y = c(0, ceiling(y_max * 2) / 2)) + + labs(x = 'per-capita GDP [1000 $/year]', + y = 'per-capita Industry Value Added [1000 $/year]') + + theme_minimal() + + ggsave(plot = p, filename = '03_Industry_regression_projection.png', + device = 'png', path = save.plots, bg = 'white', + width = 18, height = 14, units = 'cm', scale = 1.73) + + write_rds(x = p, + file = file.path(save.plots, + '03_Industry_regression_projection.rds')) + } + # calculate other Industries Value Added projections ---- projections <- bind_rows( projected_data %>% From 29c069ae23151051ccb45f358169125509bea718 Mon Sep 17 00:00:00 2001 From: Michaja Pehl Date: Thu, 13 Jul 2023 13:17:51 +0200 Subject: [PATCH 3/3] lucode hubbub --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 89cf3d8d..b9f49718 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '32076470' +ValidationKey: '32259150' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index f5f7f9e8..f476dd1c 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'mrremind: MadRat REMIND Input Data Package' -version: 0.164.2 -date-released: '2023-06-27' +version: 0.165.0 +date-released: '2023-07-13' abstract: The mrremind packages contains data preprocessing for the REMIND model. authors: - family-names: Baumstark diff --git a/DESCRIPTION b/DESCRIPTION index 63e85c3d..364c4a94 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mrremind Title: MadRat REMIND Input Data Package -Version: 0.164.2 -Date: 2023-06-27 +Version: 0.165.0 +Date: 2023-07-13 Authors@R: c( person("Lavinia", "Baumstark", , "lavinia@pik-potsdam.de", role = c("aut", "cre")), person("Renato", "Rodrigues", role = "aut"), diff --git a/README.md b/README.md index d8319604..a0b82a16 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # MadRat REMIND Input Data Package -R package **mrremind**, version **0.164.2** +R package **mrremind**, version **0.165.0** [![CRAN status](https://www.r-pkg.org/badges/version/mrremind)](https://cran.r-project.org/package=mrremind) [![R build status](https://github.com/pik-piam/mrremind/workflows/check/badge.svg)](https://github.com/pik-piam/mrremind/actions) [![codecov](https://codecov.io/gh/pik-piam/mrremind/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrremind) [![r-universe](https://pik-piam.r-universe.dev/badges/mrremind)](https://pik-piam.r-universe.dev/builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Lavinia Baumstark . +Baumstark L, Rodrigues R, Levesque A, Oeser J, Bertram C, Mouratiadou I, Malik A, Schreyer F, Soergel B, Rottoli M, Mishra A, Dirnaichner A, Pehl M, Giannousakis A, Klein D, Strefler J, Feldhaus L, Brecha R, Rauner S, Dietrich J, Bi S, Benke F, Weigmann P, Richters O, Hasse R, Fuchs S, Mandaroux R (2023). _mrremind: MadRat REMIND Input Data Package_. R package version 0.165.0, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {mrremind: MadRat REMIND Input Data Package}, author = {Lavinia Baumstark and Renato Rodrigues and Antoine Levesque and Julian Oeser and Christoph Bertram and Ioanna Mouratiadou and Aman Malik and Felix Schreyer and Bjoern Soergel and Marianna Rottoli and Abhijeet Mishra and Alois Dirnaichner and Michaja Pehl and Anastasis Giannousakis and David Klein and Jessica Strefler and Lukas Feldhaus and Regina Brecha and Sebastian Rauner and Jan Philipp Dietrich and Stephen Bi and Falk Benke and Pascal Weigmann and Oliver Richters and Robin Hasse and Sophie Fuchs and Rahel Mandaroux}, year = {2023}, - note = {R package version 0.164.2}, + note = {R package version 0.165.0}, url = {https://github.com/pik-piam/mrremind}, } ```