+ script checking if fixing to ref run worked, allows to fix that in post-processing

CHANGELOG.md

@@ -9,6 +9,8 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 
 ### added
 - **config** regex tests for many parameters
+- **scripts** add script to check fixing of runs to reference run
+    [[#1410](https://github.com/remindmodel/remind/pull/1410)]
 - **testthat** test and compile all config files
 
 ### fixed

DESCRIPTION

@@ -51,10 +51,10 @@ Imports:
     nleqslv,
     optparse,
     piamenv (>= 0.4.0),
-    piamInterfaces (>= 0.0.88),
+    piamInterfaces (>= 0.5.0),
     plotly,
     purrr,
-    quitte (>= 0.3106.0),
+    quitte (>= 0.3123.0),
     R.utils,
     raster,
     readr,

config/default.cfg

@@ -110,7 +110,7 @@ cfg$logoption <- 2
 
 # Just list the name of the output scripts that should be used by output.R
 # At the moment there are several R-scripts located in scripts/output/
-cfg$output <- c("reporting","reportCEScalib","rds_report") #,"validation","emulator","reportCEScalib","validationSummary","dashboard")
+cfg$output <- c("reporting","reportCEScalib","rds_report","fixOnRef") #,"validation","emulator","reportCEScalib","validationSummary","dashboard")
 
 # Set the format for the results folder, type string :date: in order to use the current time stamp in the folder name (e.g. "results:date:") use :title: to use the current title in the folder name
 cfg$results_folder <- "output/:title::date:"

output.R

@@ -67,14 +67,13 @@ library(lucode2)
 library(gms)
 require(stringr, quietly = TRUE)
 
+flags <- NULL
 ### Define arguments that can be read from command line
 if (!exists("source_include")) {
   # if this script is not being sourced by another script but called from the command line via Rscript read the command
   # line arguments and let the user choose the slurm options
   flags <- readArgs("outputdir", "output", "comp", "remind_dir", "slurmConfig", "filename_prefix",
                     .flags = c(t = "--test", h = "--help"))
-} else {
-  flags <- NULL
 }
 
 if ("--help" %in% flags) {
@@ -125,7 +124,7 @@ if (! exists("output")) {
 # Select output directories if not defined by readArgs
 if (! exists("outputdir")) {
   modulesNeedingMif <- c("compareScenarios2", "xlsx_IIASA", "policyCosts", "Ariadne_output",
-                         "plot_compare_iterations", "varListHtml")
+                         "plot_compare_iterations", "varListHtml", "fixOnRef")
   needingMif <- any(modulesNeedingMif %in% output)
   dir_folder <- if (exists("remind_dir")) c(file.path(remind_dir, "output"), remind_dir) else "./output"
   dirs <- dirname(Sys.glob(file.path(dir_folder, "*", "fulldata.gdx")))
@@ -198,11 +197,14 @@ if (comp %in% c("comparison", "export")) {
   }
 } else { # comp = single
   # define slurm class or direct execution
-  outputUsingDirect <- c("plotIterations")
+  outputInteractive <- c("plotIterations", "fixOnRef")
   if (! exists("source_include")) {
     # for selected output scripts, only slurm configurations matching these regex are available
     slurmExceptions <- if ("reporting" %in% output) "--mem=[0-9]*[0-9]{3}" else NULL
-    if (any(output %in% outputUsingDirect)) slurmConfig <- "direct"
+    if (any(output %in% outputInteractive)) {
+      slurmConfig <- "direct"
+      flags <- c(flags, "--interactive") # to tell scripts they can run in interactive mode
+    }
     # if this script is not being sourced by another script but called from the command line via Rscript let the user
     # choose the slurm options
     if (!exists("slurmConfig")) {

scripts/output/single/fixOnRef.R

@@ -0,0 +1,84 @@
+# |  (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: remind@pik-potsdam.de
+
+# if you want to change the reference run for yourrun, you can run:
+# Rscript scripts/output/single/fixRefOn.R -i outputdir=yourrun,newreferencerun
+
+suppressPackageStartupMessages(library(tidyverse))
+
+if(! exists("source_include")) {
+  # Define arguments that can be read from command line
+  outputdir <- "."
+  flags <- readArgs("outputdir", .flags = c(i = "--interactive"))
+}
+
+findRefMif <- function(outputdir, envi) {
+  stopifnot(length(outputdir) == 1)
+  inputref <- try(envi$cfg$files2export$start[["input_ref.gdx"]], silent = TRUE)
+  if (inherits(inputref, "try-error") || is.na(inputref) || isTRUE(inputref == "NA") || length(inputref) == 0) {
+    message("No input_ref.gdx found in config.")
+    return(NULL)
+  }
+  refdir <- dirname(inputref)
+  if (! file.exists(file.path(refdir, "config.Rdata"))) {
+    message("Config in reference directory '", refdir, "' not found.")
+    return(NULL)
+  }
+  refscen <- lucode2::getScenNames(refdir)
+  refmif <- file.path(refdir, paste0("REMIND_generic_", refscen, ".mif"))
+  if (! file.exists(refmif)) {
+    message("Reference mif '", refmif, "' not found, run reporting!")
+    return(NULL)
+  }
+  return(refmif)
+}
+
+fixOnMif <- function(outputdir) {
+
+  gdxs    <- file.path(outputdir, "fulldata.gdx")
+  configs <- file.path(outputdir, "config.Rdata")
+  message("### Checking if mif is correctly fixed on reference run for ", outputdir)
+  if (! all(file.exists(gdxs, configs))) stop("gdx or config.Rdata not found!")
+  scens   <- lucode2::getScenNames(outputdir)
+  mifs    <- file.path(outputdir, paste0("REMIND_generic_", scens, ".mif"))
+  if (! all(file.exists(mifs))) stop("mif file not found, run reporting!")
+
+  envi <- new.env()
+  load(configs[[1]], env =  envi)
+  title <- envi$cfg$title
+  stopifnot(title == scens[[1]])
+  startyear <- envi$cfg$gms$cm_startyear
+
+  if (length(outputdir) == 1) {
+    refmif <- findRefMif(outputdir, envi)
+    if (is.null(refmif)) return(NULL)
+  } else if (length(outputdir) == 2) {
+    refmif <- mifs[[2]]
+  } else {
+    stop("length(outputdir)=", length(outputdir), ", is bigger than 2.")
+  }
+  refname <- basename(dirname(refmif))
+  d <- quitte::as.quitte(mifs)
+  dref <- quitte::as.quitte(refmif)
+  failfile <- file.path(outputdir, "log_fixOnRef.csv")
+  fixeddata <- piamInterfaces::fixOnRef(d, dref, ret = "fixed", startyear = startyear, failfile = failfile)
+
+  if (exists("flags") && isTRUE("--interactive" %in% flags)) {
+    message("\nDo you want to fix that by overwriting ", title, " mif with reference run ", refname, " for t < ", startyear, "?\nType: y/N")
+    if (tolower(gms::getLine()) %in% c("y", "yes")) {
+      message("Updating ", mifs[[1]])
+      tmpfile <- paste0(mifs[[1]], "fixOnMif")
+      quitte::write.mif(fixeddata, tmpfile)
+      file.rename(tmpfile, mifs[[1]])
+      remind2::deletePlus(mifs[[1]], writemif = TRUE)
+      message("Keep in mind to update the runs that use this as `path_gdx_ref` as well.")
+    }
+  }
+  return(NULL)
+}
+
+invisible(fixOnMif(outputdir))