Release v0.1.0

.Rbuildignore

@@ -3,3 +3,9 @@
 ^Makefile$
 ^workflow$
 ^.*CITATION.cff$
+^.*\.Rproj$
+^\.Rproj\.user$
+^.lintr$
+^tests/.lintr$
+^codecov\.yml$
+^\.github$

.buildlibrary

@@ -1,7 +1,10 @@
-ValidationKey: '39524'
+ValidationKey: '198020'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'
-AcceptedNotes: ~
-allowLinterWarnings: no
+AcceptedNotes:
+- no visible binding for global variable
+- 'Found the following hidden files and directories:'
+allowLinterWarnings: yes
+enforceVersionUpdate: no

.github/workflows/check.yaml

@@ -49,6 +49,11 @@ jobs:
         shell: Rscript {0}
         run: lucode2:::validkey(stopIfInvalid = TRUE)
 
+      - name: Verify that lucode2::buildLibrary was successful
+        if: github.event_name == 'pull_request'
+        shell: Rscript {0}
+        run: lucode2:::isVersionUpdated()
+
       - name: Checks
         shell: Rscript {0}
         run: |

.gitignore

@@ -0,0 +1,6 @@
+*.Rproj.user
+*.Rhistory
+*.RData
+*.Ruserdata
+*.html
+.Rproj.user

.lintr

@@ -0,0 +1,2 @@
+linters: lucode2::lintrRules()
+encoding: "UTF-8"

.pre-commit-config.yaml

@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9025
+    rev: v0.4.0
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

CITATION.cff

@@ -2,14 +2,16 @@ cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
 title: 'piamValidation: Validation Tools for PIK-PIAM'
-version: 0.0.2
-date-released: '2024-02-09'
+version: 0.1.0
+date-released: '2024-03-20'
 abstract: The piamValidation package provides validation tools for the Potsdam Integrated
   Assessment Modelling environment.
 authors:
 - family-names: Weigmann
   given-names: Pascal
   email: [email protected]
+- family-names: Richters
+  given-names: Oliver
 license: LGPL-3.0
 repository-code: https://github.com/pik-piam/piamValidation
 

DESCRIPTION

@@ -1,14 +1,30 @@
 Type: Package
 Package: piamValidation
 Title: Validation Tools for PIK-PIAM
-Version: 0.0.2
-Date: 2024-02-09
+Version: 0.1.0
+Date: 2024-03-20
 Authors@R:
-    person("Pascal", "Weigmann", , "[email protected]", role = c("aut", "cre"))
+    c(person("Pascal", "Weigmann",, "[email protected]", role = c("aut", "cre")),
+      person("Oliver", "Richters",, role = "aut"))
 Description: The piamValidation package provides validation tools for the Potsdam Integrated Assessment Modelling environment.
 License: LGPL-3
 URL: https://github.com/pik-piam/piamValidation
+Imports:
+    devtools,
+    dplyr (>= 1.1.1),
+    ggplot2,
+    ggthemes,
+    htmltools,
+    knitr,
+    plotly,
+    quitte (>= 0.3123.0),
+    readxl,
+    tibble,
+    tidyr
 Suggests:
-    testthat
+    testthat,
+    remind2
 Encoding: UTF-8
 RoxygenNote: 7.3.1
+Depends: 
+    R (>= 2.10)

NAMESPACE

@@ -1,2 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
+export(validateScenarios)
+export(validationHeatmap)
+export(validationPass)
+import(ggplot2)
+importFrom(dplyr,"%>%")
+importFrom(dplyr,filter)
+importFrom(dplyr,group_by)
+importFrom(dplyr,mutate)
+importFrom(dplyr,select)
+importFrom(dplyr,summarise)
+importFrom(ggthemes,theme_tufte)
+importFrom(plotly,ggplotly)
+importFrom(readxl,excel_sheets)
+importFrom(readxl,read_excel)
+importFrom(utils,read.csv2)

R/appendTooltips.R

@@ -0,0 +1,96 @@
+# construct tooltips for interactive plots
+appendTooltips <- function(df) {
+
+  df$text <- NA
+  region <- period <- NULL
+
+  # historic - relative
+  df[df$category == "historic" & df$metric == "relative", ] <-
+    df[df$category == "historic" & df$metric == "relative", ] %>%
+    mutate(text = paste0(.data$region, "\n",
+                         .data$period, "\n",
+                         "Value: ", round(value, 2), "\n",
+                         "Ref_Value: ", round(ref_value, 2), "\n",
+                         "Ref_Source: ", ref_model, "\n",
+                         "Deviation:", round(check_value)*100, "%\n",
+                         "Thresholds (yel/red): \n",
+                         paste0("Max: ", max_yel*100, "% / ", max_red*100, "%")
+    )
+    )
+
+  # historic - difference
+  df[df$category == "historic" & df$metric == "difference", ] <-
+    df[df$category == "historic" & df$metric == "difference", ] %>%
+    mutate(text = paste0(region, "\n",
+                         period, "\n",
+                         "Value: ", round(value, 2), "\n",
+                         "Ref_Value: ", round(ref_value, 2), "\n",
+                         "Ref_Source: ", ref_model, "\n",
+                         "Thresholds (yel/red): \n",
+                         "Max: ", max_yel, " / ", max_red
+    )
+    )
+
+  # scenario - relative
+  df[df$category == "scenario" & df$metric == "relative", ] <-
+    df[df$category == "scenario" & df$metric == "relative", ] %>%
+    mutate(text = paste0(region, "\n",
+                         period, "\n",
+                         ifelse(!is.na(ref_model),
+                                paste("Model:", model, "\n"),
+                                ""),
+                         "Value: ", round(value, 2), "\n",
+                         "Ref ", ifelse(!is.na(ref_period),
+                                               paste("Period:", ref_period),
+                                        ifelse(!is.na(ref_scenario),
+                                               paste("Scenario:", ref_scenario),
+                                               paste("Model:", ref_model))
+                                               ), "\n",
+                         "Ref Value: ", round(ref_value, 2), "\n",
+                         "Rel Deviation: ", round(check_value, 2)*100, "% \n",
+                         "Thresholds (yel/red): \n",
+                         "Min: ", min_yel*100, "% / ", min_red*100,"% \n",
+                         "Max: ", max_yel*100, "% / ", max_red*100, "%")
+           )
+
+  # scenario - difference
+  df[df$category == "scenario" & df$metric == "difference", ] <-
+    df[df$category == "scenario" & df$metric == "difference", ] %>%
+    mutate(text = paste0(region, "\n",
+                         period, "\n",
+                         "Value: ", round(value, 2), "\n",
+                         "Ref Value: ", round(ref_value, 2), "\n",
+                         "Difference: ", round(check_value, 2), "\n",
+                         "Thresholds (yel/red): \n",
+                         "Min: ", min_yel, " / ", min_red,"\n",
+                         "Max: ", max_yel, " / ", max_red
+    )
+    )
+
+  # scenario - absolute
+  df[df$category == "scenario" & df$metric == "absolute", ] <-
+    df[df$category == "scenario" & df$metric == "absolute", ] %>%
+    mutate(text = paste0(region, "\n",
+                         period, "\n",
+                         "Value: ", round(value, 2), "\n",
+                         "Thresholds (yel/red): \n",
+                         "Min: ", min_yel, " / ", min_red,"\n",
+                         "Max: ", max_yel, " / ", max_red
+                         )
+           )
+
+  # scenario - growthrate
+  df[df$category == "scenario" & df$metric == "growthrate", ] <-
+    df[df$category == "scenario" & df$metric == "growthrate", ] %>%
+    mutate(text = paste0(region, "\n",
+                         period, "\n",
+                         "Avg. growth/yr: ", round(check_value)*100, "% \n",
+                         "Absolute value: ", round(value, 2), " \n",
+                         "Thresholds (yel/red): \n",
+                         "Min: ", min_yel*100, "% / ", min_red*100, "% \n",
+                         "Max: ", max_yel*100, "% / ", max_red*100, "%"
+                         )
+           )
+
+  return(df)
+}

R/combineData.R

@@ -0,0 +1,168 @@
+#' @importFrom dplyr filter select mutate summarise group_by %>%
+
+# for one row of cfg: filter and merge relevant scenario data with cfg
+# results in one df that contains scenario data, reference data and thresholds
+combineData <- function(data, cfgRow, refData = NULL) {
+
+  # shorten as it will be used a lot
+  c <- cfg_row
+
+  # full dimensions and important slices
+  all_mod <- unique(data$model)
+  all_sce <- unique(data$scenario)
+  all_reg <- unique(data$region)
+  all_per <- unique(data$period)  # not a factor, convert?
+  all_per <- all_per[all_per <= 2100]
+  ref_per <- c(2005, 2010, 2015, 2020)
+
+
+  # create filters ####
+  # check whether regions, periods, scenarios are specified, else use all
+  mod <- if (is.na(c$model)) all_mod else
+    strsplit(c$model, split = ", |, ")[[1]]
+  sce <- if (is.na(c$scenario)) all_sce else
+    strsplit(c$scenario, split = ", |, ")[[1]]
+  reg <- if (is.na(c$region))   all_reg else
+    strsplit(c$region, split = ", |,")[[1]]
+
+
+  # empty "period" field means different years for historic or scenario category
+  if (c$category == "historic") {
+    per <- if (is.na(c$period))  ref_per else
+      strsplit(as.character(c$period), split = ", |,")[[1]]
+  } else {
+    per <- if (is.na(c$period))  all_per else
+      strsplit(as.character(c$period), split = ", |,")[[1]]
+  }
+
+  # apply filters ####
+  # filter scenario data according to each row in cfg
+  d <- data %>%
+    filter(variable %in% c$variable,  # alternative approach for multiple variables could be used here
+           model    %in% mod,
+           scenario %in% sce,
+           region   %in% reg,
+           period   %in% per)
+
+  # attach cfg information to data slice, which is independent of category
+  d <- d %>%
+    mutate(min_red  = c$min_red,
+           min_yel  = c$min_yel,
+           max_yel  = c$max_yel,
+           max_red  = c$max_red,
+           category = c$category,
+           metric   = c$metric,
+           critical = c$critical)
+
+  # historic ####
+  # depending on category: filter and attach reference values if they are needed
+  if (c$category == "historic") {
+    # historic data for relevant variable and dimensions (all sources)
+    h <- ref_data %>%
+      filter(variable %in% c$variable,
+             region %in% reg,
+             period %in% per) %>%
+      mutate(ref_value = value, ref_model = model) %>%
+      select(-c("scenario", "unit", "value", "model"))
+
+    # test whether ref_model exists and has data to compare to
+    if (nrow(h) == 0) {
+      cat(paste0("No reference data for variable ", c$variable, " found.\n"))
+      df <- data.frame()
+    } else {
+
+      # in case one or more sources are specified, filter for them
+      if (!is.na(c$ref_model)) {
+        h <- filter(
+          h, ref_model %in% strsplit(c$ref_model, split = ", |,")[[1]]
+        )
+      }
+
+      # in case of multiple sources, use mean (of all available sources)
+      if (length(unique(h$ref_model)) > 1) {
+        h_mean <- group_by(h, period, region) %>%
+          summarise(ref_value = mean(ref_value, na.rm = TRUE))
+        h <- mutate(h_mean, variable = c$variable, ref_model = "multiple")
+      }
+
+      # merge with historical data adds columns ref_value and ref_model
+      df <- merge(d, h)
+
+      # add columns which are not used in this category, fill NA
+      df <- df %>% mutate(ref_period = NA, ref_scenario = NA)
+    }
+
+  # scenario ####
+  # filter and attach reference values if they are needed; scenario data
+  } else if (c$category == "scenario") {
+
+    # no reference values needed for these metrics, fill NA
+    if (c$metric %in% c("absolute", "growthrate")) {
+      df <- d %>%
+        mutate(ref_value    = NA,
+               ref_model    = NA,
+               ref_scenario = NA,
+               ref_period   = NA)
+
+
+    # get reference values for these metrics
+    # TODO: support choosing ref_period AND model/scenario?
+    } else if (c$metric %in% c("relative", "difference")) {
+
+      # if a reference model should be used, same scenario, same period
+      if (!is.na(c$model)) {
+        ref <- data %>%
+          filter(variable %in% c$variable,
+                 model    %in% c$ref_model, # expects exactly one model for now
+                 scenario %in% sce,
+                 region   %in% reg,
+                 period   %in% per) %>%
+
+          mutate(ref_value = value, ref_model = model) %>%
+          select(-c(model, value)) %>%
+          # add columns which are not used in this category, fill NA
+          mutate(ref_scenario = NA, ref_period = NA)
+
+      # if a reference scenario should be used, same period, same model
+      } else if (!is.na(c$ref_scenario)) {
+        ref <- data %>%
+          filter(variable %in% c$variable,
+                 model    %in% mod,
+                 scenario %in% c$ref_scenario,  # expects exactly one scenario
+                 region   %in% reg,
+                 period   %in% per) %>%
+
+          mutate(ref_value = value, ref_scenario = scenario) %>%
+          select(-c(scenario, value)) %>%
+          # add columns which are not used in this category, fill NA
+          mutate(ref_model = NA, ref_period = NA)
+
+      # if a reference period should be used, same scenario, same model
+      } else if (!is.na(c$ref_period)) {
+        ref <- data %>%
+          filter(variable %in% c$variable,
+                 model    %in% mod,
+                 scenario %in% sce,
+                 region   %in% reg,
+                 period   %in% c$ref_period) %>% # expects exactly one period
+
+          mutate(ref_value = value, ref_period = period) %>%
+          select(-c(period, value)) %>%
+          # add columns which are not used in this category, fill NA
+          mutate(ref_model = NA, ref_scenario = NA)
+      }
+
+      df <- merge(d, ref)
+
+    } else {
+      # TODO: have this warning here or earlier when cleaning config?
+      warning("'metric' for category 'scenario' must be either 'absolute',
+              'relative', 'difference' or 'growthrate'.")
+    }
+
+  } else {
+    warning("'category' must be either 'historic' or 'scenario'.")
+  }
+
+  return(df)
+}