Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

REMIND/EDGE-T variable harmonization #650

Merged
merged 6 commits into from
Aug 27, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .buildlibrary
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
ValidationKey: '229736538'
ValidationKey: '229791032'
AcceptedWarnings:
- 'Warning: package ''.*'' was built under R version'
- 'Warning: namespace ''.*'' is not available and has been replaced'
Expand Down
4 changes: 2 additions & 2 deletions CITATION.cff
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,8 @@ cff-version: 1.2.0
message: If you use this software, please cite it using the metadata from this file.
type: software
title: 'remind2: The REMIND R package (2nd generation)'
version: 1.151.1
date-released: '2024-08-23'
version: 1.151.2
date-released: '2024-08-26'
abstract: Contains the REMIND-specific routines for data and model output manipulation.
authors:
- family-names: Rodrigues
Expand Down
9 changes: 3 additions & 6 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Type: Package
Package: remind2
Title: The REMIND R package (2nd generation)
Version: 1.151.1
Date: 2024-08-23
Version: 1.151.2
Date: 2024-08-26
Authors@R: c(
person("Renato", "Rodrigues", , "[email protected]", role = c("aut", "cre")),
person("Lavinia", "Baumstark", role = "aut"),
Expand Down Expand Up @@ -49,12 +49,9 @@ Imports:
data.table,
dplyr (>= 1.1.1),
gdx (>= 1.53.0),
gdxdt,
gdxrrw,
ggplot2,
gms,
htmltools,
knitr,
lucode2 (>= 0.43.0),
lusweave,
madrat (>= 3.11.3),
Expand All @@ -70,11 +67,11 @@ Imports:
reshape2,
rlang,
rmarkdown,
rmndt,
tibble,
tidyr,
tidyselect,
withr,
knitr,
yaml,
digest
Suggests:
Expand Down
11 changes: 0 additions & 11 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,6 @@ export(reportClimate)
export(reportCosts)
export(reportCrossVariables)
export(reportDIETER)
export(reportEDGETransport)
export(reportEmi)
export(reportEmiAirPol)
export(reportEmiForClimateAssessment)
Expand Down Expand Up @@ -84,16 +83,10 @@ importFrom(abind,abind)
importFrom(assertr,assert)
importFrom(assertr,not_na)
importFrom(data.table,":=")
importFrom(data.table,CJ)
importFrom(data.table,as.data.table)
importFrom(data.table,copy)
importFrom(data.table,data.table)
importFrom(data.table,fread)
importFrom(data.table,frollmean)
importFrom(data.table,fwrite)
importFrom(data.table,rbindlist)
importFrom(data.table,setDT)
importFrom(data.table,setnames)
importFrom(digest,digest)
importFrom(dplyr,"%>%")
importFrom(dplyr,across)
Expand Down Expand Up @@ -124,7 +117,6 @@ importFrom(dplyr,tibble)
importFrom(dplyr,tribble)
importFrom(dplyr,ungroup)
importFrom(gdx,readGDX)
importFrom(gdxdt,readgdx)
importFrom(gdxrrw,gdxInfo)
importFrom(ggplot2,aes)
importFrom(ggplot2,aes_)
Expand Down Expand Up @@ -242,9 +234,6 @@ importFrom(rlang,is_empty)
importFrom(rlang,sym)
importFrom(rlang,syms)
importFrom(rmarkdown,render)
importFrom(rmndt,approx_dt)
importFrom(rmndt,readMIF)
importFrom(rmndt,writeMIF)
importFrom(tibble,as_tibble)
importFrom(tibble,tibble)
importFrom(tibble,tribble)
Expand Down
145 changes: 73 additions & 72 deletions R/calc_CES_marginals.R
Original file line number Diff line number Diff line change
@@ -1,147 +1,148 @@
#' Calculate CES Marginals
#'
#'
#' Calculate marginals on the REMIND CES function and combine them to prices.
#'
#'
#' Marginals are calculated analytically
#' \deqn{\frac{\partial V_i}{\partial V_o} = \xi_i (\theta_i \delta_i)^{\rho_o}
#' \deqn{\frac{\partial V_i}{\partial V_o} = \xi_i (\theta_i \delta_i)^{\rho_o}
#' {V_o}^{1 - \rho_o} {V_i}^{\rho_o - 1}}
#' and prices by recursively applying the chain rule
#' \deqn{\pi_i = \frac{\partial V_i}{\partial V_o} \pi_o
#' \deqn{\pi_i = \frac{\partial V_i}{\partial V_o} \pi_o
#' \quad \forall (i,o) \in CES}
#'
#' @md
#' @param gdxName Vector of paths to `.gdx` files.
#' @param id If several `.gdx` files are read, an id column is appended to the
#' @param id If several `.gdx` files are read, an id column is appended to the
#' result; either `file`, with the paths of the originating `.gdx` files,
#' or `scenario`, with the content of `c_expname`.
#'
#' @return A `data frame` with columns `pf` (production factor), `t`, `regi`,
#' `marginal`, `price`, and `file` (path to originating `.gdx` file).
#'
#'
#' @importFrom quitte read.gdx
#' @importFrom dplyr %>% left_join filter sym select rename mutate pull
#' @importFrom dplyr %>% left_join filter sym select rename mutate pull
#' @importFrom data.table :=
#' @importFrom tidyr pivot_wider drop_na
#' @importFrom gdxrrw gdxInfo
#' @importFrom rlang is_empty

#' @export
calc_CES_marginals <- function(gdxName, id = 'file') {

if (all(!is.null(id), !id %in% c('file', 'scenario'))) {
warning('id must be either "file" or "scenario". Defaulting to "file".')
id <- 'file'
}

gdxName <- path.expand(gdxName)

.calc_CES_marginals <- function(gdxName, id) {
# ---- read required items from gdx ----
pm_cesdata <- read.gdx(gdxName, 'pm_cesdata',
colNames = c('t', 'regi', 'pf', 'param', 'value'))

vm_effGr <- read.gdx(gdxName, 'vm_effGr',
colNames = c('t', 'regi', 'pf', 'effGr'))

vm_cesIO <- read.gdx(gdxName, 'vm_cesIO',
colNames = c('t', 'regi', 'pf', 'value'))

cesOut2cesIn <- read.gdx(gdxName, 'cesOut2cesIn',
colNames = c('pf.out', 'pf.in'))

# ---- calculate marginals ----
marginals <- cesOut2cesIn %>%
marginals <- cesOut2cesIn %>%
left_join(
pm_cesdata %>%
filter(!!sym('param') %in% c('xi', 'eff')) %>%
pivot_wider(names_from = 'param') %>%
pm_cesdata %>%
filter(!!sym('param') %in% c('xi', 'eff')) %>%
pivot_wider(names_from = 'param') %>%
drop_na(),

c('pf.in' = 'pf')
) %>%
) %>%
left_join(
pm_cesdata %>%
filter('rho' == !!sym('param')) %>%
pm_cesdata %>%
filter('rho' == !!sym('param')) %>%
select(-'param', 'rho' = 'value'),

c('t', 'regi', 'pf.out' = 'pf')
) %>%
) %>%
left_join(
vm_effGr,

c('t', 'regi', 'pf.in' = 'pf')
) %>%
) %>%
left_join(
vm_cesIO %>%
rename('value.in' = 'value'),
vm_cesIO %>%
rename('value.in' = 'value'),

c('t', 'regi', 'pf.in' = 'pf')
) %>%
) %>%
left_join(
vm_cesIO %>%
vm_cesIO %>%
rename('value.out' = 'value'),

c('t', 'regi', 'pf.out' = 'pf')
) %>%
) %>%
mutate(
# ^ !!sym() doesn't work, so use the explicit function call
!!sym('marginal') := !!sym('xi')
!!sym('marginal') := !!sym('xi')
* (!!sym('eff') * !!sym('effGr')) ^ (!!sym('rho'))
* `^`(!!sym('value.out'), 1 - !!sym('rho'))
* `^`(!!sym('value.in'), !!sym('rho') - 1))

# ---- calculate prices recursively using the chain rule ----
CES_root <- setdiff(cesOut2cesIn$pf.out, cesOut2cesIn$pf.in)
prices <- marginals %>%
filter(!!sym('pf.out') %in% CES_root) %>%

prices <- marginals %>%
filter(!!sym('pf.out') %in% CES_root) %>%
select('pf' = 'pf.in', 't', 'regi', 'price' = 'marginal')
CES_root <- cesOut2cesIn %>%
filter(!!sym('pf.out') %in% CES_root) %>%

CES_root <- cesOut2cesIn %>%
filter(!!sym('pf.out') %in% CES_root) %>%
pull('pf.in')

while (!is_empty(CES_root)) {
prices <- bind_rows(
prices,
marginals %>%
filter(!!sym('pf.out') %in% CES_root) %>%
select('pf' = 'pf.in', 't', 'regi', 'price' = 'marginal') %>%
left_join(cesOut2cesIn, c('pf' = 'pf.in')) %>%

marginals %>%
filter(!!sym('pf.out') %in% CES_root) %>%
select('pf' = 'pf.in', 't', 'regi', 'price' = 'marginal') %>%
left_join(cesOut2cesIn, c('pf' = 'pf.in')) %>%
left_join(
prices %>%
rename('price.out' = 'price'),
prices %>%
rename('price.out' = 'price'),

c('t', 'regi', 'pf.out' = 'pf')
) %>%
mutate(!!sym('price') := !!sym('price') * !!sym('price.out')) %>%
) %>%
mutate(!!sym('price') := !!sym('price') * !!sym('price.out')) %>%
select('pf', 't', 'regi', 'price')
)
CES_root <- cesOut2cesIn %>%
filter(!!sym('pf.out') %in% CES_root) %>%

CES_root <- cesOut2cesIn %>%
filter(!!sym('pf.out') %in% CES_root) %>%
pull('pf.in')
}

# ---- bind marginals and prices together ----
r <- bind_rows(
marginals %>%
select('pf' = 'pf.in', 't', 'regi', 'value' = 'marginal') %>%
marginals %>%
select('pf' = 'pf.in', 't', 'regi', 'value' = 'marginal') %>%
mutate(!!sym('name') := 'marginal'),
prices %>%
rename('value' = 'price') %>%

prices %>%
rename('value' = 'price') %>%
mutate(!!sym('name') := 'price')
) %>%
) %>%
pivot_wider()

if (id) {
r <- r %>%
mutate(!!sym('scenario') := read.gdx(gdxName, 'c_expname',
colNames = 'c_expname') %>%
r <- r %>%
mutate(!!sym('scenario') := read.gdx(gdxName, 'c_expname',
colNames = 'c_expname') %>%
pull('c_expname'))
}

return(r)
}

Expand All @@ -158,19 +159,19 @@ calc_CES_marginals <- function(gdxName, id = 'file') {
}
)
}

# ---- bind results for all valid input files together ----
r <- bind_rows(
lapply(gdxName, function(gdxName) {
.calc_CES_marginals(gdxName, id = all(!is.null(id), id == 'scenario')) %>%
.calc_CES_marginals(gdxName, id = all(!is.null(id), id == 'scenario')) %>%
mutate(file = gdxName)
})
)

if (any(is.null(id), 'file' != id)) {
r <- r %>%
r <- r %>%
select(-file)
}

return(r)
}
1 change: 1 addition & 0 deletions R/plotNashConvergence.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@
#' @importFrom gdx readGDX
#' @importFrom dplyr summarise group_by mutate filter distinct case_when
#' @importFrom quitte as.quitte
#' @importFrom data.table :=
#' @importFrom mip plotstyle
#' @importFrom ggplot2 scale_y_continuous scale_x_continuous scale_y_discrete
#' scale_fill_manual scale_color_manual coord_cartesian aes_ geom_rect
Expand Down
3 changes: 2 additions & 1 deletion R/reportCrossVariables.R
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@
#' @importFrom magclass getYears getRegions mbind setNames mselect
#' new.magpie setYears mcalc
#' @importFrom tibble as_tibble
#' @importFrom data.table :=
#' @importFrom tidyselect everything
#' @importFrom madrat toolAggregate
#'
Expand Down Expand Up @@ -234,7 +235,7 @@ reportCrossVariables <- function(gdx, output = NULL, regionSubsetList = NULL,
output[,,"FE|Transport|Liquids (EJ/yr)"] * output[,,"Price|Final Energy|Transport|Liquids (US$2005/GJ)"] +
output[,,"FE|Transport|Hydrogen (EJ/yr)"] * output[,,"Price|Final Energy|Transport|Hydrogen (US$2005/GJ)"] +
output[,,"FE|Transport|Electricity (EJ/yr)"] * output[,,"Price|Final Energy|Transport|Electricity (US$2005/GJ)"],
"Expenditure|Transport|Fuel (billion $US/yr)"))
"Expenditure|Transport|Fuel (billion US$2005/yr)"))

# calculate intensities growth
int_gr <- new.magpie(getRegions(tmp),getYears(tmp),c("Intensity Growth|GDP|Final Energy (% pa)","Intensity Growth|GDP|Final Energy to 2005 (% pa)",
Expand Down
Loading