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