-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy pathcpi_inflator.R
206 lines (179 loc) · 8.26 KB
/
cpi_inflator.R
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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
#' CPI inflator
#'
#' @name cpi_inflator
#' @export
#' @param from_nominal_price (numeric) the price (or vector of prices) to be inflated
#' @param from_fy,to_fy (character) a character vector with each element in the form "2012-13" representing the financial years between which the CPI inflator is desired.
#'
#' If both \code{from_fy} and \code{to_fy} are \code{NULL} (the default), \code{from_fy} is set to the previous financial year and \code{to_fy} to the current financial year, with a warning. Setting only one is an error.
#' @param adjustment What CPI index to use ("none" = raw series, "seasonal", or "trimmed" [mean]).
#' @param useABSConnection Should the function connect with ABS.Stat via an SDMX connection? If \code{FALSE} (the default), a pre-prepared index table is used. This is much faster and more reliable (in terms of errors), though of course relies on the package maintainer to keep the tables up-to-date.
#'
#' If the SDMX connection fails, a message is emitted (not a warning) and
#' the function contines as if \code{useABSConnection = FALSE}.
#'
#' The internal data was updated on 2019-10-29 to 2019-Q2.
#' If using \code{useABSConnection = TRUE}, ensure you have \code{rsdmx (>= 0.5-10)} up-to-date.
#' @param allow.projection Should projections beyond the ABS's data be allowed?
#' @param accelerate.above An integer setting the threshold for 'acceleration'.
#' When the maximum length of the arguments exceeds this value, calculate each unique value individually
#' then combine. Set to 100,000 as a rule of thumb beyond which calculation speeds benefit
#' dramatically. Can be set to \code{Inf} to disable acceleration.
#' @examples
#' cpi_inflator(100, from_fy = "2005-06", to_fy = "2014-15")
#' @return The value of \code{from_nominal_price} in real (\code{to_fy}) dollars.
cpi_inflator <- function(from_nominal_price = 1,
from_fy = NULL,
to_fy = NULL,
adjustment = c("seasonal", "none", "trimmed.mean"),
useABSConnection = FALSE,
allow.projection = TRUE,
accelerate.above = 1e5L) {
# CRAN
obsTime <- obsValue <- NULL
if (is.null(from_fy) && is.null(to_fy)) {
to_fy <- date2fy(Sys.Date())
from_fy <- prev_fy(to_fy)
warning("`from_fy` and `to_fy` are missing, using previous and current financial years respectively")
}
if (is.null(from_fy)){
stop("`from_fy` is missing, with no default.")
}
if (is.null(to_fy)){
stop("`to_fy` is missing, with no default.")
}
check_TF(useABSConnection)
check_TF(allow.projection)
# Don't like vector recycling
# http://stackoverflow.com/a/9335687/1664978
max.length <-
prohibit_vector_recycling.MAXLENGTH(from_nominal_price, from_fy, to_fy)
if (max.length == 0L) {
warning("Zero-length arguments provided, returning double(0).")
return(double(0))
}
adjustment <- match.arg(adjustment, several.ok = FALSE)
if (max.length > accelerate.above &&
# don't connect for every group
!useABSConnection &&
length(from_nominal_price) == 1L) {
if (length(to_fy) == 1L) {
cpi_fun <- function(x) {
cpi_inflator(from_nominal_price = from_nominal_price[[1L]],
from_fy = x,
to_fy = to_fy[[1L]],
adjustment = adjustment[[1L]],
useABSConnection = FALSE,
allow.projection = allow.projection[[1L]],
accelerate.above = Inf)
}
return(accel_repetitive_input(from_fy, cpi_fun))
}
if (length(from_fy) == 1L) {
cpi_fun <- function(x) {
cpi_inflator(from_nominal_price = from_nominal_price[[1L]],
from_fy = from_fy[[1L]],
to_fy = x,
adjustment = adjustment[[1L]],
useABSConnection = FALSE,
allow.projection = allow.projection[[1L]],
accelerate.above = Inf)
}
return(accel_repetitive_input(to_fy, cpi_fun))
}
}
cpi.indices <-
if (useABSConnection) {
switch(adjustment,
"none" = url <-
"http://stat.data.abs.gov.au/restsdmx/sdmx.ashx/GetData/CPI/1.50.10001.10.Q/ABS?startTime=1948",
"seasonal" = url <-
"http://stat.data.abs.gov.au/restsdmx/sdmx.ashx/GetData/CPI/1.50.999901.10+20.Q/ABS?startTime=1948",
"trimmed.mean" = url <-
"http://stat.data.abs.gov.au/restsdmx/sdmx.ashx/GetData/CPI/1.50.999902.10+20.Q/ABS?startTime=1948")
# nocov start
sdmx_ok <- TRUE
cpi <- tryCatch(rsdmx::readSDMX(url),
error = function(e) {
sdmx_ok <<- FALSE
message("SDMX failed with error ", e$m,
"falling back to useABSConnection = FALSE.")
switch(adjustment,
"none" = cpi_unadj_fy,
"seasonal" = cpi_seasonal_adjustment_fy,
"trimmed.mean" = cpi_trimmed_fy)
})
# nocov end
if (sdmx_ok) {
message("Using ABS sdmx connection")
as.data.frame(cpi) %>%
as.data.table %>%
.[endsWith(obsTime, "Q1")] %>%
.[, "fy_year" := yr2fy(as.integer(sub("-Q1", "", obsTime, fixed = TRUE)))]
} else {
cpi # nocov
}
} else {
switch(adjustment,
"none" = cpi_unadj_fy,
"seasonal" = cpi_seasonal_adjustment_fy,
"trimmed.mean" = cpi_trimmed_fy)
}
permitted_fys <- .subset2(cpi.indices, "fy_year")
earliest_from_fy <- permitted_fys[[1L]]
cpi_table_nom <-
switch(adjustment,
"none" = "first instance of the unadjusted CPI",
"seasonal" = "first instance of the seasonally adjusted CPI",
"trimmed.mean" = "first instance of the trimmed mean CPI")
the_min.yr <-
switch(adjustment,
"none" = min.cpi_unadj.yr,
"seasonal" = min.cpi_seasonal_adjustment.yr,
"trimmed.mean" = min.cpi_trimmed.yr)
the_max.yr <-
switch(adjustment,
"none" = max.cpi_unadj.yr,
"seasonal" = max.cpi_seasonal_adjustment.yr,
"trimmed.mean" = max.cpi_trimmed.yr)
from_fy <- validate_fys_permitted(from_fy,
min.yr = the_min.yr,
# else 2050L because we will need max year later
max.yr = if (!allow.projection) the_max.yr else 2050L,
deparsed = "from_fy",
allow.projection = allow.projection,
earliest_permitted_financial_year = cpi_table_nom)
to_fy <- validate_fys_permitted(to_fy,
min.yr = the_min.yr,
max.yr = if (!allow.projection) the_max.yr else 2050L,
deparsed = "to_fy",
allow.projection = allow.projection,
earliest_permitted_financial_year = cpi_table_nom)
if (max_fy2yr(to_fy) > the_max.yr ||
max_fy2yr(from_fy) > the_max.yr) {
# Number of years beyond the data our forecast must reach
years.beyond <- max_fy2yr(to_fy) - max_fy2yr(permitted_fys)
cpi_index_forecast <-
cpi.indices %$%
gforecast(obsValue, h = years.beyond) %$%
as.numeric(mean)
cpi.indices.new <-
setDT(list(fy_year = yr2fy(seq(max_fy2yr(permitted_fys) + 1L,
max_fy2yr(to_fy),
by = 1L)),
obsValue = cpi_index_forecast))
# TODO: fy should inherit 'character'
cpi.indices.new[, fy_year := as.character(fy_year)]
cpi.indices <-
rbindlist(list(cpi.indices, cpi.indices.new),
use.names = TRUE,
fill = TRUE)
}
inflator(from_nominal_price,
from = from_fy,
to = to_fy,
inflator_table = cpi.indices,
index.col = "obsValue",
time.col = "fy_year",
max.length = max.length)
}