add heat map plots to calibration reporting

scripts/output/single/notebook_templates/cesCalibrationReport.Rmd

@@ -1,5 +1,5 @@
 ---
-title: "CES Calibration Report"
+title: "`r params$doctitle`"
 date: "`r format(Sys.Date())`"
 output:
   pdf_document:
@@ -9,23 +9,20 @@ output:
   html_document: default
 geometry: "a4paper, landscape, left = 0.5cm, right = 0.5cm, top = 0.5cm, bottom = 0.5cm, footnotesep = 0.0cm, footskip = 0.1cm"
 params:
+  doctitle: "CES Calibration Report"
   cal: "CES_calibration.csv"
   gdx: "fulldata.gdx"
   outputdir: "."
+  lastiteration: null 
   warning: false
   message: false
 ---
 
 ```{r setup, include = FALSE}
+library(tidyverse)
 library(quitte)
-library(lucode2)
 library(colorspace)
 library(gdx)
-library(ggplot2)
-library(gridExtra)
-library(grid)
-library(dplyr)
-library(knitr)
 
 knitr::opts_chunk$set(
   echo = FALSE,
@@ -35,11 +32,13 @@ knitr::opts_chunk$set(
 )
 ```
 
+## Line Plots
+
 ```{r load data}
 gdx <- file.path(params$outputdir, params$gdx)
 
 ces <- read.table(file.path(params$outputdir, params$cal),
-  header = TRUE, sep = ",", quote = "\""
+                  header = TRUE, sep = ",", quote = "\""
 ) %>%
   as.data.frame()
 
@@ -56,7 +55,7 @@ itr <- sort(as.double(setdiff(
 )))
 
 colour <- c("#fc0000", "#000000", diverging_hcl(length(itr),
-  palette = "Purple-Green"
+                                                palette = "Purple-Green"
 ))
 names(colour) <- c("origin", "target", itr)
 
@@ -71,43 +70,41 @@ ces <- ces %>%
 ppf_29 <- readGDX(gdx, "ppf_29")
 pf_eff_target_dyn37 <- readGDX(gdx, "pf_eff_target_dyn37")
 ces <- ces %>% filter(.data$pf %in% c(ppf_29, pf_eff_target_dyn37))
+
+last_iteration <- max(itr)
 ```
 
 ## Quantity Outliers
-```{r quantity outliers}
-quant_outliers <- function(df, threshold, iter_max) {
-  
-  eps <- 1e-2
 
-  target_period_items <- df %>%
-    filter(iteration == "target") %>%
-    select(t, pf) %>%
-    unique()
-
-  tmp <- left_join(target_period_items, df, by = c("pf", "t")) %>%
-    filter(
-      .data$variable == "quantity",
-      .data$iteration %in% c("target", iter_max),
-      .data$t <= 2100
-    ) %>%
-    group_by(t, regi, variable, pf) %>%
-    filter(abs((value[iteration == "target"] - value[iteration == iter_max]) /
-      value[iteration == "target"]) > threshold) %>%
-    ungroup() %>%
-    filter(.data$value > eps) %>%
-    select("regi", "pf", "t") %>%
-    unique() %>%
-    group_by(regi, pf) %>%
-    mutate("period" = paste(.data$t, collapse = ", ")) %>%
-    select(-"t") %>%
-    unique() %>%
-    ungroup() %>%
-    arrange(regi, pf, period)
-
-  return(tmp)
-}
+```{r quantity outliers}
+threshold <- 0.15
+eps <- 1e-2
+
+target_period_items <- ces %>%
+  filter(iteration == "target") %>%
+  select(t, pf) %>%
+  unique()
+
+df <- left_join(target_period_items, ces, by = c("pf", "t")) %>%
+  filter(
+    .data$variable == "quantity",
+    .data$iteration %in% c("target", last_iteration),
+    .data$t <= 2100
+  ) %>%
+  group_by(t, regi, variable, pf) %>%
+  filter(abs((value[iteration == "target"] - value[iteration == last_iteration]) /
+               value[iteration == "target"]) > threshold) %>%
+  ungroup() %>%
+  filter(.data$value > eps) %>%
+  select("regi", "pf", "t") %>%
+  unique() %>%
+  group_by(regi, pf) %>%
+  mutate("period" = paste(.data$t, collapse = ", ")) %>%
+  select(-"t") %>%
+  unique() %>%
+  ungroup() %>%
+  arrange(regi, pf, period)
 
-df <- quant_outliers(ces, threshold = 0.15, iter_max = max(itr))
 knitr::kable(df, caption = "Quantities diverge by more than 15%")
 ```
 
@@ -116,30 +113,30 @@ knitr::kable(df, caption = "Quantities diverge by more than 15%")
 ## Price Outliers
 
 ```{r price outliers}
-price_outliers <- function(df, threshold, iter_max) {
-  tmp <- df %>%
-    filter(
-      .data$variable == "price",
-      .data$iteration %in% c(iter_max),
-      .data$pf != "inco",
-      .data$t <= 2100,
-      .data$value < threshold
-    ) %>%
-    select("regi", "pf", "t") %>%
-    group_by(regi, pf) %>%
-    filter(length(.data$t) > 1) %>%
-    mutate("period" = paste(.data$t, collapse = ", ")) %>%
-    select(-"t") %>%
-    unique() %>%
-    ungroup() %>%
-    arrange(regi, pf, period)
-  return(tmp)
-}
+threshold <- 0.01
+
+df <- ces %>%
+  filter(
+    .data$variable == "price",
+    .data$iteration %in% c(last_iteration),
+    .data$pf != "inco",
+    .data$t <= 2100,
+    .data$value < threshold
+  ) %>%
+  select("regi", "pf", "t") %>%
+  group_by(regi, pf) %>%
+  filter(length(.data$t) > 1) %>%
+  mutate("period" = paste(.data$t, collapse = ", ")) %>%
+  select(-"t") %>%
+  unique() %>%
+  ungroup() %>%
+  arrange(regi, pf, period)
 
-df <- price_outliers(ces, threshold = 0.01, iter_max = max(itr))
 knitr::kable(df, caption = "Prices below 0.01")
 ```
 
+\newpage
+
 ## Line Plots
 
 \newpage
@@ -155,7 +152,6 @@ structure <- sort(intersect(in_set, getColValues(ces, "pf")))
 for (s in levels(ces$scenario)) {
   for (r in unique(ces[ces$scenario == s, ][["regi"]])) {
     # plot quantities
-
     df <- ces %>%
       filter(
         .data$scenario == s,
@@ -164,7 +160,7 @@ for (s in levels(ces$scenario)) {
         .data$variable == "quantity"
       ) %>%
       order.levels(pf = structure)
-
+    
     p <- ggplot(
       df,
       aes(
@@ -180,9 +176,9 @@ for (s in levels(ces$scenario)) {
       ggtitle(paste("quantities", r, s)) +
       theme_bw() +
       theme(text = element_text(size = 8))
-
+    
     plot(p)
-
+    
     # plot prices
     df <- ces %>%
       filter(
@@ -192,7 +188,7 @@ for (s in levels(ces$scenario)) {
         .data$variable == "price"
       ) %>%
       order.levels(pf = structure)
-
+    
     p <- ggplot(df, aes(
       x = t, y = value, colour = iteration,
       linetype = iteration
@@ -205,9 +201,9 @@ for (s in levels(ces$scenario)) {
       ggtitle(paste("prices", r, s)) +
       theme_bw() +
       theme(text = element_text(size = 8))
-
+    
     plot(p)
-
+    
     # plot efficiencies
     df <- ces %>%
       filter(
@@ -233,9 +229,9 @@ for (s in levels(ces$scenario)) {
       ggtitle(paste("total efficiency (1 = iteration 1)", r, s)) +
       theme_bw() +
       theme(text = element_text(size = 8))
-
+    
     plot(p)
-
+    
     # plot delta_cap
     if ("vm_deltaCap" %in% unique(ces$variable)) {
       df <- ces %>%
@@ -245,10 +241,10 @@ for (s in levels(ces$scenario)) {
           .data$t >= 1980,
           .data$regi == r,
           .data$variable == "vm_deltaCap",
-          pf %in% .pf$TE
+          pf %in% te
         ) %>%
         order.levels(pf = te)
-
+      
       p <- ggplot(df, aes(
         x = t,
         y = value,
@@ -264,9 +260,10 @@ for (s in levels(ces$scenario)) {
         ggtitle(paste("vm_deltaCap", r, s)) +
         theme_bw() +
         theme(text = element_text(size = 8))
-
+      
       plot(p)
     }
   }
 }
 ```
+

scripts/output/single/reportCEScalib.R

@@ -13,10 +13,13 @@ if (!exists("source_include")) {
   readArgs("outputdir")
 }
 
-
-yamlParams <- list(outputdir = normalizePath(outputdir, mustWork = TRUE))
 scenario <- lucode2::getScenNames(outputdir)
 
+yamlParams <- list(
+  outputdir = normalizePath(outputdir, mustWork = TRUE),
+  doctitle = paste0("CES Calibration Report ", scenario)
+)
+
 rmarkdown::render(
   file.path("scripts", "output", "single", "notebook_templates", "cesCalibrationReport.Rmd"),
   output_dir = outputdir,