From 372d4e6ab85865b2663f006d6ea0b554c86e88aa Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 29 Jul 2024 15:40:18 +0200 Subject: [PATCH 1/7] use piamPlotComparison for comparing scenarios --- .buildlibrary | 2 +- CITATION.cff | 4 +- DESCRIPTION | 13 +- NAMESPACE | 7 - R/transportCompareScenarios.R | 164 +----- README.md | 6 +- ...gy_demand.Rmd => cs2_01_energy_demand.Rmd} | 0 ...and_UE.Rmd => cs2_02_energy_demand_UE.Rmd} | 0 ...ervices.Rmd => cs2_03_energy_services.Rmd} | 0 ...ensity.Rmd => cs2_04_energy_intensity.Rmd} | 0 ...d_sales.Rmd => cs2_05_stock_and_sales.Rmd} | 0 ..._05_Emissions.Rmd => cs2_06_emissions.Rmd} | 0 ...d => cs2_07_endogenous_cost_analytics.Rmd} | 0 ...Rmd => cs2_08_nav_scenario_evaluation.Rmd} | 0 inst/compareScenarios/cs2_latex_template.tex | 540 ------------------ inst/compareScenarios/cs2_plot_functions.R | 457 --------------- inst/compareScenarios/csEDGET_main.Rmd | 328 ----------- .../cs_pdf_header_include.tex | 12 - inst/compareScenarios/preprocessing.Rmd | 178 ++++++ man/transportCompareScenarios.Rd | 77 +-- 20 files changed, 210 insertions(+), 1578 deletions(-) rename inst/compareScenarios/{csEDGET_01_energy_demand.Rmd => cs2_01_energy_demand.Rmd} (100%) rename inst/compareScenarios/{csEDGET_01_energy_demand_UE.Rmd => cs2_02_energy_demand_UE.Rmd} (100%) rename inst/compareScenarios/{csEDGET_02_energy_services.Rmd => cs2_03_energy_services.Rmd} (100%) rename inst/compareScenarios/{csEDGET_03_energy_intensity.Rmd => cs2_04_energy_intensity.Rmd} (100%) rename inst/compareScenarios/{csEDGET_04_stock_and_sales.Rmd => cs2_05_stock_and_sales.Rmd} (100%) rename inst/compareScenarios/{csEDGET_05_Emissions.Rmd => cs2_06_emissions.Rmd} (100%) rename inst/compareScenarios/{csEDGET_EndogenousCostAnalytics.Rmd => cs2_07_endogenous_cost_analytics.Rmd} (100%) rename inst/compareScenarios/{csEDGET_NAV_scenario_evaluation.Rmd => cs2_08_nav_scenario_evaluation.Rmd} (100%) delete mode 100644 inst/compareScenarios/cs2_latex_template.tex delete mode 100644 inst/compareScenarios/cs2_plot_functions.R delete mode 100644 inst/compareScenarios/csEDGET_main.Rmd delete mode 100644 inst/compareScenarios/cs_pdf_header_include.tex create mode 100644 inst/compareScenarios/preprocessing.Rmd diff --git a/.buildlibrary b/.buildlibrary index ccfe57f..a54b5ad 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '219142' +ValidationKey: '239196' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 5c300de..3fc2b04 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: 'reporttransport: Reporting package for edgeTransport' -version: 0.0.11 -date-released: '2024-07-18' +version: 0.0.12 +date-released: '2024-07-29' abstract: This package contains edgeTransport-specific routines to report model results. The main functionality is to generate transport reporting variables in MIF format from a given edgeTransport model run folder or REMIND input data. diff --git a/DESCRIPTION b/DESCRIPTION index 264364d..294dc65 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: reporttransport Title: Reporting package for edgeTransport -Version: 0.0.11 -Date: 2024-07-18 +Version: 0.0.12 +Date: 2024-07-29 Authors@R: person("Johanna", "Hoppe", , "johanna.hoppe@pik-potsdam.de", role = c("aut", "cre")) Description: This package contains edgeTransport-specific routines to @@ -17,17 +17,14 @@ Imports: data.table, gdx, gdxrrw, + piamPlotComparison, quitte, remind2, - rlang, - rmarkdown, rmndt, - utils, - yaml, - ymlthis + utils Suggests: knitr, sf, testthat Encoding: UTF-8 -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index f607c32..934bad8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -33,15 +33,8 @@ importFrom(quitte,aggregate_map) importFrom(quitte,as.quitte) importFrom(quitte,write.mif) importFrom(remind2,toolRegionSubsets) -importFrom(rlang,parse_expr) -importFrom(rmarkdown,render) importFrom(rmndt,approx_dt) importFrom(rmndt,disaggregate_dt) importFrom(rmndt,magpie2dt) importFrom(utils,packageVersion) importFrom(utils,write.csv) -importFrom(yaml,yaml.load) -importFrom(ymlthis,as_yml) -importFrom(ymlthis,use_rmarkdown) -importFrom(ymlthis,yml_params_code) -importFrom(ymlthis,yml_replace) diff --git a/R/transportCompareScenarios.R b/R/transportCompareScenarios.R index 54636d4..59bd2b4 100644 --- a/R/transportCompareScenarios.R +++ b/R/transportCompareScenarios.R @@ -1,9 +1,6 @@ -#' Render CompareScenarios EDGE Transport +#' Render CompareScenarios for EDGE Transport #' -#' Renders the *.Rmd-files associated to CompareScenarios EDGE TRansport. In the Rmds, -#' scenario- and historical .mif-files are loaded. Then plots are created from -#' this data. The result may be rendered to PDF or HTML. Alternatively one can -#' choose Rmd as output format and obtain a copy of the *.Rmd-files. +#' A wrapper for piamPlotComparison::compareScenarios #' #' @param mifScen \code{character(n)}, optionally named. Paths to scenario mifs. #' If the vector has names, those are used to refer to the scenarios in the @@ -15,149 +12,24 @@ #' and intermediary files are created. #' @param outputFormat \code{character(1)}, not case-sensitive. \code{"html"}, #' \code{"pdf"}, or \code{"rmd"}. -#' @param ... YAML parameters, see below. -#' @importFrom yaml yaml.load -#' @importFrom rlang parse_expr -#' @importFrom ymlthis yml_params_code yml_replace as_yml use_rmarkdown -#' @importFrom rmarkdown render #' @return The value returned by \code{\link[rmarkdown:render]{render()}}. -#' @section YAML Parameters: -#' \describe{ -#' \item{\code{yearsScen}}{ -#' \code{numeric(n)}. -#' Default: \code{c(seq(2005, 2060, 5), seq(2070, 2100, 10))}. -#' Years to show for scenario data.} -#' \item{\code{yearsHist}}{ -#' \code{numeric(n)}. -#' Default: \code{c(seq(1990, 2020, 1), seq(2025, 2100, 5))}. -#' Years to show for historical data.} -#' \item{\code{yearsBarPlot}}{ -#' \code{numeric(n)}. -#' Default: \code{c(2010, 2030, 2050, 2100)}. -#' Years to show in bar plots of scenario data.} -#' \item{\code{reg}}{ -#' \code{NULL} or \code{character(n)}. -#' Default: \code{NULL}. -#' Regions to show. \code{NULL} means all.} -#' \item{\code{modelsHistExclude}}{ -#' \code{character(n) or NULL}. -#' Default: \code{c()}. -#' Models in historical data to exclude.} -#' \item{\code{sections}}{ -#' \code{character(n)}. -#' Default: \code{"all"}. -#' Names of sections to include. A subset of -#' \code{c("01_energy_demand", "02_energy_services", "03_stock_and_sales", "04_costs_and_shareweight_trends")} -#' or \code{"all"} for all available sections.} -#' \item{\code{userSectionPath}}{ -#' \code{NULL} or \code{character(n)}. -#' Default: \code{NULL}. -#' Path to a *.Rmd-file that may be included as additional section.} -#' \item{\code{mainReg}}{ -#' \code{character(1)}. -#' Default: \code{"World"}. -#' A region for which larger plots are shown.} -#' \item{\code{figWidth, figHeight}}{ -#' \code{numeric(1)}. -#' Default: \code{15} and \code{10}, respectively. -#' Size of plots in inches.} -#' \item{\code{warning}}{ -#' \code{logical(1)}. -#' Default: \code{TRUE}. -#' Show warnings in output?} -#' } -#' @author Christof Schoetz, Johanna Hoppe -#' @examples -#' \dontrun{ -#' compareScenarios2( -#' mifScen = c("path/to/Base.mif", "path/to/NDC.mif"), -#' mifHist = "path/to/historical.mif", -#' outputFile = "CompareScenarios2Example1", -#' userSectionPath = "path/to/myPlots.Rmd") -#' compareScenarios2( -#' mifScen = c(ScenarioName1 = "path/to/scen1.mif", ScenarioName2 = "path/to/scen2.mif"), -#' mifHist = "path/to/historical.mif", -#' outputFile = "CompareScenarios2Example2", -#' figWidth = 18, figHeight = 10) -#' } #' @export transportCompareScenarios <- function( - mifScen, mifHist, - outputDir = getwd(), - outputFile = "CompareScenarios", - outputFormat = "PDF", - ... -) { - yamlParams <- c( - list( - mifScen = normalizePath(mifScen, mustWork = TRUE), - mifScenNames = names(mifScen), - mifHist = normalizePath(mifHist, mustWork = TRUE)), - list(...)) + mifScen, mifHist, + outputDir = getwd(), + outputFile = "CompareScenarios", + outputFormat = "PDF") { - # convert relative to absolute paths - if ("userSectionPath" %in% names(yamlParams)) { - yamlParams$userSectionPath <- normalizePath(yamlParams$userSectionPath, - mustWork = TRUE) - } - - outputFormat <- tolower(outputFormat) - if (outputFormat == "pdf") outputFormat <- "pdf_document" - if (outputFormat == "html") outputFormat <- "html_document" - if (identical(tolower(outputFormat), "rmd")) { - return(.compareScenarios2Rmd(yamlParams, outputDir, outputFile)) - } - # copy the template directory from the package to the outputDir because rmarkdown writes to the folder - # containing the template. - templateInOutputDir <- file.path(outputDir, "CompareScenarios", "csEDGET_main.Rmd") - file.copy(system.file("compareScenarios", package = "reporttransport"), - outputDir, recursive = TRUE) - render( - templateInOutputDir, - intermediates_dir = outputDir, - output_dir = outputDir, - output_file = outputFile, - output_format = outputFormat, - params = yamlParams, - envir = new.env()) - unlink(file.path(outputDir, "CompareScenarios"), recursive = TRUE) -} - -# Copies the CompareScenarios2-Rmds to the specified location and modifies -# their YAML header according to \code{yamlParams}. -.compareScenarios2Rmd <- function(yamlParams, outputDir, outputFile) { - pathMain <- system.file("CompareScenarios/csEDGET_main.Rmd", package = "reporttransport") - linesMain <- readLines(pathMain) - delimiters <- grep("^(---|\\.\\.\\.)\\s*$", linesMain) - headerMain <- linesMain[(delimiters[1]):(delimiters[2])] - yml <- yaml.load( - headerMain, - handlers = list(r = function(x) yml_params_code(!!parse_expr(x)))) - baseYaml <- as_yml(yml) - newYamlParams <- baseYaml$params - newYamlParams[names(yamlParams)] <- yamlParams - if (!is.null(names(yamlParams$mifScen))) { - newYamlParams$mifScenNames <- names(yamlParams$mifScen) - } - newYaml <- yml_replace( - baseYaml, - params = newYamlParams, - date = format(Sys.Date())) - pathDir <- file.path(outputDir, paste0(outputFile, "_Rmd")) - if (!dir.exists(pathDir)) dir.create(pathDir) - dirFiles <- dir( - system.file("CompareScenarios", package = "reporttransport"), - full.names = TRUE) - rmdDirFiles <- grep( - dirFiles, - pattern = "csEDGET_main\\.Rmd$", - invert = TRUE, value = TRUE) - file.copy(rmdDirFiles, pathDir) - use_rmarkdown( - newYaml, - path = file.path(pathDir, "cs2_main.Rmd"), - template = system.file( - "CompareScenarios/csEDGET_main.Rmd", - package = "reporttransport"), - include_yaml = FALSE) + piamPlotComparison::compareScenarios( + projectLibrary = "edgeTransport", + mifScen = mifScen, + mifHist = mifHist, + outputFormat = outputFormat, + outputFile = outputFile, + sections = "all", + docTitle = "Edge Transport Compare Scenarios", + outputDir = outputDir, + reg = c("OAS", "MEA", "SSA", "LAM", "REF", "CAZ", "CHA", "IND", "JPN", "USA", "NEU", "EUR", "World"), + yearsHist = c(seq(2010, 2020, 1), seq(2025, 2100, 5)) + ) } diff --git a/README.md b/README.md index aba1075..9270ca8 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Reporting package for edgeTransport -R package **reporttransport**, version **0.0.11** +R package **reporttransport**, version **0.0.12** [![CRAN status](https://www.r-pkg.org/badges/version/reporttransport)](https://cran.r-project.org/package=reporttransport) [![R build status](https://github.com/pik-piam/reporttransport/workflows/check/badge.svg)](https://github.com/pik-piam/reporttransport/actions) [![codecov](https://codecov.io/gh/pik-piam/reporttransport/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/reporttransport) [![r-universe](https://pik-piam.r-universe.dev/badges/reporttransport)](https://pik-piam.r-universe.dev/builds) @@ -41,7 +41,7 @@ In case of questions / problems please contact Johanna Hoppe . +Hoppe J (2024). _reporttransport: Reporting package for edgeTransport_. R package version 0.0.12, . A BibTeX entry for LaTeX users is @@ -50,7 +50,7 @@ A BibTeX entry for LaTeX users is title = {reporttransport: Reporting package for edgeTransport}, author = {Johanna Hoppe}, year = {2024}, - note = {R package version 0.0.11}, + note = {R package version 0.0.12}, url = {https://github.com/pik-piam/reporttransport}, } ``` diff --git a/inst/compareScenarios/csEDGET_01_energy_demand.Rmd b/inst/compareScenarios/cs2_01_energy_demand.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_01_energy_demand.Rmd rename to inst/compareScenarios/cs2_01_energy_demand.Rmd diff --git a/inst/compareScenarios/csEDGET_01_energy_demand_UE.Rmd b/inst/compareScenarios/cs2_02_energy_demand_UE.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_01_energy_demand_UE.Rmd rename to inst/compareScenarios/cs2_02_energy_demand_UE.Rmd diff --git a/inst/compareScenarios/csEDGET_02_energy_services.Rmd b/inst/compareScenarios/cs2_03_energy_services.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_02_energy_services.Rmd rename to inst/compareScenarios/cs2_03_energy_services.Rmd diff --git a/inst/compareScenarios/csEDGET_03_energy_intensity.Rmd b/inst/compareScenarios/cs2_04_energy_intensity.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_03_energy_intensity.Rmd rename to inst/compareScenarios/cs2_04_energy_intensity.Rmd diff --git a/inst/compareScenarios/csEDGET_04_stock_and_sales.Rmd b/inst/compareScenarios/cs2_05_stock_and_sales.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_04_stock_and_sales.Rmd rename to inst/compareScenarios/cs2_05_stock_and_sales.Rmd diff --git a/inst/compareScenarios/csEDGET_05_Emissions.Rmd b/inst/compareScenarios/cs2_06_emissions.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_05_Emissions.Rmd rename to inst/compareScenarios/cs2_06_emissions.Rmd diff --git a/inst/compareScenarios/csEDGET_EndogenousCostAnalytics.Rmd b/inst/compareScenarios/cs2_07_endogenous_cost_analytics.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_EndogenousCostAnalytics.Rmd rename to inst/compareScenarios/cs2_07_endogenous_cost_analytics.Rmd diff --git a/inst/compareScenarios/csEDGET_NAV_scenario_evaluation.Rmd b/inst/compareScenarios/cs2_08_nav_scenario_evaluation.Rmd similarity index 100% rename from inst/compareScenarios/csEDGET_NAV_scenario_evaluation.Rmd rename to inst/compareScenarios/cs2_08_nav_scenario_evaluation.Rmd diff --git a/inst/compareScenarios/cs2_latex_template.tex b/inst/compareScenarios/cs2_latex_template.tex deleted file mode 100644 index da4c684..0000000 --- a/inst/compareScenarios/cs2_latex_template.tex +++ /dev/null @@ -1,540 +0,0 @@ -%% NOTE: This a slightly modified verseion of the default Pandoc LaTeX template https://github.com/jgm/pandoc/tree/master/data/templates/ -%% Modifications: -%% * package hyperref is loaded last -%% -% Options for packages loaded elsewhere -\PassOptionsToPackage{unicode$for(hyperrefoptions)$,$hyperrefoptions$$endfor$}{hyperref} -\PassOptionsToPackage{hyphens}{url} -$if(colorlinks)$ -\PassOptionsToPackage{dvipsnames,svgnames,x11names}{xcolor} -$endif$ -$if(CJKmainfont)$ -\PassOptionsToPackage{space}{xeCJK} -$endif$ -% -\documentclass[ -$if(fontsize)$ - $fontsize$, -$endif$ -$if(papersize)$ - $papersize$paper, -$endif$ -$if(beamer)$ - ignorenonframetext, -$if(handout)$ - handout, -$endif$ -$if(aspectratio)$ - aspectratio=$aspectratio$, -$endif$ -$endif$ -$for(classoption)$ - $classoption$$sep$, -$endfor$ -]{$documentclass$} -$if(beamer)$ -$if(background-image)$ -\usebackgroundtemplate{% - \includegraphics[width=\paperwidth]{$background-image$}% -} -$endif$ -\usepackage{pgfpages} -\setbeamertemplate{caption}[numbered] -\setbeamertemplate{caption label separator}{: } -\setbeamercolor{caption name}{fg=normal text.fg} -\beamertemplatenavigationsymbols$if(navigation)$$navigation$$else$empty$endif$ -$for(beameroption)$ -\setbeameroption{$beameroption$} -$endfor$ -% Prevent slide breaks in the middle of a paragraph -\widowpenalties 1 10000 -\raggedbottom -$if(section-titles)$ -\setbeamertemplate{part page}{ - \centering - \begin{beamercolorbox}[sep=16pt,center]{part title} - \usebeamerfont{part title}\insertpart\par - \end{beamercolorbox} -} -\setbeamertemplate{section page}{ - \centering - \begin{beamercolorbox}[sep=12pt,center]{part title} - \usebeamerfont{section title}\insertsection\par - \end{beamercolorbox} -} -\setbeamertemplate{subsection page}{ - \centering - \begin{beamercolorbox}[sep=8pt,center]{part title} - \usebeamerfont{subsection title}\insertsubsection\par - \end{beamercolorbox} -} -\AtBeginPart{ - \frame{\partpage} -} -\AtBeginSection{ - \ifbibliography - \else - \frame{\sectionpage} - \fi -} -\AtBeginSubsection{ - \frame{\subsectionpage} -} -$endif$ -$endif$ -$if(beamerarticle)$ -\usepackage{beamerarticle} % needs to be loaded first -$endif$ -\usepackage{amsmath,amssymb} -$if(fontfamily)$ -\usepackage[$for(fontfamilyoptions)$$fontfamilyoptions$$sep$,$endfor$]{$fontfamily$} -$else$ -\usepackage{lmodern} -$endif$ -$if(linestretch)$ -\usepackage{setspace} -$endif$ -\usepackage{iftex} -\ifPDFTeX - \usepackage[$if(fontenc)$$fontenc$$else$T1$endif$]{fontenc} - \usepackage[utf8]{inputenc} - \usepackage{textcomp} % provide euro and other symbols -\else % if luatex or xetex -$if(mathspec)$ - \ifXeTeX - \usepackage{mathspec} - \else - \usepackage{unicode-math} - \fi -$else$ - \usepackage{unicode-math} -$endif$ - \defaultfontfeatures{Scale=MatchLowercase} - \defaultfontfeatures[\rmfamily]{Ligatures=TeX,Scale=1} -$if(mainfont)$ - \setmainfont[$for(mainfontoptions)$$mainfontoptions$$sep$,$endfor$]{$mainfont$} -$endif$ -$if(sansfont)$ - \setsansfont[$for(sansfontoptions)$$sansfontoptions$$sep$,$endfor$]{$sansfont$} -$endif$ -$if(monofont)$ - \setmonofont[$for(monofontoptions)$$monofontoptions$$sep$,$endfor$]{$monofont$} -$endif$ -$for(fontfamilies)$ - \newfontfamily{$fontfamilies.name$}[$for(fontfamilies.options)$$fontfamilies.options$$sep$,$endfor$]{$fontfamilies.font$} -$endfor$ -$if(mathfont)$ -$if(mathspec)$ - \ifXeTeX - \setmathfont(Digits,Latin,Greek)[$for(mathfontoptions)$$mathfontoptions$$sep$,$endfor$]{$mathfont$} - \else - \setmathfont[$for(mathfontoptions)$$mathfontoptions$$sep$,$endfor$]{$mathfont$} - \fi -$else$ - \setmathfont[$for(mathfontoptions)$$mathfontoptions$$sep$,$endfor$]{$mathfont$} -$endif$ -$endif$ -$if(CJKmainfont)$ - \ifXeTeX - \usepackage{xeCJK} - \setCJKmainfont[$for(CJKoptions)$$CJKoptions$$sep$,$endfor$]{$CJKmainfont$} - \fi -$endif$ -$if(luatexjapresetoptions)$ - \ifLuaTeX - \usepackage[$for(luatexjapresetoptions)$$luatexjapresetoptions$$sep$,$endfor$]{luatexja-preset} - \fi -$endif$ -$if(CJKmainfont)$ - \ifLuaTeX - \usepackage[$for(luatexjafontspecoptions)$$luatexjafontspecoptions$$sep$,$endfor$]{luatexja-fontspec} - \setmainjfont[$for(CJKoptions)$$CJKoptions$$sep$,$endfor$]{$CJKmainfont$} - \fi -$endif$ -\fi -$if(zero-width-non-joiner)$ -%% Support for zero-width non-joiner characters. -\makeatletter -\def\zerowidthnonjoiner{% - % Prevent ligatures and adjust kerning, but still support hyphenating. - \texorpdfstring{% - \textormath{\nobreak\discretionary{-}{}{\kern.03em}% - \ifvmode\else\nobreak\hskip\z@skip\fi}{}% - }{}% -} -\makeatother -\ifPDFTeX - \DeclareUnicodeCharacter{200C}{\zerowidthnonjoiner} -\else - \catcode`^^^^200c=\active - \protected\def ^^^^200c{\zerowidthnonjoiner} -\fi -%% End of ZWNJ support -$endif$ -$if(beamer)$ -$if(theme)$ -\usetheme[$for(themeoptions)$$themeoptions$$sep$,$endfor$]{$theme$} -$endif$ -$if(colortheme)$ -\usecolortheme{$colortheme$} -$endif$ -$if(fonttheme)$ -\usefonttheme{$fonttheme$} -$endif$ -$if(mainfont)$ -\usefonttheme{serif} % use mainfont rather than sansfont for slide text -$endif$ -$if(innertheme)$ -\useinnertheme{$innertheme$} -$endif$ -$if(outertheme)$ -\useoutertheme{$outertheme$} -$endif$ -$endif$ -% Use upquote if available, for straight quotes in verbatim environments -\IfFileExists{upquote.sty}{\usepackage{upquote}}{} -\IfFileExists{microtype.sty}{% use microtype if available - \usepackage[$for(microtypeoptions)$$microtypeoptions$$sep$,$endfor$]{microtype} - \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts -}{} -$if(indent)$ -$else$ -\makeatletter -\@ifundefined{KOMAClassName}{% if non-KOMA class - \IfFileExists{parskip.sty}{% - \usepackage{parskip} - }{% else - \setlength{\parindent}{0pt} - \setlength{\parskip}{6pt plus 2pt minus 1pt}} -}{% if KOMA class - \KOMAoptions{parskip=half}} -\makeatother -$endif$ -$if(verbatim-in-note)$ -\usepackage{fancyvrb} -$endif$ -\usepackage{xcolor} -\IfFileExists{xurl.sty}{\usepackage{xurl}}{} % add URL line breaks if available -\urlstyle{same} % disable monospaced font for URLs -$if(verbatim-in-note)$ -\VerbatimFootnotes % allow verbatim text in footnotes -$endif$ -$if(geometry)$ -$if(beamer)$ -\geometry{$for(geometry)$$geometry$$sep$,$endfor$} -$else$ -\usepackage[$for(geometry)$$geometry$$sep$,$endfor$]{geometry} -$endif$ -$endif$ -$if(beamer)$ -\newif\ifbibliography -$endif$ -$if(listings)$ -\usepackage{listings} -\newcommand{\passthrough}[1]{#1} -\lstset{defaultdialect=[5.3]Lua} -\lstset{defaultdialect=[x86masm]Assembler} -$endif$ -$if(lhs)$ -\lstnewenvironment{code}{\lstset{language=Haskell,basicstyle=\small\ttfamily}}{} -$endif$ -$if(highlighting-macros)$ -$highlighting-macros$ -$endif$ -$if(tables)$ -\usepackage{longtable,booktabs,array} -$if(multirow)$ -\usepackage{multirow} -$endif$ -\usepackage{calc} % for calculating minipage widths -$if(beamer)$ -\usepackage{caption} -% Make caption package work with longtable -\makeatletter -\def\fnum@table{\tablename~\thetable} -\makeatother -$else$ -% Correct order of tables after \paragraph or \subparagraph -\usepackage{etoolbox} -\makeatletter -\patchcmd\longtable{\par}{\if@noskipsec\mbox{}\fi\par}{}{} -\makeatother -% Allow footnotes in longtable head/foot -\IfFileExists{footnotehyper.sty}{\usepackage{footnotehyper}}{\usepackage{footnote}} -\makesavenoteenv{longtable} -$endif$ -$endif$ -$if(graphics)$ -\usepackage{graphicx} -\makeatletter -\def\maxwidth{\ifdim\Gin@nat@width>\linewidth\linewidth\else\Gin@nat@width\fi} -\def\maxheight{\ifdim\Gin@nat@height>\textheight\textheight\else\Gin@nat@height\fi} -\makeatother -% Scale images if necessary, so that they will not overflow the page -% margins by default, and it is still possible to overwrite the defaults -% using explicit options in \includegraphics[width, height, ...]{} -\setkeys{Gin}{width=\maxwidth,height=\maxheight,keepaspectratio} -% Set default figure placement to htbp -\makeatletter -\def\fps@figure{htbp} -\makeatother -$endif$ -$if(links-as-notes)$ -% Make links footnotes instead of hotlinks: -\DeclareRobustCommand{\href}[2]{#2\footnote{\url{#1}}} -$endif$ -$if(strikeout)$ -$-- also used for underline -\usepackage[normalem]{ulem} -% Avoid problems with \sout in headers with hyperref -\pdfstringdefDisableCommands{\renewcommand{\sout}{}} -$endif$ -\setlength{\emergencystretch}{3em} % prevent overfull lines -\providecommand{\tightlist}{% - \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} -$if(numbersections)$ -\setcounter{secnumdepth}{$if(secnumdepth)$$secnumdepth$$else$5$endif$} -$else$ -\setcounter{secnumdepth}{-\maxdimen} % remove section numbering -$endif$ -$if(beamer)$ -$else$ -$if(block-headings)$ -% Make \paragraph and \subparagraph free-standing -\ifx\paragraph\undefined\else - \let\oldparagraph\paragraph - \renewcommand{\paragraph}[1]{\oldparagraph{#1}\mbox{}} -\fi -\ifx\subparagraph\undefined\else - \let\oldsubparagraph\subparagraph - \renewcommand{\subparagraph}[1]{\oldsubparagraph{#1}\mbox{}} -\fi -$endif$ -$endif$ -$if(pagestyle)$ -\pagestyle{$pagestyle$} -$endif$ -$if(csl-refs)$ -\newlength{\cslhangindent} -\setlength{\cslhangindent}{1.5em} -\newlength{\csllabelwidth} -\setlength{\csllabelwidth}{3em} -\newlength{\cslentryspacingunit} % times entry-spacing -\setlength{\cslentryspacingunit}{\parskip} -\newenvironment{CSLReferences}[2] % #1 hanging-ident, #2 entry spacing - {% don't indent paragraphs - \setlength{\parindent}{0pt} - % turn on hanging indent if param 1 is 1 - \ifodd #1 - \let\oldpar\par - \def\par{\hangindent=\cslhangindent\oldpar} - \fi - % set entry spacing - \setlength{\parskip}{#2\cslentryspacingunit} - }% - {} -\usepackage{calc} -\newcommand{\CSLBlock}[1]{#1\hfill\break} -\newcommand{\CSLLeftMargin}[1]{\parbox[t]{\csllabelwidth}{#1}} -\newcommand{\CSLRightInline}[1]{\parbox[t]{\linewidth - \csllabelwidth}{#1}\break} -\newcommand{\CSLIndent}[1]{\hspace{\cslhangindent}#1} -$endif$ -$if(lang)$ -\ifLuaTeX -\usepackage[bidi=basic]{babel} -\else -\usepackage[bidi=default]{babel} -\fi -$if(babel-lang)$ -\babelprovide[main,import]{$babel-lang$} -$endif$ -$for(babel-otherlangs)$ -\babelprovide[import]{$babel-otherlangs$} -$endfor$ -% get rid of language-specific shorthands (see #6817): -\let\LanguageShortHands\languageshorthands -\def\languageshorthands#1{} -$endif$ -$for(header-includes)$ -$header-includes$ -$endfor$ -\ifLuaTeX - \usepackage{selnolig} % disable illegal ligatures -\fi -$if(dir)$ -\ifPDFTeX - \TeXXeTstate=1 - \newcommand{\RL}[1]{\beginR #1\endR} - \newcommand{\LR}[1]{\beginL #1\endL} - \newenvironment{RTL}{\beginR}{\endR} - \newenvironment{LTR}{\beginL}{\endL} -\fi -$endif$ -$if(natbib)$ -\usepackage[$natbiboptions$]{natbib} -\bibliographystyle{$if(biblio-style)$$biblio-style$$else$plainnat$endif$} -$endif$ -$if(biblatex)$ -\usepackage[$if(biblio-style)$style=$biblio-style$,$endif$$for(biblatexoptions)$$biblatexoptions$$sep$,$endfor$]{biblatex} -$for(bibliography)$ -\addbibresource{$bibliography$} -$endfor$ -$endif$ -$if(nocite-ids)$ -\nocite{$for(nocite-ids)$$it$$sep$, $endfor$} -$endif$ -$if(csquotes)$ -\usepackage{csquotes} -$endif$ - -$if(title)$ -\title{$title$$if(thanks)$\thanks{$thanks$}$endif$} -$endif$ -$if(subtitle)$ -$if(beamer)$ -$else$ -\usepackage{etoolbox} -\makeatletter -\providecommand{\subtitle}[1]{% add subtitle to \maketitle - \apptocmd{\@title}{\par {\large #1 \par}}{}{} -} -\makeatother -$endif$ -\subtitle{$subtitle$} -$endif$ -\author{$for(author)$$author$$sep$ \and $endfor$} -\date{$date$} -$if(beamer)$ -$if(institute)$ -\institute{$for(institute)$$institute$$sep$ \and $endfor$} -$endif$ -$if(titlegraphic)$ -\titlegraphic{\includegraphics{$titlegraphic$}} -$endif$ -$if(logo)$ -\logo{\includegraphics{$logo$}} -$endif$ -$endif$ -\IfFileExists{bookmark.sty}{\usepackage{bookmark}}{\usepackage{hyperref}} -\hypersetup{ -$if(title-meta)$ - pdftitle={$title-meta$}, -$endif$ -$if(author-meta)$ - pdfauthor={$author-meta$}, -$endif$ -$if(lang)$ - pdflang={$lang$}, -$endif$ -$if(subject)$ - pdfsubject={$subject$}, -$endif$ -$if(keywords)$ - pdfkeywords={$for(keywords)$$keywords$$sep$, $endfor$}, -$endif$ -$if(colorlinks)$ - colorlinks=true, - linkcolor={$if(linkcolor)$$linkcolor$$else$Maroon$endif$}, - filecolor={$if(filecolor)$$filecolor$$else$Maroon$endif$}, - citecolor={$if(citecolor)$$citecolor$$else$Blue$endif$}, - urlcolor={$if(urlcolor)$$urlcolor$$else$Blue$endif$}, -$else$ - hidelinks, -$endif$ - pdfcreator={LaTeX via pandoc}} - -\begin{document} -$if(has-frontmatter)$ -\frontmatter -$endif$ -$if(title)$ -$if(beamer)$ -\frame{\titlepage} -$else$ -\maketitle -$endif$ -$if(abstract)$ -\begin{abstract} -$abstract$ -\end{abstract} -$endif$ -$endif$ - -$for(include-before)$ -$include-before$ - -$endfor$ -$if(toc)$ -$if(toc-title)$ -\renewcommand*\contentsname{$toc-title$} -$endif$ -$if(beamer)$ -\begin{frame}[allowframebreaks] -$if(toc-title)$ - \frametitle{$toc-title$} -$endif$ - \tableofcontents[hideallsubsections] -\end{frame} -$else$ -{ -$if(colorlinks)$ -\hypersetup{linkcolor=$if(toccolor)$$toccolor$$else$$endif$} -$endif$ -\setcounter{tocdepth}{$toc-depth$} -\tableofcontents -} -$endif$ -$endif$ -$if(lof)$ -\listoffigures -$endif$ -$if(lot)$ -\listoftables -$endif$ -$if(linestretch)$ -\setstretch{$linestretch$} -$endif$ -$if(has-frontmatter)$ -\mainmatter -$endif$ -$body$ - -$if(has-frontmatter)$ -\backmatter -$endif$ -$if(natbib)$ -$if(bibliography)$ -$if(biblio-title)$ -$if(has-chapters)$ -\renewcommand\bibname{$biblio-title$} -$else$ -\renewcommand\refname{$biblio-title$} -$endif$ -$endif$ -$if(beamer)$ -\begin{frame}[allowframebreaks]{$biblio-title$} - \bibliographytrue -$endif$ - \bibliography{$for(bibliography)$$bibliography$$sep$,$endfor$} -$if(beamer)$ -\end{frame} -$endif$ - -$endif$ -$endif$ -$if(biblatex)$ -$if(beamer)$ -\begin{frame}[allowframebreaks]{$biblio-title$} - \bibliographytrue - \printbibliography[heading=none] -\end{frame} -$else$ -\printbibliography$if(biblio-title)$[title=$biblio-title$]$endif$ -$endif$ - -$endif$ -$for(include-after)$ -$include-after$ - -$endfor$ -\end{document} diff --git a/inst/compareScenarios/cs2_plot_functions.R b/inst/compareScenarios/cs2_plot_functions.R deleted file mode 100644 index edfd00e..0000000 --- a/inst/compareScenarios/cs2_plot_functions.R +++ /dev/null @@ -1,457 +0,0 @@ -lineplot <- function(varname, data) { - p <- ggplot(data, aes(x = as.character(period), y = value, group = scenario, color = scenario)) + - geom_line(size = 1) + - facet_wrap(~ data$variable, nrow = 4, scales = "free") + - scale_x_discrete(breaks = c(1990, 2010, 2030, 2050, 2100)) + - labs(x = "", y = paste0(varname, " [", unique(data$unit), "]"), title = paste0(varname)) - return(p) -} - -mipBarYearDataMod <- function(x, colour = NULL, ylab = NULL, xlab = NULL, title = NULL, - scenario_markers = TRUE) { # nolint - scenarioMarkers <- scenario_markers - x <- as.quitte(x) - - - if (length(unique(x$model)) > 1) { - stop("this plot can only deal with data that have only one model") - } - - if (!is.integer(x$period)) { - stop("this plot can only deal with data that have integer periods") - } - - # calculate y-axis label - x$variable <- shorten_legend(x$variable, identical_only = TRUE) - - if (is.null(ylab)) { - ylab <- paste0(sub(".$", "", attr(x$variable, "front")), attr(x$variable, "back")) - # add unit - unit <- unique(as.character(x$unit)) - ylab <- paste0(ylab, " (", paste0(unit, collapse = " | "), ")") - } - - # add dummy-dimension for space between the time-steps - xpos <- crossing(period = unique(x$period), - region = factor(c(levels(x$region), "\x13"))) %>% - order.levels(region = c(levels(x$region), "\x13")) %>% - arrange(!!sym("period"), !!sym("region")) %>% - mutate(xpos = 1:n()) %>% - filter("\x13" != !!sym("region")) %>% - droplevels() - - x <- x %>% - inner_join( - xpos, - - c("region", "period") - ) - - if (scenarioMarkers) { - yMarker <- crossing( - x %>% - group_by(!!sym("scenario"), !!sym("xpos")) %>% - summarise(top = sum(pmax(0, !!sym("value"))), - bottom = sum(pmin(0, !!sym("value")))) %>% - summarise(top = max(!!sym("top")), - bottom = min(!!sym("bottom"))) %>% - mutate( - y = !!sym("bottom") - 0.05 * (!!sym("top") + !!sym("bottom"))) %>% - select(-"top", -"bottom"), - - xpos - ) - } - - if (scenarioMarkers) { - scenarioMarkers <- setNames((1:20)[seq_along(unique(x$region))], - levels(x$region)) - } - - # calculate positions of period labels - if (any(scenarioMarkers)) { - xpos <- xpos %>% - group_by(!!sym("period")) %>% - summarise(xpos = mean(!!sym("xpos"))) - } - - if (is.null(colour)) { - colour <- plotstyle(levels(x$variable)) - } - - # make plot - p <- ggplot() + - geom_col(data = x, - mapping = aes(x = !!sym("xpos"), y = !!sym("value"), - fill = !!sym("variable"))) + - scale_fill_manual(values = colour, name = NULL, - guide = guide_legend(reverse = TRUE)) + - facet_wrap(~scenario, scales = "free_y") + - labs(x = xlab, y = ylab, title = title) + - theme(legend.position = "bottom") - - # add markers - if (any(scenarioMarkers)) { - p <- p + - scale_x_continuous(breaks = xpos$xpos, - labels = xpos$period) + - geom_point(data = yMarker, - mapping = aes(x = !!sym("xpos"), y = !!sym("y"), - shape = !!sym("region")), - size = 1.5) + - scale_shape_manual(values = scenarioMarkers, name = NULL) + - theme(legend.box = "vertical") - } else { - p <- p + - scale_x_continuous(breaks = xpos$xpos, - labels = xpos %>% - unite(!!sym("label"), !!sym("region"), - !!sym("period"), sep = " ") %>% - getElement("label")) + - theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) - } - - return(p) -} - -#' Show Multi-Line Plots by Variable -#' -#' Show plots with different regions in the same plot; x-axis variable chosen by -#' user. -#' -#' Same as \code{\link{showMultiLinePlots}} but with the variable specified by -#' \code{xVar} on x-axis. For every y-axis-value, we need a unique x-axis-value. -#' For historical data, there may be several sources / models of the same -#' variable. For the x-axis-variable a unique historical source / model is -#' chosen via \code{histRefModel}. -#' -#' @param xVar A single string. The variable for the x-axis. -#' @param showHistorical A single logical value. Should historical data be -#' shown? It is not recommended to set this to \code{TRUE} as the resulting -#' plot we probably be quite confusing. -#' @param histRefModel A named character vector identifying the unique model to -#' be chosen for historical data. Use \code{options(mip.histRefModel=)} -#' to set globally. -#' @param yearsByVariable A numeric vector. The years to be marked in the plots. -#' As default it uses the value globally set by \code{options(mip.yearsBarPlot=)}. -#' @inheritParams showMultiLinePlots -#' @return \code{NULL} is returned invisible. -#' @section Example Plots: -#' \if{html}{page 1: \figure{showMultiLinePlotsByVariable1.png}{options: width="100\%"}} -#' \if{html}{page 2: \figure{showMultiLinePlotsByVariable2.png}{options: width="100\%"}} -#' @export -#' @importFrom rlang data .env -#' @importFrom tidyr drop_na -#' @importFrom ggplot2 ylim - -showMultiLinePlotsByVariable_orig_ETP <- function( - data, vars, xVar, scales = "free_y", - showHistorical = FALSE, - showETPorig = FALSE) { - - data <- as.quitte(data) - yearsByVariable <- c(2010, 2030, 2050) - - # Validate function arguments. - stopifnot(is.character(vars)) - stopifnot(is.character(xVar) && length(xVar) == 1) - stopifnot(is.character(scales) && length(scales) == 1) - stopifnot(identical(showHistorical, TRUE) || identical(showHistorical, FALSE)) - stopifnot(is.null(yearsByVariable) || is.numeric(yearsByVariable)) - stopifnot(is.character(params$mainReg) && length(params$mainReg) == 1) - stopifnot(is.character(histRefModel) && !is.null(names(histRefModel))) - stopifnot(xVar %in% names(histRefModel)) - - # load and wrangle original ETP data - ETPorig <- readSource("IEA_ETP", subtype = "transport", convert = FALSE) - ETPorig <- as.quitte(ETPorig) - Mapping_IEA_ETP <- fread(system.file("extdata", "Mapping_IEA_ETP.csv", package = "edgeTrpLib"), header = TRUE) - setnames(Mapping_IEA_ETP, "IEA_ETP", "variable") - ETPorig <- merge(ETPorig, Mapping_IEA_ETP[, -c("Comment")], all.x = TRUE) - ETPorig <- as.data.table(ETPorig) - ETPorig[, value := value * Conversion][, Conversion := NULL][, unit := NULL] - ETPorig <- ETPorig[, .(value = sum(value)), by = .(REMIND, region, period, Unit_REMIND, scenario)] - setnames(ETPorig, c("REMIND", "Unit_REMIND"), c("variable", "unit")) - ETPorig[, model := paste0("IEA ETP ", scenario)][, scenario := NULL] - - GDP_country <- { - x <- calcOutput("GDP", aggregate = FALSE) - x - } - POP_country <- { - x <- calcOutput("Population", aggregate = FALSE) - x - } - - - GDP_country <- as.data.table(as.quitte(GDP_country)) - GDP_country <- GDP_country[, scenario := gsub("gdp_", "", variable)][, variable := NULL][, model := NULL][, conversion := 1e3] - POP_country <- as.data.table(as.quitte(POP_country)) - POP_country[, scenario := gsub("pop_", "", variable)][, variable := NULL][, model := NULL][, conversion := 1e6] - # Change unit from million US$2005/yr to kUS$2005/yr - GDP_country[, value := value * conversion][, conversion := NULL][, unit := NULL] - # Change unit from million to one - POP_country[, value := value * conversion][, conversion := NULL][, unit := NULL] - - setnames(GDP_country, c("region", "value"), c("ISO", "gdp")) - setnames(POP_country, c("region", "value"), c("ISO", "pop")) - - Map_ETP <- data.table( - ETPreg = c("Brazil", "China", "India", "Mexico", "Russia", "South Africa", "United States"), - ISO = c("BRA", "CHN", "IND", "MEX", "RUS", "ZAF", "USA") - ) - - GDP_country <- merge(GDP_country, Map_ETP, all.y = TRUE) - POP_country <- merge(POP_country, Map_ETP, all.y = TRUE) - - GDP <- copy(GDP_country) - GDP <- merge(GDP, POP_country, by = c("ISO", "ETPreg", "period", "scenario")) - GDP[, gdp := gdp / pop][, value := gdp][, pop := NULL] - GDP_B2DS <- copy(GDP) - GDP_B2DS[, variable := "GDP|PPP pCap"][, model := "IEA ETP B2DS"] - GDP_RTS <- copy(GDP) - GDP_RTS[, variable := "GDP|PPP pCap"][, model := "IEA ETP RTS"] - GDP_2DS <- copy(GDP) - GDP_2DS[, variable := "GDP|PPP pCap"][, model := "IEA ETP RTS 2DS"] - GDP <- rbind(GDP_B2DS, GDP_RTS, GDP_2DS) - GDP[, ISO := NULL][, unit := "kUS$2005/yr"] - setnames(GDP, c("ETPreg"), c("region")) - - ETPorig <- merge(ETPorig, GDP_country, by.x = c("region", "period"), by.y = c("ETPreg", "period"), allow.cartesian = TRUE) - ETPorig <- ETPorig[!is.na(value)] - ETPorig <- merge(ETPorig, POP_country, by.x = c("region", "period", "scenario", "ISO"), by.y = c("ETPreg", "period", "scenario", "ISO")) - # Calculate pCap values - ETPorig[, value := value / pop] - # Calculate GDP|PPP in kUSD2005 pCap - ETPorig[, gdp := gdp / pop][, pop := NULL] - ETPorig[, variable := paste0(variable, " ", "pCap")] - - # Exclude disaggregated ETP data - data <- data[!grepl("IEA ETP", model)] - data <- rbind(ETPorig[, ISO := NULL], GDP, data) - - # filter for stated variables - dy <- data %>% - filter(.data$variable %in% vars) - # filter fo x variable GDP|PPP - dx <- data %>% - filter(.data$variable %in% xVar) %>% - filter(.data$scenario != "historical" | .data$model == histRefModel[xVar]) - d <- dy %>% - left_join(dx, by = c("scenario", "region", "period"), suffix = c("", ".x")) %>% - drop_na(.data$value, .data$value.x) %>% - arrange(.data$period) %>% - droplevels() - dMainScen <- d %>% - filter(.data$region == params$mainReg, .data$scenario != "historical") %>% - droplevels() - dMainHist <- d %>% - filter(.data$region == params$mainReg, .data$scenario == "historical") %>% - droplevels() - dRegiScen <- d %>% - filter(.data$region != params$mainReg, .data$scenario != "historical") %>% - droplevels() - dRegiHist <- d %>% - filter(.data$region != params$mainReg, .data$scenario == "historical") %>% - droplevels() - - - - dRegiETPorig <- ETPorig[region %in% regiETP & variable %in% vars] - dRegiETPorig <- droplevels(dRegiETPorig) - scen <- unique(data$scenario) - scen <- gsub("(Mix.|ElecEra|HydrHype|ConvCase|historical)", "", scen) - dRegiETPorig <- ETPorig[scenario %in% scen] - - regions <- levels(dRegiScen$region) - - warnMissingVars(dMainScen, vars) - if (NROW(dMainScen) == 0) { - warning("Nothing to plot.", call. = FALSE) - return(invisible(NULL)) - } - - label <- paste0("[", paste0(levels(d$unit), collapse = ","), "]") - xLabel <- paste0(xVar, " [", paste0(levels(d$unit.x), collapse = ","), "]") - - p1 <- dMainScen %>% - ggplot(aes(.data$value.x, .data$value)) + - geom_line(aes(linetype = .data$scenario)) + - facet_wrap(vars(.data$variable), scales = scales) + - theme_minimal() + - expand_limits(y = 0) + - ylab(label) + xlab(xLabel) - p2 <- dRegiScen %>% - ggplot(aes(.data$value.x, .data$value, color = .data$region)) + - geom_line(aes(linetype = .data$scenario)) + - facet_wrap(vars(.data$variable), scales = scales) + - theme_minimal() + - scale_color_manual(values = plotstyle(regions)) + - expand_limits(y = 0) + - ylab(label) + xlab(xLabel) - if (showHistorical) { - p1 <- p1 + - geom_point(data = dMainHist, aes(shape = .data$model)) + - geom_line(data = dMainHist, aes(group = paste0(data$model, .data$region)), alpha = 0.5) - p2 <- p2 + - geom_point(data = dRegiHist, aes(shape = .data$model)) + - geom_line(data = dRegiHist, aes(group = paste0(.data$model, .data$region)), alpha = 0.5) - } - if (showETPorig & xVar == "GDP|PPP pCap") { - p2 <- p2 + - geom_point(data = dRegiETPorig, aes(dRegiETPorig$gdp, dRegiETPorig$value, shape = dRegiETPorig$model)) + - geom_line(data = dRegiETPorig, aes(group = paste0(dRegiETPorig$model, dRegiETPorig$region)), alpha = 0.5) - } - # Add markers for certain years. - if (length(yearsByVariable) > 0) { - p1 <- p1 + - geom_point( - data = dMainScen %>% - filter(.data$period %in% yearsByVariable) %>% - mutate(year = factor(.data$period)), - mapping = aes(.data$value.x, .data$value, shape = .data$year)) - p2 <- p2 + - geom_point( - data = dRegiScen %>% - filter(.data$period %in% yearsByVariable) %>% - mutate(year = factor(.data$period)), - mapping = aes(.data$value.x, .data$value, shape = .data$year)) - } - - # Show plots. - print(p1) - cat("\n\n") - print(p2) - cat("\n\n") - - return(invisible(NULL)) -} - - - - - -#' Show Line Plots by Variable -#' -#' x-axis variable chosen by -#' user. -#' -#' Same as \code{\link{showLinePlots}} but with the variable specified by -#' \code{xVar} on x-axis. For every y-axis-value, we need a unique x-axis-value. -#' For historical data, there may be several sources / models of the same -#' variable. For the x-axis-variable a unique historical source / model is -#' chosen via \code{histRefModel}. -#' -#' @param xVar A single string. The variable for the x-axis. -#' @param showHistorical A single logical value. Should historical data be -#' shown? It is not recommended to set this to \code{TRUE} as the resulting -#' plot we probably be quite confusing. -#' @param histRefModel A named character vector identifying the unique model to -#' be chosen for historical data. Use \code{options(mip.histRefModel=)} -#' to set globally. -#' @param yearsByVariable A numeric vector. The years to be marked in the plots. -#' As default it uses the value globally set by \code{options(mip.yearsBarPlot=)}. -#' @inheritParams showLinePlots -#' @return \code{NULL} is returned invisible. -#' @section Example Plots: -#' \if{html}{page 1: \figure{showLinePlotsByVariable1.png}{options: width="100\%"}} -#' \if{html}{page 2: \figure{showLinePlotsByVariable2.png}{options: width="100\%"}} -#' @examples -#' \dontrun{ -#' options(mip.mainReg = "World") -#' options(mip.yearsBarPlot = c(2010, 2030, 2050, 2100)) -#' options(mip.histRefModel = c("GDP|PPP pCap" = "James_IMF")) -#' data <- as.quitte(data) -#' vars <- c( -#' "FE|Transport pCap") -#' showLinePlotsByVariable(data, vars, "GDP|PPP pCap") -#' } -#' @export -#' @importFrom rlang .data .env -#' @importFrom tidyr drop_na -#' @importFrom ggplot2 ylim -showLinePlotsByVariable <- function( - data, vars, xVar, scales = "free_y", - showHistorical = FALSE, - mainReg = getOption("mip.mainReg"), - histRefModel = getOption("mip.histRefModel"), - yearsByVariable = getOption("mip.yearsBarPlot") -) { - - data <- as.quitte(data) - - # Validate function arguments. - stopifnot(is.character(vars)) - stopifnot(is.character(xVar) && length(xVar) == 1) - stopifnot(is.character(scales) && length(scales) == 1) - stopifnot(identical(showHistorical, TRUE) || identical(showHistorical, FALSE)) - stopifnot(is.null(yearsByVariable) || is.numeric(yearsByVariable)) - checkGlobalOptionsProvided(c("mainReg", "histRefModel")) - stopifnot(is.character(mainReg) && length(mainReg) == 1) - stopifnot(is.character(histRefModel) && !is.null(names(histRefModel))) - stopifnot(xVar %in% names(histRefModel)) - - dy <- data %>% - filter(.data$variable %in% .env$vars) - dx <- data %>% - filter(.data$variable %in% .env$xVar) %>% - filter(.data$scenario != "historical" | .data$model == .env$histRefModel[.env$xVar]) - d <- dy %>% - left_join(dx, by = c("scenario", "region", "period"), suffix = c("", ".x")) %>% - drop_na(.data$value, .data$value.x) %>% - arrange(.data$period) %>% - droplevels() - dMainScen <- d %>% - filter(.data$region == .env$mainReg, .data$scenario != "historical") %>% - droplevels() - dMainHist <- d %>% - filter(.data$region == .env$mainReg, .data$scenario == "historical") %>% - droplevels() - dRegiScen <- d %>% - filter(.data$region != .env$mainReg, .data$scenario != "historical") %>% - droplevels() - dRegiHist <- d %>% - filter(.data$region != .env$mainReg, .data$scenario == "historical") %>% - droplevels() - - regions <- levels(dRegiScen$region) - - warnMissingVars(dMainScen, vars) - if (NROW(dMainScen) == 0) { - warning("Nothing to plot.", call. = FALSE) - return(invisible(NULL)) - } - - unitlabel <- ifelse(length(levels(d$unit)) == 0, "", paste0(" [", paste0(levels(d$unit), collapse = ","), "]")) - label <- paste0(paste0(vars, collapse = ","), unitlabel) - xLabel <- paste0(xVar, " [", paste0(levels(d$unit.x), collapse = ","), "]") - - - p1 <- dRegiScen %>% - ggplot(aes(.data$value.x, .data$value, color = .data$scenario)) + - geom_line(aes(linetype = .data$scenario)) + - facet_wrap(vars(.data$region), scales = scales) + - theme_minimal() + - expand_limits(y = 0) + - ylab(label) + xlab(xLabel) - if (showHistorical) { - p1 <- p1 + - geom_point(data = dRegiHist, aes(shape = .data$model)) + - geom_line(data = dRegiHist, aes(group = paste0(.data$model, .data$region)), alpha = 0.5) - } - # Add markers for certain years. - if (length(yearsByVariable) > 0) { - p1 <- p1 + - geom_point( - data = dRegiScen %>% - filter(.data$period %in% .env$yearsByVariable) %>% - mutate(year = factor(.data$period)), - mapping = aes(.data$value.x, .data$value, shape = .data$year)) - } - - # Show plots. - print(p1) - cat("\n\n") - - return(invisible(NULL)) -} diff --git a/inst/compareScenarios/csEDGET_main.Rmd b/inst/compareScenarios/csEDGET_main.Rmd deleted file mode 100644 index 9292f80..0000000 --- a/inst/compareScenarios/csEDGET_main.Rmd +++ /dev/null @@ -1,328 +0,0 @@ ---- -title: "Edge Transport Compare Scenarios" -date: "`r format(Sys.Date())`" -output: - pdf_document: - toc: yes - number_sections: yes - toc_depth: 6 - keep_tex: false - template: cs2_latex_template.tex - includes: - in_header: cs_pdf_header_include.tex - html_document: - toc: yes - toc_float: yes - toc_depth: 6 - number_sections: yes -geometry: "a4paper,landscape,left = 0.5cm,right = 0.5cm,top = 0.5cm,bottom = 0.5cm,footnotesep=0.0cm,footskip = 0.1cm" -params: - mifScen: !r c() - mifScenNames: !r c() - mifHist: "" - yearsScen: !r c(seq(2005, 2050, 5)) - yearsHist: !r c(seq(2005, 2050, 5)) - yearsBarPlot: !r c(2020, 2025, 2030, 2035) - reg: !r c("OAS","MEA","SSA","LAM","REF","CAZ","CHA","IND","JPN","USA","NEU","EUR","World") - modelsHistExclude: !r c() - sections: !r c("01_energy_demand","02_energy_services","03_energy_intensity", "04_stock_and_sales", "05_Emissions") - userSectionPath: null - mainReg: "World" - figWidth: 15 - figHeight: 10 - warning: no -subparagraph: yes ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set( - echo = FALSE, - error = TRUE, - message = FALSE, - warning = params$warning, - fig.width = params$figWidth, - fig.height = params$figHeight) -``` - - -```{r libraries, include=FALSE} -# kableExtra must not be loaded before the call of library(kableExtra) below, -# as its .onLoad() function must be called to tell knitr about add necessary -# LaTeX libraries needed for tables. -# If the following line is not included, successive calls to compareScenarios2() -# may cause "Undefined control sequence" errors in LaTeX. -try(unloadNamespace("kableExtra"), silent = TRUE) - -library(gridExtra) -options(tidyverse.quiet = TRUE) -library(tidyverse) -library(kableExtra) -library(devtools) -library(mip) -library(quitte) -library(edgeTransport) -library(data.table) -``` - -```{r read scenario mifs} -# Read *.mif-files as nested tibble. -tibble(path = unname(params$mifScen)) %>% - rowid_to_column("fileid") %>% - mutate(data = map( - path, - read.quitte, - factors = TRUE, - # read.quitte() default NA-strings and Inf, -Inf - na.strings = c("UNDF", "NA", "N/A", "n_a", "Inf", "-Inf"))) %>% - unnest(data) %>% - nest(data = -c(fileid, path, scenario)) -> - dataScenNested -# Add column character column "newScenarioName", -# either with contents of params$mifScenNames or copy names from column scenario. -if (is.null(params$mifScenNames)) { - dataScenNested %>% - mutate(newScenarioName = as.character(scenario)) -> - dataScenNested -} else { - dataScenNested %>% - left_join( - tibble( - fileid = seq_along(params$mifScen), - newScenarioName = params$mifScenNames), - by = "fileid") -> - dataScenNested -} -# Check for duplicated scenario names. -if (anyDuplicated(dataScenNested$newScenarioName)) { - warning("There are duplicated scenario names. They will be renamed.") - dataScenNested %>% - mutate(newScenarioName = make.unique(newScenarioName)) -> - dataScenNested -} -# Retrieve data for reference table to be shown at the beginning of the document. -dataScenNested %>% - select(fileid, path, scenario, newScenarioName) -> - fileReference -# Apply renaming of scenario, unnest, and select only relevant columns. -dataScenNested %>% - mutate(scenario = factor(newScenarioName, levels = newScenarioName)) %>% - unnest(data) %>% - select(model, scenario, region, variable, unit, period, value) -> - dataScen -``` - -```{r define scenario colors} -# Get colors of scenarios to be used, e.g., in the info sections. -# They will coincide with the colors of the scenarios in line plots. -scenarioColors <- plotstyle(fileReference$newScenarioName) -lightenColor <- function(clr, by) { - colRGB <- colorRamp(c(clr, "white"))(by) - rgb(colRGB[1], colRGB[2], colRGB[3], maxColorValue = 255) -} -bkgndColors <- sapply(scenarioColors, lightenColor, by = 0.5) -``` - - -```{r read historical mif} -params$mifHist %>% - read.quitte(factors = TRUE) -> - dataHist -``` - - -```{r preprocess} -# Filter years and NA. -dataScen %>% - filter(period %in% params$yearsScen) -> - dataScen -dataHist %>% - filter(period %in% params$yearsHist, !(model %in% params$modelsHistExclude), !is.na(value)) %>% - droplevels() -> - dataHist -# Combine into one data frame and remove old. -data <- bind_rows(dataScen, dataHist) -rm(dataScen, dataScenNested, dataHist) -# In the variable names, replace |+|, |++|, |+++|, ... by |. -data %>% - mutate( - varplus = as.character(variable), - variable = remind2::deletePlus(variable)) -> - data -# Filter regions. -if (!is.null(params$reg)) { - data %>% - filter(region %in% params$reg) -> - data -} -``` - - -```{r Corrections} -# TODO: Should not be done in compareScenarios. -# Change unit million US$2005/yr to billion US$2005/yr. -# Relevant for ARIADNE historical EUR GDP|PPP. -bind_rows( - data %>% filter(!unit %in% c("million US$2005/yr")), - data %>% - filter(unit == "million US$2005/yr") %>% - mutate( - unit = "billion US$2005/yr", - value = value / 1000)) -> - data -``` - - -```{r reference models for historical} -# Sometimes it is necessary to choose a single model for the historical data, -# e.g., calculating per capita variables. These reference models are defined here. -histRefModel <- c( - "Population" = "WDI", - "GDP|PPP pCap" = "James_IMF") -``` - - -```{r calcuate pCap variables} -# For all variables in following table, add a new variable to data with the name -# "OldName pCap". Calculate its value by -# OldValue * conversionFactor -# and set its unit to newUnit. -# The new variable "OldName pCap" will be available in the plot sections. -pCapVariables <- tribble( - ~variable, ~newUnit, ~conversionFactor, - "GDP|PPP", "kUS$2005", 1e6, - "ES|Transport edge|Pass", "pkm/yr", 1e9, - "ES|Transport|Pass|Aviation", "pkm/yr", 1e9, - "ES|Transport|Bunkers|Pass|International Aviation", "pkm/yr", 1e9, - "ES|Transport|Pass|Domestic Aviation", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|Bus", "pkm/yr", 1e9, - "ES|Transport|Pass|Non-motorized|Walk", "pkm/yr", 1e9, - "ES|Transport|Pass|Non-motorized|Cycle", "pkm/yr", 1e9, - "ES|Transport|Pass|Rail|non-HSR", "pkm/yr", 1e9, - "ES|Transport|Pass|Rail|HSR", "pkm/yr", 1e9, - "ES|Transport edge|Freight", "tkm/yr", 1e9, - "ES|Transport|Bunkers|Freight|International Shipping", "tkm/yr", 1e9, - "ES|Transport|Freight|Road", "tkm/yr", 1e9, - "ES|Transport|Freight|Domestic Shipping", "tkm/yr", 1e9, - "ES|Transport|Freight|Rail", "tkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|Four Wheelers", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|Two Wheelers", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|BEV", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|FCEV", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|Gases", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|Hybrid electric", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|Liquids", "pkm/yr", 1e9, - "ES|Transport|Freight with bunkers", "tkm/yr", 1e9, - "ES|Transport|Freight|Road|BEV", "pkm/yr", 1e9, - "ES|Transport|Freight|Road|FCEV", "pkm/yr", 1e9, - "ES|Transport|Freight|Road|Gases", "pkm/yr", 1e9, - "ES|Transport|Freight|Road|Liquids", "pkm/yr", 1e9) - -data %>% - filter(variable == "Population") %>% - filter(scenario != "historical" | model == histRefModel["Population"]) %>% - select(scenario, region, period, value) %>% - mutate( - population = value * 1e6, # unit originally is million, now is 1 - value = NULL) -> - dataPop - -data %>% - inner_join(pCapVariables, 'variable') %>% - left_join(dataPop, c('scenario', 'region', 'period')) %>% - mutate( - value = value / population * conversionFactor, - variable = paste0(variable, " pCap"), - unit = newUnit, - newUnit = NULL, conversionFactor = NULL, population = NULL) -> - dataPCap - -data %>% - bind_rows(dataPCap) -> - data -``` - - -```{r add gdp column} -# Create a new column gdp with the value of GDP|PPP pCap (kUS$2005). -data %>% - filter(variable == "GDP|PPP pCap") %>% - filter(scenario != "historical" | model == histRefModel["GDP|PPP pCap"]) %>% - select(scenario, region, period, value) %>% - rename(gdp = value) -> - dataGDP -data %>% - left_join(dataGDP, c('scenario', 'region', 'period')) -> - data -``` - - -```{r calcuate pGDP variables} -# For all variables in following table, add a new variable to data with the name -# "OldName pGDP". Calculate its value by -# OldValue / (GDP|PPP pCap) * conversionFactor -# and set its unit to newUnit. -# The new variable "OldName pGDP" will be available in the plot sections. -pGdpVariables <- tribble( - ~variable, ~newUnit, ~conversionFactor, - "FE", "MJ/US$2005", 1e3, - "FE|CDR", "MJ/US$2005", 1e3, - "FE|Transport", "MJ/US$2005", 1e3, - "FE|Buildings", "MJ/US$2005", 1e3, - "FE|Industry", "MJ/US$2005", 1e3) -data %>% - inner_join(pGdpVariables, 'variable') %>% - mutate( - value = value / gdp * conversionFactor, - variable = paste0(variable, " pGDP"), - unit = newUnit, - newUnit = NULL, conversionFactor = NULL) -> - dataPGdp -data %>% - bind_rows(dataPGdp) -> - data -``` - -```{r quitte} -data <- as.quitte(data) -``` - -```{r global variables} -# Set global variables for use in plotting. -options(mip.mainReg = params$mainReg) -options(mip.yearsBarPlot = params$yearsBarPlot) -options(mip.histRefModel = histRefModel) -``` - -```{r define plot functions} -source("cs2_plot_functions.R", local=TRUE) -``` - - -```{r sectionPaths, include=FALSE} -if (length(params$sections) == 1 && params$sections == "all") { - dir() %>% - str_subset("^csEDGET_[0-9]{2}.+//.Rmd$") %>% - sort() -> - sectionPaths -} else { - if (length(params$sections) > 0) { - sectionPaths <- paste0("csEDGET_", params$sections, ".Rmd") - } else { - sectionPaths <- character(0) - } -} -``` - - -```{r prepare mark} -# CLICK "RUN ALL CHUNKS ABOVE" HERE TO PREPARE THE ENVIRONMENT -``` - - -```{r include sections, child = sectionPaths} -``` - - -```{r include user section, child = params$userSectionPath} -``` diff --git a/inst/compareScenarios/cs_pdf_header_include.tex b/inst/compareScenarios/cs_pdf_header_include.tex deleted file mode 100644 index 38186b6..0000000 --- a/inst/compareScenarios/cs_pdf_header_include.tex +++ /dev/null @@ -1,12 +0,0 @@ -\usepackage{titlesec} -\titleformat{\paragraph} - {\normalfont\bfseries} - {\theparagraph\ } - {0pt} - {} -\titleformat{\subparagraph} - {\normalfont\itshape} - {\thesubparagraph\ } - {0pt} - {} - diff --git a/inst/compareScenarios/preprocessing.Rmd b/inst/compareScenarios/preprocessing.Rmd new file mode 100644 index 0000000..e4265df --- /dev/null +++ b/inst/compareScenarios/preprocessing.Rmd @@ -0,0 +1,178 @@ +```{r load additional libraries} + +library(ggplot2) +library(dplyr) + +``` + +```{r reference models for historical} + +# Sometimes it is necessary to choose a single model for the historical data, +# e.g., calculating per capita variables. These reference models are defined here. + +histRefModel <- c( + "Population" = "WDI", + "GDP|PPP pCap" = "James_IMF" +) + +options(mip.histRefModel = histRefModel) # nolint + +``` + + +```{r load custom plotting function} + +showLinePlotsByVariable <- function( + data, vars, xVar, scales = "free_y", + showHistorical = FALSE, + mainReg = getOption("mip.mainReg"), + histRefModel = getOption("mip.histRefModel"), + yearsByVariable = getOption("mip.yearsBarPlot")) { + data <- as.quitte(data) + + # Validate function arguments. + stopifnot(is.character(vars)) + stopifnot(is.character(xVar) && length(xVar) == 1) + stopifnot(is.character(scales) && length(scales) == 1) + stopifnot(identical(showHistorical, TRUE) || identical(showHistorical, FALSE)) + stopifnot(is.null(yearsByVariable) || is.numeric(yearsByVariable)) + checkGlobalOptionsProvided(c("mainReg", "histRefModel")) + stopifnot(is.character(mainReg) && length(mainReg) == 1) + stopifnot(is.character(histRefModel) && !is.null(names(histRefModel))) + stopifnot(xVar %in% names(histRefModel)) + + dy <- data %>% + filter(.data$variable %in% .env$vars) + dx <- data %>% + filter(.data$variable %in% .env$xVar) %>% + filter(.data$scenario != "historical" | .data$model == .env$histRefModel[.env$xVar]) + d <- dy %>% + left_join(dx, by = c("scenario", "region", "period"), suffix = c("", ".x")) %>% + drop_na(.data$value, .data$value.x) %>% + arrange(.data$period) %>% + droplevels() + dMainScen <- d %>% + filter(.data$region == .env$mainReg, .data$scenario != "historical") %>% + droplevels() + dMainHist <- d %>% + filter(.data$region == .env$mainReg, .data$scenario == "historical") %>% + droplevels() + dRegiScen <- d %>% + filter(.data$region != .env$mainReg, .data$scenario != "historical") %>% + droplevels() + dRegiHist <- d %>% + filter(.data$region != .env$mainReg, .data$scenario == "historical") %>% + droplevels() + + regions <- levels(dRegiScen$region) + + warnMissingVars(dMainScen, vars) + + if (NROW(dMainScen) == 0) { + warning("Nothing to plot.", call. = FALSE) + return(invisible(NULL)) + } + + unitlabel <- ifelse(length(levels(d$unit)) == 0, "", paste0(" [", paste0(levels(d$unit), collapse = ","), "]")) + label <- paste0(paste0(vars, collapse = ","), unitlabel) + xLabel <- paste0(xVar, " [", paste0(levels(d$unit.x), collapse = ","), "]") + + + p1 <- dRegiScen %>% + ggplot(aes(.data$value.x, .data$value, color = .data$scenario)) + + geom_line(aes(linetype = .data$scenario)) + + facet_wrap(vars(.data$region), scales = scales) + + theme_minimal() + + expand_limits(y = 0) + + ylab(label) + + xlab(xLabel) + if (showHistorical) { + p1 <- p1 + + geom_point(data = dRegiHist, aes(shape = .data$model)) + + geom_line(data = dRegiHist, aes(group = paste0(.data$model, .data$region)), alpha = 0.5) + } + # Add markers for certain years. + if (length(yearsByVariable) > 0) { + p1 <- p1 + + geom_point( + data = dRegiScen %>% + filter(.data$period %in% .env$yearsByVariable) %>% + mutate(year = factor(.data$period)), + mapping = aes(.data$value.x, .data$value, shape = .data$year) + ) + } + + # Show plots. + print(p1) + cat("\n\n") + + return(invisible(NULL)) +} + +``` + +```{r calcuate pCap variables} +# For all variables in following table, add a new variable to data with the name +# "OldName pCap". Calculate its value by OldValue * conversionFactor and set its unit to newUnit. +# The new variable "OldName pCap" will be available in the plot sections. + +pCapVariables <- tribble( + ~variable, ~newUnit, ~conversionFactor, + "GDP|PPP", "kUS$2005", 1e6, + "ES|Transport|Pass|w/o bunkers", "pkm/yr", 1e9, + "ES|Transport|Pass|Aviation", "pkm/yr", 1e9, + "ES|Transport|Pass|Aviation|International", "pkm/yr", 1e9, + "ES|Transport|Pass|Aviation|Domestic", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|Bus", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|Non-Motorized|Walking", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|Non-Motorized|Cycling", "pkm/yr", 1e9, + "ES|Transport|Pass|Rail|non-HSR", "pkm/yr", 1e9, + "ES|Transport|Pass|Rail|HSR", "pkm/yr", 1e9, + "ES|Transport|Freight|w/o bunkers", "tkm/yr", 1e9, + "ES|Transport|Freight|International Shipping", "tkm/yr", 1e9, + "ES|Transport|Freight|Road", "tkm/yr", 1e9, + "ES|Transport|Freight|Navigation", "tkm/yr", 1e9, + "ES|Transport|Freight|Rail", "tkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|Four Wheelers", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|Two Wheelers", "pkm/yr", 1e9, + "ES|Transport|Pass|non-LDV", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|BEV", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|FCEV", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|Gases", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|Hybrid Electric", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|Liquids", "pkm/yr", 1e9, + "ES|Transport edge|Freight", "tkm/yr", 1e9, + "ES|Transport|Freight|Road|Electric", "pkm/yr", 1e9, + "ES|Transport|Freight|Road|FCEV", "pkm/yr", 1e9, + "ES|Transport|Freight|Road|Gases", "pkm/yr", 1e9, + "ES|Transport|Freight|Road|Liquids", "pkm/yr", 1e9 +) + +data %>% + filter(variable == "Population") %>% + filter(scenario != "historical" | model == histRefModel["Population"]) %>% + select(scenario, region, period, value) %>% + mutate( + population = value * 1e6, # unit originally is million, now is 1 + value = NULL + ) -> +dataPop + +data %>% + inner_join(pCapVariables, "variable") %>% + left_join(dataPop, c("scenario", "region", "period")) %>% + mutate( + value = value / population * conversionFactor, + variable = paste0(variable, " pCap"), + unit = newUnit, + newUnit = NULL, conversionFactor = NULL, population = NULL + ) -> +dataPCap + +data %>% + bind_rows(dataPCap) -> +data +``` + + diff --git a/man/transportCompareScenarios.Rd b/man/transportCompareScenarios.Rd index 186e743..eed35f2 100644 --- a/man/transportCompareScenarios.Rd +++ b/man/transportCompareScenarios.Rd @@ -2,15 +2,14 @@ % Please edit documentation in R/transportCompareScenarios.R \name{transportCompareScenarios} \alias{transportCompareScenarios} -\title{Render CompareScenarios EDGE Transport} +\title{Render CompareScenarios for EDGE Transport} \usage{ transportCompareScenarios( mifScen, mifHist, outputDir = getwd(), outputFile = "CompareScenarios", - outputFormat = "PDF", - ... + outputFormat = "PDF" ) } \arguments{ @@ -28,80 +27,10 @@ output document to be created.} \item{outputFormat}{\code{character(1)}, not case-sensitive. \code{"html"}, \code{"pdf"}, or \code{"rmd"}.} - -\item{...}{YAML parameters, see below.} } \value{ The value returned by \code{\link[rmarkdown:render]{render()}}. } \description{ -Renders the *.Rmd-files associated to CompareScenarios EDGE TRansport. In the Rmds, -scenario- and historical .mif-files are loaded. Then plots are created from -this data. The result may be rendered to PDF or HTML. Alternatively one can -choose Rmd as output format and obtain a copy of the *.Rmd-files. -} -\section{YAML Parameters}{ - -\describe{ - \item{\code{yearsScen}}{ - \code{numeric(n)}. - Default: \code{c(seq(2005, 2060, 5), seq(2070, 2100, 10))}. - Years to show for scenario data.} - \item{\code{yearsHist}}{ - \code{numeric(n)}. - Default: \code{c(seq(1990, 2020, 1), seq(2025, 2100, 5))}. - Years to show for historical data.} - \item{\code{yearsBarPlot}}{ - \code{numeric(n)}. - Default: \code{c(2010, 2030, 2050, 2100)}. - Years to show in bar plots of scenario data.} - \item{\code{reg}}{ - \code{NULL} or \code{character(n)}. - Default: \code{NULL}. - Regions to show. \code{NULL} means all.} - \item{\code{modelsHistExclude}}{ - \code{character(n) or NULL}. - Default: \code{c()}. - Models in historical data to exclude.} - \item{\code{sections}}{ - \code{character(n)}. - Default: \code{"all"}. - Names of sections to include. A subset of - \code{c("01_energy_demand", "02_energy_services", "03_stock_and_sales", "04_costs_and_shareweight_trends")} - or \code{"all"} for all available sections.} - \item{\code{userSectionPath}}{ - \code{NULL} or \code{character(n)}. - Default: \code{NULL}. - Path to a *.Rmd-file that may be included as additional section.} - \item{\code{mainReg}}{ - \code{character(1)}. - Default: \code{"World"}. - A region for which larger plots are shown.} - \item{\code{figWidth, figHeight}}{ - \code{numeric(1)}. - Default: \code{15} and \code{10}, respectively. - Size of plots in inches.} - \item{\code{warning}}{ - \code{logical(1)}. - Default: \code{TRUE}. - Show warnings in output?} -} -} - -\examples{ -\dontrun{ -compareScenarios2( - mifScen = c("path/to/Base.mif", "path/to/NDC.mif"), - mifHist = "path/to/historical.mif", - outputFile = "CompareScenarios2Example1", - userSectionPath = "path/to/myPlots.Rmd") -compareScenarios2( - mifScen = c(ScenarioName1 = "path/to/scen1.mif", ScenarioName2 = "path/to/scen2.mif"), - mifHist = "path/to/historical.mif", - outputFile = "CompareScenarios2Example2", - figWidth = 18, figHeight = 10) -} -} -\author{ -Christof Schoetz, Johanna Hoppe +A wrapper for piamPlotComparison::compareScenarios } From db2b2cb3f2f511780b6d1d4a5f3fd7e915c268b5 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 29 Jul 2024 15:45:12 +0200 Subject: [PATCH 2/7] remove markdowns no longer used --- .../cs2_02_energy_demand_UE.Rmd | 62 -------- ...ervices.Rmd => cs2_02_energy_services.Rmd} | 0 ...ensity.Rmd => cs2_03_energy_intensity.Rmd} | 0 ...d_sales.Rmd => cs2_04_stock_and_sales.Rmd} | 0 ..._06_emissions.Rmd => cs2_05_emissions.Rmd} | 0 .../cs2_07_endogenous_cost_analytics.Rmd | 19 --- .../cs2_08_nav_scenario_evaluation.Rmd | 147 ------------------ 7 files changed, 228 deletions(-) delete mode 100644 inst/compareScenarios/cs2_02_energy_demand_UE.Rmd rename inst/compareScenarios/{cs2_03_energy_services.Rmd => cs2_02_energy_services.Rmd} (100%) rename inst/compareScenarios/{cs2_04_energy_intensity.Rmd => cs2_03_energy_intensity.Rmd} (100%) rename inst/compareScenarios/{cs2_05_stock_and_sales.Rmd => cs2_04_stock_and_sales.Rmd} (100%) rename inst/compareScenarios/{cs2_06_emissions.Rmd => cs2_05_emissions.Rmd} (100%) delete mode 100644 inst/compareScenarios/cs2_07_endogenous_cost_analytics.Rmd delete mode 100644 inst/compareScenarios/cs2_08_nav_scenario_evaluation.Rmd diff --git a/inst/compareScenarios/cs2_02_energy_demand_UE.Rmd b/inst/compareScenarios/cs2_02_energy_demand_UE.Rmd deleted file mode 100644 index 5f8a171..0000000 --- a/inst/compareScenarios/cs2_02_energy_demand_UE.Rmd +++ /dev/null @@ -1,62 +0,0 @@ -# Useful Energy Demand - - -## Useful Energy by carrier - -### Total -```{r} -items <- c( - "UE|Transport|Electricity", - "UE|Transport|Hydrogen", - "UE|Transport|Liquids" - ) - -walk(items, showLinePlots, data = data) -``` - -### Road -```{r} -items <- c( - "UE|Transport|Road|Electricity", - "UE|Transport|Road|Liquids", - "UE|Transport|Road|Hydrogen", - ) - -walk(items, showLinePlots, data = data) -``` - -### Passenger -```{r} -items <- c( - "UE|Transport|Pass with bunkers|Electricity", - "UE|Transport|Pass with bunkers|Hydrogen", - "UE|Transport|Pass with bunkers|Liquids" - ) - -walk(items, showLinePlots, data = data) -``` - -### Passenger -```{r} -items <- c( - "UE|Transport|Pass|Electricity", - "UE|Transport|Pass|Hydrogen", - "UE|Transport|Pass|Liquids" - ) -walk(items, showLinePlots, data = data) -``` - - -## Useful Energy by transport modes - -### Passenger -```{r} -items <- c( - "UE|Transport|Pass|Rail|HSR", - "UE|Transport|Pass|Rail|non-HSR", - "UE|Transport|Pass|Road|Bus", - "UE|Transport|Pass|Road|LDV|Four Wheelers", - "UE|Transport|Pass|Road|LDV|Two Wheelers" - ) -walk(items, showLinePlots, data = data) -``` diff --git a/inst/compareScenarios/cs2_03_energy_services.Rmd b/inst/compareScenarios/cs2_02_energy_services.Rmd similarity index 100% rename from inst/compareScenarios/cs2_03_energy_services.Rmd rename to inst/compareScenarios/cs2_02_energy_services.Rmd diff --git a/inst/compareScenarios/cs2_04_energy_intensity.Rmd b/inst/compareScenarios/cs2_03_energy_intensity.Rmd similarity index 100% rename from inst/compareScenarios/cs2_04_energy_intensity.Rmd rename to inst/compareScenarios/cs2_03_energy_intensity.Rmd diff --git a/inst/compareScenarios/cs2_05_stock_and_sales.Rmd b/inst/compareScenarios/cs2_04_stock_and_sales.Rmd similarity index 100% rename from inst/compareScenarios/cs2_05_stock_and_sales.Rmd rename to inst/compareScenarios/cs2_04_stock_and_sales.Rmd diff --git a/inst/compareScenarios/cs2_06_emissions.Rmd b/inst/compareScenarios/cs2_05_emissions.Rmd similarity index 100% rename from inst/compareScenarios/cs2_06_emissions.Rmd rename to inst/compareScenarios/cs2_05_emissions.Rmd diff --git a/inst/compareScenarios/cs2_07_endogenous_cost_analytics.Rmd b/inst/compareScenarios/cs2_07_endogenous_cost_analytics.Rmd deleted file mode 100644 index e9bd720..0000000 --- a/inst/compareScenarios/cs2_07_endogenous_cost_analytics.Rmd +++ /dev/null @@ -1,19 +0,0 @@ -# Endogenous Cost Analytics - -```{r} -data <- as.data.table(data) -plotData <- data[grepl("(Policy mask.*|rawEndogenousCost.*|updatedEndogenousCost.*"), variable] - -# Convert year to a factor for better plotting -plotData$period <- as.factor(plotData$period) - -# Create the line plot with facets -ggplot(plotData, aes(x = period, y = value, group = variable, color = variable)) + - geom_line() + - facet_grid(region ~ vehicleType + technology, scales = "free_y") + - labs(title = "Endogenous Cost", - x = "period", - y = "value", - color = "variable") + - theme_minimal() -``` diff --git a/inst/compareScenarios/cs2_08_nav_scenario_evaluation.Rmd b/inst/compareScenarios/cs2_08_nav_scenario_evaluation.Rmd deleted file mode 100644 index 28e6c90..0000000 --- a/inst/compareScenarios/cs2_08_nav_scenario_evaluation.Rmd +++ /dev/null @@ -1,147 +0,0 @@ -# Evaluation Sheet NAVIGATE scenarios -```{r setting} -data <- as.data.table(data) -Baseline <- "Mix1 SSP2" -``` - -```{r Calculate ES reduction rate for Passenger Cars compared to Baseline for all scenarios} -targetyear <- 2050 -ES_data_base <- data[scenario == Baseline & variable == "ES|Transport|Pass|Road|LDV|Four Wheelers" & period == targetyear][, scenario := NULL] -setnames(ES_data_base, "value", "ES_base") -red_ES_pass <- merge(ES_data_base, data[!scenario == Baseline & variable == "ES|Transport|Pass|Road|LDV|Four Wheelers" & period == targetyear], all = TRUE) -red_ES_pass[, reduction_rate := round((value/ES_base)*100-100,2)] -red_ES_pass <- red_ES_pass[, c("scenario", "region", "reduction_rate")] -``` - -```{r Plot ES reduction rate for Passenger Cars compared to Baseline for all scenarios} -ggplot(red_ES_pass, aes(x = scenario, y = reduction_rate)) + - geom_bar(stat="identity") + - geom_label(aes(label = reduction_rate), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("ES reduction rate for Passenger Cars compared to Baseline for all scenarios")) + -``` - -```{r Calculate ES reduction rate for Freight compared to Baseline for all scenarios} -targetyear <- 2050 -ES_data_base <- data[scenario == Baseline & grepl("ES\\|Transport\\|Freight\\|(Road|Rail)$", variable) & period == targetyear] -ES_data_base <- ES_data_base[, .(ES_Freight_land_base = sum(value)), by = "region"] -ES_data <- data[!scenario %in% c(Baseline, "historical") & grepl("ES\\|Transport\\|Freight\\|(Road|Rail)$", variable) & period == targetyear] -ES_data <- ES_data[, .(ES_Freight_land = sum(value)), by = c("scenario", "region")] -ES_data <- merge(ES_data_base, ES_data, all = TRUE) -ES_data[, reduction_rate := round((ES_Freight_land/ES_Freight_land_base)*100-100)] -ES_data <- ES_data[, c("scenario", "region", "reduction_rate")] -``` - -```{r Plot ES reduction rate for Freight compared to Baseline for all scenarios} -ggplot(ES_data, aes(x = scenario, y = reduction_rate)) + - geom_bar(stat="identity") + - geom_label(aes(label = reduction_rate), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for land-based freight transport compared to Baseline for all scenarios")) + - facet_wrap(~region, nrow = 5,scales = "free") -``` - -```{r Calculate ES shares for all scenarios} -targetyear <- 2050 -Pass_land <- c("ES|Transport|Pass|Rail", "ES|Transport|Pass|Road|LDV", "ES|Transport|Pass|Road|Bus", "ES|Transport|Pass|Non-motorized") -Pass_land_public <- c("ES|Transport|Pass|Road|Bus", "ES|Transport|Pass|Rail") -ES_data_land <- data[!scenario %in% c(Baseline, "historical") & variable %in% Pass_land & period == targetyear] -ES_data_land <- ES_data_land[, .(ES_Pass_land = sum(value)), by = c("region", "scenario")] -ES_data_public <- data[!scenario %in% c(Baseline, "historical") & variable %in% Pass_land_public & period == targetyear] -ES_data_public <- ES_data_public[, .(ES_Pass_public = sum(value)), by = c("region", "scenario")] -ES_data_nonmot <- data[!scenario %in% c(Baseline, "historical") & variable == "ES|Transport|Pass|Non-motorized" & period == targetyear] -ES_data_nonmot <- ES_data_nonmot[, .(ES_Pass_nonmot = sum(value)), by = c("region", "scenario")] -ES_data <- merge(ES_data_land, ES_data_public, by = c("region", "scenario")) -ES_data <- merge(ES_data, ES_data_nonmot, by = c("region", "scenario")) -ES_data[, share_public := round(ES_Pass_public/ES_Pass_land*100,2)][, ES_Pass_public := NULL] -ES_data[, share_nonmot := round(ES_Pass_nonmot/ES_Pass_land*100,2)][, ES_Pass_land := NULL][, ES_Pass_nonmot := NULL] -``` - -```{r Plot ES shares nonmot for all scenarios} -ggplot(ES_data, aes(x = scenario, y = share_nonmot)) + - geom_bar(stat="identity") + - geom_label(aes(label = share_nonmot), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Share nonmot [%]"), title = paste0("Share of active modes in Passenger land-based transport for all scenarios")) + - facet_wrap(~region, nrow = 5, scales = "free") -``` - -```{r Plot ES shares public for all scenarios} -ggplot(ES_data, aes(x = scenario, y = share_public)) + - geom_bar(stat="identity") + - geom_label(aes(label = share_public), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Share public transport [%]"), title = paste0("Share of public modes in Passenger land-based transport for all scenarios")) + - facet_wrap(~region, nrow = 5, scales = "free") -``` - -```{r Calculate ES reduction rate for Aviation compared to Baseline for all scenarios} -targetyear <- 2050 -ES_data_base_dom <- data[scenario == Baseline & variable == "ES|Transport|Pass|Domestic Aviation" & period == targetyear] -ES_data_base_int <- data[scenario == Baseline & variable == "ES|Transport|Bunkers|Pass|International Aviation" & period == targetyear] -setnames(ES_data_base_dom, "value", "ES_dom_base") -setnames(ES_data_base_int, "value", "ES_int_base") -ES_data_base <- merge(ES_data_base_dom[, c("region", "ES_dom_base")], ES_data_base_int[, c("region", "ES_int_base")]) - -ES_data_dom <- data[!scenario %in% c(Baseline, "historical") & variable == "ES|Transport|Pass|Domestic Aviation" & period == targetyear] -ES_data_int <- data[!scenario %in% c(Baseline, "historical") & variable == "ES|Transport|Bunkers|Pass|International Aviation" & period == targetyear] -setnames(ES_data_dom, "value", "ES_dom") -setnames(ES_data_int, "value", "ES_int") -ES_data <- merge(ES_data_dom[, c("region", "ES_dom", "scenario")], ES_data_int[, c("region", "ES_int", "scenario")]) - -ES_data <- merge(ES_data_base, ES_data, all = TRUE) -ES_data[, reduction_rate_int := round((ES_int/ES_int_base)*100-100)] -ES_data[, reduction_rate_dom := round((ES_dom/ES_dom_base)*100-100)] -ES_data <- ES_data[, c("scenario", "region", "reduction_rate_int", "reduction_rate_dom")] -``` - -```{r Plot ES reduction rate for Aviation dom compared to Baseline for all scenarios} -ggplot(ES_data, aes(x = scenario, y = reduction_rate_dom)) + - geom_bar(stat="identity") + - geom_label(aes(label = reduction_rate_dom), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for domestic passenger avitaion compared to Baseline for all scenarios")) + - facet_wrap(~region, nrow = 5, scales = "free") -``` - -```{r Plot ES reduction rate for Aviation int compared to Baseline for all scenarios} -ggplot(ES_data, aes(x = scenario, y = reduction_rate_int)) + - geom_bar(stat="identity") + - geom_label(aes(label = reduction_rate_int), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for international passenger avitaion compared to Baseline for all scenarios")) + - facet_wrap(~region, nrow = 5, scales = "free") -``` - - - -```{r Calculate ES reduction rate for Freight shipping compared to Baseline for all scenarios} -targetyear <- 2050 -ES_data_base <- data[scenario == Baseline & grepl("ES\\|Transport\\|Freight\\|(International Shipping|Domestic Shipping)$", variable) & period == targetyear] -ES_data_base <- ES_data_base[, .(ES_Freight_shipping_base = sum(value)), by = "region"] -ES_data <- data[!scenario %in% c(Baseline, "historical") & grepl("ES\\|Transport\\|Freight\\|(International Shipping|Domestic Shipping)$", variable) & period == targetyear] -ES_data <- ES_data[, .(ES_Freight_shipping = sum(value)), by = c("scenario", "region")] -ES_data <- merge(ES_data_base, ES_data, all = TRUE) -ES_data[, reduction_rate := round((ES_Freight_shipping/ES_Freight_shipping_base)*100-100)] -ES_data <- ES_data[, c("scenario", "region", "reduction_rate")] -``` - -```{r Plot ES reduction rate for Freight shipping compared to Baseline for all scenarios} -ggplot(ES_data, aes(x = scenario, y = reduction_rate)) + - geom_bar(stat="identity") + - geom_label(aes(label = reduction_rate), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for freight shipping compared to Baseline for all scenarios")) + - facet_wrap(~region, nrow = 5, scales = "free") -``` - -```{r Calculate Share of H2 in aviation (international+domestic) for all scenarios} -targetyear <- 2070 -FE_data_h2 <- data[!scenario %in% c(Baseline, "historical") & grepl("FE\\|Transport\\|Pass\\|Aviation\\|Domestic\\|Hydrogen$", variable) & period == targetyear] -setnames(FE_data_h2, "value", "FE_h2") -FE_data <- data[!scenario %in% c(Baseline, "historical") & grepl("FE\\|Transport\\|Pass\\|Aviation$", variable) & period == targetyear] -FE_data <- merge(FE_data_h2[, c("region", "scenario", "FE_h2")], FE_data[, c("region", "scenario", "value")]) -FE_data[, shareh2 := round((FE_h2/value)*100)] -FE_data <- FE_data[, c("scenario", "region", "shareh2")] -``` - -```{r Plot Share of H2 in aviation (international+domestic) for all scenarios} -ggplot(FE_data, aes(x = scenario, y = shareh2)) + - geom_bar(stat="identity") + - geom_label(aes(label = shareh2), vjust = 0.5, colour = "black") + - labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Share of H2 in aviation (international+domestic) for all scenarios")) + - facet_wrap(~region, nrow = 5, scales = "free") -``` From 08bba20d16c4505888ca7f4ba07fcdc47b2a57cb Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 29 Jul 2024 16:23:08 +0200 Subject: [PATCH 3/7] rename markdown files --- ...rgy_demand.Rmd => cs_01_energy_demand.Rmd} | 0 ...services.Rmd => cs_02_energy_services.Rmd} | 0 ...tensity.Rmd => cs_03_energy_intensity.Rmd} | 0 ...nd_sales.Rmd => cs_04_stock_and_sales.Rmd} | 0 ...2_05_emissions.Rmd => cs_05_emissions.Rmd} | 0 inst/compareScenarios/preprocessing.Rmd | 23 +++++++++---------- 6 files changed, 11 insertions(+), 12 deletions(-) rename inst/compareScenarios/{cs2_01_energy_demand.Rmd => cs_01_energy_demand.Rmd} (100%) rename inst/compareScenarios/{cs2_02_energy_services.Rmd => cs_02_energy_services.Rmd} (100%) rename inst/compareScenarios/{cs2_03_energy_intensity.Rmd => cs_03_energy_intensity.Rmd} (100%) rename inst/compareScenarios/{cs2_04_stock_and_sales.Rmd => cs_04_stock_and_sales.Rmd} (100%) rename inst/compareScenarios/{cs2_05_emissions.Rmd => cs_05_emissions.Rmd} (100%) diff --git a/inst/compareScenarios/cs2_01_energy_demand.Rmd b/inst/compareScenarios/cs_01_energy_demand.Rmd similarity index 100% rename from inst/compareScenarios/cs2_01_energy_demand.Rmd rename to inst/compareScenarios/cs_01_energy_demand.Rmd diff --git a/inst/compareScenarios/cs2_02_energy_services.Rmd b/inst/compareScenarios/cs_02_energy_services.Rmd similarity index 100% rename from inst/compareScenarios/cs2_02_energy_services.Rmd rename to inst/compareScenarios/cs_02_energy_services.Rmd diff --git a/inst/compareScenarios/cs2_03_energy_intensity.Rmd b/inst/compareScenarios/cs_03_energy_intensity.Rmd similarity index 100% rename from inst/compareScenarios/cs2_03_energy_intensity.Rmd rename to inst/compareScenarios/cs_03_energy_intensity.Rmd diff --git a/inst/compareScenarios/cs2_04_stock_and_sales.Rmd b/inst/compareScenarios/cs_04_stock_and_sales.Rmd similarity index 100% rename from inst/compareScenarios/cs2_04_stock_and_sales.Rmd rename to inst/compareScenarios/cs_04_stock_and_sales.Rmd diff --git a/inst/compareScenarios/cs2_05_emissions.Rmd b/inst/compareScenarios/cs_05_emissions.Rmd similarity index 100% rename from inst/compareScenarios/cs2_05_emissions.Rmd rename to inst/compareScenarios/cs_05_emissions.Rmd diff --git a/inst/compareScenarios/preprocessing.Rmd b/inst/compareScenarios/preprocessing.Rmd index e4265df..58dc4f8 100644 --- a/inst/compareScenarios/preprocessing.Rmd +++ b/inst/compareScenarios/preprocessing.Rmd @@ -119,31 +119,30 @@ showLinePlotsByVariable <- function( pCapVariables <- tribble( ~variable, ~newUnit, ~conversionFactor, "GDP|PPP", "kUS$2005", 1e6, - "ES|Transport|Pass|w/o bunkers", "pkm/yr", 1e9, + "ES|Transport edge|Pass", "pkm/yr", 1e9, "ES|Transport|Pass|Aviation", "pkm/yr", 1e9, - "ES|Transport|Pass|Aviation|International", "pkm/yr", 1e9, - "ES|Transport|Pass|Aviation|Domestic", "pkm/yr", 1e9, + "ES|Transport|Bunkers|Pass|International Aviation", "pkm/yr", 1e9, + "ES|Transport|Pass|Domestic Aviation", "pkm/yr", 1e9, "ES|Transport|Pass|Road|Bus", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|Non-Motorized|Walking", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|Non-Motorized|Cycling", "pkm/yr", 1e9, + "ES|Transport|Pass|Non-motorized|Walk", "pkm/yr", 1e9, + "ES|Transport|Pass|Non-motorized|Cycle", "pkm/yr", 1e9, "ES|Transport|Pass|Rail|non-HSR", "pkm/yr", 1e9, "ES|Transport|Pass|Rail|HSR", "pkm/yr", 1e9, - "ES|Transport|Freight|w/o bunkers", "tkm/yr", 1e9, - "ES|Transport|Freight|International Shipping", "tkm/yr", 1e9, + "ES|Transport edge|Freight", "tkm/yr", 1e9, + "ES|Transport|Bunkers|Freight|International Shipping", "tkm/yr", 1e9, "ES|Transport|Freight|Road", "tkm/yr", 1e9, - "ES|Transport|Freight|Navigation", "tkm/yr", 1e9, + "ES|Transport|Freight|Domestic Shipping", "tkm/yr", 1e9, "ES|Transport|Freight|Rail", "tkm/yr", 1e9, "ES|Transport|Pass|Road|LDV", "pkm/yr", 1e9, "ES|Transport|Pass|Road|LDV|Four Wheelers", "pkm/yr", 1e9, "ES|Transport|Pass|Road|LDV|Two Wheelers", "pkm/yr", 1e9, - "ES|Transport|Pass|non-LDV", "pkm/yr", 1e9, "ES|Transport|Pass|Road|LDV|BEV", "pkm/yr", 1e9, "ES|Transport|Pass|Road|LDV|FCEV", "pkm/yr", 1e9, "ES|Transport|Pass|Road|LDV|Gases", "pkm/yr", 1e9, - "ES|Transport|Pass|Road|LDV|Hybrid Electric", "pkm/yr", 1e9, + "ES|Transport|Pass|Road|LDV|Hybrid electric", "pkm/yr", 1e9, "ES|Transport|Pass|Road|LDV|Liquids", "pkm/yr", 1e9, - "ES|Transport edge|Freight", "tkm/yr", 1e9, - "ES|Transport|Freight|Road|Electric", "pkm/yr", 1e9, + "ES|Transport|Freight with bunkers", "tkm/yr", 1e9, + "ES|Transport|Freight|Road|BEV", "pkm/yr", 1e9, "ES|Transport|Freight|Road|FCEV", "pkm/yr", 1e9, "ES|Transport|Freight|Road|Gases", "pkm/yr", 1e9, "ES|Transport|Freight|Road|Liquids", "pkm/yr", 1e9 From 4ef654f0c4552fd495de21e5b50318470a9e8a4a Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 29 Jul 2024 16:27:16 +0200 Subject: [PATCH 4/7] convert preprocessing to R script --- .../{preprocessing.Rmd => preprocessing.R} | 37 +++++-------------- 1 file changed, 10 insertions(+), 27 deletions(-) rename inst/compareScenarios/{preprocessing.Rmd => preprocessing.R} (94%) diff --git a/inst/compareScenarios/preprocessing.Rmd b/inst/compareScenarios/preprocessing.R similarity index 94% rename from inst/compareScenarios/preprocessing.Rmd rename to inst/compareScenarios/preprocessing.R index 58dc4f8..8cfe934 100644 --- a/inst/compareScenarios/preprocessing.Rmd +++ b/inst/compareScenarios/preprocessing.R @@ -1,11 +1,4 @@ -```{r load additional libraries} - -library(ggplot2) -library(dplyr) - -``` - -```{r reference models for historical} +# reference models for historical ---- # Sometimes it is necessary to choose a single model for the historical data, # e.g., calculating per capita variables. These reference models are defined here. @@ -15,12 +8,9 @@ histRefModel <- c( "GDP|PPP pCap" = "James_IMF" ) -options(mip.histRefModel = histRefModel) # nolint - -``` +options(mip.histRefModel = histRefModel) - -```{r load custom plotting function} +# load custom plotting function ---- showLinePlotsByVariable <- function( data, vars, xVar, scales = "free_y", @@ -109,9 +99,8 @@ showLinePlotsByVariable <- function( return(invisible(NULL)) } -``` +# calculate pCap variables ---- -```{r calcuate pCap variables} # For all variables in following table, add a new variable to data with the name # "OldName pCap". Calculate its value by OldValue * conversionFactor and set its unit to newUnit. # The new variable "OldName pCap" will be available in the plot sections. @@ -148,17 +137,16 @@ pCapVariables <- tribble( "ES|Transport|Freight|Road|Liquids", "pkm/yr", 1e9 ) -data %>% +dataPop <- data %>% filter(variable == "Population") %>% filter(scenario != "historical" | model == histRefModel["Population"]) %>% select(scenario, region, period, value) %>% mutate( population = value * 1e6, # unit originally is million, now is 1 value = NULL - ) -> -dataPop + ) -data %>% +dataPCap <- data %>% inner_join(pCapVariables, "variable") %>% left_join(dataPop, c("scenario", "region", "period")) %>% mutate( @@ -166,12 +154,7 @@ data %>% variable = paste0(variable, " pCap"), unit = newUnit, newUnit = NULL, conversionFactor = NULL, population = NULL - ) -> -dataPCap - -data %>% - bind_rows(dataPCap) -> -data -``` - + ) +data <- data %>% + bind_rows(dataPCap) From 2f58ad755a1dd1fbaf7ca1fbaf59ae4a726f1804 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 29 Jul 2024 17:21:13 +0200 Subject: [PATCH 5/7] fix project reference in transportCompareScenarios.R --- R/transportCompareScenarios.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/transportCompareScenarios.R b/R/transportCompareScenarios.R index 59bd2b4..6e7ad39 100644 --- a/R/transportCompareScenarios.R +++ b/R/transportCompareScenarios.R @@ -21,7 +21,7 @@ transportCompareScenarios <- function( outputFormat = "PDF") { piamPlotComparison::compareScenarios( - projectLibrary = "edgeTransport", + projectLibrary = "reporttransport", mifScen = mifScen, mifHist = mifHist, outputFormat = outputFormat, From 3339066a3b15e6e54f47d6fbebf0ce790df4a7dc Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 30 Jul 2024 16:18:01 +0200 Subject: [PATCH 6/7] bring back deleted notebooks --- .../csEDGET_01_energy_demand_UE.Rmd | 62 ++++++++ .../csEDGET_EndogenousCostAnalytics.Rmd | 19 +++ .../csEDGET_NAV_scenario_evaluation.Rmd | 147 ++++++++++++++++++ 3 files changed, 228 insertions(+) create mode 100644 inst/compareScenarios/csEDGET_01_energy_demand_UE.Rmd create mode 100644 inst/compareScenarios/csEDGET_EndogenousCostAnalytics.Rmd create mode 100644 inst/compareScenarios/csEDGET_NAV_scenario_evaluation.Rmd diff --git a/inst/compareScenarios/csEDGET_01_energy_demand_UE.Rmd b/inst/compareScenarios/csEDGET_01_energy_demand_UE.Rmd new file mode 100644 index 0000000..5f8a171 --- /dev/null +++ b/inst/compareScenarios/csEDGET_01_energy_demand_UE.Rmd @@ -0,0 +1,62 @@ +# Useful Energy Demand + + +## Useful Energy by carrier + +### Total +```{r} +items <- c( + "UE|Transport|Electricity", + "UE|Transport|Hydrogen", + "UE|Transport|Liquids" + ) + +walk(items, showLinePlots, data = data) +``` + +### Road +```{r} +items <- c( + "UE|Transport|Road|Electricity", + "UE|Transport|Road|Liquids", + "UE|Transport|Road|Hydrogen", + ) + +walk(items, showLinePlots, data = data) +``` + +### Passenger +```{r} +items <- c( + "UE|Transport|Pass with bunkers|Electricity", + "UE|Transport|Pass with bunkers|Hydrogen", + "UE|Transport|Pass with bunkers|Liquids" + ) + +walk(items, showLinePlots, data = data) +``` + +### Passenger +```{r} +items <- c( + "UE|Transport|Pass|Electricity", + "UE|Transport|Pass|Hydrogen", + "UE|Transport|Pass|Liquids" + ) +walk(items, showLinePlots, data = data) +``` + + +## Useful Energy by transport modes + +### Passenger +```{r} +items <- c( + "UE|Transport|Pass|Rail|HSR", + "UE|Transport|Pass|Rail|non-HSR", + "UE|Transport|Pass|Road|Bus", + "UE|Transport|Pass|Road|LDV|Four Wheelers", + "UE|Transport|Pass|Road|LDV|Two Wheelers" + ) +walk(items, showLinePlots, data = data) +``` diff --git a/inst/compareScenarios/csEDGET_EndogenousCostAnalytics.Rmd b/inst/compareScenarios/csEDGET_EndogenousCostAnalytics.Rmd new file mode 100644 index 0000000..e9bd720 --- /dev/null +++ b/inst/compareScenarios/csEDGET_EndogenousCostAnalytics.Rmd @@ -0,0 +1,19 @@ +# Endogenous Cost Analytics + +```{r} +data <- as.data.table(data) +plotData <- data[grepl("(Policy mask.*|rawEndogenousCost.*|updatedEndogenousCost.*"), variable] + +# Convert year to a factor for better plotting +plotData$period <- as.factor(plotData$period) + +# Create the line plot with facets +ggplot(plotData, aes(x = period, y = value, group = variable, color = variable)) + + geom_line() + + facet_grid(region ~ vehicleType + technology, scales = "free_y") + + labs(title = "Endogenous Cost", + x = "period", + y = "value", + color = "variable") + + theme_minimal() +``` diff --git a/inst/compareScenarios/csEDGET_NAV_scenario_evaluation.Rmd b/inst/compareScenarios/csEDGET_NAV_scenario_evaluation.Rmd new file mode 100644 index 0000000..28e6c90 --- /dev/null +++ b/inst/compareScenarios/csEDGET_NAV_scenario_evaluation.Rmd @@ -0,0 +1,147 @@ +# Evaluation Sheet NAVIGATE scenarios +```{r setting} +data <- as.data.table(data) +Baseline <- "Mix1 SSP2" +``` + +```{r Calculate ES reduction rate for Passenger Cars compared to Baseline for all scenarios} +targetyear <- 2050 +ES_data_base <- data[scenario == Baseline & variable == "ES|Transport|Pass|Road|LDV|Four Wheelers" & period == targetyear][, scenario := NULL] +setnames(ES_data_base, "value", "ES_base") +red_ES_pass <- merge(ES_data_base, data[!scenario == Baseline & variable == "ES|Transport|Pass|Road|LDV|Four Wheelers" & period == targetyear], all = TRUE) +red_ES_pass[, reduction_rate := round((value/ES_base)*100-100,2)] +red_ES_pass <- red_ES_pass[, c("scenario", "region", "reduction_rate")] +``` + +```{r Plot ES reduction rate for Passenger Cars compared to Baseline for all scenarios} +ggplot(red_ES_pass, aes(x = scenario, y = reduction_rate)) + + geom_bar(stat="identity") + + geom_label(aes(label = reduction_rate), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("ES reduction rate for Passenger Cars compared to Baseline for all scenarios")) + +``` + +```{r Calculate ES reduction rate for Freight compared to Baseline for all scenarios} +targetyear <- 2050 +ES_data_base <- data[scenario == Baseline & grepl("ES\\|Transport\\|Freight\\|(Road|Rail)$", variable) & period == targetyear] +ES_data_base <- ES_data_base[, .(ES_Freight_land_base = sum(value)), by = "region"] +ES_data <- data[!scenario %in% c(Baseline, "historical") & grepl("ES\\|Transport\\|Freight\\|(Road|Rail)$", variable) & period == targetyear] +ES_data <- ES_data[, .(ES_Freight_land = sum(value)), by = c("scenario", "region")] +ES_data <- merge(ES_data_base, ES_data, all = TRUE) +ES_data[, reduction_rate := round((ES_Freight_land/ES_Freight_land_base)*100-100)] +ES_data <- ES_data[, c("scenario", "region", "reduction_rate")] +``` + +```{r Plot ES reduction rate for Freight compared to Baseline for all scenarios} +ggplot(ES_data, aes(x = scenario, y = reduction_rate)) + + geom_bar(stat="identity") + + geom_label(aes(label = reduction_rate), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for land-based freight transport compared to Baseline for all scenarios")) + + facet_wrap(~region, nrow = 5,scales = "free") +``` + +```{r Calculate ES shares for all scenarios} +targetyear <- 2050 +Pass_land <- c("ES|Transport|Pass|Rail", "ES|Transport|Pass|Road|LDV", "ES|Transport|Pass|Road|Bus", "ES|Transport|Pass|Non-motorized") +Pass_land_public <- c("ES|Transport|Pass|Road|Bus", "ES|Transport|Pass|Rail") +ES_data_land <- data[!scenario %in% c(Baseline, "historical") & variable %in% Pass_land & period == targetyear] +ES_data_land <- ES_data_land[, .(ES_Pass_land = sum(value)), by = c("region", "scenario")] +ES_data_public <- data[!scenario %in% c(Baseline, "historical") & variable %in% Pass_land_public & period == targetyear] +ES_data_public <- ES_data_public[, .(ES_Pass_public = sum(value)), by = c("region", "scenario")] +ES_data_nonmot <- data[!scenario %in% c(Baseline, "historical") & variable == "ES|Transport|Pass|Non-motorized" & period == targetyear] +ES_data_nonmot <- ES_data_nonmot[, .(ES_Pass_nonmot = sum(value)), by = c("region", "scenario")] +ES_data <- merge(ES_data_land, ES_data_public, by = c("region", "scenario")) +ES_data <- merge(ES_data, ES_data_nonmot, by = c("region", "scenario")) +ES_data[, share_public := round(ES_Pass_public/ES_Pass_land*100,2)][, ES_Pass_public := NULL] +ES_data[, share_nonmot := round(ES_Pass_nonmot/ES_Pass_land*100,2)][, ES_Pass_land := NULL][, ES_Pass_nonmot := NULL] +``` + +```{r Plot ES shares nonmot for all scenarios} +ggplot(ES_data, aes(x = scenario, y = share_nonmot)) + + geom_bar(stat="identity") + + geom_label(aes(label = share_nonmot), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Share nonmot [%]"), title = paste0("Share of active modes in Passenger land-based transport for all scenarios")) + + facet_wrap(~region, nrow = 5, scales = "free") +``` + +```{r Plot ES shares public for all scenarios} +ggplot(ES_data, aes(x = scenario, y = share_public)) + + geom_bar(stat="identity") + + geom_label(aes(label = share_public), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Share public transport [%]"), title = paste0("Share of public modes in Passenger land-based transport for all scenarios")) + + facet_wrap(~region, nrow = 5, scales = "free") +``` + +```{r Calculate ES reduction rate for Aviation compared to Baseline for all scenarios} +targetyear <- 2050 +ES_data_base_dom <- data[scenario == Baseline & variable == "ES|Transport|Pass|Domestic Aviation" & period == targetyear] +ES_data_base_int <- data[scenario == Baseline & variable == "ES|Transport|Bunkers|Pass|International Aviation" & period == targetyear] +setnames(ES_data_base_dom, "value", "ES_dom_base") +setnames(ES_data_base_int, "value", "ES_int_base") +ES_data_base <- merge(ES_data_base_dom[, c("region", "ES_dom_base")], ES_data_base_int[, c("region", "ES_int_base")]) + +ES_data_dom <- data[!scenario %in% c(Baseline, "historical") & variable == "ES|Transport|Pass|Domestic Aviation" & period == targetyear] +ES_data_int <- data[!scenario %in% c(Baseline, "historical") & variable == "ES|Transport|Bunkers|Pass|International Aviation" & period == targetyear] +setnames(ES_data_dom, "value", "ES_dom") +setnames(ES_data_int, "value", "ES_int") +ES_data <- merge(ES_data_dom[, c("region", "ES_dom", "scenario")], ES_data_int[, c("region", "ES_int", "scenario")]) + +ES_data <- merge(ES_data_base, ES_data, all = TRUE) +ES_data[, reduction_rate_int := round((ES_int/ES_int_base)*100-100)] +ES_data[, reduction_rate_dom := round((ES_dom/ES_dom_base)*100-100)] +ES_data <- ES_data[, c("scenario", "region", "reduction_rate_int", "reduction_rate_dom")] +``` + +```{r Plot ES reduction rate for Aviation dom compared to Baseline for all scenarios} +ggplot(ES_data, aes(x = scenario, y = reduction_rate_dom)) + + geom_bar(stat="identity") + + geom_label(aes(label = reduction_rate_dom), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for domestic passenger avitaion compared to Baseline for all scenarios")) + + facet_wrap(~region, nrow = 5, scales = "free") +``` + +```{r Plot ES reduction rate for Aviation int compared to Baseline for all scenarios} +ggplot(ES_data, aes(x = scenario, y = reduction_rate_int)) + + geom_bar(stat="identity") + + geom_label(aes(label = reduction_rate_int), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for international passenger avitaion compared to Baseline for all scenarios")) + + facet_wrap(~region, nrow = 5, scales = "free") +``` + + + +```{r Calculate ES reduction rate for Freight shipping compared to Baseline for all scenarios} +targetyear <- 2050 +ES_data_base <- data[scenario == Baseline & grepl("ES\\|Transport\\|Freight\\|(International Shipping|Domestic Shipping)$", variable) & period == targetyear] +ES_data_base <- ES_data_base[, .(ES_Freight_shipping_base = sum(value)), by = "region"] +ES_data <- data[!scenario %in% c(Baseline, "historical") & grepl("ES\\|Transport\\|Freight\\|(International Shipping|Domestic Shipping)$", variable) & period == targetyear] +ES_data <- ES_data[, .(ES_Freight_shipping = sum(value)), by = c("scenario", "region")] +ES_data <- merge(ES_data_base, ES_data, all = TRUE) +ES_data[, reduction_rate := round((ES_Freight_shipping/ES_Freight_shipping_base)*100-100)] +ES_data <- ES_data[, c("scenario", "region", "reduction_rate")] +``` + +```{r Plot ES reduction rate for Freight shipping compared to Baseline for all scenarios} +ggplot(ES_data, aes(x = scenario, y = reduction_rate)) + + geom_bar(stat="identity") + + geom_label(aes(label = reduction_rate), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Cange in ES for freight shipping compared to Baseline for all scenarios")) + + facet_wrap(~region, nrow = 5, scales = "free") +``` + +```{r Calculate Share of H2 in aviation (international+domestic) for all scenarios} +targetyear <- 2070 +FE_data_h2 <- data[!scenario %in% c(Baseline, "historical") & grepl("FE\\|Transport\\|Pass\\|Aviation\\|Domestic\\|Hydrogen$", variable) & period == targetyear] +setnames(FE_data_h2, "value", "FE_h2") +FE_data <- data[!scenario %in% c(Baseline, "historical") & grepl("FE\\|Transport\\|Pass\\|Aviation$", variable) & period == targetyear] +FE_data <- merge(FE_data_h2[, c("region", "scenario", "FE_h2")], FE_data[, c("region", "scenario", "value")]) +FE_data[, shareh2 := round((FE_h2/value)*100)] +FE_data <- FE_data[, c("scenario", "region", "shareh2")] +``` + +```{r Plot Share of H2 in aviation (international+domestic) for all scenarios} +ggplot(FE_data, aes(x = scenario, y = shareh2)) + + geom_bar(stat="identity") + + geom_label(aes(label = shareh2), vjust = 0.5, colour = "black") + + labs(x = "Scenario", y = paste0("Change [%]"), title = paste0("Share of H2 in aviation (international+domestic) for all scenarios")) + + facet_wrap(~region, nrow = 5, scales = "free") +``` From b9c118549b14c9cab1e543eedbbf17e8172933e4 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 30 Jul 2024 16:38:12 +0200 Subject: [PATCH 7/7] run buildLibrary --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index a54b5ad..ec48bea 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '239196' +ValidationKey: '239208' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 3fc2b04..393ab15 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -3,7 +3,7 @@ message: If you use this software, please cite it using the metadata from this f type: software title: 'reporttransport: Reporting package for edgeTransport' version: 0.0.12 -date-released: '2024-07-29' +date-released: '2024-07-30' abstract: This package contains edgeTransport-specific routines to report model results. The main functionality is to generate transport reporting variables in MIF format from a given edgeTransport model run folder or REMIND input data. diff --git a/DESCRIPTION b/DESCRIPTION index 294dc65..6754f4f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: reporttransport Title: Reporting package for edgeTransport Version: 0.0.12 -Date: 2024-07-29 +Date: 2024-07-30 Authors@R: person("Johanna", "Hoppe", , "johanna.hoppe@pik-potsdam.de", role = c("aut", "cre")) Description: This package contains edgeTransport-specific routines to