add fixing to reference to reportEnergyInvestment.R

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)[, 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)[, t, ])
   message("running reportEnergyInvestment...")
-  output <- mbind(output,reportEnergyInvestment(gdx,regionSubsetList,t)[,t,])
+  output <- mbind(output, reportEnergyInvestment(gdx, regionSubsetList, t)[, 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/reportEnergyInvestment.R

@@ -10,6 +10,8 @@
 #' be created.
 #' @param t temporal resolution of the reporting, default:
 #' t=c(seq(2005,2060,5),seq(2070,2110,10),2130,2150)
+#' @param gdx_ref a GDX object as created by readGDX, or the path to a gdx of the reference run.
+#' It is used to guarantee consistency for Moving Avg prices before cm_startyear
 #'
 #' @return MAgPIE object - contains the price variables
 #' @author Anastasis Giannousaki
@@ -24,7 +26,8 @@
 #' @importFrom gdx readGDX
 
 reportEnergyInvestment <- function(gdx, regionSubsetList = NULL,
-                                   t = c(seq(2005, 2060, 5), seq(2070, 2110, 10), 2130, 2150)) {
+                                   t = c(seq(2005, 2060, 5), seq(2070, 2110, 10), 2130, 2150),
+                                   gdx_ref = NULL) {
   # read sets
   adjte   <- readGDX(gdx, name = c("teAdj", "adjte"), format = "first_found")
   petyf   <- readGDX(gdx, c("peFos", "petyf"), format = "first_found")
@@ -236,5 +239,22 @@ reportEnergyInvestment <- function(gdx, regionSubsetList = NULL,
     tmp <- mbind(tmp, calc_regionSubset_sums(tmp, regionSubsetList))
 
   getSets(tmp)[3] <- "variable"
+
+  # reset values for years smaller than cm_startyear to avoid inconsistencies in cm_startyear - 5
+  cm_startyear <- as.integer(readGDX(gdx, name = "cm_startyear", format = "simplest"))
+  fixedYears <- getYears(tmp)[getYears(tmp, as.integer = TRUE) < cm_startyear]
+
+  if (!is.null(gdx_ref) && length(fixedYears) > 0) {
+    message("reportEnergyInvestment loads price for < cm_startyear from gdx_ref.")
+    ref <- try(reportEnergyInvestment(gdx_ref, regionSubsetList = regionSubsetList, t = t))
+    if (!inherits(ref, "try-error")) {
+      joinedNamesRep <- intersect(getNames(tmp), getNames(ref))
+      joinedRegions <- intersect(getItems(ref, dim = 1), getItems(tmp, dim = 1))
+      tmp[joinedRegions, fixedYears, joinedNamesRep] <- ref[joinedRegions, fixedYears, joinedNamesRep]
+    } else {
+      message("failed to run reportEnergyInvestment on gdx_ref")
+    }
+  }
+
   return(tmp)
 }

R/reportPrices.R

@@ -677,17 +677,20 @@ reportPrices <- function(gdx, output = NULL, regionSubsetList = NULL,
     out.reporting[, cm_startyear, ] <- 0.5 * (out[, cm_startyear - 5, ] + out[, cm_startyear + 5, ])
   }
   out.reporting <- lowpass(out.reporting)
+
   # reset values for years smaller than cm_startyear to avoid inconsistencies in cm_startyear - 5
-  if (!is.null(gdx_ref)) {
+  fixedyears <- getYears(out)[getYears(out, as.integer = TRUE) < cm_startyear]
+  if (!is.null(gdx_ref) && length(fixedyears) > 0) {
     message("reportPrices loads price for < cm_startyear from gdx_ref.")
     priceRef <- try(reportPrices(gdx_ref, output = NULL, regionSubsetList = regionSubsetList, t = t))
-    fixedyears <- getYears(out)[getYears(out, as.integer = TRUE) < cm_startyear]
-    if (!inherits(priceRef, "try-error") && length(fixedyears) > 0) {
+    if (!inherits(priceRef, "try-error")) {
       joinedNamesRep <- intersect(getNames(out), getNames(priceRef))
-      joinedRegions <- intersect(getRegions(priceRef), getRegions(out))
+      joinedRegions <- intersect(getItems(priceRef, dim = 1), getItems(out, dim = 1))
       out.reporting[joinedRegions, fixedyears, joinedNamesRep] <- priceRef[joinedRegions, fixedyears, joinedNamesRep]
       joinedNamesRaw <- intersect(getNames(out.rawdata), getNames(priceRef))
       out.rawdata[joinedRegions, fixedyears, joinedNamesRaw] <- priceRef[joinedRegions, fixedyears, joinedNamesRaw]
+    } else {
+      message("failed to run reportPrices on gdx_ref")
     }
   }