You need to sign in or sign up before continuing.
Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
#' CAPRI gdx utilities
#'
#' simply loads the data cube from a CAPMOD result file
#'
#' @param filename Name of the .gdx file to be loaded
#'
#' @examples
#' load_dataout("test.gdx")
#'
load_dataout <- function(filename){
dataout <- rgdx.param(filename, "dataOut")
dataout <- as.tibble(dataout)
colnames(dataout) <- c("region","dim5","cols","rows","year","value")
return(dataout)
}
#' Load CAPRI results and filter to a user-specified subset of results
#'
#' @param filename Name of the file
#' @param selregion Character vector of regions, default = "all"
#' @param seldim5 Selection of the elements in the fifth dimension of the CAPRI data cube. By default it is the empty element
#' @param selcols Selection of columns in the CAPRI data cube
#' @param selrows Selection of rows in the CAPRI data cube
#' @param simyear Simulation year to be loaded/filtered
#' @param scenarionam Name of the scenario
#'
#' @example
#'
#'
#' # Extract pork balance from many scenario versions
#'
#'
#' get_pork_balance <- function(version) {
#'
#' return(capri_filter(filename = paste("gdx/baseline_", version, ".gdx", sep = ""),
#' seldim5 = "",
#' selcols = c("prod","hcon","proc","Imports_noIntra","Exports_noIntra"),
#' selrows = "pork",
#' selregion = c("eu","EU028000"),
#' simyear = "2030",
#' scenarioname = version))
#'
#'
#' }
#'
#'
#'
#'
#' get_pork_balance_n <- function(versions){
#'
#' pork_balance <- get_pork_balance(versions[1])
#'
#' for(i in versions){
#'
#' if(i != versions[1]){pork_balance <- rbind(pork_balance, get_pork_balance(i))}
#'
#' }
#'
#' return(pork_balance)
#' }
#'
#'
#' versions <- c("v5","v6","v7","v8","v9")
#'
#' pork_balance <- get_pork_balance_n(versions = versions)
#'
#'
#' @export
#'
capri_filter <- function(filename, selregion = "all", seldim5 = "", selcols, selrows, simyear = "2030", scenarioname = "baseline"){
x <- load_dataout(filename)
# the grepl-paste trick is needed for case insensitive filtering
if(length(seldim5)) {x <- x %>% filter(grepl(paste("\\b", paste(seldim5, collapse = "\\b|"), "\\b", sep =""),
dim5, ignore.case = TRUE))}
# special case for the filter (empty cell often specified for dim5 in the .gdx cube)
if(seldim5 == "") {x <- x %>% filter(dim5 == "")}
if(seldim5[1] == "-1") {x <- x %>% select(-dim5)}
if(selregion[1] != "all") {
if(length(selregion)) {x <- x %>% filter(grepl(paste("\\b", paste(selregion, collapse = "\\b|"), "\\b", sep =""),
region, ignore.case = TRUE))}
if(selregion[1] == "-1") {x <- x %>% select(-region)}
}
if(length(selcols)) {x <- x %>% filter(grepl(paste("\\b", paste(selcols, collapse = "\\b|"), "\\b", sep =""),
cols, ignore.case = TRUE))}
if(selcols[1] == "-1") {x <- x %>% select(-cols)}
if(length(selrows)) {x <- x %>% filter(grepl(paste("\\b", paste(selrows, collapse = "\\b|"), "\\b", sep =""),
rows, ignore.case = TRUE))}
if(selrows[1] == "-1") {x <- x %>% select(-rows)}
if(length(simyear)) {x <- x %>% filter(year %in% simyear)}
if(simyear[1] == "-1") {x <- x %>% select(-year)}
# optional regional selection
if(selregion[1] == "nuts0") {x <- x %>% filter(grepl("*000000", region))}
# optional scenario name to attach
if(nrow(x) > 0) {x$scenario <- scenarioname}
return(x)
}
#' function to calculate percentage changes
#'
#' @param a Base number of the percentage change calculation
#' @param b Target number of the percentage change calculation
#'
pchange <- function(a,b){(b-a)/abs(a)*100}
#' write a parameter into a .gdx file
#'
#' @param x R object
#' @param file Name of the output .gdx
#' @param symname Name of the GAMS parameter in the output .gdx file
#' @param ts GAMS parameter description
#'
#' @export
#'
write_param_togdx <- function(x, file, symname = "default", ts = "default") {
x <- data.frame(x)
attr(x, "symName") <- symname
attr(x, "ts") <- ts
wgdx.lst(file, x)
}