-
Notifications
You must be signed in to change notification settings - Fork 0
/
update.aggregation_structure.R
65 lines (65 loc) · 2.06 KB
/
update.aggregation_structure.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
#' Update an aggregation structure
#'
#' Price update the weights in a price index aggregation structure.
#'
#' @param object A price index aggregation structure, as made by
#' [aggregation_structure()].
#' @param index A price index, or something that can be coerced into one.
#' Usually an aggregate price index as made by
#' [`aggregate()`][aggregate.piar_index].
#' @param period The time period used to price update the weights. The default
#' uses the last period in `index`.
#' @param r Order of the generalized mean to update the weights. The default is
#' 1 for an arithmetic index.
#' @param ... Not currently used.
#'
#' @returns
#' A copy of `object` with price-updated weights using the index
#' values in `index`.
#'
#' @seealso
#' [`aggregate()`][aggregate.piar_index] to make an aggregated price index.
#'
#' @examples
#' # A simple aggregation structure
#' # 1
#' # |-----+-----|
#' # 11 12
#' # |---+---| |
#' # 111 112 121
#' # (1) (3) (4)
#'
#' aggregation_weights <- data.frame(
#' level1 = c("1", "1", "1"),
#' level2 = c("11", "11", "12"),
#' ea = c("111", "112", "121"),
#' weight = c(1, 3, 4)
#' )
#'
#' pias <- as_aggregation_structure(aggregation_weights)
#'
#' index <- as_index(
#' matrix(1:9, 3, dimnames = list(c("111", "112", "121"), NULL))
#' )
#'
#' weights(pias, ea_only = FALSE)
#'
#' weights(update(pias, index), ea_only = FALSE)
#'
#' @importFrom stats update
#' @family aggregation structure methods
#' @export
update.piar_aggregation_structure <- function(object, index,
period = end(index), ...,
r = 1) {
price_update <- gpindex::factor_weights(r)
index <- as_index(index)
period <- match_time(as.character(period), index$time)
eas <- match(object$levels[[length(object$levels)]], index$levels)
if (anyNA(eas)) {
warning("not all weights in 'object' have a corresponding index value")
}
epr <- chain(index)$index[[period]]
weights(object) <- price_update(epr[eas], object$weights)
object
}