reactive check_config, add regexp check for cfg$… values

CHANGELOG.md

@@ -7,16 +7,19 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 
 ## [Unreleased]
 
+### added
+- **config** regex tests for many parameters
+- **testthat** test and compile all config files
 
 ## [3.2.1] - 2023-07-13 (incomplete)
 
 ### changed
 - **documentation** MAgPIE coupling, DIETER coupling, input changes
-- **config** NGFS, SHAPE
+- **config** NGFS_v4, SHAPE
 - **scripts** re-enable summation checks for IIASA submission
 
 ### added
-- **45_carbonprice** added realization for National Policies Implemented 
+- **45_carbonprice** added realization `NPi` (National Policies Implemented)
 - **47_carbonpriceRegi** now supports BECCS quantity targets
 - **MAgPIE coupling** added `qos=auto` mode
 - **MAgPIE coupling** added renv support mode

Makefile

@@ -59,6 +59,10 @@ test-coupled:    ## Test if the coupling with MAgPIE works. Takes significantly
 	$(info Coupling tests take around 75 minutes to run, please be patient)
 	@R_PROFILE_USER= TESTTHAT_RUN_SLOW=TRUE Rscript -e 'testthat::test_file("tests/testthat/test_20-coupled.R")'
 
+test-coupled-slurm: ## test-coupled, but on slurm
+	$(info Coupling tests take around 75 minutes to run. Sent to slurm, find log in test-coupled.log)
+	@sbatch --qos=priority --wrap="make test-coupled" --job-name=test-coupled --mail-type=END --output=test-coupled.log
+
 test-full:       ## Run all tests, including coupling tests and a default
                  ## REMIND scenario. Takes significantly longer than 10 minutes to run.
 	$(info Full tests take more than an hour to run, please be patient)

config/tests/scenario_config_coupled_shortCascade.csv

@@ -1,4 +1,4 @@
 title;start;qos;sbatch;magpie_scen;magpie_empty;no_ghgprices_land_until;max_iterations;oldrun;path_gdx;path_gdx_ref;path_gdx_bau;path_report;cm_nash_autoconverge_lastrun;path_mif_ghgprice_land
-TESTTHAT-SSP2EU-Base;1;auto;--wait;SSP2|NPI;TRUE;y2150;2;;;;;;2;
-TESTTHAT-SSP2EU-NDC;1;auto;--wait;SSP2|NDC;TRUE;y2150;2;;;;;;2;TESTTHAT-SSP2EU-Base
-TESTTHAT-SSP2EU-Policy;2;auto;--wait;SSP2|NDC;TRUE;y2150;2;TESTTHAT-SSP2EU-Base;;;;;;output/C_TESTTHAT-SSP2EU-Base-rem-1/REMIND_generic_C_TESTTHAT-SSP2EU-Base-rem-1.mif
+TESTTHAT-SSP2EU-Base;1;auto;--wait --mail-type=FAIL;SSP2|NPI;TRUE;y2150;2;;;;;;2;
+TESTTHAT-SSP2EU-NDC;1;auto;--wait --mail-type=FAIL;SSP2|NDC;TRUE;y2150;2;;;;;;2;TESTTHAT-SSP2EU-Base
+TESTTHAT-SSP2EU-Policy;2;auto;--wait --mail-type=FAIL;SSP2|NDC;TRUE;y2150;2;TESTTHAT-SSP2EU-Base;;;;;;output/C_TESTTHAT-SSP2EU-Base-rem-1/REMIND_generic_C_TESTTHAT-SSP2EU-Base-rem-1.mif

scripts/start/checkFixCfg.R

@@ -0,0 +1,77 @@
+#' take a REMIND cfg, runs some consistency checks and automatically fix some wrong settings
+#' The regexp check loads the code from main.gms and looks for 'regexp = ' patterns.
+#' It then checks whether the current cfg matches those patterns.
+#'
+#' @param cfg list with REMIND setting
+#' @param remindPath path to REMIND directory containing the main.gms
+#' @param testmode boolean. Default is FALSE which fails on errors, in testmode only raise warnings
+#' @author Oliver Richters
+#' @return updated cfg
+checkFixCfg <- function(cfg, remindPath = ".", testmode = FALSE) {
+  refcfg <- gms::readDefaultConfig(remindPath)
+  gms::check_config(cfg, reference_file = refcfg, modulepath = file.path(remindPath, "modules"),
+                    settings_config = file.path(remindPath, "config", "settings_config.csv"),
+                    extras = c("backup", "remind_folder", "pathToMagpieReport", "cm_nash_autoconverge_lastrun",
+                               "gms$c_expname", "restart_subsequent_runs", "gms$c_GDPpcScen",
+                               "gms$cm_CES_configuration", "gms$c_description", "model"))
+
+  errorsfound <- 0
+
+  ## regexp check
+  # extract all instances of 'regexp' from main.gms
+  code <- system(paste0("grep regexp ", file.path(remindPath, "main.gms")), intern = TRUE)
+  # this is used to replace all 'regexp = is.numeric'
+  grepisnum <- "((\\+|-)?[0-9]*([0-9]\\.?|\\.?[0-9])[0-9]*)"
+  grepisshare <-  "(\\+?0?\\.[0-9]+|0|0\\.0*|1|1\\.0*)"
+  # some simple tests
+  if (testmode) {
+    stopifnot(all(  grepl(paste0("^", grepisnum, "$"), c("2", "2.2", "32.", "+32.", "+.05", "-0.5", "-.5", "-5", "-7."))))
+    stopifnot(all(! grepl(paste0("^", grepisnum, "$"), c("2.2.", "0a", "1e1", ".2.", "ab", "2.3a", "--a", "++2"))))
+    stopifnot(all(  grepl(paste0("^", grepisshare, "$"), c("0", "0.0", ".000", "1.0", "1.", "1", "0.12341234"))))
+    stopifnot(all(! grepl(paste0("^", grepisshare, "$"), c("1.1", "-0.3", "-0", "."))))
+  }
+
+  for (n in names(cfg$gms)) {
+    errormsg <- NULL
+    # how parameter n is defined in main.gms
+    paramdef <- paste0("^([ ]*", n, "[ ]*=|\\$setglobal[ ]+", n, " )")
+    # filter fitting parameter definition from code snippets containing regexp
+    filtered <- grep(paste0(paramdef, ".*regexp[ ]*=[ ]*"), code, value = TRUE)
+    if (length(filtered) == 1) {
+      # search for string '!! regexp = whatever', potentially followed by '!! otherstuff' and extract 'whatever'
+      regexp <- paste0("^(", trimws(gsub("!!.*", "", gsub("^.*regexp[ ]*=", "", filtered))), ")$")
+      # replace is.numeric by pattern defined above
+      useregexp <- gsub("is.numeric", grepisnum, regexp, fixed = TRUE)
+      useregexp <- gsub("is.share", grepisshare, useregexp, fixed = TRUE)
+      # check whether parameter value fits regular expression
+      if (! grepl(useregexp, cfg$gms[[n]])) {
+        errormsg <- paste0("Parameter cfg$gms$", n, "=", cfg$gms[[n]], " does not fit this regular expression: ", regexp)
+      }
+    } else if (length(filtered) > 1) {
+      # fail if more than one regexp found for parameter
+      errormsg <- paste0("More than one regexp found for ", n, ". These are the code lines:\n", paste(filtered, collapse = "\n"))
+    }
+    # count errors
+    if (! is.null(errormsg)) {
+      errorsfound <- errorsfound + 1
+      if (testmode) warning(errormsg) else message(errormsg)
+    }
+  }
+
+  # Check for compatibility with subsidizeLearning
+  if ((cfg$gms$optimization != "nash") && (cfg$gms$subsidizeLearning == "globallyOptimal") ) {
+    message("Only optimization='nash' is compatible with subsidizeLearning='globallyOptimal'. Switching subsidizeLearning to 'off' now.\n")
+    cfg$gms$subsidizeLearning <- "off"
+  }
+
+  # reportCEScalib only works with the calibrate module
+  if (! isTRUE(cfg$gms$CES_parameters == "calibrate")) {
+    cfg$output <- setdiff(cfg$output, "reportCEScalib")
+  }
+  if (errorsfound > 0) {
+    if (testmode) warning(errorsfound, " errors found.")
+      else stop(errorsfound, " errors found, see above. Either adapt the parameter choice or the regexp in main.gms")
+  }
+
+  return(cfg)
+}

scripts/start/combine_slurmConfig.R

@@ -12,8 +12,8 @@
 combine_slurmConfig <- function(original, update_with) {
 
   # trim whitespaces
-  original <- trimws(original)
-  update_with <- trimws(update_with)
+  original <- trimws(toString(original))
+  update_with <- trimws(toString(update_with))
 
   # remove double whitespaces
   original <- gsub("\\s+", " ", original)

scripts/start/prepare.R

@@ -68,28 +68,13 @@ prepare <- function() {
   # change to REMIND main folder
   setwd(cfg$remind_folder)
 
-  # Check configuration for consistency
-#  cfg <- check_config(cfg, reference_file="config/default.cfg",
-#                      settings_config = "config/settings_config.csv",
-#                      extras = c("backup", "remind_folder", "pathToMagpieReport", "cm_nash_autoconverge_lastrun",
-#                                 "gms$c_expname", "restart_subsequent_runs", "gms$c_GDPpcScen",
-#                                 "gms$cm_CES_configuration", "gms$c_description"))
-
-  # Check for compatibility with subsidizeLearning
-  if ( (cfg$gms$optimization != 'nash') & (cfg$gms$subsidizeLearning == 'globallyOptimal') ) {
-    cat("Only optimization='nash' is compatible with subsudizeLearning='globallyOptimal'. Switching subsidizeLearning to 'off' now. \n")
-    cfg$gms$subsidizeLearning = 'off'
-  }
-
-  # reportCEScalib only works with the calibrate module
-  if ( cfg$gms$CES_parameters != "calibrate" ) cfg$output <- setdiff(cfg$output,"reportCEScalib")
+  cfg <- checkFixCfg(cfg, remindPath = cfg$remind_folder)
 
   #AJS quit if title is too long - GAMS can't handle that
   if( nchar(cfg$title) > 75 | grepl("\\.",cfg$title) ) {
       stop("This title is too long or the name contains dots - GAMS would not tolerate this, and quit working at a point where you least expect it. Stopping now. ")
   }
 
-
   # adjust GDPpcScen based on GDPscen
   cfg$gms$c_GDPpcScen <- gsub("gdp_","",cfg$gms$cm_GDPscen)
 

scripts/start/runGamsCompile.R

@@ -19,12 +19,12 @@ runGamsCompile <- function(modelFile, cfg, interactive = TRUE) {
   gcdir <- file.path(dirname(modelFile), "output", "gamscompile")
   dir.create(gcdir, recursive = TRUE, showWarnings = FALSE)
   tmpModelFile <- file.path(gcdir, paste0("main_", cfg$title, ".gms"))
+  tmpModelLst <- gsub("gms$", "lst", tmpModelFile)
   file.copy(modelFile, tmpModelFile, overwrite = TRUE)
   lucode2::manipulateConfig(tmpModelFile, cfg$gms)
   exitcode <- system2(
     command = cfg$gamsv,
-    args = paste(tmpModelFile, "-o", gsub("gms$", "lst", tmpModelFile),
-                 "-action=c -errmsg=1 -pw=132 -ps=0 -logoption=0"))
+    args = paste(tmpModelFile, "-o", tmpModelLst, "-action=c -errmsg=1 -pw=132 -ps=0 -logoption=0"))
   if (0 < exitcode) {
     message(red, "FAIL ", NC, gsub("gms$", "lst", tmpModelFile))
     if (interactive) {
@@ -39,6 +39,9 @@ runGamsCompile <- function(modelFile, cfg, interactive = TRUE) {
     return(FALSE)
   } else {
     message(green, " OK  ", NC, gsub("gms$", "lst", tmpModelFile))
+    if (isTRUE(grepl("TESTTHAT_scenario_config", cfg$title))) { # for test_04-gamscompile
+      unlink(c(tmpModelFile, tmpModelLst))
+    }
     return(TRUE)
   }
 }

scripts/start/selectScenarios.R

@@ -13,6 +13,7 @@
 #' @return dataframe with scenarios from settings which should be started
 
 selectScenarios <- function (settings, interactive, startgroup) {
+    if (isTRUE(startgroup == "*")) return(settings)
     scenariosInGroup <- grepl(paste0("(^|,)", startgroup, "($|,)"), as.character(settings$start), perl = TRUE)
     if (interactive | ! any(scenariosInGroup)) {
       scenariosInGroup <- gms::chooseFromList(setNames(rownames(settings), settings$start), type = "runs", returnBoolean = TRUE)

start.R

@@ -39,7 +39,7 @@ helpText <- "
 #'   --testOneRegi, -1:  starting the REMIND run(s) in testOneRegi mode
 #'   startgroup=MYGROUP  when reading a scenario config .csv file, don't start
 #'                       everything specified by \"start = 1\", instead start everything
-#'                       specified by \"start = MYGROUP\"
+#'                       specified by \"start = MYGROUP\". Use startgroup=* to start all.
 #'   titletag=MYTAG      append \"-MYTAG\" to all titles of all runs that are started
 #'   slurmConfig=CONFIG  use the provided CONFIG as slurmConfig: a string, or an integer <= 16
 #'                       to select one of the options shown when running './start.R -t'.
@@ -328,6 +328,8 @@ if (any(c("--reprepare", "--restart") %in% flags)) {
     # abort on too long paths ----
     cfg$gms$cm_CES_configuration <- calculate_CES_configuration(cfg, check = TRUE)
 
+    cfg <- checkFixCfg(cfg)
+
     # save the cfg object for the later automatic start of subsequent runs (after preceding run finished)
     if (! "--gamscompile" %in% flags) {
       filename <- paste0(cfg$title,".RData")

start_bundle_coupled.R

@@ -142,7 +142,7 @@ if (length(argv) > 0) {
   if (sum(file_exists) > 1) stop("Enter only a scenario_config_coupled* file via command line or set all files manually in start_bundle_coupled.R")
   if (!all(file_exists)) stop("Unknown parameter provided: ", paste(argv[!file_exists], collapse = ", "))
   # set config file to not known parameter where the file actually exists
-  path_settings_coupled <- file.path(path_remind, argv[[1]])
+  path_settings_coupled <- normalizePath(argv[[1]])
   if (! isTRUE(grepl("scenario_config_coupled", path_settings_coupled)))
     stop("Enter only a scenario_config_coupled* file via command line or set all files manually in start_bundle_coupled.R.\n",
          "Your command line arguments were: ", paste0(argv, collapse = " "))
@@ -540,6 +540,8 @@ for(scen in common){
       numberOfTasks <- 1
     }
 
+    cfg_rem <- checkFixCfg(cfg_rem, remindPath = path_remind)
+
     Rdatafile <- paste0(fullrunname, ".RData")
     message("Save settings to ", Rdatafile)
     save(path_remind, path_magpie, cfg_rem, cfg_mag, runname, fullrunname, max_iterations, start_iter,
@@ -618,12 +620,12 @@ for (scen in common) {
           sq <- system(paste0("squeue -u ", Sys.info()[["user"]], " -o '%q %j'"), intern = TRUE)
           runEnv$qos <- if (is.null(attr(sq, "status")) && sum(grepl("^priority ", sq)) < 4) "priority" else "short"
         }
-        slurm_command <- paste0("sbatch --qos=", runEnv$qos, " --job-name=", fullrunname,
-        " --output=", logfile, " --mail-type=END --comment=REMIND-MAgPIE --tasks-per-node=", runEnv$numberOfTasks,
-        if (runEnv$numberOfTasks == 1) " --mem=8000", " ", runEnv$sbatch,
-        " ", runEnv$sbatch, " --wrap=\"Rscript start_coupled.R coupled_config=", Rdatafile, "\"")
-        message(slurm_command)
-        exitCode <- system(slurm_command)
+        slurmOptions <- combine_slurmConfig(paste0("--qos=", runEnv$qos, " --job-name=", fullrunname, " --output=", logfile,
+          " --mail-type=END --comment=REMIND-MAgPIE --tasks-per-node=", runEnv$numberOfTasks,
+          if (runEnv$numberOfTasks == 1) " --mem=8000"), runEnv$sbatch)
+        slurmCommand <- paste0("sbatch ", slurmOptions, " --wrap=\"Rscript start_coupled.R coupled_config=", Rdatafile, "\"")
+        message(slurmCommand)
+        exitCode <- system(slurmCommand)
         if (0 < exitCode) {
           errorsfound <- errorsfound + 1
           message("sbatch command failed, check logs.")

start_coupled.R

@@ -18,6 +18,7 @@ start_coupled <- function(path_remind, path_magpie, cfg_rem, cfg_mag, runname, m
   require(gdx)
   library(methods)
   library(remind2)
+  source("scripts/start/combine_slurmConfig.R")
 
   errorsfound <- 0
   # delete entries in stack that contain needle and append new
@@ -250,10 +251,10 @@ start_coupled <- function(path_remind, path_magpie, cfg_rem, cfg_mag, runname, m
           sq <- system(paste0("squeue -u ", Sys.info()[["user"]], " -o '%q %j' | grep -v ", fullrunname), intern = TRUE)
           subseq.env$qos <- if (is.null(attr(sq, "status")) && sum(grepl("^priority ", sq)) < 4) "priority" else "short"
         }
-        subsequentcommand <- paste0("sbatch --qos=", subseq.env$qos, " --job-name=", subseq.env$fullrunname, " --output=", logfile,
-        " --mail-type=END --comment=REMIND-MAgPIE --tasks-per-node=", subseq.env$numberOfTasks,
-        if (subseq.env$numberOfTasks == 1) " --mem=8000",
-        " ", subseq.env$sbatch, " --wrap=\"Rscript start_coupled.R coupled_config=", RData_file, "\"")
+        slurmOptions <- combine_slurmConfig(paste0("--qos=", subseq.env$qos, " --job-name=", subseq.env$fullrunname, " --output=", logfile,
+           " --mail-type=END --comment=REMIND-MAgPIE --tasks-per-node=", subseq.env$numberOfTasks,
+          if (subseq.env$numberOfTasks == 1) " --mem=8000"), subseq.env$sbatch)
+        subsequentcommand <- paste0("sbatch ", slurmOptions, " --wrap=\"Rscript start_coupled.R coupled_config=", RData_file, "\"")
         message(subsequentcommand)
         if (length(needfulldatagdx) > 0) {
           exitCode <- system(subsequentcommand)

tests/testthat/test_01-checkFixCfg.R

@@ -0,0 +1,36 @@
+# |  (C) 2006-2023 Potsdam Institute for Climate Impact Research (PIK)
+# |  authors, and contributors see CITATION.cff file. This file is part
+# |  of REMIND and licensed under AGPL-3.0-or-later. Under Section 7 of
+# |  AGPL-3.0, you are granted additional permissions described in the
+# |  REMIND License Exception, version 1.0 (see LICENSE file).
+# |  Contact: [email protected]
+test_that("checkFixCfg works", {
+  remind_folder <- "../.."
+  savecfg <- cfg <- gms::readDefaultConfig(remind_folder)
+  # regexp = NA means: no warning
+  expect_warning(checkFixCfg(cfg, remind_folder, testmode = TRUE), regexp = NA)
+
+  wrongsetting <- c(
+    "cm_NDC_version" = "2004_cond",
+    "cm_emiscen" = "123",
+    "cm_nash_autoconverge" = "NA",
+    "cm_co2_tax_2020" = "2.2.2",
+    "cm_co2_tax_growth" = "333++",
+    "c_macscen" = "-1",
+    "cm_keep_presolve_gdxes" = "1.1",
+    "cm_startyear" = "1985",
+    "cm_netZeroScen" = "NöööGFS_v4",
+    "cm_rcp_scen" = "apocalypse",
+    "c_testOneRegi_region" = "LOONG",
+    "c_shGreenH2" = "1.5",
+  NULL)
+
+  cfg <- savecfg
+  cfg$gms[names(wrongsetting)] <- wrongsetting
+  w <- capture_warnings(checkFixCfg(cfg, remind_folder, testmode = TRUE))
+  for (n in names(wrongsetting)) {
+    expect_match(w, paste0(n, "=", wrongsetting[[n]]), all = FALSE, fixed = TRUE)
+  }
+  expect_match(w, paste0(length(wrongsetting), " errors found"), all = FALSE, fixed = TRUE)
+  expect_equal(length(w), length(wrongsetting) + 1)
+})

tests/testthat/test_01-combine_slurmConfig.R

@@ -6,8 +6,13 @@
 # |  Contact: [email protected]
 test_that("combine_slurmConfig works", {
   teststring <- "--qos=priority --time=03:30:00"
+  expect_identical(combine_slurmConfig(teststring, teststring), teststring)
+  expect_identical(combine_slurmConfig(teststring, NULL), teststring)
+  expect_identical(combine_slurmConfig(NULL, NULL), "")
+  expect_identical(combine_slurmConfig(teststring, ""), teststring)
   expect_identical(combine_slurmConfig(teststring, "--qos=standby"), "--qos=standby --time=03:30:00")
   expect_identical(combine_slurmConfig(teststring, "--bla=blub"), paste("--bla=blub", teststring))
+  expect_identical(combine_slurmConfig(teststring, "--wait"), paste("--wait", teststring))
   teststring <- "--qos=priority --wait"
   expect_identical(combine_slurmConfig(teststring, "--qos=standby"), "--qos=standby --wait")
 })

tests/testthat/test_01-readCheckScenarioConfig.R

@@ -10,7 +10,7 @@ if (length(csvfiles) == 0) {
                          file.path("../../config", "*", "scenario_config*.csv")))
 }
 for (csvfile in csvfiles) {
-  test_that(paste("perform readCheckScenarioConfig with", gsub("../../config/", "", csvfile, fixed = TRUE)), {
+  test_that(paste("perform readCheckScenarioConfig with", basename(csvfile)), {
     # regexp = NA means: expect no warning
     expect_warning(readCheckScenarioConfig(csvfile, remindPath = "../../", testmode = TRUE), regexp = NA)
   })
@@ -24,15 +24,15 @@ test_that("readCheckScenarioConfig fails on error-loaden config", {
                "PBScopy;0;PBS;;;mustbedifferenttoPBS"),
              con = csvfile, sep = "\n")
   w <- capture_warnings(scenConf <- readCheckScenarioConfig(csvfile, remindPath = "../../", testmode = TRUE))
-  expect_match(w, "11 errors found", all = FALSE)
-  expect_match(w, "These titles are too long", all = FALSE)
-  expect_match(w, "These titles may be confused with regions", all = FALSE)
-  expect_match(w, "These titles contain illegal characters", all = FALSE)
+  expect_match(w, "11 errors found", all = FALSE, fixed = TRUE)
+  expect_match(w, "These titles are too long", all = FALSE, fixed = TRUE)
+  expect_match(w, "These titles may be confused with regions", all = FALSE, fixed = TRUE)
+  expect_match(w, "These titles contain illegal characters", all = FALSE, fixed = TRUE)
   expect_match(w, "\\.@&", all = FALSE)
-  expect_match(w, "Outdated column names found that must not be used", all = FALSE)
-  expect_match(w, "contain whitespaces", all = FALSE)
-  expect_match(w, "scenario names indicated in copyConfigFrom column were not found", all = FALSE)
-  expect_match(w, "specify in copyConfigFrom column a scenario name defined below in the file", all = FALSE)
+  expect_match(w, "Outdated column names found that must not be used", all = FALSE, fixed = TRUE)
+  expect_match(w, "contain whitespaces", all = FALSE, fixed = TRUE)
+  expect_match(w, "scenario names indicated in copyConfigFrom column were not found", all = FALSE, fixed = TRUE)
+  expect_match(w, "specify in copyConfigFrom column a scenario name defined below in the file", all = FALSE, fixed = TRUE)
   copiedFromPBS <- c("c_budgetCO2", "path_gdx", "path_gdx_ref")
   expect_identical(unlist(scenConf["PBS", copiedFromPBS]),
                    unlist(scenConf["PBScopy", copiedFromPBS]))