1
2
3# artificial 1 sec data with missing Data
4
5
6tX <- timeSequence("2014-03-07 00:00:00", "2014-03-07 23:59:59", by="sec")
7
8s <- sample(1:length(tX))[1:length(tX)/10]
9tX <- tX[-s]
10
11
12
13###############################################################################
14# align
15#   extract index values of a given xts object corresponding to the last
16#   observations given a period specified by on
17
18
19require(timeSeries)
20
21
22# Random Seed:
23set.seed(1953)
24
25# Create a day of 1s time stamps:
26tX <- timeSequence("2014-03-07 09:03:17", "2014-03-07 15:53:16", by="sec")
27
28# Remove randomly 10% of the data:
29s <- sample(1:length(tX))[1:length(tX)/10]
30tX <- sort(tX[-s])
31tS <- 201.7*cumulated(timeSeries(data=rnorm(length(tX))/(24*3600), charvec=tX))
32
33plot(tS)
34head(tS)
35
36
37tZ <- align(tS, by="1min", method="fillNA", offset="42s")
38head(tZ)
39
40tZ <- align(tS, by="3min", method="fillNA", offset="162s")
41head(tZ)
42
43tZ <- align(tS, by="5min", method="fillNA", offset="102")
44head(tZ)
45
46tZ <- align(tS, by="15min", method="fillNA", offset="702s")
47head(tZ)
48
49tZ <- align(tS, by="30min", method="fillNA", offset="1602s")
50head(tZ)
51
52tZ <- align(tS, by="60min", method="fillNA", offset="3402")
53head(tZ)
54
55
56toPeriod <- function(x, by, method, offset="0s"")
57{
58  open <- function(x) as.vector(x)[1]
59  high <- function(x) max(x)
60  low <- function(x) min(x)
61  close <- function(x) rev(as.vector(x))[1]
62
63  cbind(
64    aggregate(SPI, by, open),
65    aggregate(SPI, by, high),
66    aggregate(SPI, by, low),
67    aggregate(SPI, by, close))
68}
69
70A1 <- timeSeries::align(tS, by="60min")
71A2 <- xts::to.period(as.xts(tS), period = "minutes", k = 2)
72
73
74open <- function(x) as.vector(x)[1]
75close <- function(x) rev(as.vector(x))[1]
76high <- function(x) max(x)
77low <- function(x) min(x)
78
79SPI <- tS[, "SPI"]
80by <- timeLastDayInMonth(time(tS))
81OHLC <- cbind(
82  aggregate(SPI, by, open),
83  aggregate(SPI, by, high),
84  aggregate(SPI, by, low),
85  aggregate(SPI, by, close))
86OHLC
87
88
89xts::to.minutes(x,k,name,...)
90xts::to.minutes3(x,name,...)
91xts::to.minutes5(x,name,...)
92xts::to.minutes10(x,name,...)
93xts::to.minutes15(x,name,...)
94xts::to.minutes30(x,name,...)
95xts::to.hourly(x,name,...)
96
97
98# -----------------------------------------------------------------------------
99
100# Time alignment:
101
102alignDaily(x=time(tS), include.weekends=FALSE)
103alignMonthly(x=time(tS), include.weekends=FALSE)     # error
104alignQuarterly(x=time(tS), include.weekends=FALSE)   # error
105
106
107tD <- Sys.timeDate() + 1:1000
108timeDate::align(tD, by="10s")
109timeDate::align(tD, by="60s")
110timeDate::align(tD, by="10m")     # error
111
112
113td <- as.xts(Sys.time()) + 1:1000
114xts::align.time(td, n=10)         # every 10 seconds
115xts::align.time(td, n=60)         # align to next whole minute
116xts::align.time(td, n=10*60)      # align to next whole 10 min interval
117
118
119xts::shift.time(td, n=10)
120xts::shift.time(td, n=60)
121
122xts::shift.time(td)
123
124# -----------------------------------------------------------------------------
125
126xts::to.daily(x,drop.time=TRUE,name,...)
127
128xts::to.weekly(x,drop.time=TRUE,name,...)
129xts::to.monthly(x,indexAt='yearmon',drop.time=TRUE,name,...)
130xts::to.quarterly(x,indexAt='yearqtr',drop.time=TRUE,name,...)
131xts::to.yearly(x,drop.time=TRUE,name,...)
132
133xts::to.period(
134  x,
135  period = 'months',
136  k = 1,
137  indexAt,
138  name=NULL,
139  OHLC = TRUE,
140  ...)
141
142
143# -----------------------------------------------------------------------------
144
145
146Convert an object to a specified periodicity lower than the given data
147object. For example, convert a daily series to a monthly series, or a
148monthly series to a yearly one, or a one minute series to an hourly
149series.
150
151
152data(sample_matrix)
153xts <- as.xts(sample_matrix)    # is daily
154
155to.weekly(xts)
156to.monthly(xts)
157to.quarterly(xts)
158to.yearly(xts)
159
160tS <- as.timeSeries(sample_matrix)
161
162
163% -----------------------------------------------------------------------------
164
165
166as.numeric(as.POSIXct(time(tS)))
167getFinCenter(tS)
168
169
170indexTZ(xts, )
171tzone(xts, )
172tzone(xts) <- "GMT"
173.index(xts, )
174
175
176indexClass(xts)
177class(time(tS))
178
179
180% -----------------------------------------------------------------------------
181
182
183.index <- function(x) as.numeric(as.POSIXct(time(x)))
184.indexDate <- function(x) .index(x)%/%86400L
185.indexday <- function(x) .index(x)%/%86400L
186.indexmday <- function(x) as.POSIXlt(.POSIXct(.index(x)))$mday
187.indexwday <- function(x) as.POSIXlt(.POSIXct(.index(x)))$wday
188.indexweek <- function(x)
189.indexmon <- function(x)
190.indexyday <- function(x)
191.indexyear <- function(x)
192
193.indexhour <- function(x)
194.indexmin <- function(x)
195.indexsec <- function(x)
196
197
198atoms
199
200
201
202
203
204
205# Roll over fixed periods of length k point by point ...
206# Functions borrowed from zoo
207
208timeSeries::rollMin(
209  x, k, na.pad = FALSE, align = c("center", "left", "right"),  ...)
210timeSeries::rollMax(
211  x, k, na.pad = FALSE, align = c("center", "left", "right"),  ...)
212timeSeries::rollMean(
213  x, k, na.pad = FALSE, align = c("center", "left", "right"),  ...)
214timeSeries::rollMedian(
215  x, k, na.pad = FALSE, align = c("center", "left", "right"),  ...)
216timeSeries::rollStats(
217  x, k, FUN = mean, na.pad = FALSE, align = c("center", "left", "right"), ...)
218
219
220# Roll over Calendarical periods:
221
222rollDailySeries(x, period="7d", FUN, ...)
223rollMonthlySeries(x, period="12m", by="1m", FUN, ...)
224# e.g. rollQuarterlySeries(x, period="12m", by="3m", FUN)
225# e.g. rollYearlySeries
226
227rollMonthlyWindows(x, period="12m", by="1m")
228
229apply
230applySeries
231
232
233# period.apply
234#   Apply a specified function to data over a given interval, where the
235#   interval is taken to be the data from INDEX[k] to INDEX[k+1], for
236#   k=1:(length(INDEX)-1).
237
238
239
240x1 <- xts(matrix(1:(9*6),nc=6),
241         order.by=as.Date(13000,origin="1970-01-01")+1:9)
242x2 <- x1
243
244xtsAttributes(x1) <- list(series1="1")
245xtsAttributes(x2) <- list(series2="2")
246
247xtsAttributes(x1)
248xtsAttributes(x2)
249
250
251x3 <- x1+x2
252xtsAttributes(x3)
253
254x33 <- cbind(x1, x2)
255xtsAttributes(x33)
256
257x33 <- rbind(x2, x1)
258xtsAttributes(x33)
259
260
261
262###############################################################################
263
264appendList <- function (x, value) {
265  stopifnot(is.list(x), is.list(value))
266  xnames <- names(x)
267  for (v in names(value)) {
268    x[[v]] <-
269      if (v %in% xnames && is.list(x[[v]]) && is.list(value[[v]]))
270        appendList(x[[v]], value[[v]])
271      else c(x[[v]], value[[v]]) }
272  x }
273
274
275"setAttributes<-" <- function(obj, value) {
276  stopifnot(is.list(value))
277  ATTRIBUTES <- getAttributes(obj)
278  VALUE <- appendList(ATTRIBUTES, value)
279  attr(obj@documentation, "Attributes") <- VALUE
280  obj }
281
282
283getAttributes <- function(obj) {
284  attr(obj@documentation, "Attributes") }
285
286
287
288
289obj1 <- dummySeries()
290getAttributes(obj1)
291setAttributes(obj1) <- list(series="obj1")
292getAttributes(obj1)
293
294
295obj2 <- dummySeries()
296getAttributes(obj2)
297setAttributes(obj2) <- list(series="obj2")
298getAttributes(obj2)
299
300
301getAttributes(obj1+obj2)  # returns the attributes only for the first
302getAttributes(obj1-obj2)  # returns the attributes only for the first
303
304getAttributes(cbind(obj1, obj2))
305getAttributes(cbind(obj1, as.matrix(obj2)))   # matrix fails
306
307
308getAttributes(rbind(obj1, obj2))
309getAttributes(rbind(obj1, as.matrix(obj2)))   # matrix fails
310
311
312getAttributes( rev(obj) )
313
314getAttributes( obj[, 1] )
315
316getAttributes( sample(obj) )
317
318getAttributes( sort(sample(obj)) )
319
320getAttributes( scale(obj) )
321
322
323
324
325getAttributes( returns(obj) )
326getAttributes( cumulated(returns(obj)) )
327
328
329
330
331
332
333
334
335
336
337BIND(# Add another Attribute:
338ATTRIBUTES <- attr(obj@documentation, "Attributes")
339ATTRIBUTES
340
341ATTRIBUTES <- appendList(ATTRIBUTES, list(say="hello"))
342ATTRIBUTES
343
344attr(obj@documentation, "Attributes") <- ATTRIBUTES
345
346cbind(obj, obj, documentation = obj@documentation)
347
348
349
350
351
352# Documentation
353
354# Series:
355#    dim(@.Data)
356#    @units
357#    @positions
358#    @format
359#    @FinCenter
360#    @recordIDs
361#    @title
362#    @documentation
363#       attributes(@documentation, "attributes)
364
365
366
367
368
369
370
371
372
373
374
375