In pik-piam/limes: The liMES R package

knitr::opts_chunk$set(
  echo = FALSE,
  error = TRUE,
  message = FALSE,
  warning = params$warning,
  fig.width = params$figWidth,
  fig.height = params$figHeight,
  fig.pos = "H")

# Hack to use the same fig.width and fig.height as described in previous chunk
# for chunks in RStudio Notebook mode.
if (interactive()) {
  insertExprAtStartOfFun <- function(fun, funName, env, expr) {
    body(env[[funName]]) <- call("{", expr, body(fun))
  }
  fn <- ".rs.setNotebookGraphicsOption"
  envToolsRstudio <- as.environment("tools:rstudio")
  if (!exists(".old.rs.setNotebookGraphicsOption"))
    oldRsSetNotebookGraphicsOption <- envToolsRstudio[[fn]]
  insertExprAtStartOfFun(
    oldRsSetNotebookGraphicsOption,
    fn,
    envToolsRstudio,
    rlang::expr({
      width <- !!knitr::opts_chunk$get()$fig.width
      height <- !!knitr::opts_chunk$get()$fig.height
      units <- "in"
    })
  )
}

# 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 compareScenariosLimes()
# may cause "Undefined control sequence" errors in LaTeX.
try(unloadNamespace("kableExtra"), silent = TRUE)

library(gridExtra) # nolint
options(tidyverse.quiet = TRUE) # nolint
library(tidyverse) # nolint
library(kableExtra) # nolint
library(quitte) # nolint
library(mip) # nolint
library(limes) # nolint

if (!is.null(params$cfgScen)) {
  loadCfg <- function(path) {
    cfg <- yaml::read_yaml(path)
    return(cfg)
  }
  cfgs <-
    tibble(path = unname(params$cfgScen)) %>%
    rowid_to_column("fileid") %>%
    mutate(cfg = map(path, loadCfg)) %>%
    unnest(cfg) %>%
    mutate(
      name = names(cfg),
      value = unname(cfg),
      cfg = NULL)
  cfgGms <-
    cfgs %>%
    filter(name == "gms") %>%
    unnest(value) %>%
    mutate(name = names(value))
  cfgTopLevel <-
    cfgs %>%
    filter(name != "gms")
  rm(cfgs)
}
if (!is.null(params$cfgDefault)) {
  env <- new.env()
  source(params$cfgDefault, local = env, echo = FALSE) # nolint
  cfgDefault <- env$cfg
}

# Read *.mif-files as nested tibble.
dataScenNested <-
  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))
# Add column character column "newScenarioName",
# either with contents of params$mifScenNames or copy names from column scenario.
if (is.null(params$mifScenNames)) {
  dataScenNested <-
    dataScenNested %>%
    mutate(newScenarioName = as.character(scenario))
} else {
  dataScenNested <-
    dataScenNested %>%
    left_join(
      tibble(
        fileid = seq_along(params$mifScen),
        newScenarioName = params$mifScenNames),
      by = "fileid")
}
# Check for duplicated scenario names.
if (anyDuplicated(dataScenNested$newScenarioName)) {
  warning("There are duplicated scenario names. They will be renamed.")
  dataScenNested <-
    dataScenNested %>%
    mutate(newScenarioName = make.unique(newScenarioName))
}
# Retrieve data for reference table to be shown at the beginning of the document.
fileReference <-
  dataScenNested %>%
  select(fileid, path, scenario, newScenarioName)

# Apply renaming of scenario, unnest, and select only relevant columns.
dataScen <-
  dataScenNested %>%
  mutate(scenario = factor(newScenarioName, levels = newScenarioName)) %>%
  unnest(data) %>%
  select(model, scenario, region, variable, unit, period, value)

# 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 <- vapply(scenarioColors, lightenColor, rgb(0, 0, 0), by = 0.5)

largeRegions <- function(df) {
  largeRegionsVec <- c(
  params$mainReg,
  "EUETS",
  "DEU",
  "FRA",
  "GBR",
  "ESP",
  "ITA",
  "POL",
  "NLD",
  "SWE",
  "NOR",
  "BEL",
  "AUT"
)
  return(df %>% filter(region %in% largeRegionsVec))
}

removeAggRegions <- function(df, except = NULL){
  regsToRemove <- 
    c("EU27",
      "EUETS",
      "EUETS_nonDE",
      "World")
  return(df %>%
           filter(! region %in% setdiff(regsToRemove,
                                        except)
                  )
         )
}

# Filter years and NA.
dataScen <-
  dataScen %>%
  filter(period %in% params$yearsScen)

# Combine into one data frame and remove old.
data <- dataScen
rm(dataScen, dataScenNested)

# Filter regions.
if (!is.null(params$reg)) {
  data <-
    data %>%
    filter(region %in% params$reg) %>%
    droplevels()
}

data <- as.quitte(data)

# Set global variables for use in plotting.
options(mip.mainReg = params$mainReg) # nolint
options(mip.yearsBarPlot = params$yearsBarPlot) # nolint

matches <-
  dir() %>%
  str_match("^cs2_([0-9]+).+\\.Rmd$")
availableSections <-
  tibble(
    files = matches[, 1],
    nums = as.numeric(matches[, 2])
  ) %>%
  drop_na() %>%
  arrange(files)
if (length(params$sections) == 1 && params$sections == "all") {
  sectionPaths <- availableSections$files
} else if (is.numeric(params$sections)) {
  sectionPaths <-
    tibble(nums = params$sections) %>%
    left_join(availableSections, by = "nums") %>%
    drop_na() %>%
    pull(files)
} else {
  if (length(params$sections) > 0) {
    sectionPaths <- paste0("cs2_", params$sections, ".Rmd")
  } else {
    sectionPaths <- character(0)
  }
}

# Restrictions on heating configuration
heatingCfg <- 
  cfgGms %>% 
  filter(name == "heating") %>%
  pull("value") %>%
  unlist()

if (length(heatingCfg) > 0){
  if (! "fullDH" %in% heatingCfg){
    sectionPaths <-
      setdiff(sectionPaths, "cs2_04_heating.Rmd")
  }
}

# CLICK "RUN ALL CHUNKS ABOVE" HERE TO PREPARE THE ENVIRONMENT

pik-piam/limes documentation built on May 1, 2024, 6:17 a.m.