|
| 1 | +h <- " |
| 2 | +#' Rscript scripts/utils/readcoupled.R 'vars' [regi] [time] |
| 3 | +#' |
| 4 | +#' Read data from fulldata.gdx or .mif file of REMIND-MAgPIE coupled runs. |
| 5 | +#' |
| 6 | +#' Command line parameters: |
| 7 | +#' vars comma-separated list of GAMS variables or reporting variables. |
| 8 | +#' Example: 'pm_taxCO2eq,Price|Carbon'. Default: pm_gmt_conv,pm_sccConvergenceMaxDeviation |
| 9 | +#' regi optional comma-separated list of GAMS regions. Example: EUR,USA. Default: World/GLO. |
| 10 | +#' time optional comma-separated list of timesteps. Example: 2030,2100. Default: 2050 |
| 11 | +#' |
| 12 | +#' The script loops through all options of vars, regi and time, reads vars that |
| 13 | +#' look like gams names from fulldata.gdx and everything else from the mif file. |
| 14 | +#' |
| 15 | +#' If only NA are returned, try to adjust the settings and check the GAMS sets it is defined on. |
| 16 | +#' For example, many GAMS parameters don't have data for GLO, so adjust the regi. |
| 17 | +#' If a GAMS parameter is defined on more sets then regi and t, simply the first element is printed. |
| 18 | +" |
| 19 | +suppressMessages(library(tidyverse)) |
| 20 | +suppressMessages(library(gdx)) |
| 21 | +suppressMessages(library(modelstats)) |
| 22 | +suppressMessages(library(magclass)) |
| 23 | +suppressMessages(library(quitte)) |
| 24 | +suppressMessages(library(piamutils)) |
| 25 | +suppressMessages(library(lucode2)) |
| 26 | +options(width = 160) |
| 27 | +vars <- c("pm_gmt_conv", "pm_sccConvergenceMaxDeviation") |
| 28 | +regi <- "EUR" |
| 29 | +time <- "2050" |
| 30 | +# overwrite arguments from command line if specified |
| 31 | +argv <- commandArgs(trailingOnly = TRUE) |
| 32 | +if (length(argv) > 0 && ! isTRUE(argv == "")) vars <- trimws(strsplit(argv, ",")[[1]]) |
| 33 | +# print help message |
| 34 | +if (any(vars %in% c("-h", "--help"))) { message(h); q() } |
| 35 | +# next all-numeric is year, other regi |
| 36 | +if (length(argv) > 1) { |
| 37 | + argv2 <- trimws(strsplit(argv, ",")[[2]]) |
| 38 | + if (all(grepl("^[0-9]+$", argv2))) time <- argv2 else regi <- argv2 |
| 39 | +} |
| 40 | +if (length(argv) > 2) { |
| 41 | + argv3 <- trimws(strsplit(argv, ",")[[3]]) |
| 42 | + if (all(grepl("^[0-9]+$", argv2))) regi <- argv3 else time <- argv3 |
| 43 | +} |
| 44 | +# be flexible about folder the script is started |
| 45 | +folder <- "." |
| 46 | +if (sum(file.exists(c("output", "output.R", "start.R", "main.gms"))) == 4) folder <- "output" |
| 47 | +if (file.exists("readcoupled.R")) folder <- "../../output" |
| 48 | + |
| 49 | +# find runs |
| 50 | +dirs <- grep(".*-rem-[0-9]+$", dir(folder), value = TRUE) |
| 51 | +if (length(dirs) == 0) { |
| 52 | + message("No run found in ", normalizePath(folder)) |
| 53 | + q() |
| 54 | +} |
| 55 | +# determine highest rem-xx and base run names |
| 56 | +maxrem <- max(as.numeric(gsub(".*-rem-", "", dirs))) |
| 57 | +runs <- unique(gsub("-rem-[0-9]+$", "", dirs)) |
| 58 | +# print user information |
| 59 | +message("\nNumbers in parentheses indicate runs currently in slurm.") |
| 60 | +message("A minus sign indicates that run does not exist.") |
| 61 | +message("For help, run: Rscript readcoupled.R --help") |
| 62 | +# loop over vars, regi and time |
| 63 | +for (v in vars) { |
| 64 | + v <- deletePlus(v) |
| 65 | + # does it look like a gams variable, then read from fulldata.gdx |
| 66 | + usegdx <- grepl("^[qvsfopcs](m_|_|\\d{2}_)", v) |
| 67 | + # correctly use of GLO in gdx and World in mif |
| 68 | + regi <- gsub("^GLO$|^World$", if (usegdx) "GLO" else "World", regi) |
| 69 | + for (re in regi) { |
| 70 | + for (t in time) { |
| 71 | + # inform user about what is read |
| 72 | + message("\n### Read '", v, "' from ", if (usegdx) "fulldata.gdx" else ".mif file", ".", |
| 73 | + if(! grepl("^s", v) || ! usegdx) paste0(" It uses t=", t, " and regi=", re, " if these dimensions exist.")) |
| 74 | + # create empty results tibble |
| 75 | + results <- matrix(nrow = length(runs), ncol = maxrem + 1) |
| 76 | + colnames(results) <- c("run", paste0("rem", seq(maxrem))) |
| 77 | + results <- as_tibble(results) |
| 78 | + # loop through runs and rem-x |
| 79 | + for (r in seq_along(runs)) { |
| 80 | + results[[r, "run"]] <- runs[[r]] |
| 81 | + for (m in seq(maxrem)) { |
| 82 | + rfolder <- file.path(folder, paste0(runs[r], "-rem-", m)) |
| 83 | + # define gdx and mif file with data |
| 84 | + gdx <- file.path(rfolder, "fulldata.gdx") |
| 85 | + if (dir.exists(rfolder)) report <- file.path(rfolder, paste0("REMIND_generic_", getScenNames(rfolder), "_withoutPlus.mif")) |
| 86 | + data <- NA |
| 87 | + if (usegdx && file.exists(gdx)) { # read from fulldata.gdx |
| 88 | + data <- try(gdx::readGDX(gdx, v, react = "silent"), silent = TRUE) |
| 89 | + # handle errors and null |
| 90 | + if (inherits(data, "try-error") || is.null(data)) { |
| 91 | + data <- "-" |
| 92 | + } else { # transform to quitte |
| 93 | + data <- as.quitte(data) |
| 94 | + } |
| 95 | + } else if (dir.exists(rfolder) && file.exists(report)) { # read from mif file |
| 96 | + data <- read.snapshot(report, list(variable = v)) |
| 97 | + } |
| 98 | + if ("data.frame" %in% class(data)) { |
| 99 | + # select var. select regi and time if more than one in data |
| 100 | + if (length(unique(data$region)) > 1) data <- data[data$region == re, ] |
| 101 | + if (length(unique(data$period)) > 1) data <- data[data$period == t, ] |
| 102 | + data <- if (nrow(data) == 0) NA else niceround(data$value[[1]], 3) |
| 103 | + } # check whether run still in slurm |
| 104 | + if (! modelstats::foundInSlurm(rfolder) == "no") { |
| 105 | + data <- paste0("(", data, ")") |
| 106 | + } |
| 107 | + # add to results tibble |
| 108 | + results[[r, paste0("rem", m)]] <- data |
| 109 | + } |
| 110 | + } |
| 111 | + # overwrite NA with "-" and print results while suppressing tibble size and column type info |
| 112 | + results[is.na(results)] <- "-" |
| 113 | + message(cat(format(as_tibble(results))[-1L][-2L], sep = "\n")) |
| 114 | + } |
| 115 | + } |
| 116 | +} |
0 commit comments