Apply shift in investment variables

NAMESPACE

@@ -136,7 +136,6 @@ importFrom(ggplot2,ggtitle)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,scale_color_manual)
 importFrom(ggplot2,scale_fill_brewer)
-importFrom(ggplot2,scale_fill_discrete)
 importFrom(ggplot2,scale_fill_manual)
 importFrom(ggplot2,scale_linetype_identity)
 importFrom(ggplot2,scale_x_continuous)
@@ -148,7 +147,6 @@ importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,theme_minimal)
 importFrom(ggplot2,unit)
-importFrom(ggplot2,xlab)
 importFrom(gms,getLine)
 importFrom(gms,readDefaultConfig)
 importFrom(lucode2,getScenNames)
@@ -179,6 +177,7 @@ importFrom(magclass,getNames)
 importFrom(magclass,getRegions)
 importFrom(magclass,getSets)
 importFrom(magclass,getYears)
+importFrom(magclass,is.magpie)
 importFrom(magclass,lowpass)
 importFrom(magclass,magpie_expand)
 importFrom(magclass,mbind)
@@ -222,7 +221,6 @@ importFrom(quitte,overwrite)
 importFrom(quitte,read.gdx)
 importFrom(quitte,read.quitte)
 importFrom(quitte,revalue.levels)
-importFrom(quitte,sum_total)
 importFrom(readr,read_csv)
 importFrom(readr,write_rds)
 importFrom(remulator,calc_supplycurve)

R/convGDX2MIF.R

@@ -16,8 +16,9 @@
 #' @param testthat boolean whether called by tests, turns some messages into warnings
 #' @author Lavinia Baumstark
 #' @examples
-#'
-#' \dontrun{convGDX2MIF(gdx,gdx_refpolicycost,file="REMIND_generic_default.csv",scenario="default")}
+#' \dontrun{
+#' convGDX2MIF(gdx, gdx_refpolicycost, file = "REMIND_generic_default.csv", scenario = "default")
+#' }
 #'
 #' @export
 #' @importFrom dplyr %>% bind_rows filter
@@ -30,62 +31,68 @@
 convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
                         t = c(seq(2005, 2060, 5), seq(2070, 2110, 10), 2130, 2150),
                         gdx_refpolicycost = gdx_ref, testthat = FALSE) {
-
   # Define region subsets ----
   regionSubsetList <- toolRegionSubsets(gdx)
   # ADD EU-27 region aggregation if possible
-  if("EUR" %in% names(regionSubsetList)){
-    regionSubsetList <- c(regionSubsetList,list(
-      "EU27"=c("ENC","EWN","ECS","ESC","ECE","FRA","DEU","ESW")
+  if ("EUR" %in% names(regionSubsetList)) {
+    regionSubsetList <- c(regionSubsetList, list(
+      "EU27" = c("ENC", "EWN", "ECS", "ESC", "ECE", "FRA", "DEU", "ESW")
     ))
   }
 
   # main reporting ----
   output <- NULL
 
   message("running reportMacroEconomy...")
-  output <- mbind(output,reportMacroEconomy(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportMacroEconomy(gdx, regionSubsetList, t)[, t, ])
   message("running reportTrade...")
-  output <- mbind(output,reportTrade(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportTrade(gdx, regionSubsetList, t)[, t, ])
   message("running reportPE...")
-  output <- mbind(output,reportPE(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportPE(gdx, regionSubsetList, t)[, t, ])
   message("running reportSE...")
-  output <- mbind(output,reportSE(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportSE(gdx, regionSubsetList, t)[, t, ])
   message("running reportFE...")
-  output <- mbind(output,reportFE(gdx,regionSubsetList,t))
+  output <- mbind(output, reportFE(gdx, regionSubsetList, t))
   message("running reportExtraction...")
-  output <- mbind(output,reportExtraction(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportExtraction(gdx, regionSubsetList, t)[, t, ])
   message("running reportCapacity...")
-  output <- mbind(output,reportCapacity(gdx,regionSubsetList,t)[,t,])
-  #output <- mbind(output,reportLCOE(gdx)[,t,])     now moved to additional LCOE.mif file because many variables
+  output <- mbind(output, reportCapacity(gdx, regionSubsetList, t, gdx_ref = gdx_ref)[, t, ])
+  # output <- mbind(output,reportLCOE(gdx)[,t,])     now moved to additional LCOE.mif file because many variables
   message("running reportCapitalStock...")
-  output <- mbind(output,reportCapitalStock(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportCapitalStock(gdx, regionSubsetList, t, gdx_ref = gdx_ref)[, t, ])
   message("running reportEnergyInvestment...")
-  output <- mbind(output,reportEnergyInvestment(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportEnergyInvestment(gdx, regionSubsetList, t, gdx_ref = gdx_ref)[, t, ])
   message("running reportEmiAirPol...")
-  tmp <- try(reportEmiAirPol(gdx,regionSubsetList,t))  # test whether reportEmiAirPol works
+  tmp <- try(reportEmiAirPol(gdx, regionSubsetList, t))  # test whether reportEmiAirPol works
   if (!inherits(tmp, "try-error")) {
     if (!is.null(tmp)) output <- mbind(output, tmp[, t, ])
   } else {
     message("function reportEmiAirPol does not work and is skipped")
   }
 
   # reporting of variables that need variables from different other report functions
-  message("running reportEmi...")
-  output <- mbind(output,reportEmi(gdx,output,regionSubsetList,t)[,t,])    # needs output from reportFE
+  message("running reportEmi...") # needs output from reportFE
+  output <- mbind(output, reportEmi(gdx, output, regionSubsetList, t)[, t, ])
+
   message("running reportTechnology...")
-  output <- mbind(output,reportTechnology(gdx,output,regionSubsetList,t)[,t,])    # needs output from reportSE
+  # needs output from reportSE
+  output <- mbind(output, reportTechnology(gdx, output, regionSubsetList, t)[, t, ])
+
   message("running reportPrices...")
-  output <- mbind(output,reportPrices(gdx,output,regionSubsetList,t,gdx_ref = gdx_ref)[,t,]) # needs output from reportSE, reportFE, reportEmi, reportExtraction, reportMacroEconomy
+  # needs output from reportSE, reportFE, reportEmi, reportExtraction, reportMacroEconomy
+  output <- mbind(output, reportPrices(gdx, output, regionSubsetList, t, gdx_ref = gdx_ref)[, t, ])
+
   message("running reportCosts...")
-  output <- mbind(output,reportCosts(gdx,output,regionSubsetList,t)[,t,])  # needs output from reportEnergyInvestment, reportPrices, reportEnergyInvestments
+  # needs output from reportEnergyInvestment, reportPrices, reportEnergyInvestments
+  output <- mbind(output, reportCosts(gdx, output, regionSubsetList, t)[, t, ])
+
   message("running reportTax...")
-  output <- mbind(output,reportTax(gdx,output,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportTax(gdx, output, regionSubsetList, t)[, t, ])
 
   # cross variables ----
   # needs variables from different other report* functions
   message("running reportCrossVariables...")
-  output <- mbind(output,reportCrossVariables(gdx,output,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportCrossVariables(gdx, output, regionSubsetList, t)[, t, ])
 
   # policy costs, if possible and sensible ----
   if (is.null(gdx_refpolicycost)) {
@@ -94,15 +101,15 @@ convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
   if (file.exists(gdx_refpolicycost)) {
     gdp_scen <- try(readGDX(gdx, "cm_GDPscen", react = "error"), silent = TRUE)
     gdp_scen_ref <- try(readGDX(gdx_refpolicycost, "cm_GDPscen", react = "error"), silent = TRUE)
-    if (! inherits(gdp_scen, "try-error") && ! inherits(gdp_scen_ref, "try-error")) {
+    if (!inherits(gdp_scen, "try-error") && !inherits(gdp_scen_ref, "try-error")) {
       if (gdp_scen[1] == gdp_scen_ref[1]) {
         if (gdx == gdx_refpolicycost) {
           msg_refpc <- "reporting 0 everywhere"
         } else {
           msg_refpc <- paste0("comparing to ", basename(dirname(gdx_refpolicycost)), "/", basename(gdx_refpolicycost), "...")
         }
         message("running reportPolicyCosts, ", msg_refpc)
-        output <- mbind(output, reportPolicyCosts(gdx, gdx_refpolicycost, regionSubsetList, t)[,t,])
+        output <- mbind(output, reportPolicyCosts(gdx, gdx_refpolicycost, regionSubsetList, t)[, t, ])
       } else {
         warning("The GDP scenario differs from that of the reference run. Did not execute 'reportPolicyCosts'! ",
                 "If a policy costs reporting is desired, please use the 'policyCosts' output.R script.")
@@ -119,9 +126,9 @@ convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
 
   # SDP variables ----
   message("running reportSDPVariables...")
-  tmp <- try(reportSDPVariables(gdx,output,t))  # test whether reportSDPVariables works
+  tmp <- try(reportSDPVariables(gdx, output, t))  # test whether reportSDPVariables works
   if (!inherits(tmp, "try-error")) {
-    if(!is.null(tmp)) output <- tmp
+    if (!is.null(tmp)) output <- tmp
   } else {
     message("function reportSDPVariables does not work and is skipped")
   }
@@ -133,16 +140,16 @@ convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
   # clean and test output ----
   # Add dimension names "scenario.model.variable"
   getSets(output)[3] <- "variable"
-  output <- add_dimension(output,dim=3.1,add = "model",nm = "REMIND")
-  output <- add_dimension(output,dim=3.1,add = "scenario",nm = scenario)
+  output <- add_dimension(output, dim = 3.1, add = "model", nm = "REMIND")
+  output <- add_dimension(output, dim = 3.1, add = "scenario", nm = scenario)
 
   ## check variable names ----
   checkVarNames(getNames(output, dim = 3))
 
   ## summation checks ----
   .reportSummationErrors <- function(msg, testthat) {
-    if (!any(grepl('All summation checks were fine', msg))) {
-      msgtext <- paste(msg, collapse = '\n')
+    if (!any(grepl("All summation checks were fine", msg))) {
+      msgtext <- paste(msg, collapse = "\n")
       if (isTRUE(testthat)) warning("### Analyzing ", basename(gdx), ":\n", msgtext) else message(msgtext)
     }
   }
@@ -153,16 +160,16 @@ convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
       summationsFile = "extractVariableGroups",
       absDiff = 0.01, relDiff = 0.02, roundDiff = TRUE
     ),
-    type = 'message') %>%
+    type = "message") %>%
     .reportSummationErrors(testthat = testthat)
 
   capture.output(sumChecks <- checkSummations(
     mifFile = output, dataDumpFile = NULL, outputDirectory = NULL,
-    summationsFile = system.file('extdata/additional_summation_checks.csv',
-                                 package = 'remind2'),
+    summationsFile = system.file("extdata/additional_summation_checks.csv",
+                                 package = "remind2"),
     absDiff = 0.01, relDiff = 0.02, roundDiff = TRUE) %>%
-      bind_rows(sumChecks),
-    type = 'message'
+    bind_rows(sumChecks),
+    type = "message"
   ) %>%
     .reportSummationErrors(testthat = testthat)
 
@@ -174,7 +181,7 @@ convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
             "^Emi\\|CO2\\|Energy\\|Demand\\|Industry\\|.*Fossil \\(Mt CO2/yr\\)$",
             low = 0),
           list("Share.*\\((%|Percent)\\)$", low = 0, up = 100)),
-        reaction = 'warning')
+        reaction = "warning")
 
   # write or return output ----
   if (!is.null(file)) {
@@ -184,18 +191,17 @@ convGDX2MIF <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
 
     # write additional file on summation errors if needed
     if (nrow(sumChecks) > 0) {
-      summation_errors_file <- sub('(\\.[^.]+)$', '_summation_errors.csv', file)
+      summation_errors_file <- sub("(\\.[^.]+)$", "_summation_errors.csv", file)
       warning("Summation checks have revealed some gaps! See file ",
               summation_errors_file)
       write.csv(sumChecks, summation_errors_file, quote = FALSE, row.names = FALSE)
     }
-  }
-  else {
+  } else {
     # return summation errors as attribute
     if (nrow(sumChecks) > 0) {
       warning("Summation checks have revealed some gaps! ",
               "See `summation_errors` attribute on output for details.")
-      attr(output, 'summation_errors') <- sumChecks
+      attr(output, "summation_errors") <- sumChecks
     }
     return(output)
   }

R/convGDX2MIF_LCOE.R

@@ -23,11 +23,11 @@
 #' @importFrom magclass mbind write.report
 #' @importFrom utils write.table
 
-convGDX2MIF_LCOE <- function(gdx, gdx_ref, file = NULL, scenario = "default",
+convGDX2MIF_LCOE <- function(gdx, gdx_ref = NULL, file = NULL, scenario = "default",
                              t = c(seq(2005, 2060, 5), seq(2070, 2110, 10), 2130, 2150)) {
   # make the reporting
   output <- NULL
-  output <- mbind(output, reportLCOE(gdx)[, t, ])
+  output <- mbind(output, reportLCOE(gdx = gdx, gdx_ref = gdx_ref)[, t, ])
 
   # write the LCOE.mif or give back the magpie object output
   if (!is.null(file)) {

R/modifyInvestmentVariables.R

@@ -0,0 +1,41 @@
+#' Modify Investment Variables
+#'
+#' a helper to adapt investment variables in reporting after changes in
+#' https://github.com/remindmodel/remind/pull/1238
+#'
+#' for a given magclass object, calculates the value of each timestep
+#' as the average of this timestep and the next timestep
+#' the data for the last timestep in the magclass object remains unchanged
+#'
+#' @param x a magclass object to be manipulated
+#' @param ref an optional magclass object to be used for fixing values before 'startYear'
+#' @param startYear years before will be overwritten with values from 'ref'
+#'
+#'
+#' @author Falk Benke
+modifyInvestmentVariables <- function(x, ref = NULL, startYear = NULL) {
+
+  # obtain 't+1'
+  idx <- c(tail(getYears(x, as.integer = TRUE), -1), tail(getYears(x, as.integer = TRUE), 1))
+
+  # retrieve values for 't+1'  and assign to 't'
+  tmp <- x[, idx, ]
+  getItems(tmp, dim = 2) <- getItems(x, dim = 2)
+
+  # calculate average of 't' and 't'+1
+  x <- (x + tmp) / 2
+
+  if (!is.null(ref)) {
+    joinedYears <- intersect(getYears(x, as.integer = TRUE), getYears(ref, as.integer = TRUE))
+    fixedYears <- joinedYears[joinedYears < startYear]
+    if (length(fixedYears) == 0) {
+      return(x)
+    }
+    ref <- modifyInvestmentVariables(ref)
+    joinedNames <- intersect(getNames(x), getNames(ref))
+    joinedRegions <- intersect(getItems(ref, dim = 1), getItems(x, dim = 1))
+    x[joinedRegions, fixedYears, joinedNames] <- ref[joinedRegions, fixedYears, joinedNames]
+  }
+
+  return(x)
+}