GCAMEurope connection

.gitignore

@@ -51,6 +51,9 @@ figures/
 outputs_di/
 outputs_dii/
 
+# GCAM
+output
+*.dat
 
 # Tests
 tests/testthat/test_inputs/csv/*

DESCRIPTION

@@ -32,9 +32,12 @@ Imports:
   	stringr,
   	here,
 	  spatstat.geom,
-	  tibble
+	  tibble,
+	  countrycode
 Remotes:
     github::JGCRI/rpackageutils,
+    github::JGCRI/gcamdata,
+    github::JGCRI/rgcam,
     github::eurostat/restatapi
 Suggests: 
     rmarkdown,

NAMESPACE

@@ -14,6 +14,7 @@ export(check_year)
 export(elevate_hbs)
 export(ex_shocks)
 export(ex_var_intersec)
+export(get_prices_gcam)
 export(id_ep1)
 export(id_ep2)
 export(id_tp)
@@ -22,9 +23,11 @@ export(impact_intersectional)
 export(intersectional_graph)
 export(load_rawhbs)
 export(order_var)
+export(order_vars)
 export(price_shock)
 export(rename_values)
 export(standardize)
 export(weighted.median)
 export(weighted.quantile)
 importFrom(dplyr,"%>%")
+importFrom(magrittr,"%>%")

R/data.R

@@ -662,3 +662,15 @@
 #' @source medusa
 #' @format .csv
 "graph_labels"
+
+#' Mapping between the GCAM items names and the COICOP codes
+#'
+#' @source medusa
+#' @format .csv
+"mapping_gcam_medusa"
+
+#' List of all COICOP codes available in MEDUSA
+#'
+#' @source medusa
+#' @format .csv
+"all_coicop"

R/models_connections.R

@@ -0,0 +1,199 @@
+#' get_prices_gcameurope
+#'
+#' Extract and format prices from a GCAM-Europe database or project file for MEDUSA.
+#' @keywords GCAM, GCAM-Europe, prices.
+#' @return a dataframe with prices by sector and GCAM-Europe region.
+#' @param db_path Path to the GCAM-Europe database.
+#' @param query_path Path to the query file.
+#' @param db_name Name of the GCAM-Europe database.
+#' @param prj_name Name of the rgcam project. This can be an existing project, or, if not, this will be the newly created project name.
+#' @param scenarios Vector names of the GCAM-Europe scenarios to be processed.
+#' @param queries Name of the GCAM-Europe query file. The file by default includes the queries required to run rfasst.
+#' @param final_db_year Final year in the GCAM-Europe database (this allows to process databases with user-defined "stop periods").
+#' @param saveOutput Writes the files.By default=T.
+#' @param base_scen The base scenario that other scenarios will be compared against.
+#' @param selected_year The year of analysis, when the scenarios will be compared.
+#' @importFrom magrittr %>%
+#' @export
+get_prices_gcameurope <- function(db_path = NULL, query_path = "inst/extdata", db_name = NULL, prj_name,
+                            scenarios, queries = "queries_GCAM_MEDUSA.xml", final_db_year = 2100,
+                            saveOutput = T, base_scen, selected_year) {
+
+  # Set countries
+  EU_COUNTRIES <- c("Austria", "Belgium", "Bulgaria", "Croatia",
+                    "Cyprus", "Czech Republic", "Denmark",
+                    "Estonia", "Finland", "France", "Germany",
+                    "Greece", "Hungary", "Ireland", "Italy",
+                    "Latvia", "Lithuania", "Luxembourg", "Malta",
+                    "Netherlands", "Poland", "Portugal", "Romania",
+                    "Slovakia", "Slovenia", "Spain", "Sweden")
+
+  crop_prod_COUNTRY <- "Austria"
+
+  # Set crop coicop codes (for adjustment)
+  crop_coicop_codes <- c("CP01111",
+                         "CP01112",
+                         "CP01154",
+                         "CP0116",
+                         "CP01163",
+                         "CP0117",
+                         "CP01176",
+                         "CP01181")
+
+  # Set delivered biomass code (not working well)
+  deliv_bio_coicop <- "CP04549"
+
+  # Load price mapping files
+  map_price <- medusa::mapping_gcam_medusa %>%
+    dplyr::filter(query == "prices by sector") %>%
+    dplyr::select(sector = gcam) %>%
+    dplyr::distinct() %>%
+    dplyr::pull()
+
+  map_cost <- medusa::mapping_gcam_medusa %>%
+    dplyr::filter(query == "costs by subsector") %>%
+    dplyr::select(sector = gcam) %>%
+    dplyr::distinct() %>%
+    dplyr::pull()
+
+  # Load or create the rgcam project:
+  if (!is.null(db_path) & !is.null(db_name)) {
+    rlang::inform('Creating project ...')
+    conn <- rgcam::localDBConn(db_path,
+                               db_name,migabble = FALSE)
+
+    prj <- rgcam::addScenario(conn = conn,
+                              proj = prj_name,
+                              scenario = scenarios,
+                              queryFile = paste0(query_path,"/",queries),
+                              clobber = F,
+                              saveProj = F)
+
+    if (!file.exists('output')) dir.create('output')
+    rgcam::saveProject(prj, file = file.path('output',prj_name))
+
+  } else {
+    rlang::inform('Loading project ...')
+    prj <- rgcam::loadProject(prj_name)
+
+  }
+
+
+  rlang::inform('Extracting prices ...')
+
+
+  prices <- rgcam::getQuery(prj, "prices by sector") %>%
+    dplyr::filter(region %in% EU_COUNTRIES,
+                  sector %in% map_price)
+
+  costs <- rgcam::getQuery(prj, "costs by subsector") %>%
+    dplyr::filter(region %in% EU_COUNTRIES,
+                  subsector %in% map_cost) %>%
+    dplyr::select(-sector) %>%
+    dplyr::rename(sector = subsector)
+
+
+  data <- dplyr::bind_rows(
+    prices,
+    costs
+  )
+
+  # -----
+  # Aggregate to COICOP categories
+  coicop_map <- medusa::mapping_gcam_medusa %>%
+    dplyr::select(-query) %>%
+    dplyr::rename(sector = gcam)
+
+  data_coicop <- data %>%
+    dplyr::filter(year == selected_year) %>%
+    dplyr::left_join(coicop_map, by = "sector", relationship = "many-to-many") %>%
+    dplyr::group_by(scenario, region, coicop, year) %>%
+    dplyr::summarise(value = mean(value)) %>%
+    dplyr::ungroup()
+
+  # -----
+  # Compute price changes in relation to base_scen
+  data_coicop_diff <- data_coicop %>%
+    dplyr::filter(scenario != base_scen) %>%
+    gcamdata::left_join_error_no_match(
+      data_coicop %>%
+        dplyr::filter(scenario == base_scen) %>%
+        dplyr::rename(value_base = value) %>%
+        dplyr::select(-scenario),
+      by = c("region", "coicop", "year")
+    ) %>%
+    # filter out negative prices from delivered biomass
+    dplyr::filter(coicop != deliv_bio_coicop) %>%
+    dplyr::mutate(price_diff = value / value_base)
+
+
+  # With the new structure, we need to adjust price changes in crops: The price change in Austria
+  # should be extended to all EU countries
+  data_coicop_adjCrop <- data_coicop_diff %>%
+    dplyr::filter(region == 'Austria') %>%
+    dplyr::filter(coicop %in% crop_coicop_codes) %>%
+    dplyr::select(-region) %>%
+    tibble::as_tibble() %>%
+    gcamdata::repeat_add_columns(tibble::tibble(region = EU_COUNTRIES))
+
+
+  # Create the final dataset:
+  data_coicop_fin <- data_coicop_diff %>%
+    dplyr::filter(!coicop %in% crop_coicop_codes) %>%
+    dplyr::bind_rows(
+      data_coicop_adjCrop
+    ) %>%
+    dplyr::mutate(
+      eurostat_code = countrycode::countrycode(region, origin = "country.name", destination = "eurostat")
+    ) %>%
+    dplyr::mutate(ctry_sce = paste0(eurostat_code, "_", scenario)) %>%
+    dplyr::select(ctry_sce, coicop, price_diff) %>%
+    dplyr::mutate(price_diff = dplyr::if_else(is.nan(price_diff), 1, price_diff)) %>%
+    dplyr::distinct() %>%
+    tidyr::pivot_wider(
+      names_from = ctry_sce,
+      values_from = price_diff
+    )
+
+  # -------
+  # Add all the remaining coicop categories (with no change, value = 1)
+  data_coicop_fin_full <- data_coicop_diff %>%
+    dplyr::filter(!coicop %in% crop_coicop_codes) %>%
+    dplyr::bind_rows(
+      data_coicop_adjCrop
+    ) %>%
+    dplyr::mutate(
+      eurostat_code = countrycode::countrycode(region, origin = "country.name", destination = "eurostat")
+    ) %>%
+    dplyr::mutate(ctry_sce = paste0(eurostat_code, "_", scenario)) %>%
+    dplyr::select(ctry_sce, coicop, price_diff) %>%
+    dplyr::mutate(price_diff = dplyr::if_else(is.nan(price_diff), 1, price_diff)) %>%
+    tidyr::complete(tidyr::nesting(ctry_sce), coicop = medusa::all_coicop) %>%
+    tidyr::replace_na(list(price_diff = 1)) %>%
+    tidyr::pivot_wider(
+      names_from = ctry_sce,
+      values_from = price_diff
+    )
+
+  # -------
+  # Add names column
+  names_coicop_map <- get(paste0("coicop_", selected_year)) %>%
+    dplyr::select(names, coicop) %>%
+    dplyr::distinct() %>%
+    dplyr::mutate(coicop = stringr::str_replace(coicop, 'EUR_A_', 'CP'))
+
+  data_coicop_fin_full_names <- data_coicop_fin_full %>%
+    dplyr::right_join(names_coicop_map, by = 'coicop') %>%
+    dplyr::relocate(last_col())
+
+
+  # -------
+  # Save and return
+  file_name <- paste0('GCAMEurope_shocks_',stringr::str_remove(prj_name,'.dat'),'.csv')
+  write.csv(data_coicop_fin, file = file.path('output',file_name))
+  print(paste0("The GCAM-Europe prices file has been saved in`", getwd(),"/output/",file_name))
+
+  return(invisible(data_coicop_fin_full))
+
+}
+

inst/extdata/mapping_gcam_medusa.csv

@@ -0,0 +1,36 @@
+query,gcam,coicop
+prices by sector,regional rice,CP01111
+prices by sector,regional corn,CP01112
+prices by sector,regional othergrain,CP01112
+prices by sector,regional wheat,CP01112
+prices by sector,regional beef,CP01121
+prices by sector,regional pork,CP01122
+prices by sector,regional sheepgoat,CP01123
+prices by sector,regional poultry,CP01124
+prices by sector,regional dairy,CP0114
+prices by sector,regional oilcrop,CP01154
+prices by sector,regional fruits,CP0116
+prices by sector,regional nuts_seeds,CP01163
+prices by sector,regional vegetables,CP0117
+prices by sector,regional legumes,CP01176
+prices by sector,regional root_tuber,CP01176
+prices by sector,regional sugarcrop,CP01181
+prices by sector,cement,CP04310
+prices by sector,water_td_muni_C,CP0441
+prices by sector,elect_td_bld,CP04510
+prices by sector,delivered gas,CP04521
+prices by sector,delivered coal,CP04541
+prices by sector,delivered biomass,CP04549
+prices by sector,district heat,CP0455/0
+prices by sector,refined liquids enduse,CP07221
+prices by sector,refined liquids enduse,CP07222
+prices by sector,refined liquids enduse,CP04530
+prices by sector,elect_td_trn,CP07223
+costs by subsector,HSR,CP07311
+costs by subsector,Passenger Rail,CP07311
+costs by subsector,Passenger Rail,CP07312
+costs by subsector,Bus,CP07321
+costs by subsector,Domestic Aviation,CP07331
+prices by sector,trn_aviation_intl,CP07332
+prices by sector,N fertilizer,CP09331
+prices by sector,paper,CP09541

inst/extdata/queries_GCAM_MEDUSA.xml

@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<queries>
+   <aQuery>
+     <all-regions/>
+        <supplyDemandQuery title="prices by sector">
+                <axis1 name="sector">sector</axis1>
+                <axis2 name="Year">cost</axis2>
+                <xPath buildList="true" dataName="Price" group="false" sumAll="false">*[@type = 'sector']/cost/text()</xPath>
+                <comments/>
+            </supplyDemandQuery>
+   </aQuery>
+   <aQuery>
+            <supplyDemandQuery title="costs by subsector">
+                <axis1 name="subsector">subsector</axis1>
+                <axis2 name="Year">cost</axis2>
+                <xPath buildList="true" dataName="Price" group="false" sumAll="false">*[@type='sector' and (local-name()!='AgSupplySector')]/*[@type = 'subsector']/cost/text()</xPath>
+                <comments>Excludes AgSupplySubsector costs, where data written out are no meaningful</comments>
+            </supplyDemandQuery> 
+   </aQuery>   
+</queries>