Introduce clean calibration implementation: Most handling of calibrat…

…ion procedure in runCalibration.R; major restructuring in comparison to test-calibration branch.

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '10231110'
+ValidationKey: '2010500'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
@@ -8,3 +8,4 @@ AddLogoReadme: man/figures/logo_text_wide.svg
 LogoHeightReadme: 70
 enforceVersionUpdate: no
 skipCoverage: no
+AutocreateCITATION: yes

.github/workflows/check.yaml

@@ -44,6 +44,13 @@ jobs:
           [ -f requirements.txt ] && python -m pip install --upgrade pip wheel || true
           [ -f requirements.txt ] && pip install -r requirements.txt || true
 
+      - name: Run pre-commit checks
+        shell: bash
+        run: |
+          python -m pip install pre-commit
+          python -m pip freeze --local
+          pre-commit run --show-diff-on-failure --color=always --all-files
+
       - name: Verify validation key
         shell: Rscript {0}
         run: lucode2:::validkey(stopIfInvalid = TRUE)

.pre-commit-config.yaml

@@ -25,4 +25,4 @@ repos:
     -   id: readme-rmd-rendered
     -   id: use-tidy-description
 ci:
-    autoupdate_schedule: quarterly
+    autoupdate_schedule: weekly

CITATION.cff

@@ -3,8 +3,8 @@ message: If you use this software, please cite it using the metadata from this f
 type: software
 title: 'brick: Building sector model with heterogeneous renovation and construction
   of the stock'
-version: 0.5.10
-date-released: '2024-12-04'
+version: 1.0.0
+date-released: '2025-01-17'
 abstract: This building stock model represents residential and commercial buildings
   at customisable regional and temporal resolution. The building stock is quantified
   in floor area and distinguished by building type (SFH/MFH) and location (rural/urban).

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: brick
 Title: Building sector model with heterogeneous renovation and construction of the stock
-Version: 0.5.10
-Date: 2024-12-04
+Version: 1.0.0
+Date: 2025-01-17
 Authors@R: c(
     person("Robin", "Hasse", , "robin.hasse@pik-potsdam.de",
            role = c("aut", "cre"),

NAMESPACE

@@ -16,9 +16,11 @@ importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
 importFrom(dplyr,across)
 importFrom(dplyr,all_of)
+importFrom(dplyr,anti_join)
 importFrom(dplyr,any_of)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
+importFrom(dplyr,case_match)
 importFrom(dplyr,case_when)
 importFrom(dplyr,cross_join)
 importFrom(dplyr,everything)
@@ -32,6 +34,7 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,n)
 importFrom(dplyr,reframe)
 importFrom(dplyr,rename)
+importFrom(dplyr,rename_with)
 importFrom(dplyr,right_join)
 importFrom(dplyr,row_number)
 importFrom(dplyr,select)
@@ -86,13 +89,15 @@ importFrom(stats,median)
 importFrom(stats,pweibull)
 importFrom(tidyr,complete)
 importFrom(tidyr,matches)
+importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
 importFrom(tidyr,replace_na)
 importFrom(tidyr,unite)
 importFrom(utils,head)
 importFrom(utils,read.csv)
 importFrom(utils,read.csv2)
 importFrom(utils,tail)
+importFrom(utils,write.csv)
 importFrom(utils,write.csv2)
 importFrom(withr,with_dir)
 importFrom(yaml,read_yaml)

R/checkGamsSuccess.R

@@ -15,7 +15,14 @@ checkGamsSuccess <- function(path) {
   } else if (file.exists(file.path(path, "abort.gdx"))) {
     stop("Gams aborted with \"abort.gdx\" due to errors in at least one variable.")
   } else {
-    stop("Gams did not finish successfully.\n",
-         "Check the files main.log and main.lst for more information.")
+    allCalibrationFiles <- list.files(path, pattern = "calibration_\\d+\\.gdx$")
+    if (length(allCalibrationFiles) > 0) {
+      maxIteration <- max(as.numeric(sub("calibration_(\\d+)\\.gdx", "\\1", allCalibrationFiles)))
+      message("Gams successfully completed ", maxIteration, " calibration iterations: ",
+              "\"calibration_", maxIteration, ".gdx\" exists.")
+    } else {
+      stop("Gams did not finish successfully.\n",
+           "Check the files main.log and main.lst for more information.")
+    }
   }
 }

R/createParameters.R

@@ -104,7 +104,8 @@ createParameters <- function(m, config, inputDir) {
                                  c("ttot", "reg", "bs", "hs", "bsr", "hsr",
                                    "typ", "vin"),
                                  inputDir) %>%
-    toModelResolution(m)
+    toModelResolution(m) %>%
+    .explicitZero()
   p_specCostRen <- expandSets("cost", "bs", "hs", "bsr", "hsr", "vin", "reg",
                               "loc", "typ", "inc", "ttot", .m = m)
   p_specCostRenTang <- p_specCostRen %>%
@@ -486,6 +487,32 @@ createParameters <- function(m, config, inputDir) {
   )
 
 
+
+  # Price sensitivity ---------------------------------------------------
+
+  priceSensBS <- unlist(config[["priceSens"]][["bs"]])
+  priceSensBS <- expandSets("var", "reg", "loc", "typ", "inc", .m = m) %>%
+    filter(.data[["var"]] %in% names(priceSensBS)) %>%
+    mutate(value = priceSensBS[.data[["var"]]])
+  priceSensBS <- m$addParameter(
+    name = "priceSensBS",
+    domain = c("var", "reg", "loc", "typ", "inc"),
+    records = priceSensBS,
+    description = "price sensitivity of building shell choice"
+  )
+
+  priceSensHS <- unlist(config[["priceSens"]][["hs"]])
+  priceSensHS <- expandSets("var", "reg", "loc", "typ", "inc", .m = m) %>%
+    filter(.data[["var"]] %in% names(priceSensHS)) %>%
+    mutate(value = priceSensHS[.data[["var"]]])
+  priceSensHS <- m$addParameter(
+    name = "priceSensHS",
+    domain = c("var", "reg", "loc", "typ", "inc"),
+    records = priceSensHS,
+    description = "price sensitivity of heating system choice"
+  )
+
+
   return(m)
 }
 

R/createSets.R

@@ -31,7 +31,6 @@ createSets <- function(m, config) {
   ))
 
 
-
   # Temporal -------------------------------------------------------------------
 
   ttotNum <- periodFromConfig(config, "ttot")
@@ -66,6 +65,14 @@ createSets <- function(m, config) {
     description = "historic time steps"
   ))
 
+  if (grepl("calibration", config[["switches"]][["RUNTYPE"]], fixed = TRUE)) {
+    invisible(m$addSet(
+      "tcalib",
+      records = periodFromConfig(config, "tcalib"),
+      description = "time steps for calibration"
+    ))
+  }
+
 
   # Vintages -------------------------------------------------------------------
 

R/initModel.R

@@ -107,7 +107,12 @@ initModel <- function(config = NULL,
 
     cfg <- readConfig(config = config,
                       configFolder = configFolder)
-    title <- cfg[["title"]]
+    title <- paste(cfg[["title"]], sep = "-")
+
+    if (cfg[["switches"]][["RUNTYPE"]] %in% c("calibrationOptimization", "calibrationLogit")) {
+      title <- paste0(title, cfg[["parameters"]][["iteration"]], "Iter",
+                      cfg[["parameters"]][["alpha"]], "A")
+    }
 
     if (is.null(path)) {
       stamp <- format(Sys.time(), "_%Y-%m-%d_%H.%M.%S")

R/periodFromConfig.R

@@ -20,6 +20,13 @@ periodFromConfig <- function(config, periodType) {
 
   t <- ttot[which(ttot >= startyear)]
 
+  if (periodType == "tcalib") {
+    calibperiods <- config[["calibperiods"]]
+    #TODO: Add check that calibration periods are consistent with t
+  } else {
+    calibperiods <- min(t)
+  }
+
   switch(periodType,
     ttot = ttot,
     tall = min(ttot):max(ttot),
@@ -28,6 +35,7 @@ periodFromConfig <- function(config, periodType) {
     thist = setdiff(ttot, t),
     tinit = min(ttot),
     t0 = min(t),
+    tcalib = calibperiods,
     stop("unknown type of period: ", periodType)
   )
 }