/
series.R
127 lines (116 loc) · 4.1 KB
/
series.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
# TIME SERIES
#' @include AllGenerics.R
NULL
# array ========================================================================
#' @export
#' @rdname series
#' @aliases series,array,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "array", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
## Validation
arkhe::assert_length(time, NROW(object))
## Set the names of the series
if (!is.null(names))
dimnames(object)[[2L]] <- names
if (is.null(dimnames(object)[[2L]]))
dimnames(object)[[2L]] <- paste0("S", seq_len(dim(object)[2L]))
## Chronological order
i <- order(time, decreasing = FALSE)
time <- time[i]
object <- object[i, , , drop = FALSE]
.TimeSeries(object, .Time = time)
}
)
#' @export
#' @rdname series
#' @aliases series,array,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "array", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
if (methods::is(time, "RataDie")) {
msg <- "%s is already expressed in rata die: %s is ignored."
warning(sprintf(msg, sQuote("time"), sQuote("calendar")), call. = FALSE)
} else {
time <- fixed(time, calendar = calendar, scale = scale)
}
methods::callGeneric(object = object, time = time, names = names)
}
)
# matrix =======================================================================
#' @export
#' @rdname series
#' @aliases series,matrix,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "matrix", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
x <- array(object, dim = c(dim(object), 1))
rownames(x) <- rownames(object)
colnames(x) <- colnames(object)
methods::callGeneric(object = x, time = time, calendar = calendar,
scale = scale, names = names)
}
)
#' @export
#' @rdname series
#' @aliases series,matrix,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "matrix", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
x <- array(object, dim = c(dim(object), 1))
colnames(x) <- colnames(object)
methods::callGeneric(object = x, time = time, names = names)
}
)
# numeric ======================================================================
#' @export
#' @rdname series
#' @aliases series,numeric,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "numeric", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
object <- array(data = object, dim = c(length(object), 1, 1))
methods::callGeneric(object = object, time = time, calendar = calendar,
scale = scale, names = names)
}
)
#' @export
#' @rdname series
#' @aliases series,numeric,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "numeric", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
object <- array(data = object, dim = c(length(object), 1, 1))
methods::callGeneric(object = object, time = time, names = names)
}
)
# data.frame ===================================================================
#' @export
#' @rdname series
#' @aliases series,data.frame,numeric,TimeScale-method
setMethod(
f = "series",
signature = c(object = "data.frame", time = "numeric", calendar = "TimeScale"),
definition = function(object, time, calendar, scale = 1, names = NULL) {
object <- data.matrix(object)
methods::callGeneric(object = object, time = time, calendar = calendar,
scale = scale, names = names)
}
)
#' @export
#' @rdname series
#' @aliases series,data.frame,RataDie,missing-method
setMethod(
f = "series",
signature = c(object = "data.frame", time = "RataDie", calendar = "missing"),
definition = function(object, time, names = NULL) {
object <- data.matrix(object)
methods::callGeneric(object = object, time = time, names = names)
}
)