-
Notifications
You must be signed in to change notification settings - Fork 0
/
split.piar_index.R
61 lines (60 loc) · 1.77 KB
/
split.piar_index.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
#' Split an index into groups
#'
#' Split an index into groups of indexes according to a factor, along either
#' the levels or time periods of the index.
#'
#' @param x A price index, as made by, e.g., [elemental_index()].
#' @param f A factor or list of factors to group elements of `x`.
#' @param drop Should levels that do not occur in `f` be dropped? By default
#' all levels are kept.
#' @param margin Either 'levels' to split over the levels of `x` (the default),
#' or 'time' to split over the time periods of `x`.
#' @param value A list of values compatible with the splitting of `x`, recycled
#' if necessary.
#' @param ... Further arguments passed to [`split.default()`].
#'
#' @returns
#' `split()` returns a list of index objects for each level in `f`. The
#' replacement method replaces these values with the corresponding element of
#' `value`.
#'
#' @examples
#' index <- as_index(matrix(1:6, 2))
#'
#' split(index, 1:2)
#'
#' split(index, c(1, 1, 2), margin = "time")
#'
#' @family index methods
#' @export
split.piar_index <- function(x, f, drop = FALSE, ...,
margin = c("levels", "time")) {
margin <- match.arg(margin)
ix <- split(seq_along(x[[margin]]), f, drop = drop, ...)
if (margin == "levels") {
lapply(ix, \(i) x[i, ])
} else {
lapply(ix, \(i) x[, i])
}
}
#' @rdname split.piar_index
#' @export
`split<-.piar_index` <- function(x, f, drop = FALSE, ...,
margin = c("levels", "time"), value) {
margin <- match.arg(margin)
ix <- split(seq_along(x[[margin]]), f, drop = drop, ...)
n <- length(value)
j <- 0
if (margin == "levels") {
for (i in ix) {
j <- j %% n + 1
x[i, ] <- value[[j]]
}
} else {
for (i in ix) {
j <- j %% n + 1
x[, i] <- value[[j]]
}
}
x
}