zoo/0000755000175100001440000000000014756326054011113 5ustar hornikuserszoo/tests/0000755000175100001440000000000014755651346012261 5ustar hornikuserszoo/tests/vignette-zoo-quickref.R0000644000175100001440000002220014633672353016635 0ustar hornikusers################################################### ### chunk number 1: preliminaries ################################################### library("zoo") library("tseries") online <- FALSE ## if set to FALSE the local copy of ## is used instead of get.hist.quote() options(prompt = "R> ") Sys.setenv(TZ = "GMT") suppressWarnings(RNGversion("3.5.0")) ################################################### ### chunk number 2: read.zoo ################################################### inrusd <- read.zoo(system.file("doc", "demo1.txt", package = "zoo"), sep = "|", format="%d %b %Y") ################################################### ### chunk number 3: read.table ################################################### tmp <- read.table(system.file("doc", "demo2.txt", package = "zoo"), sep = ",") z <- zoo(tmp[, 3:4], as.Date(as.character(tmp[, 2]), format="%d %b %Y")) colnames(z) <- c("Nifty", "Junior") ################################################### ### chunk number 4: extract dates ################################################### time(z) ################################################### ### chunk number 5: start and end ################################################### start(z) end(inrusd) ################################################### ### chunk number 6: convert to plain matrix ################################################### plain <- coredata(z) str(plain) ################################################### ### chunk number 7: intersection ################################################### m <- merge(inrusd, z, all = FALSE) ################################################### ### chunk number 8: union ################################################### m <- merge(inrusd, z) ################################################### ### chunk number 9: merge with lag ################################################### merge(inrusd, lag(inrusd, -1)) ################################################### ### chunk number 10: plotting1 ################################################### plot(m) ################################################### ### chunk number 11: plotting2 ################################################### plot(m[, 2:3], plot.type = "single", col = c("red", "blue"), lwd = 2) ################################################### ### chunk number 12: select range of dates ################################################### window(z, start = as.Date("2005-02-15"), end = as.Date("2005-02-28")) ################################################### ### chunk number 13: select one date ################################################### m[as.Date("2005-03-10")] ################################################### ### chunk number 14: impute NAs by interpolation ################################################### interpolated <- na.approx(m) ################################################### ### chunk number 15: impute NAs by LOCF ################################################### m <- na.locf(m) m ################################################### ### chunk number 16: compute returns ################################################### prices2returns <- function(x) 100*diff(log(x)) ################################################### ### chunk number 17: column-wise returns ################################################### r <- prices2returns(m) ################################################### ### chunk number 18: rolling standard deviations ################################################### rollapply(r, 10, sd) ################################################### ### chunk number 19: last day of month ################################################### prices2returns(aggregate(m, as.yearmon, tail, 1)) ################################################### ### chunk number 20: last day of week ################################################### nextfri <- function(x) 7 * ceiling(as.numeric(x-5+4) / 7) + as.Date(5-4) prices2returns(aggregate(na.locf(m), nextfri, tail, 1)) ################################################### ### chunk number 21: four second mark ################################################### zsec <- structure(1:10, index = structure(c(1234760403.968, 1234760403.969, 1234760403.969, 1234760405.029, 1234760405.029, 1234760405.03, 1234760405.03, 1234760405.072, 1234760405.073, 1234760405.073 ), class = c("POSIXt", "POSIXct"), tzone = ""), class = "zoo") to4sec <- function(x) as.POSIXct(4*ceiling(as.numeric(x)/4), origin = "1970-01-01") aggregate(zsec, to4sec, tail, 1) ################################################### ### chunk number 22: one second grid ################################################### # tmp is zsec with time discretized into one second bins tmp <- zsec st <- start(tmp) Epoch <- st - as.numeric(st) time(tmp) <- as.integer(time(tmp) + 1e-7) + Epoch # find index of last value in each one second interval ix <- !duplicated(time(tmp), fromLast = TRUE) # merge with grid merge(tmp[ix], zoo(, seq(start(tmp), end(tmp), "sec"))) # Here is a function which generalizes the above: intraday.discretise <- function(b, Nsec) { st <- start(b) time(b) <- Nsec * as.integer(time(b)+1e-7) %/% Nsec + st - as.numeric(st) ix <- !duplicated(time(b), fromLast = TRUE) merge(b[ix], zoo(, seq(start(b), end(b), paste(Nsec, "sec")))) } intraday.discretise(zsec, 1) ################################################### ### chunk number 23: tseries ################################################### library("tseries") ################################################### ### chunk number 24: data handling if offline ################################################### if(online) { sunw <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31") sunw2 <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31", compression = "m", quote = "Close") eur.usd <- get.hist.quote(instrument = "EUR/USD", provider = "oanda", start = "2004-01-01", end = "2004-12-31") save(sunw, sunw2, eur.usd, file = "sunw.rda") } else { load(system.file("doc", "sunw.rda", package = "zoo")) } ################################################### ### chunk number 25: get.hist.quote daily series eval=FALSE ################################################### ## sunw <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31") ################################################### ### chunk number 26: get.hist.quote monthly series eval=FALSE ################################################### ## sunw2 <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31", ## compression = "m", quote = "Close") ################################################### ### chunk number 27: change index to yearmon ################################################### time(sunw2) <- as.yearmon(time(sunw2)) ################################################### ### chunk number 28: compute same series via aggregate ################################################### sunw3 <- aggregate(sunw[, "Close"], as.yearmon, tail, 1) ################################################### ### chunk number 29: compute returns ################################################### r <- prices2returns(sunw3) ################################################### ### chunk number 30: get.hist.quote oanda eval=FALSE ################################################### ## eur.usd <- get.hist.quote(instrument = "EUR/USD", provider = "oanda", start = "2004-01-01", end = "2004-12-31") ################################################### ### chunk number 31: is.weekend convenience function ################################################### is.weekend <- function(x) ((as.numeric(x)-2) %% 7) < 2 ################################################### ### chunk number 32: omit weekends ################################################### eur.usd <- eur.usd[!is.weekend(time(eur.usd))] ################################################### ### chunk number 33: is.weekend based on POSIXlt ################################################### is.weekend <- function(x) { x <- as.POSIXlt(x) x$wday > 5 | x$wday < 1 } ################################################### ### chunk number 34: summaries ################################################### date1 <- seq(as.Date("2001-01-01"), as.Date("2002-12-1"), by = "day") len1 <- length(date1) set.seed(1) # to make it reproducible data1 <- zoo(rnorm(len1), date1) # quarterly summary data1q.mean <- aggregate(data1, as.yearqtr, mean) data1q.sd <- aggregate(data1, as.yearqtr, sd) head(cbind(mean = data1q.mean, sd = data1q.sd), main = "Quarterly") # weekly summary - week ends on tuesday # Given a date find the next Tuesday. # Based on formula in Prices and Returns section. nexttue <- function(x) 7 * ceiling(as.numeric(x - 2 + 4)/7) + as.Date(2 - 4) data1w <- cbind( mean = aggregate(data1, nexttue, mean), sd = aggregate(data1, nexttue, sd) ) head(data1w) ### ALTERNATIVE ### # Create function ag like aggregate but takes vector of # function names. FUNs <- c(mean, sd) ag <- function(z, by, FUNs) { f <- function(f) aggregate(z, by, f) do.call(cbind, sapply(FUNs, f, simplify = FALSE)) } data1q <- ag(data1, as.yearqtr, c("mean", "sd")) data1w <- ag(data1, nexttue, c("mean", "sd")) head(data1q) head(data1w) zoo/tests/bugfixes.R0000644000175100001440000000155614633672353014223 0ustar hornikusers## packages library("zoo") library("timeDate") ## aggregate() with "timeDate" index z <- zoo(1:3, timeDate(c("2011-09-19 12:00", "2011-09-19 12:00", "2011-09-19 13:00"))) aggregate(z, identity, mean) ## assignment and preservation of column names in merge() x <- zoo(cbind(a = 3:4, b = 5:6)) y <- zoo(1:2) merge(x, zoo(, time(x))) merge(y, x) ## [<-.zoo with logical row index z <- zoo(cbind(1:5, 11:15), 101:105) z[index(z) == 103, 1] <- 0 ## rollapply(..., mean, partial = TRUE) z <- zoo(11:15) identical(rollapply(z, 3, mean, partial = TRUE), rollapply(z, 3, (mean), partial = TRUE)) ## rollmedian(..., k = 1) z <- zoo(sin(0:20)) identical(z, rollmedian(z, 1)) identical(coredata(rollmedian(z, 1)), as.vector(runmed(coredata(z), 1))) ## na.fill with just NAs (directly and implicitly through rollapply) na.fill(c(NA, NA), fill = NA) rollapply(1:2, 3, sum, fill = NA) zoo/tests/as.Date.R0000644000175100001440000000322514633672353013661 0ustar hornikusers## set Z's timezone for reproducibility Sys.setenv(TZ = "Europe/Vienna") ## base results as.Date(10957, origin = "1970-01-01") as.Date("2000-01-01") as.Date(as.POSIXct("2000-01-01 00:00:00 GMT", tz = "GMT")) as.Date(as.POSIXlt("2000-01-01 00:00:00 GMT", tz = "GMT")) as.Date(NA) ## for chron objects library("chron") as.Date(dates("01/01/2000")) as.Date(chron("01/01/2000", "00:00:00")) ## for tis objects library("tis") as.Date(ti(20000101, "daily")) as.Date(jul(20000101)) ## for timeDate objects library("timeDate") as.Date(timeDate("2000-01-01")) ## with zoo attached (masking as.Date/as.Date.numeric) library("zoo") as.Date(10957) as.Date("2000-01-01") as.Date(as.POSIXct("2000-01-01 00:00:00 GMT", tz = "GMT")) as.Date(as.POSIXlt("2000-01-01 00:00:00 GMT", tz = "GMT")) as.Date(NA) as.Date(yearmon(2000)) as.Date(yearqtr(2000)) as.Date(dates("01/01/2000")) as.Date(chron("01/01/2000", "00:00:00")) as.Date.ti <- tis:::as.Date.ti ## filed request for export as.Date(ti(20000101, "daily")) as.Date.jul <- tis:::as.Date.jul ## filed request for export as.Date(jul(20000101)) as.Date.timeDate <- timeDate:::as.Date.timeDate ## filed request for export as.Date(timeDate("2000-01-01")) ## with mondate attached (masking again as.Date) library("mondate") as.Date(10957) as.Date("2000-01-01") as.Date(as.POSIXct("2000-01-01 00:00:00 GMT", tz = "GMT")) as.Date(as.POSIXlt("2000-01-01 00:00:00 GMT", tz = "GMT")) as.Date(NA) as.Date(yearmon(2000)) as.Date(yearqtr(2000)) as.Date(dates("01/01/2000")) as.Date(chron("01/01/2000", "00:00:00")) as.Date(ti(20000101, "daily")) as.Date(jul(20000101)) as.Date(timeDate("2000-01-01")) as.Date(mondate(1/31)) zoo/tests/na.locf.Rout.save0000644000175100001440000000566414633672353015420 0ustar hornikusers R version 3.3.2 (2016-10-31) -- "Sincere Pumpkin Patch" Copyright (C) 2016 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library("zoo") Attaching package: 'zoo' The following objects are masked from 'package:base': as.Date, as.Date.numeric > > x <- cbind( + c(1, NA, 2, NA, NA, NA, NA, 3), + c(NA, 1, NA, 2, NA, NA, NA, 3) + ) > na.locf(x) [,1] [,2] [1,] 1 NA [2,] 1 1 [3,] 2 1 [4,] 2 2 [5,] 2 2 [6,] 2 2 [7,] 2 2 [8,] 3 3 > na.locf(x, fromLast = TRUE) [,1] [,2] [1,] 1 1 [2,] 2 1 [3,] 2 2 [4,] 3 2 [5,] 3 3 [6,] 3 3 [7,] 3 3 [8,] 3 3 > na.locf(x, maxgap = 3) [,1] [,2] [1,] 1 NA [2,] 1 1 [3,] 2 1 [4,] NA 2 [5,] NA 2 [6,] NA 2 [7,] NA 2 [8,] 3 3 > na.locf(x[,2]) [1] 1 1 2 2 2 2 3 > na.locf(x[,2], na.rm = FALSE) [1] NA 1 1 2 2 2 2 3 > > z <- zoo(x, as.Date("2000-01-01") + 0:8) > na.locf(z) 2000-01-01 1 NA 2000-01-02 1 1 2000-01-03 2 1 2000-01-04 2 2 2000-01-05 2 2 2000-01-06 2 2 2000-01-07 2 2 2000-01-08 3 3 2000-01-09 1 3 > na.locf(z, fromLast = TRUE) 2000-01-01 1 1 2000-01-02 2 1 2000-01-03 2 2 2000-01-04 3 2 2000-01-05 3 3 2000-01-06 3 3 2000-01-07 3 3 2000-01-08 3 3 2000-01-09 1 NA > na.locf(z, maxgap = 3) 2000-01-01 1 NA 2000-01-02 1 1 2000-01-03 2 1 2000-01-04 NA 2 2000-01-05 NA 2 2000-01-06 NA 2 2000-01-07 NA 2 2000-01-08 3 3 2000-01-09 1 3 > na.locf(z[,2]) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 2000-01-08 1 1 2 2 2 2 3 2000-01-09 3 > na.locf(z[,2], na.rm = FALSE) 2000-01-01 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 NA 1 1 2 2 2 2 2000-01-08 2000-01-09 3 3 > > d <- as.Date("2000-01-01") + c(0, NA, 2, NA, NA, NA, NA, 7) > na.locf(d) [1] "2000-01-01" "2000-01-01" "2000-01-03" "2000-01-03" "2000-01-03" [6] "2000-01-03" "2000-01-03" "2000-01-08" > na.locf(d, fromLast = TRUE) [1] "2000-01-01" "2000-01-03" "2000-01-03" "2000-01-08" "2000-01-08" [6] "2000-01-08" "2000-01-08" "2000-01-08" > na.locf(d, maxgap = 3) [1] "2000-01-01" "2000-01-01" "2000-01-03" NA NA [6] NA NA "2000-01-08" > > proc.time() user system elapsed 0.196 0.024 0.216 zoo/tests/na.fill.Rout.save0000644000175100001440000000431214633672353015410 0ustar hornikusers R version 3.4.4 (2018-03-15) -- "Someone to Lean On" Copyright (C) 2018 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library("zoo") Attaching package: 'zoo' The following objects are masked from 'package:base': as.Date, as.Date.numeric > > target <- c(100, 1, 200, 2, 300) > current <- na.fill0(c(NA, 1, NA, 2, NA), c(100, 200, 300)) > identical(target, current) [1] TRUE > > target <- structure(c(100, 1, 200, 2), na.action = 5L) > current <- na.fill0(c(NA, 1, NA, 2, NA), list(100, 200, NULL)) > identical(target, current) [1] TRUE > > target <- structure(c(1, 1, 200, 2), na.action = 5L) > current <- na.fill0(c(NA, 1, NA, 2, NA), list("extend", 200, NULL)) > identical(target, current) [1] TRUE > > target <- c(1, 1, 200, 2, 2) > current <- na.fill0(c(NA, 1, NA, 2, NA), list("extend", 200, "extend")) > identical(target, current) [1] TRUE > > target <- structure(c(1, 2), na.action = c(1L, 3L, 5L)) > current <- na.fill0(c(NA, 1, NA, 2, NA), list()) > identical(target, current) [1] TRUE > > target <- NULL > current <- na.fill0(NULL, list(1)) > identical(target, current) [1] TRUE > > target <- 1 > current <- na.fill0(1, list(1)) > identical(target, current) [1] TRUE > > target <- 1 > current <- na.fill0(1, 2) > identical(target, current) [1] TRUE > > target <- structure(c(17650, 17650, 0, 17651, 17651), class = "Date") > current <- na.fill0(as.Date("2018-04-28") + c(NA, 1, NA, 2, NA), list("extend", as.Date(0))) > identical(target, current) [1] TRUE > > target <- structure(c(0, 17650, 0, 17651, 0), class = "Date") > current <- na.fill0(as.Date("2018-04-28") + c(NA, 1, NA, 2, NA), as.Date(0)) > identical(target, current) [1] TRUE > > proc.time() user system elapsed 0.199 0.036 0.224 zoo/tests/Examples/0000755000175100001440000000000014633672353014033 5ustar hornikuserszoo/tests/Examples/zoo-Ex.Rout.save0000644000175100001440000032202414755510073017022 0ustar hornikusers R version 4.4.2 (2024-10-31) -- "Pile of Leaves" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > pkgname <- "zoo" > source(file.path(R.home("share"), "R", "examples-header.R")) > options(warn = 1) > library('zoo') Attaching package: ‘zoo’ The following objects are masked from ‘package:base’: as.Date, as.Date.numeric > > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') > base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv') > cleanEx() > nameEx("MATCH") > ### * MATCH > > flush(stderr()); flush(stdout()) > > ### Name: MATCH > ### Title: Value Matching > ### Aliases: MATCH MATCH.default MATCH.times MATCH.timeDate MATCH.Date > ### MATCH.POSIXct MATCH.POSIXlt > ### Keywords: manip > > ### ** Examples > > MATCH(1:5, 2:3) [1] NA 1 2 NA NA > > > > cleanEx() > nameEx("ORDER") > ### * ORDER > > flush(stderr()); flush(stdout()) > > ### Name: ORDER > ### Title: Ordering Permutation > ### Aliases: ORDER ORDER.default > ### Keywords: manip > > ### ** Examples > > ORDER(rnorm(5)) [1] 3 1 2 5 4 > > > > cleanEx() > nameEx("aggregate.zoo") > ### * aggregate.zoo > > flush(stderr()); flush(stdout()) > > ### Name: aggregate.zoo > ### Title: Compute Summary Statistics of zoo Objects > ### Aliases: aggregate.zoo split.zoo > ### Keywords: ts > > ### ** Examples > > ## averaging over values in a month: > # x.date is jan 1,3,5,7; feb 9,11,13; mar 15,17,19 > x.date <- as.Date(paste(2004, rep(1:4, 4:1), seq(1,20,2), sep = "-")); x.date [1] "2004-01-01" "2004-01-03" "2004-01-05" "2004-01-07" "2004-02-09" [6] "2004-02-11" "2004-02-13" "2004-03-15" "2004-03-17" "2004-04-19" > x <- zoo(rnorm(12), x.date); x 2004-01-01 2004-01-03 2004-01-05 2004-01-07 2004-02-09 2004-02-11 2004-02-13 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 -0.8204684 0.4874291 2004-03-15 2004-03-17 2004-04-19 0.7383247 0.5757814 -0.3053884 > # coarser dates - jan 1 (4 times), feb 1 (3 times), mar 1 (3 times) > x.date2 <- as.Date(paste(2004, rep(1:4, 4:1), 1, sep = "-")); x.date2 [1] "2004-01-01" "2004-01-01" "2004-01-01" "2004-01-01" "2004-02-01" [6] "2004-02-01" "2004-02-01" "2004-03-01" "2004-03-01" "2004-04-01" > x2 <- aggregate(x, x.date2, mean); x2 2004-01-01 2004-02-01 2004-03-01 2004-04-01 0.079210426 -0.001177187 0.657053028 -0.305388387 > # same - uses as.yearmon > x2a <- aggregate(x, as.Date(as.yearmon(time(x))), mean); x2a 2004-01-01 2004-02-01 2004-03-01 2004-04-01 0.079210426 -0.001177187 0.657053028 -0.305388387 > # same - uses by function > x2b <- aggregate(x, function(tt) as.Date(as.yearmon(tt)), mean); x2b 2004-01-01 2004-02-01 2004-03-01 2004-04-01 0.079210426 -0.001177187 0.657053028 -0.305388387 > # same - uses cut > x2c <- aggregate(x, as.Date(cut(time(x), "month")), mean); x2c 2004-01-01 2004-02-01 2004-03-01 2004-04-01 0.079210426 -0.001177187 0.657053028 -0.305388387 > # almost same but times of x2d have yearmon class rather than Date class > x2d <- aggregate(x, as.yearmon, mean); x2d Jan 2004 Feb 2004 Mar 2004 Apr 2004 0.079210426 -0.001177187 0.657053028 -0.305388387 > > # compare time series > plot(x) > lines(x2, col = 2) > > ## aggregate a daily time series to a quarterly series > # create zoo series > tt <- as.Date("2000-1-1") + 0:300 > z.day <- zoo(0:300, tt) > > # function which returns corresponding first "Date" of quarter > first.of.quarter <- function(tt) as.Date(as.yearqtr(tt)) > > # average z over quarters > # 1. via "yearqtr" index (regular) > # 2. via "Date" index (not regular) > z.qtr1 <- aggregate(z.day, as.yearqtr, mean) > z.qtr2 <- aggregate(z.day, first.of.quarter, mean) > > # The last one used the first day of the quarter but suppose > # we want the first day of the quarter that exists in the series > # (and the series does not necessarily start on the first day > # of the quarter). > z.day[!duplicated(as.yearqtr(time(z.day)))] 2000-01-01 2000-04-01 2000-07-01 2000-10-01 0 91 182 274 > > # This is the same except it uses the last day of the quarter. > # It requires R 2.6.0 which introduced the fromLast= argument. > ## Not run: > ##D z.day[!duplicated(as.yearqtr(time(z.day)), fromLast = TRUE)] > ## End(Not run) > > # The aggregated series above are of class "zoo" (because z.day > # was "zoo"). To create a regular series of class "zooreg", > # the frequency can be automatically chosen > zr.qtr1 <- aggregate(z.day, as.yearqtr, mean, regular = TRUE) > # or specified explicitely > zr.qtr2 <- aggregate(z.day, as.yearqtr, mean, frequency = 4) > > > ## aggregate on month and extend to monthly time series > if(require(chron)) { + y <- zoo(matrix(11:15, nrow = 5, ncol = 2), chron(c(15, 20, 80, 100, 110))) + colnames(y) <- c("A", "B") + + # aggregate by month using first of month as times for coarser series + # using first day of month as repesentative time + y2 <- aggregate(y, as.Date(as.yearmon(time(y))), head, 1) + + # fill in missing months by merging with an empty series containing + # a complete set of 1st of the months + yrt2 <- range(time(y2)) + y0 <- zoo(,seq(from = yrt2[1], to = yrt2[2], by = "month")) + merge(y2, y0) + } Loading required package: chron A B 1970-01-01 11 11 1970-02-01 NA NA 1970-03-01 13 13 1970-04-01 14 14 > > # given daily series keep only first point in each month at > # day 21 or more > z <- zoo(101:200, as.Date("2000-01-01") + seq(0, length = 100, by = 2)) > zz <- z[as.numeric(format(time(z), "%d")) >= 21] > zz[!duplicated(as.yearmon(time(zz)))] 2000-01-21 2000-02-22 2000-03-21 2000-04-22 2000-05-22 2000-06-21 111 127 141 157 172 187 > > # same except times are of "yearmon" class > aggregate(zz, as.yearmon, head, 1) Jan 2000 Feb 2000 Mar 2000 Apr 2000 May 2000 Jun 2000 111 127 141 157 172 187 > > # aggregate POSIXct seconds data every 10 minutes > Sys.setenv(TZ = "GMT") > tt <- seq(10, 2000, 10) > x <- zoo(tt, structure(tt, class = c("POSIXt", "POSIXct"))) > aggregate(x, time(x) - as.numeric(time(x)) %% 600, mean) 1970-01-01 00:00:00 1970-01-01 00:10:00 1970-01-01 00:20:00 1970-01-01 00:30:00 300 895 1495 1900 > > # aggregate weekly series to a series with frequency of 52 per year > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > z <- zooreg(1:100 + rnorm(100), start = as.Date("2001-01-01"), deltat = 7) > > # new.freq() converts dates to a grid of freq points per year > # yd is sequence of dates of firsts of years > # yy is years of the same sequence > # last line interpolates so dates, d, are transformed to year + frac of year > # so first week of 2001 is 2001.0, second week is 2001 + 1/52, third week > # is 2001 + 2/52, etc. > new.freq <- function(d, freq = 52) { + y <- as.Date(cut(range(d), "years")) + c(0, 367) + yd <- seq(y[1], y[2], "year") + yy <- as.numeric(format(yd, "%Y")) + floor(freq * approx(yd, yy, xout = d)$y) / freq + } > > # take last point in each period > aggregate(z, new.freq, tail, 1) 2001(1) 2001(2) 2001(3) 2001(4) 2001(5) 2001(6) 2001(7) 2001(8) 2.183643 2.164371 5.595281 5.329508 5.179532 7.487429 8.738325 9.575781 2001(9) 2001(10) 2001(11) 2001(12) 2001(13) 2001(14) 2001(15) 2001(16) 9.694612 12.511781 12.389843 12.378759 11.785300 16.124931 15.955066 16.983810 2001(17) 2001(18) 2001(19) 2001(20) 2001(21) 2001(22) 2001(23) 2001(24) 18.943836 19.821221 20.593901 21.918977 22.782136 23.074565 22.010648 25.619826 2001(25) 2001(26) 2001(27) 2001(28) 2001(29) 2001(30) 2001(31) 2001(32) 25.943871 26.844204 26.529248 28.521850 30.417942 32.358680 31.897212 33.387672 2001(33) 2001(34) 2001(35) 2001(36) 2001(37) 2001(38) 2001(39) 2001(40) 33.946195 33.622940 35.585005 36.605710 37.940687 40.100025 40.763176 40.835476 2001(41) 2001(42) 2001(43) 2001(44) 2001(45) 2001(46) 2001(47) 2001(48) 41.746638 43.696963 44.556663 44.311244 45.292505 47.364582 48.768533 48.887654 2001(49) 2001(50) 2001(51) 2001(52) 2002(1) 2002(2) 2002(3) 2002(4) 50.881108 51.398106 51.387974 53.341120 52.870637 56.433024 57.980400 56.632779 2002(5) 2002(6) 2002(7) 2002(8) 2002(9) 2002(10) 2002(11) 2002(12) 56.955865 59.569720 59.864945 63.401618 61.960760 63.689739 64.028002 64.256727 2002(13) 2002(14) 2002(15) 2002(16) 2002(17) 2002(18) 2002(19) 2002(20) 66.188792 65.195041 69.465555 69.153253 72.172612 71.475510 71.290054 73.610726 2002(21) 2002(22) 2002(23) 2002(24) 2002(25) 2002(26) 2002(27) 2002(28) 73.065902 73.746367 76.291446 76.556708 78.001105 79.074341 79.410479 80.431331 2002(29) 2002(30) 2002(31) 2002(32) 2002(33) 2002(34) 2002(35) 2002(36) 81.864821 84.178087 82.476433 85.593946 86.332950 88.063100 87.695816 89.370019 2002(37) 2002(38) 2002(39) 2002(40) 2002(41) 2002(42) 2002(43) 2002(44) 90.267099 90.457480 93.207868 94.160403 94.700214 96.586833 96.558486 95.723408 2002(45) 2002(46) 2002(47) 97.426735 97.775387 99.526599 > > # or, take mean of all points in each > aggregate(z, new.freq, mean) 2001(1) 2001(2) 2001(3) 2001(4) 2001(5) 2001(6) 2001(7) 2001(8) 1.278595 2.164371 5.595281 5.329508 5.179532 7.487429 8.738325 9.575781 2001(9) 2001(10) 2001(11) 2001(12) 2001(13) 2001(14) 2001(15) 2001(16) 9.694612 12.511781 12.389843 12.378759 11.785300 16.124931 15.955066 16.983810 2001(17) 2001(18) 2001(19) 2001(20) 2001(21) 2001(22) 2001(23) 2001(24) 18.943836 19.821221 20.593901 21.918977 22.782136 23.074565 22.010648 25.619826 2001(25) 2001(26) 2001(27) 2001(28) 2001(29) 2001(30) 2001(31) 2001(32) 25.943871 26.844204 26.529248 28.521850 30.417942 32.358680 31.897212 33.387672 2001(33) 2001(34) 2001(35) 2001(36) 2001(37) 2001(38) 2001(39) 2001(40) 33.946195 33.622940 35.585005 36.605710 37.940687 40.100025 40.763176 40.835476 2001(41) 2001(42) 2001(43) 2001(44) 2001(45) 2001(46) 2001(47) 2001(48) 41.746638 43.696963 44.556663 44.311244 45.292505 47.364582 48.768533 48.887654 2001(49) 2001(50) 2001(51) 2001(52) 2002(1) 2002(2) 2002(3) 2002(4) 50.881108 51.398106 51.387974 53.341120 52.870637 56.433024 57.980400 56.632779 2002(5) 2002(6) 2002(7) 2002(8) 2002(9) 2002(10) 2002(11) 2002(12) 56.955865 59.569720 59.864945 63.401618 61.960760 63.689739 64.028002 64.256727 2002(13) 2002(14) 2002(15) 2002(16) 2002(17) 2002(18) 2002(19) 2002(20) 66.188792 65.195041 69.465555 69.153253 72.172612 71.475510 71.290054 73.610726 2002(21) 2002(22) 2002(23) 2002(24) 2002(25) 2002(26) 2002(27) 2002(28) 73.065902 73.746367 76.291446 76.556708 78.001105 79.074341 79.410479 80.431331 2002(29) 2002(30) 2002(31) 2002(32) 2002(33) 2002(34) 2002(35) 2002(36) 81.864821 84.178087 82.476433 85.593946 86.332950 88.063100 87.695816 89.370019 2002(37) 2002(38) 2002(39) 2002(40) 2002(41) 2002(42) 2002(43) 2002(44) 90.267099 90.457480 93.207868 94.160403 94.700214 96.586833 96.558486 95.723408 2002(45) 2002(46) 2002(47) 97.426735 97.775387 99.526599 > > # example of taking means in the presence of NAs > z.na <- zooreg(c(1:364, NA), start = as.Date("2001-01-01")) > aggregate(z.na, as.yearqtr, mean, na.rm = TRUE) 2001 Q1 2001 Q2 2001 Q3 2001 Q4 45.5 136.0 227.5 319.0 > > # Find the sd of all days that lie in any Jan, all days that lie in > # any Feb, ..., all days that lie in any Dec (i.e. output is vector with > # 12 components) > aggregate(z, format(time(z), "%m"), sd) 01 02 03 04 05 06 07 08 27.931987 27.985392 27.679111 27.774779 27.328400 27.840695 27.520893 28.058606 09 10 11 12 27.806512 28.066187 27.406884 1.589453 > > > > > cleanEx() detaching ‘package:chron’ > nameEx("as.zoo") > ### * as.zoo > > flush(stderr()); flush(stdout()) > > ### Name: as.zoo > ### Title: Coercion from and to zoo > ### Aliases: as.zoo as.zoo.default as.zoo.data.frame as.zoo.fts as.zoo.its > ### as.zoo.irts as.zoo.matrix as.zoo.mcmc as.zoo.tis as.zoo.xts > ### as.zoo.zoo as.matrix.zoo as.vector.zoo as.data.frame.zoo as.list.zoo > ### as.list.ts as.zoo.ts as.ts.zoo > ### Keywords: ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > ## coercion to zoo: > ## default method > as.zoo(rnorm(5)) 1 2 3 4 5 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 > ## method for "ts" objects > as.zoo(ts(rnorm(5), start = 1981, freq = 12)) Jan 1981 Feb 1981 Mar 1981 Apr 1981 May 1981 -0.8204684 0.4874291 0.7383247 0.5757814 -0.3053884 > > ## coercion from zoo: > x.date <- as.POSIXct(paste("2003-", rep(1:4, 4:1), "-", sample(1:28, 10, replace = TRUE), sep = "")) > x <- zoo(matrix(rnorm(24), ncol = 2), x.date) > as.matrix(x) x.1 x.2 2003-01-04 0.82122120 1.35867955 2003-01-06 -0.01619026 -0.47815006 2003-01-19 0.94383621 0.41794156 2003-01-27 -0.04493361 -1.47075238 2003-02-01 0.78213630 -0.05380504 2003-02-08 0.59390132 -0.10278773 2003-02-11 0.91897737 0.38767161 2003-03-11 0.07456498 -1.37705956 2003-03-25 -1.98935170 -0.41499456 2003-04-10 0.61982575 -0.39428995 > as.vector(x) [1] 0.82122120 -0.01619026 0.94383621 -0.04493361 0.78213630 0.59390132 [7] 0.91897737 0.07456498 -1.98935170 0.61982575 1.35867955 -0.47815006 [13] 0.41794156 -1.47075238 -0.05380504 -0.10278773 0.38767161 -1.37705956 [19] -0.41499456 -0.39428995 > as.data.frame(x) x.1 x.2 2003-01-04 0.82122120 1.35867955 2003-01-06 -0.01619026 -0.47815006 2003-01-19 0.94383621 0.41794156 2003-01-27 -0.04493361 -1.47075238 2003-02-01 0.78213630 -0.05380504 2003-02-08 0.59390132 -0.10278773 2003-02-11 0.91897737 0.38767161 2003-03-11 0.07456498 -1.37705956 2003-03-25 -1.98935170 -0.41499456 2003-04-10 0.61982575 -0.39428995 > as.list(x) $x.1 2003-01-04 2003-01-06 2003-01-19 2003-01-27 2003-02-01 2003-02-08 0.82122120 -0.01619026 0.94383621 -0.04493361 0.78213630 0.59390132 2003-02-11 2003-03-11 2003-03-25 2003-04-10 0.91897737 0.07456498 -1.98935170 0.61982575 $x.2 2003-01-04 2003-01-06 2003-01-19 2003-01-27 2003-02-01 2003-02-08 1.35867955 -0.47815006 0.41794156 -1.47075238 -0.05380504 -0.10278773 2003-02-11 2003-03-11 2003-03-25 2003-04-10 0.38767161 -1.37705956 -0.41499456 -0.39428995 > > > > cleanEx() > nameEx("coredata") > ### * coredata > > flush(stderr()); flush(stdout()) > > ### Name: coredata > ### Title: Extracting/Replacing the Core Data of Objects > ### Aliases: coredata coredata.default coredata.zoo coredata.ts > ### coredata.its coredata.irts coredata<- coredata<-.zoo coredata<-.ts > ### coredata<-.irts coredata<-.its > ### Keywords: ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > x.date <- as.Date(paste(2003, rep(1:4, 4:1), seq(1,20,2), sep = "-")) > x <- zoo(matrix(rnorm(20), ncol = 2), x.date) > > ## the full time series > x 2003-01-01 -0.6264538 1.51178117 2003-01-03 0.1836433 0.38984324 2003-01-05 -0.8356286 -0.62124058 2003-01-07 1.5952808 -2.21469989 2003-02-09 0.3295078 1.12493092 2003-02-11 -0.8204684 -0.04493361 2003-02-13 0.4874291 -0.01619026 2003-03-15 0.7383247 0.94383621 2003-03-17 0.5757814 0.82122120 2003-04-19 -0.3053884 0.59390132 > ## and only matrix of observations > coredata(x) [,1] [,2] [1,] -0.6264538 1.51178117 [2,] 0.1836433 0.38984324 [3,] -0.8356286 -0.62124058 [4,] 1.5952808 -2.21469989 [5,] 0.3295078 1.12493092 [6,] -0.8204684 -0.04493361 [7,] 0.4874291 -0.01619026 [8,] 0.7383247 0.94383621 [9,] 0.5757814 0.82122120 [10,] -0.3053884 0.59390132 > > ## change the observations > coredata(x) <- matrix(1:20, ncol = 2) > x 2003-01-01 1 11 2003-01-03 2 12 2003-01-05 3 13 2003-01-07 4 14 2003-02-09 5 15 2003-02-11 6 16 2003-02-13 7 17 2003-03-15 8 18 2003-03-17 9 19 2003-04-19 10 20 > > > > cleanEx() > nameEx("frequency") > ### * frequency > > flush(stderr()); flush(stdout()) > > ### Name: frequency<- > ### Title: Replacing the Index of Objects > ### Aliases: frequency<- frequency<-.zoo frequency<-.zooreg > ### Keywords: ts > > ### ** Examples > > z <- zooreg(1:5) > z 1 2 3 4 5 1 2 3 4 5 > as.ts(z) Time Series: Start = 1 End = 5 Frequency = 1 [1] 1 2 3 4 5 > frequency(z) <- 3 > z 1(1) 2(1) 3(1) 4(1) 5(1) 1 2 3 4 5 > as.ts(z) Time Series: Start = c(1, 1) End = c(5, 1) Frequency = 3 [1] 1 NA NA 2 NA NA 3 NA NA 4 NA NA 5 > > > > cleanEx() > nameEx("ggplot2.zoo") > ### * ggplot2.zoo > > flush(stderr()); flush(stdout()) > > ### Name: ggplot2.zoo > ### Title: Convenience Functions for Plotting zoo Objects with ggplot2 > ### Aliases: autoplot.zoo fortify.zoo ggplot2.zoo facet_free yearmon_trans > ### yearqtr_trans scale_x_yearmon scale_y_yearmon scale_x_yearqtr > ### scale_y_yearqtr scale_type.yearmon scale_type.yearqtr > > ### ** Examples > > if(require("ggplot2") && require("scales")) { + suppressWarnings(RNGversion("3.5.0")) + set.seed(1) + + ## example data + x.Date <- as.Date(paste(2003, 02, c(1, 3, 7, 9, 14), sep = "-")) + x <- zoo(rnorm(5), x.Date) + xlow <- x - runif(5) + xhigh <- x + runif(5) + z <- cbind(x, xlow, xhigh) + + ## univariate plotting + autoplot(x) + ## by hand + ggplot(aes(x = Index, y = Value), data = fortify(x, melt = TRUE)) + + geom_line() + xlab("Index") + ylab("x") + ## adding series one at a time + last_plot() + geom_line(aes(x = Index, y = xlow), colour = "red", data = fortify(xlow)) + ## add ribbon for high/low band + ggplot(aes(x = Index, y = x, ymin = xlow, ymax = xhigh), data = fortify(x)) + + geom_ribbon(fill = "darkgray") + geom_line() + + ## multivariate plotting in multiple or single panels + autoplot(z) ## multiple without color/linetype + autoplot(z, facets = Series ~ .) ## multiple with series-dependent color/linetype + autoplot(z, facets = NULL) ## single with series-dependent color/linetype + ## by hand with color/linetype and with/without facets + ggz <- ggplot(aes(x = Index, y = Value, group = Series, colour = Series, linetype = Series), + data = fortify(z, melt = TRUE)) + geom_line() + xlab("Index") + ylab("") + ggz + ggz + facet_grid(Series ~ .) + ## variations + autoplot(z, geom = "point") + autoplot(z, facets = NULL) + geom_point() + autoplot(z, facets = NULL) + scale_colour_grey() + theme_bw() + + ## for "ts" series via coercion + autoplot(as.zoo(EuStockMarkets)) + autoplot(as.zoo(EuStockMarkets), facets = NULL) + + autoplot(z) + + aes(colour = NULL, linetype = NULL) + + facet_grid(Series ~ ., scales = "free_y") + + autoplot(z) + aes(colour = NULL, linetype = NULL) + facet_free() # same + + z.yq <- zooreg(rnorm(50), as.yearqtr("2000-1"), freq = 4) + autoplot(z.yq) + + ## mimic matplot + data <- cbind(A = c(6, 1, NA, NA), B = c(16, 4, 1, NA), C = c(25, 7, 2, 1)) + autoplot(zoo(data), facet = NULL) + geom_point() + ## with different line types + autoplot(zoo(data), facet = NULL) + geom_point() + aes(linetype = Series) + + ## illustrate just fortify() method + z <- zoo(data) + fortify(z) + fortify(z, melt = TRUE) + fortify(z, melt = TRUE, names = c("Time", NA, "Data")) + fortify(z, melt = TRUE, names = c(Index = "Time")) + + ## with/without splitting + z <- zoo(cbind(a.A = 1:2, a.B = 2:3, b.A = 3:4, c.B = 4:5)) + fortify(z) + fortify(z, melt = TRUE, sep = ".", names = list(Series = c("Lower", "Upper"))) + + ## scale_x_yearmon with custom discrete breaks + df <- data.frame(dates = as.yearmon("2018-08") + 0:6/12, values = c(2:6, 0, 1)) + ggdf <- ggplot(df, aes(x = dates, y = values)) + + geom_bar(position = "dodge", stat = "identity") + theme_light() + + xlab("Month") + ylab("Values") + ggdf ## with default scale_x_yearmon + ggdf + scale_x_yearmon(breaks = df$dates) ## with custom discrete breaks + } Loading required package: ggplot2 Loading required package: scales > > > > cleanEx() detaching ‘package:scales’, ‘package:ggplot2’ > nameEx("index") > ### * index > > flush(stderr()); flush(stdout()) > > ### Name: index > ### Title: Extracting/Replacing the Index of Objects > ### Aliases: index index.default index.zoo index.ts time.zoo index<- > ### index<-.zoo time<- time<-.zoo start.zoo end.zoo > ### Keywords: ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > x.date <- as.Date(paste(2003, 2, c(1, 3, 7, 9, 14), sep = "-")) > x <- zoo(rnorm(5), x.date) > > ## query index/time of a zoo object > index(x) [1] "2003-02-01" "2003-02-03" "2003-02-07" "2003-02-09" "2003-02-14" > time(x) [1] "2003-02-01" "2003-02-03" "2003-02-07" "2003-02-09" "2003-02-14" > > ## change class of index from Date to POSIXct > ## relative to current time zone > x 2003-02-01 2003-02-03 2003-02-07 2003-02-09 2003-02-14 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 > index(x) <- as.POSIXct(format(time(x)),tz="") > x 2003-02-01 2003-02-03 2003-02-07 2003-02-09 2003-02-14 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 > > ## replace index/time of a zoo object > index(x) <- 1:5 > x 1 2 3 4 5 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 > time(x) <- 6:10 > x 6 7 8 9 10 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 > > ## query start and end of a zoo object > start(x) [1] 6 > end(x) [1] 10 > > ## query index of a usual matrix > xm <- matrix(rnorm(10), ncol = 2) > index(xm) [1] 1 2 3 4 5 > > > > cleanEx() > nameEx("is.regular") > ### * is.regular > > flush(stderr()); flush(stdout()) > > ### Name: is.regular > ### Title: Check Regularity of a Series > ### Aliases: is.regular is.regular.zoo is.regular.ts is.regular.zooreg > ### is.regular.default > ### Keywords: ts > > ### ** Examples > > ## checking of a strictly regular zoo series > z <- zoo(1:10, seq(2000, 2002.25, by = 0.25), frequency = 4) > z 2000 Q1 2000 Q2 2000 Q3 2000 Q4 2001 Q1 2001 Q2 2001 Q3 2001 Q4 2002 Q1 2002 Q2 1 2 3 4 5 6 7 8 9 10 > class(z) [1] "zooreg" "zoo" > frequency(z) ## extraction of frequency attribute [1] 4 > is.regular(z) [1] TRUE > is.regular(z, strict = TRUE) [1] TRUE > ## by omitting observations, the series is not strictly regular > is.regular(z[-3]) [1] TRUE > is.regular(z[-3], strict = TRUE) [1] FALSE > > ## checking of a plain zoo series without frequency attribute > ## which is in fact regular > z <- zoo(1:10, seq(2000, 2002.25, by = 0.25)) > z 2000 2000.25 2000.5 2000.75 2001 2001.25 2001.5 2001.75 2002 2002.25 1 2 3 4 5 6 7 8 9 10 > class(z) [1] "zoo" > frequency(z) ## data driven computation of frequency [1] 4 > is.regular(z) [1] TRUE > is.regular(z, strict = TRUE) [1] TRUE > ## by omitting observations, the series is not strictly regular > is.regular(z[-3]) [1] TRUE > is.regular(z[-3], strict = TRUE) [1] FALSE > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > ## checking of an irregular zoo series > z <- zoo(1:10, rnorm(10)) > z -0.8356 -0.8205 -0.6265 -0.3054 0.1836 0.3295 0.4874 0.5758 0.7383 1.5953 3 6 1 10 2 5 7 9 8 4 > class(z) [1] "zoo" > frequency(z) ## attempt of data-driven frequency computation NULL > is.regular(z) [1] FALSE > is.regular(z, strict = TRUE) [1] FALSE > > > > cleanEx() > nameEx("lag.zoo") > ### * lag.zoo > > flush(stderr()); flush(stdout()) > > ### Name: lag.zoo > ### Title: Lags and Differences of zoo Objects > ### Aliases: lag.zoo diff.zoo > ### Keywords: ts > > ### ** Examples > > x <- zoo(11:21) > > lag(x, k = 1) 1 2 3 4 5 6 7 8 9 10 12 13 14 15 16 17 18 19 20 21 > lag(x, k = -1) 2 3 4 5 6 7 8 9 10 11 11 12 13 14 15 16 17 18 19 20 > # this pairs each value of x with the next or future value > merge(x, lag1 = lag(x, k=1)) x lag1 1 11 12 2 12 13 3 13 14 4 14 15 5 15 16 6 16 17 7 17 18 8 18 19 9 19 20 10 20 21 11 21 NA > diff(x^3) 2 3 4 5 6 7 8 9 10 11 397 469 547 631 721 817 919 1027 1141 1261 > diff(x^3, -1) 1 2 3 4 5 6 7 8 9 10 397 469 547 631 721 817 919 1027 1141 1261 > diff(x^3, na.pad = TRUE) 1 2 3 4 5 6 7 8 9 10 11 NA 397 469 547 631 721 817 919 1027 1141 1261 > > > > > cleanEx() > nameEx("make.par.list") > ### * make.par.list > > flush(stderr()); flush(stdout()) > > ### Name: make.par.list > ### Title: Make a List from a Parameter Specification > ### Aliases: make.par.list > ### Keywords: ts > > ### ** Examples > > make.par.list(letters[1:5], 1:5, 3, 5) $a [1] 1 $b [1] 2 $c [1] 3 $d [1] 4 $e [1] 5 > suppressWarnings( make.par.list(letters[1:5], 1:4, 3, 5, 99) ) $a [1] 1 $b [1] 2 $c [1] 3 $d [1] 4 $e [1] 1 > make.par.list(letters[1:5], c(d=3), 3, 5, 99) $a [1] 99 $b [1] 99 $c [1] 99 $d [1] 3 $e [1] 99 > make.par.list(letters[1:5], list(d=1:2, 99), 3, 5) $a [1] 99 $b [1] 99 $c [1] 99 $d [1] 1 2 1 $e [1] 99 > make.par.list(letters[1:5], list(d=1:2, 99, 100), 3, 5) $a [1] 99 $b [1] 100 $c [1] 99 $d [1] 1 2 1 $e [1] 100 > > > > cleanEx() > nameEx("merge.zoo") > ### * merge.zoo > > flush(stderr()); flush(stdout()) > > ### Name: merge.zoo > ### Title: Merge Two or More zoo Objects > ### Aliases: merge.zoo rbind.zoo c.zoo cbind.zoo > ### Keywords: ts > > ### ** Examples > > ## simple merging > x.date <- as.Date(paste(2003, 02, c(1, 3, 7, 9, 14), sep = "-")) > x <- zoo(rnorm(5), x.date) > > y1 <- zoo(matrix(1:10, ncol = 2), 1:5) > y2 <- zoo(matrix(rnorm(10), ncol = 2), 3:7) > > ## using arguments `fill' and `suffixes' > merge(y1, y2, all = FALSE) y1.1 y1.2 y2.1 y2.2 3 3 8 -0.8204684 1.5117812 4 4 9 0.4874291 0.3898432 5 5 10 0.7383247 -0.6212406 > merge(y1, y2, all = FALSE, suffixes = c("a", "b")) a.1 a.2 b.1 b.2 3 3 8 -0.8204684 1.5117812 4 4 9 0.4874291 0.3898432 5 5 10 0.7383247 -0.6212406 > merge(y1, y2, all = TRUE) y1.1 y1.2 y2.1 y2.2 1 1 6 NA NA 2 2 7 NA NA 3 3 8 -0.8204684 1.5117812 4 4 9 0.4874291 0.3898432 5 5 10 0.7383247 -0.6212406 6 NA NA 0.5757814 -2.2146999 7 NA NA -0.3053884 1.1249309 > merge(y1, y2, all = TRUE, fill = 0) y1.1 y1.2 y2.1 y2.2 1 1 6 0.0000000 0.0000000 2 2 7 0.0000000 0.0000000 3 3 8 -0.8204684 1.5117812 4 4 9 0.4874291 0.3898432 5 5 10 0.7383247 -0.6212406 6 0 0 0.5757814 -2.2146999 7 0 0 -0.3053884 1.1249309 > > ## if different index classes are merged, as in > ## the next merge example then ## a warning is issued and > ### the indexes are coerced. > ## It is up to the user to ensure that the result makes sense. > merge(x, y1, y2, all = TRUE) Warning in merge.zoo(x, y1, y2, all = TRUE) : Index vectors are of different classes: Date integer integer x y1.1 y1.2 y2.1 y2.2 1970-01-02 NA 1 6 NA NA 1970-01-03 NA 2 7 NA NA 1970-01-04 NA 3 8 -0.8204684 1.5117812 1970-01-05 NA 4 9 0.4874291 0.3898432 1970-01-06 NA 5 10 0.7383247 -0.6212406 1970-01-07 NA NA NA 0.5757814 -2.2146999 1970-01-08 NA NA NA -0.3053884 1.1249309 2003-02-01 -0.6264538 NA NA NA NA 2003-02-03 0.1836433 NA NA NA NA 2003-02-07 -0.8356286 NA NA NA NA 2003-02-09 1.5952808 NA NA NA NA 2003-02-14 0.3295078 NA NA NA NA > > ## extend an irregular series to a regular one: > # create a constant series > z <- zoo(1, seq(4)[-2]) > # create a 0 dimensional zoo series > z0 <- zoo(, 1:4) > # do the extension > merge(z, z0) 1 2 3 4 1 NA 1 1 > # same but with zero fill > merge(z, z0, fill = 0) 1 2 3 4 1 0 1 1 > > merge(z, coredata(z), 1) z coredata(z) 1 1 1 1 1 3 1 1 1 4 1 1 1 > > > ## merge multiple series represented in a long form data frame > ## into a multivariate zoo series and plot, one series for each site. > ## Additional examples can be found here: > ## https://stat.ethz.ch/pipermail/r-help/2009-February/187094.html > ## https://stat.ethz.ch/pipermail/r-help/2009-February/187096.html > ## > m <- 5 # no of years > n <- 6 # no of sites > sites <- LETTERS[1:n] > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > DF <- data.frame(site = sites, year = 2000 + 1:m, data = rnorm(m*n)) > tozoo <- function(x) zoo(x$data, x$year) > Data <- do.call(merge, lapply(split(DF, DF$site), tozoo)) > plot(Data, screen = 1, col = 1:n, pch = 1:n, type = "o", xlab = "") > legend("bottomleft", legend = sites, lty = 1, pch = 1:n, col = 1:n) > > ## for each index value in x merge it with the closest index value in y > ## but retaining x's times. > x<-zoo(1:3,as.Date(c("1992-12-13", "1997-05-12", "1997-07-13"))) > y<-zoo(1:5,as.Date(c("1992-12-15", "1992-12-16", "1997-05-10","1997-05-19", "1997-07-13"))) > f <- function(u) which.min(abs(as.numeric(index(y)) - as.numeric(u))) > ix <- sapply(index(x), f) > cbind(x, y = coredata(y)[ix]) x y 1992-12-13 1 1 1997-05-12 2 3 1997-07-13 3 5 > > ## this merges each element of x with the closest time point in y at or > ## after x's time point (whereas in previous example it could be before > ## or after) > window(na.locf(merge(x, y), fromLast = TRUE), index(x)) x y 1992-12-13 1 1 1997-05-12 2 4 1997-07-13 3 5 > > > ## c() can combine several zoo series, e.g., zoo series with Date index > z <- zoo(1:5, as.Date("2000-01-01") + 0:4) > z2 <- zoo(6:7, time(z)[length(z)] + 1:2) > > ## c() combines these in a single series > c(z, z2) 2000-01-01 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 1 2 3 4 5 6 7 > > ## the order does not matter > c(z2, z) 2000-01-01 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 1 2 3 4 5 6 7 > > ## note, however, that combining a zoo series with an unclassed vector > ## of observations would try to coerce the indexes first > ## which might either give an unexpected result or an error in R >= 4.1.0 > ## c(z, 6:7) > > > > > cleanEx() > nameEx("na.StructTS") > ### * na.StructTS > > flush(stderr()); flush(stdout()) > > ### Name: na.StructTS > ### Title: Fill NA or specified positions. > ### Aliases: na.StructTS na.StructTS.zoo na.StructTS.ts > ### Keywords: ts > > ### ** Examples > > > z <- zooreg(rep(10 * seq(8), each = 4) + rep(c(3, 1, 2, 4), times = 8), + start = as.yearqtr(2000), freq = 4) > z[25] <- NA > > zout <- na.StructTS(z) > > plot(cbind(z, zout), screen = 1, col = 1:2, type = c("l", "p"), pch = 20) > > > > > > cleanEx() > nameEx("na.aggregate") > ### * na.aggregate > > flush(stderr()); flush(stdout()) > > ### Name: na.aggregate > ### Title: Replace NA by Aggregation > ### Aliases: na.aggregate na.aggregate.default > ### Keywords: ts > > ### ** Examples > > z <- zoo(c(1, NA, 3:9), + c(as.Date("2010-01-01") + 0:2, + as.Date("2010-02-01") + 0:2, + as.Date("2011-01-01") + 0:2)) > ## overall mean > na.aggregate(z) 2010-01-01 2010-01-02 2010-01-03 2010-02-01 2010-02-02 2010-02-03 2011-01-01 1.000 5.375 3.000 4.000 5.000 6.000 7.000 2011-01-02 2011-01-03 8.000 9.000 > ## group by months > na.aggregate(z, as.yearmon) 2010-01-01 2010-01-02 2010-01-03 2010-02-01 2010-02-02 2010-02-03 2011-01-01 1 2 3 4 5 6 7 2011-01-02 2011-01-03 8 9 > ## group by calendar months > na.aggregate(z, months) 2010-01-01 2010-01-02 2010-01-03 2010-02-01 2010-02-02 2010-02-03 2011-01-01 1.0 5.6 3.0 4.0 5.0 6.0 7.0 2011-01-02 2011-01-03 8.0 9.0 > ## group by years > na.aggregate(z, format, "%Y") 2010-01-01 2010-01-02 2010-01-03 2010-02-01 2010-02-02 2010-02-03 2011-01-01 1.0 3.8 3.0 4.0 5.0 6.0 7.0 2011-01-02 2011-01-03 8.0 9.0 > > > > cleanEx() > nameEx("na.approx") > ### * na.approx > > flush(stderr()); flush(stdout()) > > ### Name: na.approx > ### Title: Replace NA by Interpolation > ### Aliases: na.approx na.approx.zoo na.approx.zooreg na.approx.ts > ### na.approx.default na.spline na.spline.zoo na.spline.zooreg > ### na.spline.ts na.spline.default > ### Keywords: ts > > ### ** Examples > > > z <- zoo(c(2, NA, 1, 4, 5, 2), c(1, 3, 4, 6, 7, 8)) > > ## use underlying time scale for interpolation > na.approx(z) 1 3 4 6 7 8 2.000000 1.333333 1.000000 4.000000 5.000000 2.000000 > ## use equidistant spacing > na.approx(z, 1:6) 1 3 4 6 7 8 2.0 1.5 1.0 4.0 5.0 2.0 > > # with and without na.rm = FALSE > zz <- c(NA, 9, 3, NA, 3, 2) > na.approx(zz, na.rm = FALSE) [1] NA 9 3 3 3 2 > na.approx(zz) [1] 9 3 3 3 2 > > d0 <- as.Date("2000-01-01") > z <- zoo(c(11, NA, 13, NA, 15, NA), d0 + 1:6) > > # NA fill, drop or keep leading/trailing NAs > na.approx(z) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 11 12 13 14 15 > na.approx(z, na.rm = FALSE) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 11 12 13 14 15 NA > > # extrapolate to point outside of range of time points > # (a) drop NA, (b) keep NA, (c) extrapolate using rule = 2 from approx() > na.approx(z, xout = d0 + 7) Data: numeric(0) Index: Date of length 0 > na.approx(z, xout = d0 + 7, na.rm = FALSE) 2000-01-08 NA > na.approx(z, xout = d0 + 7, rule = 2) 2000-01-08 15 > > # use splines - extrapolation handled differently > z <- zoo(c(11, NA, 13, NA, 15, NA), d0 + 1:6) > na.spline(z) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 11 12 13 14 15 16 > na.spline(z, na.rm = FALSE) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 11 12 13 14 15 16 > na.spline(z, xout = d0 + 1:6) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 11 12 13 14 15 16 > na.spline(z, xout = d0 + 2:5) 2000-01-03 2000-01-04 2000-01-05 2000-01-06 12 13 14 15 > na.spline(z, xout = d0 + 7) 2000-01-08 17 > na.spline(z, xout = d0 + 7, na.rm = FALSE) 2000-01-08 17 > > ## using na.approx for disaggregation > zy <- zoo(1:3, 2000:2001) > > # yearly to monthly series > zmo <- na.approx(zy, xout = as.yearmon(2000+0:13/12)) > zmo Jan 2000 Feb 2000 Mar 2000 Apr 2000 May 2000 Jun 2000 Jul 2000 Aug 2000 1.000000 1.083333 1.166667 1.250000 1.333333 1.416667 1.500000 1.583333 Sep 2000 Oct 2000 Nov 2000 Dec 2000 Jan 2001 1.666667 1.750000 1.833333 1.916667 2.000000 > > # monthly to daily series > sq <- seq(as.Date(start(zmo)), as.Date(end(zmo), frac = 1), by = "day") > zd <- na.approx(zmo, x = as.Date, xout = sq) > head(zd) 2000-01-01 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 1.000000 1.002688 1.005376 1.008065 1.010753 1.013441 > > # weekly to daily series > zww <- zoo(1:3, as.Date("2001-01-01") + seq(0, length = 3, by = 7)) > zww 2001-01-01 2001-01-08 2001-01-15 1 2 3 > zdd <- na.approx(zww, xout = seq(start(zww), end(zww), by = "day")) > zdd 2001-01-01 2001-01-02 2001-01-03 2001-01-04 2001-01-05 2001-01-06 2001-01-07 1.000000 1.142857 1.285714 1.428571 1.571429 1.714286 1.857143 2001-01-08 2001-01-09 2001-01-10 2001-01-11 2001-01-12 2001-01-13 2001-01-14 2.000000 2.142857 2.285714 2.428571 2.571429 2.714286 2.857143 2001-01-15 3.000000 > > # The lines do not show up because of the NAs > plot(cbind(z, z), type = "b", screen = 1) > # use na.approx to force lines to appear > plot(cbind(z, na.approx(z)), type = "b", screen = 1) > > # Workaround where less than 2 NAs can appear in a column > za <- zoo(cbind(1:5, NA, c(1:3, NA, 5), NA)); za 1 1 NA 1 NA 2 2 NA 2 NA 3 3 NA 3 NA 4 4 NA NA NA 5 5 NA 5 NA > > ix <- colSums(!is.na(za)) > 0 > za[, ix] <- na.approx(za[, ix]); za 1 1 NA 1 NA 2 2 NA 2 NA 3 3 NA 3 NA 4 4 NA 4 NA 5 5 NA 5 NA > > # using na.approx to create regularly spaced series > # z has points at 10, 20 and 40 minutes while output also has a point at 30 > if(require("chron")) { + tt <- as.chron("2000-01-01 10:00:00") + c(1, 2, 4) * as.numeric(times("00:10:00")) + z <- zoo(1:3, tt) + tseq <- seq(start(z), end(z), by = times("00:10:00")) + na.approx(z, xout = tseq) + } Loading required package: chron (01/01/00 10:10:00) (01/01/00 10:20:00) (01/01/00 10:30:00) 1.0 2.0 2.5 > > > > cleanEx() detaching ‘package:chron’ > nameEx("na.fill") > ### * na.fill > > flush(stderr()); flush(stdout()) > > ### Name: na.fill > ### Title: Fill NA or specified positions. > ### Aliases: na.fill na.fill0 na.fill.ts na.fill.zoo na.fill.default > ### Keywords: ts > > ### ** Examples > > > z <- zoo(c(NA, 2, NA, 1, 4, 5, 2, NA)) > na.fill(z, "extend") 1 2 3 4 5 6 7 8 2.0 2.0 1.5 1.0 4.0 5.0 2.0 2.0 > na.fill(z, c("extend", NA)) 1 2 3 4 5 6 7 8 2 2 NA 1 4 5 2 2 > na.fill(z, -(1:3)) 1 2 3 4 5 6 7 8 -1 2 -2 1 4 5 2 -3 > na.fill(z, list(NA, NULL, NA)) 1 2 4 5 6 7 8 NA 2 1 4 5 2 NA > > > > > cleanEx() > nameEx("na.locf") > ### * na.locf > > flush(stderr()); flush(stdout()) > > ### Name: na.locf > ### Title: Last Observation Carried Forward > ### Aliases: na.locf na.locf0 na.locf.data.frame na.locf.list > ### na.locf.default > ### Keywords: ts > > ### ** Examples > > az <- zoo(1:6) > > bz <- zoo(c(2,NA,1,4,5,2)) > na.locf(bz) 1 2 3 4 5 6 2 2 1 4 5 2 > na.locf(bz, fromLast = TRUE) 1 2 3 4 5 6 2 1 1 4 5 2 > > cz <- zoo(c(NA,9,3,2,3,2)) > na.locf(cz) 2 3 4 5 6 9 3 2 3 2 > > # generate and fill in missing dates > z <- zoo(c(0.007306621, 0.007659046, 0.007681013, + 0.007817548, 0.007847579, 0.007867313), + as.Date(c("1993-01-01", "1993-01-09", "1993-01-16", + "1993-01-23", "1993-01-30", "1993-02-06"))) > g <- seq(start(z), end(z), "day") > na.locf(z, xout = g) 1993-01-01 1993-01-02 1993-01-03 1993-01-04 1993-01-05 1993-01-06 0.007306621 0.007306621 0.007306621 0.007306621 0.007306621 0.007306621 1993-01-07 1993-01-08 1993-01-09 1993-01-10 1993-01-11 1993-01-12 0.007306621 0.007306621 0.007659046 0.007659046 0.007659046 0.007659046 1993-01-13 1993-01-14 1993-01-15 1993-01-16 1993-01-17 1993-01-18 0.007659046 0.007659046 0.007659046 0.007681013 0.007681013 0.007681013 1993-01-19 1993-01-20 1993-01-21 1993-01-22 1993-01-23 1993-01-24 0.007681013 0.007681013 0.007681013 0.007681013 0.007817548 0.007817548 1993-01-25 1993-01-26 1993-01-27 1993-01-28 1993-01-29 1993-01-30 0.007817548 0.007817548 0.007817548 0.007817548 0.007817548 0.007847579 1993-01-31 1993-02-01 1993-02-02 1993-02-03 1993-02-04 1993-02-05 0.007847579 0.007847579 0.007847579 0.007847579 0.007847579 0.007847579 1993-02-06 0.007867313 > > # similar but use a 2 second grid > > z <- zoo(1:9, as.POSIXct(c("2010-01-04 09:30:02", "2010-01-04 09:30:06", + "2010-01-04 09:30:07", "2010-01-04 09:30:08", "2010-01-04 09:30:09", + "2010-01-04 09:30:10", "2010-01-04 09:30:11", "2010-01-04 09:30:13", + "2010-01-04 09:30:14"))) > > g <- seq(start(z), end(z), by = "2 sec") > na.locf(z, xout = g) 2010-01-04 09:30:02 2010-01-04 09:30:04 2010-01-04 09:30:06 2010-01-04 09:30:08 1 1 2 4 2010-01-04 09:30:10 2010-01-04 09:30:12 2010-01-04 09:30:14 6 7 9 > > ## get 5th of every month or most recent date prior to 5th if 5th missing. > ## Result has index of the date actually used. > > z <- zoo(c(1311.56, 1309.04, 1295.5, 1296.6, 1286.57, 1288.12, + 1289.12, 1289.12, 1285.33, 1307.65, 1309.93, 1311.46, 1311.28, + 1308.11, 1301.74, 1305.41, 1309.72, 1310.61, 1305.19, 1313.21, + 1307.85, 1312.25, 1325.76), as.Date(c(13242, 13244, + 13245, 13248, 13249, 13250, 13251, 13252, 13255, 13256, 13257, + 13258, 13259, 13262, 13263, 13264, 13265, 13266, 13269, 13270, + 13271, 13272, 13274))) > > # z.na is same as z but with missing days added (with NAs) > # It is formed by merging z with a zero with series having all the dates. > > rng <- range(time(z)) > z.na <- merge(z, zoo(, seq(rng[1], rng[2], by = "day"))) > > # use na.locf to bring values forward picking off 5th of month > na.locf(z.na)[as.POSIXlt(time(z.na))$mday == 5] 2006-04-05 2006-05-05 1311.56 1312.25 > > ## this is the same as the last one except instead of always using the > ## 5th of month in the result we show the date actually used > > # idx has NAs wherever z.na does but has 1, 2, 3, ... instead of > # z.na's data values (so idx can be used for indexing) > > idx <- coredata(na.locf(seq_along(z.na) + (0 * z.na))) > > # pick off those elements of z.na that correspond to 5th > > z.na[idx[as.POSIXlt(time(z.na))$mday == 5]] 2006-04-04 2006-05-04 1311.56 1312.25 > > ## only fill single-day gaps > > merge(z.na, filled1 = na.locf(z.na, maxgap = 1)) z.na filled1 2006-04-04 1311.56 1311.56 2006-04-05 NA 1311.56 2006-04-06 1309.04 1309.04 2006-04-07 1295.50 1295.50 2006-04-08 NA NA 2006-04-09 NA NA 2006-04-10 1296.60 1296.60 2006-04-11 1286.57 1286.57 2006-04-12 1288.12 1288.12 2006-04-13 1289.12 1289.12 2006-04-14 1289.12 1289.12 2006-04-15 NA NA 2006-04-16 NA NA 2006-04-17 1285.33 1285.33 2006-04-18 1307.65 1307.65 2006-04-19 1309.93 1309.93 2006-04-20 1311.46 1311.46 2006-04-21 1311.28 1311.28 2006-04-22 NA NA 2006-04-23 NA NA 2006-04-24 1308.11 1308.11 2006-04-25 1301.74 1301.74 2006-04-26 1305.41 1305.41 2006-04-27 1309.72 1309.72 2006-04-28 1310.61 1310.61 2006-04-29 NA NA 2006-04-30 NA NA 2006-05-01 1305.19 1305.19 2006-05-02 1313.21 1313.21 2006-05-03 1307.85 1307.85 2006-05-04 1312.25 1312.25 2006-05-05 NA 1312.25 2006-05-06 1325.76 1325.76 > > ## fill NAs in first column by inflating the most recent non-NA > ## by the growth in second column. Note that elements of x-x > ## are NA if the corresponding element of x is NA and zero else > > m <- zoo(cbind(c(1, 2, NA, NA, 5, NA, NA), seq(7)^2), as.Date(1:7)) > > r <- na.locf(m[,1]) * m[,2] / na.locf(m[,2] + (m[,1]-m[,1])) > cbind(V1 = r, V2 = m[,2]) V1 V2 1970-01-02 1.0 1 1970-01-03 2.0 4 1970-01-04 4.5 9 1970-01-05 8.0 16 1970-01-06 5.0 25 1970-01-07 7.2 36 1970-01-08 9.8 49 > > ## repeat a quarterly value every month > ## preserving NAs > zq <- zoo(c(1, NA, 3, 4), as.yearqtr(2000) + 0:3/4) > tt <- as.yearmon(start(zq)) + seq(0, len = 3 * length(zq))/12 > na.locf(zq, xout = tt, maxgap = 0) Jan 2000 Feb 2000 Mar 2000 Apr 2000 May 2000 Jun 2000 Jul 2000 Aug 2000 1 1 1 NA NA NA 3 3 Sep 2000 Oct 2000 Nov 2000 Dec 2000 3 4 4 4 > > ## na.locf() can also be mimicked with ave() > x <- c(NA, 10, NA, NA, 20, NA) > f <- function(x) x[1] > ave(x, cumsum(!is.na(x)), FUN = f) [1] NA 10 10 10 20 20 > > ## by replacing f() with other functions various generalizations can be > ## obtained, e.g., > f <- function(x) if (length(x) > 3) x else x[1] # like maxgap > f <- function(x) replace(x, 1:min(length(x)), 3) # replace up to 2 NAs > f <- function(x) if (!is.na(x[1]) && x[1] > 0) x[1] else x # only positve numbers > > > > cleanEx() > nameEx("na.trim") > ### * na.trim > > flush(stderr()); flush(stdout()) > > ### Name: na.trim > ### Title: Trim Leading/Trailing Missing Observations > ### Aliases: na.trim na.trim.default na.trim.ts > ### Keywords: ts > > ### ** Examples > > # examples of na.trim > x <- zoo(c(1, 4, 6), c(2, 4, 6)) > xx <- zoo(matrix(c(1, 4, 6, NA, 5, 7), 3), c(2, 4, 6)) > na.trim(x) 2 4 6 1 4 6 > na.trim(xx) 4 4 5 6 6 7 > > # using na.trim for alignment > # cal defines the legal dates > # all dates within the date range of x should be present > cal <- zoo(,c(1, 2, 3, 6, 7)) > x <- zoo(c(12, 16), c(2, 6)) > na.trim(merge(x, cal)) 2 3 6 12 NA 16 > > > > > cleanEx() > nameEx("plot.zoo") > ### * plot.zoo > > flush(stderr()); flush(stdout()) > > ### Name: plot.zoo > ### Title: Plotting zoo Objects > ### Aliases: plot.zoo barplot.zoo boxplot.zoo lines.zoo points.zoo > ### Keywords: ts > > ### ** Examples > > ## example dates > x.Date <- as.Date(paste(2003, 02, c(1, 3, 7, 9, 14), sep = "-")) > > ## univariate plotting > x <- zoo(rnorm(5), x.Date) > x2 <- zoo(rnorm(5, sd = 0.2), x.Date) > plot(x) > lines(x2, col = 2) > > ## multivariate plotting > z <- cbind(x, x2, zoo(rnorm(5, sd = 0.5), x.Date)) > plot(z, type = "b", pch = 1:3, col = 1:3, ylab = list(expression(mu), "b", "c")) > colnames(z) <- LETTERS[1:3] > plot(z, screens = 1, col = list(B = 2)) > plot(z, type = "b", pch = 1:3, col = 1:3) > plot(z, type = "b", pch = list(A = 1:5, B = 3), col = list(C = 4, 2)) > plot(z, type = "b", screen = c(1,2,1), col = 1:3) > # right axis is for broken lines > plot(x) > opar <- par(usr = c(par("usr")[1:2], range(x2))) > lines(x2, lty = 2) > # axis(4) > axis(side = 4) > par(opar) > > > ## Custom x axis labelling using a custom panel. > # 1. test data > z <- zoo(c(21, 34, 33, 41, 39, 38, 37, 28, 33, 40), + as.Date(c("1992-01-10", "1992-01-17", "1992-01-24", "1992-01-31", + "1992-02-07", "1992-02-14", "1992-02-21", "1992-02-28", "1992-03-06", + "1992-03-13"))) > zz <- merge(a = z, b = z+10) > # 2. axis tick for every point. Also every 3rd point labelled. > my.panel <- function(x, y, ..., pf = parent.frame()) { + fmt <- "%b-%d" # format for axis labels + lines(x, y, ...) + # if bottom panel + if (with(pf, length(panel.number) == 0 || + panel.number %% nr == 0 || panel.number == nser)) { + # create ticks at x values and then label every third tick + axis(side = 1, at = x, labels = FALSE) + ix <- seq(1, length(x), 3) + labs <- format(x, fmt) + axis(side = 1, at = x[ix], labels = labs[ix], tcl = -0.7, cex.axis = 0.7) + } + } > # 3. plot > plot(zz, panel = my.panel, xaxt = "n") > > # with a single panel plot a fancy x-axis is just the same > # procedure as for the ordinary plot command > plot(zz, screen = 1, col = 1:2, xaxt = "n") > # axis(1, at = time(zz), labels = FALSE) > tt <- time(zz) > axis(side = 1, at = tt, labels = FALSE) > ix <- seq(1, length(tt), 3) > fmt <- "%b-%d" # format for axis labels > labs <- format(tt, fmt) > # axis(1, at = time(zz)[ix], labels = labs[ix], tcl = -0.7, cex.axis = 0.7) > axis(side = 1, at = tt[ix], labels = labs[ix], tcl = -0.7, cex.axis = 0.7) > legend("bottomright", colnames(zz), lty = 1, col = 1:2) > > ## plot a mulitple ts series with nice x-axis using panel function > tab <- ts(cbind(A = 1:24, B = 24:1), start = c(2006, 1), freq = 12) > pnl.xaxis <- function(...) { + lines(...) + panel.number <- parent.frame()$panel.number + nser <- parent.frame()$nser + # if bottom panel + if (!length(panel.number) || panel.number == nser) { + tt <- list(...)[[1]] + ym <- as.yearmon(tt) + mon <- as.numeric(format(ym, "%m")) + yy <- format(ym, "%y") + mm <- substring(month.abb[mon], 1, 1) + if (any(mon == 1)) + # axis(1, tt[mon == 1], yy[mon == 1], cex.axis = 0.7) + axis(side = 1, at = tt[mon == 1], labels = yy[mon == 1], cex.axis = 0.7) + # axis(1, tt[mon > 1], mm[mon > 1], cex.axis = 0.5, tcl = -0.3) + axis(side = 1, at = tt[mon > 1], labels = mm[mon > 1], cex.axis = 0.5, tcl = -0.3) + } + } > plot(as.zoo(tab), panel = pnl.xaxis, xaxt = "n", main = "Fancy X Axis") > > ## Another example with a custom axis > # test data > z <- zoo(matrix(1:25, 5), c(10,11,20,21)) > colnames(z) <- letters[1:5] > > plot(zoo(coredata(z)), xaxt = "n", panel = function(x, y, ..., Time = time(z)) { + lines(x, y, ...) + # if bottom panel + pf <- parent.frame() + if (with(pf, panel.number %% nr == 0 || panel.number == nser)) { + axis(side = 1, at = x, labels = Time) + } + }) > > > ## plot with left and right axes > ## modified from http://www.mayin.org/ajayshah/KB/R/html/g6.html > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > z <- zoo(cbind(A = cumsum(rnorm(100)), B = cumsum(rnorm(100, mean = 0.2)))) > opar <- par(mai = c(.8, .8, .2, .8)) > plot(z[,1], type = "l", + xlab = "x-axis label", ylab = colnames(z)[1]) > par(new = TRUE) > plot(z[,2], type = "l", ann = FALSE, yaxt = "n", col = "blue") > # axis(4) > axis(side = 4) > legend(x = "topleft", bty = "n", lty = c(1,1), col = c("black", "blue"), + legend = paste(colnames(z), c("(left scale)", "(right scale)"))) > usr <- par("usr") > # if you don't care about srt= in text then mtext is shorter: > # mtext(colnames(z)[2], 4, 2, col = "blue") > text(usr[2] + .1 * diff(usr[1:2]), mean(usr[3:4]), colnames(z)[2], + srt = -90, xpd = TRUE, col = "blue") > par(opar) > > > ## another plot with left and right axes > ## modified from https://stat.ethz.ch/pipermail/r-help/2014-May/375293.html > d1 <- c(38.2, 18.1, 83.2, 42.7, 22.8, 48.1, 81.8, 129.6, 52.0, 110.3) > d2 <- c(2.2, 0.8, 0.7, 1.6, 0.9, 0.9, 1.1, 2.8, 5.1, 2.1) > z1 <- zooreg(d1, start = as.POSIXct("2013-01-01 00:00:01"), frequency = 0.0000006) > z2 <- zooreg(d2, start = as.POSIXct("2013-01-01 00:00:20"), frequency = 0.0000006) > zt <- zooreg(rnorm(1050), start = as.POSIXct("2013-01-01 00:00:01"), frequency = 0.00007) > z <- merge(zt, z1, z2, all = TRUE) > z <- na.spline(z[,2:3], na.rm = FALSE) > ## function to round up to a number divisible by n (2011 by Owen Jones) > roundup <- function(x, n) ceiling(ceiling(x)/n) * n > ## plot how to match secondary y-axis ticks to primary ones > plot(z$z1, ylim = c(0, signif(max(na.omit(z$z1)), 2)), xlab = "") > ## use multiplication for even tick numbers and fake sekondary y-axis > max.yl <- roundup(max(na.omit(z$z2)), par("yaxp")[3]) > multipl.yl <- max(na.omit(z$z2)) / max.yl > multipl.z2 <- signif(max(na.omit(z$z1) * 1.05), 2)/max.yl > lines(z$z2 * multipl.z2, lty = 2) > at4 <- axTicks(4) > axis(4, at = at4, seq(0, max.yl, length.out = par("yaxp")[3] + 1)) > > > # automatically placed point labels > ## Not run: > ##D library("maptools") > ##D pointLabel(time(z), coredata(z[,2]), labels = format(time(z)), cex = 0.5) > ## End(Not run) > > ## plot one zoo series against the other. > plot(x, x2) > plot(x, x2, xy.labels = TRUE) > plot(x, x2, xy.labels = 1:5, xy.lines = FALSE) > > ## shade a portion of a plot and make axis fancier > > v <- zooreg(rnorm(50), start = as.yearmon(2004), freq = 12) > > plot(v, type = "n") > u <- par("usr") > rect(as.yearmon("2007-8"), u[3], as.yearmon("2009-11"), u[4], + border = 0, col = "grey") > lines(v) > axis(1, floor(time(v)), labels = FALSE, tcl = -1) > > ## shade certain times to show recessions, etc. > v <- zooreg(rnorm(50), start = as.yearmon(2004), freq = 12) > plot(v, type = "n") > u <- par("usr") > rect(as.yearmon("2007-8"), u[3], as.yearmon("2009-11"), u[4], + border = 0, col = "grey") > lines(v) > axis(1, floor(time(v)), labels = FALSE, tcl = -1) > > ## fill area under plot > > pnl.xyarea <- function(x, y, fill.base = 0, col = 1, ...) { + lines(x, y, ...) + panel.number <- parent.frame()$panel.number + col <- rep(col, length = panel.number)[panel.number] + polygon(c(x[1], x, tail(x, 1), x[1]), + c(fill.base, as.numeric(y), fill.base, fill.base), col = col) + } > plot(zoo(EuStockMarkets), col = rainbow(4), panel = pnl.xyarea) > > > ## barplot > x <- zoo(cbind(rpois(5, 2), rpois(5, 3)), x.Date) > barplot(x, beside = TRUE) > > ## boxplot > boxplot(x) > > ## 3d plot > ## The persp function in R (not part of zoo) works with zoo objects. > ## The following example is by Enrico Schumann. > ## https://stat.ethz.ch/pipermail/r-sig-finance/2009q1/003710.html > nC <- 10 # columns > nO <- 100 # observations > dataM <- array(runif(nC * nO), dim=c(nO, nC)) > zz <- zoo(dataM, 1:nO) > persp(1:nO, 1:nC, zz) > > # interactive plotting > ## Not run: > ##D library("TeachingDemos") > ##D tke.test1 <- list(Parameters = list( > ##D lwd = list("spinbox", init = 1, from = 0, to = 5, increment = 1, width = 5), > ##D lty = list("spinbox", init = 1, from = 0, to = 6, increment = 1, width = 5) > ##D )) > ##D z <- zoo(rnorm(25)) > ##D tkexamp(plot(z), tke.test1, plotloc = "top") > ## End(Not run) > > # setting ylim on a multi-panel plot - 2nd panel y axis range is 1-50 > data("anscombe", package = "datasets") > ans6 <- zoo(anscombe[, 1:6]) > screens <- c(1, 1, 2, 2, 3, 3) > ylim <- unname(tapply(as.list(ans6), screens, range)) > ylim[[2]] <- 1:50 # or ylim[[2]] <- c(1, 50) > plot(ans6, screens = screens, ylim = ylim) > > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("read.zoo") > ### * read.zoo > > flush(stderr()); flush(stdout()) > > ### Name: read.zoo > ### Title: Reading and Writing zoo Series > ### Aliases: read.zoo read.table.zoo read.csv.zoo read.csv2.zoo > ### read.delim.zoo read.delim2.zoo write.zoo > ### Keywords: ts > > ### ** Examples > > ## this manual page provides a few typical examples, many more cases > ## are covered in vignette("zoo-read", package = "zoo") > > ## read text lines with a single date column > Lines <- "2013-12-24 2 + 2013-12-25 3 + 2013-12-26 8" > read.zoo(text = Lines, FUN = as.Date) # explicit coercion 2013-12-24 2013-12-25 2013-12-26 2 3 8 > read.zoo(text = Lines, format = "%Y-%m-%d") # same 2013-12-24 2013-12-25 2013-12-26 2 3 8 > read.zoo(text = Lines) # same, via heuristic 2013-12-24 2013-12-25 2013-12-26 2 3 8 > > ## read text lines with date/time in separate columns > Lines <- "2013-11-24 12:41:21 2 + 2013-12-25 12:41:22.25 3 + 2013-12-26 12:41:22.75 8" > read.zoo(text = Lines, index = 1:2, + FUN = paste, FUN2 = as.POSIXct) # explicit coercion 2013-11-24 12:41:21 2013-12-25 12:41:22 2013-12-26 12:41:22 2 3 8 > read.zoo(text = Lines, index = 1:2, tz = "") # same 2013-11-24 12:41:21 2013-12-25 12:41:22 2013-12-26 12:41:22 2 3 8 > read.zoo(text = Lines, index = 1:2) # same, via heuristic 2013-11-24 12:41:21 2013-12-25 12:41:22 2013-12-26 12:41:22 2 3 8 > > ## read text lines with month/year in separate columns > Lines <- "Jan 1998 4.36 + Feb 1998 4.34" > read.zoo(text = Lines, index = 1:2, FUN = paste, FUN2 = as.yearmon) Jan 1998 Feb 1998 4.36 4.34 > > ## read directly from a data.frame (artificial and built-in BOD) > dat <- data.frame(date = paste("2000-01-", 10:15, sep = ""), + a = sin(1:6), b = cos(1:6)) > read.zoo(dat) a b 2000-01-10 0.8414710 0.5403023 2000-01-11 0.9092974 -0.4161468 2000-01-12 0.1411200 -0.9899925 2000-01-13 -0.7568025 -0.6536436 2000-01-14 -0.9589243 0.2836622 2000-01-15 -0.2794155 0.9601703 > data("BOD", package = "datasets") > read.zoo(BOD) 1 2 3 4 5 7 8.3 10.3 19.0 16.0 15.6 19.8 > > ## Not run: > ##D ## descriptions of typical examples > ##D > ##D ## turn *numeric* first column into yearmon index > ##D ## where number is year + fraction of year represented by month > ##D z <- read.zoo("foo.csv", sep = ",", FUN = as.yearmon) > ##D > ##D ## first column is of form yyyy.mm > ##D ## (Here we use format in place of as.character so that final zero > ##D ## is not dropped in dates like 2001.10 which as.character would do.) > ##D f <- function(x) as.yearmon(format(x, nsmall = 2), "%Y.%m") > ##D z <- read.zoo("foo.csv", header = TRUE, FUN = f) > ##D > ##D ## turn *character* first column into "Date" index > ##D ## Assume lines look like: 12/22/2007 1 2 > ##D z <- read.zoo("foo.tab", format = "%m/%d/%Y") > ##D > ##D # Suppose lines look like: 09112007 1 2 and there is no header > ##D z <- read.zoo("foo.txt", format = "%d%m%Y") > ##D > ##D ## csv file with first column of form YYYY-mm-dd HH:MM:SS > ##D ## Read in times as "chron" class. Requires chron 2.3-22 or later. > ##D z <- read.zoo("foo.csv", header = TRUE, sep = ",", FUN = as.chron) > ##D > ##D ## same but with custom format. Note as.chron uses POSIXt-style ##D > ##D ## Read in times as "chron" class. Requires chron 2.3-24 or later. > ##D z <- read.zoo("foo.csv", header = TRUE, sep = ",", FUN = as.chron, > ##D format = "##D > ##D > ##D ## same file format but read it in times as "POSIXct" class. > ##D z <- read.zoo("foo.csv", header = TRUE, sep = ",", tz = "") > ##D > ##D ## csv file with first column mm-dd-yyyy. Read times as "Date" class. > ##D z <- read.zoo("foo.csv", header = TRUE, sep = ",", format = "%m-%d-%Y") > ##D > ##D ## whitespace separated file with first column of form YYYY-mm-ddTHH:MM:SS > ##D ## and no headers. T appears literally. Requires chron 2.3-22 or later. > ##D z <- read.zoo("foo.csv", FUN = as.chron) > ##D > ##D # read in all csv files in the current directory and merge them > ##D read.zoo(Sys.glob("*.csv"), header = TRUE, sep = ",") > ##D > ##D # We use "NULL" in colClasses for those columns we don't need but in > ##D # col.names we still have to include dummy names for them. Of what > ##D # is left the index is the first three columns (1:3) which we convert > ##D # to chron class times in FUN and then truncate to 5 seconds in FUN2. > ##D # Finally we use aggregate = mean to average over the 5 second intervals. > ##D library("chron") > ##D > ##D Lines <- "CVX 20070201 9 30 51 73.25 81400 0 > ##D CVX 20070201 9 30 51 73.25 100 0 > ##D CVX 20070201 9 30 51 73.25 100 0 > ##D CVX 20070201 9 30 51 73.25 300 0 > ##D CVX 20070201 9 30 51 73.25 81400 0 > ##D CVX 20070201 9 40 51 73.25 100 0 > ##D CVX 20070201 9 40 52 73.25 100 0 > ##D CVX 20070201 9 40 53 73.25 300 0" > ##D > ##D z <- read.zoo(text = Lines, > ##D colClasses = c("NULL", "NULL", "numeric", "numeric", "numeric", > ##D "numeric", "numeric", "NULL"), > ##D col.names = c("Symbol", "Date", "Hour", "Minute", "Second", "Price", "Volume", "junk"), > ##D index = 1:3, # do not count columns that are "NULL" in colClasses > ##D FUN = function(h, m, s) times(paste(h, m, s, sep = ":")), > ##D FUN2 = function(tt) trunc(tt, "00:00:05"), > ##D aggregate = mean) > ## End(Not run) > > > > > cleanEx() > nameEx("rollapply") > ### * rollapply > > flush(stderr()); flush(stdout()) > > ### Name: rollapply > ### Title: Apply Rolling Functions > ### Aliases: rollapply rollapplyr rollapply.default rollapply.ts > ### rollapply.zoo > ### Keywords: iteration array ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > ## rolling mean > z <- zoo(11:15, as.Date(31:35)) > rollapply(z, 2, mean) 1970-02-01 1970-02-02 1970-02-03 1970-02-04 11.5 12.5 13.5 14.5 > > ## non-overlapping means > z2 <- zoo(rnorm(6)) > rollapply(z2, 3, mean, by = 3) # means of nonoverlapping groups of 3 2 5 -0.4261464 0.3681067 > aggregate(z2, c(3,3,3,6,6,6), mean) # same 3 6 -0.4261464 0.3681067 > > ## optimized vs. customized versions > rollapply(z2, 3, mean) # uses rollmean which is optimized for mean 2 3 4 5 -0.4261464 0.3144318 0.3630533 0.3681067 > rollmean(z2, 3) # same 2 3 4 5 -0.4261464 0.3144318 0.3630533 0.3681067 > rollapply(z2, 3, (mean)) # does not use rollmean 2 3 4 5 -0.4261464 0.3144318 0.3630533 0.3681067 > > > ## rolling regression: > ## set up multivariate zoo series with > ## number of UK driver deaths and lags 1 and 12 > seat <- as.zoo(log(UKDriverDeaths)) > time(seat) <- as.yearmon(time(seat)) > seat <- merge(y = seat, y1 = lag(seat, k = -1), + y12 = lag(seat, k = -12), all = FALSE) > > ## run a rolling regression with a 3-year time window > ## (similar to a SARIMA(1,0,0)(1,0,0)_12 fitted by OLS) > rr <- rollapply(seat, width = 36, + FUN = function(z) coef(lm(y ~ y1 + y12, data = as.data.frame(z))), + by.column = FALSE, align = "right") > > ## plot the changes in coefficients > ## showing the shifts after the oil crisis in Oct 1973 > ## and after the seatbelt legislation change in Jan 1983 > plot(rr) > > > ## rolling mean by time window (e.g., 3 days) rather than > ## by number of observations (e.g., when these are unequally spaced): > # > ## - test data > tt <- as.Date("2000-01-01") + c(1, 2, 5, 6, 7, 8, 10) > z <- zoo(seq_along(tt), tt) > ## - fill it out to a daily series, zm, using NAs > ## using a zero width zoo series g on a grid > g <- zoo(, seq(start(z), end(z), "day")) > zm <- merge(z, g) > ## - 3-day rolling mean > rollapply(zm, 3, mean, na.rm = TRUE, fill = NA) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 2000-01-08 NA 1.5 2.0 3.0 3.5 4.0 5.0 2000-01-09 2000-01-10 2000-01-11 5.5 6.5 NA > ## > ## - without expansion to regular grid: find interval widths > ## that encompass the previous 3 days for each Date > w <- seq_along(tt) - findInterval(tt - 3, tt) > ## a solution to computing the widths 'w' that is easier to read but slower > ## w <- sapply(tt, function(x) sum(tt >= x - 2 & tt <= x)) > ## > ## - rolling sum from 3-day windows > ## without vs. with expansion to regular grid > rollapplyr(z, w, sum) 2000-01-02 2000-01-03 2000-01-06 2000-01-07 2000-01-08 2000-01-09 2000-01-11 1 3 3 7 12 15 13 > rollapplyr(zm, 3, sum, partial = TRUE, na.rm = TRUE) 2000-01-02 2000-01-03 2000-01-04 2000-01-05 2000-01-06 2000-01-07 2000-01-08 1 3 3 2 3 7 12 2000-01-09 2000-01-10 2000-01-11 15 11 13 > > > ## rolling weekly sums (with some missing dates) > z <- zoo(1:11, as.Date("2016-03-09") + c(0:7, 9:10, 12)) > weeksum <- function(z) sum(z[time(z) > max(time(z)) - 7]) > zs <- rollapplyr(z, 7, weeksum, fill = NA, coredata = FALSE) > merge(value = z, weeksum = zs) value weeksum 2016-03-09 1 NA 2016-03-10 2 NA 2016-03-11 3 NA 2016-03-12 4 NA 2016-03-13 5 NA 2016-03-14 6 NA 2016-03-15 7 28 2016-03-16 8 35 2016-03-18 9 39 2016-03-19 10 45 2016-03-21 11 45 > > > ## replicate cumsum with either 'partial' or vector width 'k' > cumsum(1:10) [1] 1 3 6 10 15 21 28 36 45 55 > rollapplyr(1:10, 10, sum, partial = TRUE) [1] 1 3 6 10 15 21 28 36 45 55 > rollapplyr(1:10, 1:10, sum) [1] 1 3 6 10 15 21 28 36 45 55 > > > ## different values of rule argument > z <- zoo(c(NA, NA, 2, 3, 4, 5, NA)) > rollapply(z, 3, sum, na.rm = TRUE) 2 3 4 5 6 2 5 9 12 9 > rollapply(z, 3, sum, na.rm = TRUE, fill = NULL) 2 3 4 5 6 2 5 9 12 9 > rollapply(z, 3, sum, na.rm = TRUE, fill = NA) 1 2 3 4 5 6 7 NA 2 5 9 12 9 NA > rollapply(z, 3, sum, na.rm = TRUE, partial = TRUE) 1 2 3 4 5 6 7 0 2 5 9 12 9 5 > > # this will exclude time points 1 and 2 > # It corresponds to align = "right", width = 3 > rollapply(zoo(1:8), list(seq(-2, 0)), sum) 3 4 5 6 7 8 6 9 12 15 18 21 > > # but this will include points 1 and 2 > rollapply(zoo(1:8), list(seq(-2, 0)), sum, partial = 1) 1 2 3 4 5 6 7 8 1 3 6 9 12 15 18 21 > rollapply(zoo(1:8), list(seq(-2, 0)), sum, partial = 0) 1 2 3 4 5 6 7 8 1 3 6 9 12 15 18 21 > > # so will this > rollapply(zoo(1:8), list(seq(-2, 0)), sum, fill = NA) 1 2 3 4 5 6 7 8 NA NA 6 9 12 15 18 21 > > # by = 3, align = "right" > L <- rep(list(NULL), 8) > L[seq(3, 8, 3)] <- list(seq(-2, 0)) > str(L) List of 8 $ : NULL $ : NULL $ : int [1:3] -2 -1 0 $ : NULL $ : NULL $ : int [1:3] -2 -1 0 $ : NULL $ : NULL > rollapply(zoo(1:8), L, sum) 3 6 6 15 > > rollapply(zoo(1:8), list(0:2), sum, fill = 1:3) 1 2 3 4 5 6 7 8 6 9 12 15 18 21 3 3 > rollapply(zoo(1:8), list(0:2), sum, fill = 3) 1 2 3 4 5 6 7 8 6 9 12 15 18 21 3 3 > > L2 <- rep(list(-(2:0)), 10) > L2[5] <- list(NULL) > str(L2) List of 10 $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 $ : NULL $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 $ : int [1:3] -2 -1 0 > rollapply(zoo(1:10), L2, sum, fill = "extend") 1 2 3 4 5 6 7 8 9 10 6 6 6 9 12 15 18 21 24 27 > rollapply(zoo(1:10), L2, sum, fill = list("extend", NULL)) 1 2 3 4 6 7 8 9 10 6 6 6 9 15 18 21 24 27 > > rollapply(zoo(1:10), L2, sum, fill = list("extend", NA)) 1 2 3 4 5 6 7 8 9 10 6 6 6 9 NA 15 18 21 24 27 > > rollapply(zoo(1:10), L2, sum, fill = NA) 1 2 3 4 5 6 7 8 9 10 NA NA 6 9 NA 15 18 21 24 27 > rollapply(zoo(1:10), L2, sum, fill = 1:3) 1 2 3 4 5 6 7 8 9 10 1 1 6 9 2 15 18 21 24 27 > rollapply(zoo(1:10), L2, sum, partial = TRUE) 1 2 3 4 6 7 8 9 10 1 3 6 9 15 18 21 24 27 > rollapply(zoo(1:10), L2, sum, partial = TRUE, fill = 99) 1 2 3 4 5 6 7 8 9 10 1 3 6 9 99 15 18 21 24 27 > > rollapply(zoo(1:10), list(-1), sum, partial = 0) 1 2 3 4 5 6 7 8 9 10 0 1 2 3 4 5 6 7 8 9 > rollapply(zoo(1:10), list(-1), sum, partial = TRUE) 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 > > rollapply(zoo(cbind(a = 1:6, b = 11:16)), 3, rowSums, by.column = FALSE) 2 12 14 16 3 14 16 18 4 16 18 20 5 18 20 22 > > # these two are the same > rollapply(zoo(cbind(a = 1:6, b = 11:16)), 3, sum) a b 2 6 36 3 9 39 4 12 42 5 15 45 > rollapply(zoo(cbind(a = 1:6, b = 11:16)), 3, colSums, by.column = FALSE) a b 2 6 36 3 9 39 4 12 42 5 15 45 > > # these two are the same > rollapply(zoo(1:6), 2, sum, by = 2, align = "right") 2 4 6 3 7 11 > aggregate(zoo(1:6), c(2, 2, 4, 4, 6, 6), sum) 2 4 6 3 7 11 > > # these two are the same > rollapply(zoo(1:3), list(-1), c) 2 3 1 2 > lag(zoo(1:3), -1) 2 3 1 2 > > # these two are the same > rollapply(zoo(1:3), list(1), c) 1 2 2 3 > lag(zoo(1:3)) 1 2 2 3 > > # these two are the same > rollapply(zoo(1:5), list(c(-1, 0, 1)), sum) 2 3 4 6 9 12 > rollapply(zoo(1:5), 3, sum) 2 3 4 6 9 12 > > # these two are the same > rollapply(zoo(1:5), list(0:2), sum) 1 2 3 6 9 12 > rollapply(zoo(1:5), 3, sum, align = "left") 1 2 3 6 9 12 > > # these two are the same > rollapply(zoo(1:5), list(-(2:0)), sum) 3 4 5 6 9 12 > rollapply(zoo(1:5), 3, sum, align = "right") 3 4 5 6 9 12 > > # these two are the same > rollapply(zoo(1:6), list(NULL, NULL, -(2:0)), sum) 3 6 6 15 > rollapply(zoo(1:6), 3, sum, by = 3, align = "right") 3 6 6 15 > > # these two are the same > rollapply(zoo(1:5), list(c(-1, 1)), sum) 2 3 4 4 6 8 > rollapply(zoo(1:5), 3, function(x) sum(x[-2])) 2 3 4 4 6 8 > > # these two are the same > rollapply(1:5, 3, rev) [,1] [,2] [,3] [1,] 3 2 1 [2,] 4 3 2 [3,] 5 4 3 > embed(1:5, 3) [,1] [,2] [,3] [1,] 3 2 1 [2,] 4 3 2 [3,] 5 4 3 > > # these four are the same > x <- 1:6 > rollapply(c(0, 0, x), 3, sum, align = "right") - x [1] 0 1 3 5 7 9 > rollapply(x, 3, sum, partial = TRUE, align = "right") - x [1] 0 1 3 5 7 9 > rollapply(x, 3, function(x) sum(x[-3]), partial = TRUE, align = "right") [1] 1 3 3 5 7 9 > rollapply(x, list(-(2:1)), sum, partial = 0) [1] 0 1 3 5 7 9 > > # same as Matlab's buffer(x, n, p) for valid non-negative p > # See http://www.mathworks.com/help/toolbox/signal/buffer.html > x <- 1:30; n <- 7; p <- 3 > t(rollapply(c(rep(0, p), x, rep(0, n-p)), n, by = n-p, c)) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 0 2 6 10 14 18 22 26 [2,] 0 3 7 11 15 19 23 27 [3,] 0 4 8 12 16 20 24 28 [4,] 1 5 9 13 17 21 25 29 [5,] 2 6 10 14 18 22 26 30 [6,] 3 7 11 15 19 23 27 0 [7,] 4 8 12 16 20 24 28 0 > > # these three are the same > y <- 10 * seq(8); k <- 4; d <- 2 > # 1 > # from http://ucfagls.wordpress.com/2011/06/14/embedding-a-time-series-with-time-delay-in-r-part-ii/ > Embed <- function(x, m, d = 1, indices = FALSE, as.embed = TRUE) { + n <- length(x) - (m-1)*d + X <- seq_along(x) + if(n <= 0) + stop("Insufficient observations for the requested embedding") + out <- matrix(rep(X[seq_len(n)], m), ncol = m) + out[,-1] <- out[,-1, drop = FALSE] + + rep(seq_len(m - 1) * d, each = nrow(out)) + if(as.embed) + out <- out[, rev(seq_len(ncol(out)))] + if(!indices) + out <- matrix(x[out], ncol = m) + out + } > Embed(y, k, d) [,1] [,2] [,3] [,4] [1,] 70 50 30 10 [2,] 80 60 40 20 > # 2 > rollapply(y, list(-d * seq(0, k-1)), c) [,1] [,2] [,3] [,4] [1,] 70 50 30 10 [2,] 80 60 40 20 > # 3 > rollapply(y, d*k-1, function(x) x[d * seq(k-1, 0) + 1]) [,1] [,2] [,3] [,4] [1,] 70 50 30 10 [2,] 80 60 40 20 > > > ## mimic convolve() using rollapplyr() > A <- 1:4 > B <- 5:8 > ## convolve(..., type = "open") > cross <- function(x) x > rollapplyr(c(A, 0*B[-1]), length(B), cross, partial = TRUE) Warning in rbind(1, c(1, 2), c(1, 2, 3), c(1, 2, 3, 4), c(2, 3, 4, 0), c(3, : number of columns of result is not a multiple of vector length (arg 3) [,1] [,2] [,3] [,4] [1,] 1 1 1 1 [2,] 1 2 1 2 [3,] 1 2 3 1 [4,] 1 2 3 4 [5,] 2 3 4 0 [6,] 3 4 0 0 [7,] 4 0 0 0 > convolve(A, B, type = "open") [1] 8 23 44 70 56 39 20 > > # convolve(..., type = "filter") > rollapplyr(A, length(B), cross) [,1] [,2] [,3] [,4] [1,] 1 2 3 4 > convolve(A, B, type = "filter") [1] 70 > > > # weighted sum including partials near ends, keeping > ## alignment with wts correct > points <- zoo(cbind(lon = c(11.8300715, 11.8296697, + 11.8268708, 11.8267236, 11.8249612, 11.8251062), + lat = c(48.1099048, 48.10884, 48.1067431, 48.1066077, + 48.1037673, 48.103318), + dist = c(46.8463805878941, 33.4921440879536, 10.6101735030534, + 18.6085009578724, 6.97253109610173, 9.8912817449265))) > mysmooth <- function(z, wts = c(0.3, 0.4, 0.3)) { + notna <- !is.na(z) + sum(z[notna] * wts[notna]) / sum(wts[notna]) + } > points2 <- points > points2[, 1:2] <- rollapply(rbind(NA, coredata(points)[, 1:2], NA), 3, mysmooth) > points2 lon lat dist 1 11.82990 48.10945 46.846381 2 11.82895 48.10853 33.492144 3 11.82767 48.10733 10.610174 4 11.82624 48.10580 18.608501 5 11.82553 48.10448 6.972531 6 11.82504 48.10351 9.891282 > > > > cleanEx() > nameEx("rollmean") > ### * rollmean > > flush(stderr()); flush(stdout()) > > ### Name: rollmean > ### Title: Rolling Means/Maximums/Medians/Sums > ### Aliases: rollmean rollmax rollmedian rollsum rollmeanr rollmaxr > ### rollmedianr rollsumr rollmean.zoo rollmax.zoo rollmedian.zoo > ### rollsum.zoo rollmean.ts rollmax.ts rollmedian.ts rollsum.ts > ### rollmean.default rollmax.default rollmedian.default rollsum.default > ### Keywords: ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > x.Date <- as.Date(paste(2004, rep(1:4, 4:1), sample(1:28, 10), sep = "-")) > x <- zoo(rnorm(12), x.Date) > > ## rolling operations for univariate series > rollmean(x, 3) 2004-01-11 2004-01-15 2004-01-23 2004-02-05 2004-02-21 2004-02-25 2004-03-13 0.1350951 0.6005117 0.3362392 0.5940580 0.5320787 -0.1043585 -0.8153657 2004-03-14 -0.5703365 > rollmax(x, 3) 2004-01-11 2004-01-15 2004-01-23 2004-02-05 2004-02-21 2004-02-25 2004-03-13 0.7383247 0.7383247 0.7383247 1.5117812 1.5117812 1.5117812 0.3898432 2004-03-14 1.1249309 > rollmedian(x, 3) 2004-01-11 2004-01-15 2004-01-23 2004-02-05 2004-02-21 2004-02-25 2004-03-13 0.4874291 0.5757814 0.5757814 0.5757814 0.3898432 0.3898432 -0.6212406 2004-03-14 -0.6212406 > rollsum(x, 3) 2004-01-11 2004-01-15 2004-01-23 2004-02-05 2004-02-21 2004-02-25 2004-03-13 0.4052854 1.8015351 1.0087177 1.7821741 1.5962360 -0.3130755 -2.4460972 2004-03-14 -1.7110095 > > ## rolling operations for multivariate series > xm <- zoo(matrix(1:12, 4, 3), x.Date[1:4]) > rollmean(xm, 3) 2004-01-11 2 6 10 2004-01-15 3 7 11 > rollmax(xm, 3) 2004-01-11 3 7 11 2004-01-15 4 8 12 > rollmedian(xm, 3) 2004-01-11 2 6 10 2004-01-15 3 7 11 > rollsum(xm, 3) 2004-01-11 6 18 30 2004-01-15 9 21 33 > > ## rollapply vs. dedicated rollmean > rollapply(xm, 3, mean) # uses rollmean 2004-01-11 2 6 10 2004-01-15 3 7 11 > rollapply(xm, 3, function(x) mean(x)) # does not use rollmean 2004-01-11 2 6 10 2004-01-15 3 7 11 > > > > cleanEx() > nameEx("tinyplot.zoo") > ### * tinyplot.zoo > > flush(stderr()); flush(stdout()) > > ### Name: tinyplot.zoo > ### Title: Plotting zoo Objects with tinyplot > ### Aliases: tinyplot.zoo > > ### ** Examples > > if(require("tinyplot")) { + suppressWarnings(RNGversion("3.5.0")) + set.seed(1) + + ## example data + x.Date <- as.Date(paste(2003, 02, c(1, 3, 7, 9, 14), sep = "-")) + x <- zoo(rnorm(5), x.Date) + xlow <- x - runif(5) + xhigh <- x + runif(5) + z <- cbind(x, xlow, xhigh) + + ## univariate plotting + tinyplot(x) + + ## multivariate plotting in multiple or single panels + tinyplot(z) ## multiple without color/linetype with free scales + tinyplot(z, facet.args = NULL) ## multiple without color/linetype with same scale + tinyplot(z, facet = ~ Series) ## multiple with series-dependent color/linetype + tinyplot(z, facet = NULL) ## single with series-dependent color/linetype + + ## by hand with color/linetype and with/without facets + d <- fortify.zoo(z, melt = TRUE) + tinyplot(Value ~ Index | Series, data = d, type = "l") + tinyplot(Value ~ Index | Series, facet = "by", data = d, type = "l") + tinyplot(Value ~ Index | Series, facet = "by", data = d, type = "l", facet.args = list(free = TRUE)) + + ## EuStockMarkets data (coerced from "ts") + eusm <- as.zoo(EuStockMarkets) + tinyplot(eusm) + tinytheme("clean2") + tinyplot(eusm, facet = NULL) + tinyplot(eusm, facet = ~ Series) + tinyplot(eusm, facet = ~ Series, facet.args = NULL) + tinytheme() ## reset + + } Loading required package: tinyplot > > > > cleanEx() detaching ‘package:tinyplot’ > nameEx("window.zoo") > ### * window.zoo > > flush(stderr()); flush(stdout()) > > ### Name: window.zoo > ### Title: Extract/Replacing the Time Windows of Objects > ### Aliases: window.zoo window<-.zoo > ### Keywords: ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > ## zoo example > x.date <- as.Date(paste(2003, rep(1:4, 4:1), seq(1,19,2), sep = "-")) > x <- zoo(matrix(rnorm(20), ncol = 2), x.date) > x 2003-01-01 -0.6264538 1.51178117 2003-01-03 0.1836433 0.38984324 2003-01-05 -0.8356286 -0.62124058 2003-01-07 1.5952808 -2.21469989 2003-02-09 0.3295078 1.12493092 2003-02-11 -0.8204684 -0.04493361 2003-02-13 0.4874291 -0.01619026 2003-03-15 0.7383247 0.94383621 2003-03-17 0.5757814 0.82122120 2003-04-19 -0.3053884 0.59390132 > > window(x, start = as.Date("2003-02-01"), end = as.Date("2003-03-01")) 2003-02-09 0.3295078 1.12493092 2003-02-11 -0.8204684 -0.04493361 2003-02-13 0.4874291 -0.01619026 > window(x, index = x.date[1:6], start = as.Date("2003-02-01")) 2003-02-09 0.3295078 1.12493092 2003-02-11 -0.8204684 -0.04493361 > window(x, index = x.date[c(4, 8, 10)]) 2003-01-07 1.5952808 -2.2146999 2003-03-15 0.7383247 0.9438362 2003-04-19 -0.3053884 0.5939013 > window(x, index = x.date[c(4, 8, 10)]) <- matrix(1:6, ncol = 2) > x 2003-01-01 -0.6264538 1.51178117 2003-01-03 0.1836433 0.38984324 2003-01-05 -0.8356286 -0.62124058 2003-01-07 1.0000000 4.00000000 2003-02-09 0.3295078 1.12493092 2003-02-11 -0.8204684 -0.04493361 2003-02-13 0.4874291 -0.01619026 2003-03-15 2.0000000 5.00000000 2003-03-17 0.5757814 0.82122120 2003-04-19 3.0000000 6.00000000 > > ## for classes that support comparisons with "character" variables > ## start and end may be "character". > window(x, start = "2003-02-01") 2003-02-09 0.3295078 1.12493092 2003-02-11 -0.8204684 -0.04493361 2003-02-13 0.4874291 -0.01619026 2003-03-15 2.0000000 5.00000000 2003-03-17 0.5757814 0.82122120 2003-04-19 3.0000000 6.00000000 > > ## zooreg example (with plain numeric index) > z <- zooreg(rnorm(10), start = 2000, freq = 4) > window(z, start = 2001.75) 2001 Q4 2002 Q1 2002 Q2 -1.4707524 -0.4781501 0.4179416 > window(z, start = c(2001, 4)) 2000 Q2 2000 Q4 2001 Q1 2001 Q2 2001 Q3 2001 Q4 0.78213630 -1.98935170 0.61982575 -0.05612874 -0.15579551 -1.47075238 2002 Q1 2002 Q2 -0.47815006 0.41794156 > > ## replace data at times of d0 which are in dn > d1 <- d0 <- zoo(1:10) + 100 > dn <- - head(d0, 4) > window(d1, time(dn)) <- coredata(dn) > > ## if the underlying time index is a float, note that the index may > ## print in the same way but actually be different (e.g., differing > ## by 0.1 second in this example) > zp <- zoo(1:4, as.POSIXct("2000-01-01 00:00:00") + c(-3600, 0, 0.1, 3600)) > ## and then the >= start and <= end may not select all intended > ## observations and adding/subtracting some "fuzz" may be needed > window(zp, end = "2000-01-01 00:00:00") 1999-12-31 23:00:00 2000-01-01 00:00:00 1 2 > window(zp, end = as.POSIXct("2000-01-01 00:00:00") + 0.5) 1999-12-31 23:00:00 2000-01-01 00:00:00 2000-01-01 00:00:00 1 2 3 > > > > cleanEx() > nameEx("xblocks") > ### * xblocks > > flush(stderr()); flush(stdout()) > > ### Name: xblocks > ### Title: Plot contiguous blocks along x axis. > ### Aliases: xblocks xblocks.default xblocks.zoo xblocks.ts > ### Keywords: dplot > > ### ** Examples > > ## example time series: > suppressWarnings(RNGversion("3.5.0")) > set.seed(0) > flow <- ts(filter(rlnorm(200, mean = 1), 0.8, method = "r")) > > ## highlight values above and below thresholds. > ## this draws on top using semi-transparent colors. > rgb <- hcl(c(0, 0, 260), c = c(100, 0, 100), l = c(50, 90, 50), alpha = 0.3) > plot(flow) > xblocks(flow > 30, col = rgb[1]) ## high values red > xblocks(flow < 15, col = rgb[3]) ## low value blue > xblocks(flow >= 15 & flow <= 30, col = rgb[2]) ## the rest gray > > ## same thing: > plot(flow) > xblocks(time(flow), cut(flow, c(0,15,30,Inf), labels = rev(rgb))) > > ## another approach is to plot blocks underneath without transparency. > plot(flow) > ## note that 'ifelse' keeps its result as class 'ts' > xblocks(ifelse(flow < mean(flow), hcl(0, 0, 90), hcl(0, 80, 70))) > ## need to redraw data series on top: > lines(flow) > box() > > ## for single series only: plot.default has a panel.first argument > plot(time(flow), flow, type = "l", + panel.first = xblocks(flow > 20, col = "lightgray")) > ## (see also the 'panel' argument for use with multiple series, below) > > ## insert some missing values > flow[c(1:10, 50:80, 100)] <- NA > > ## the default plot shows data coverage > ## (most useful when displaying multiple series, see below) > plot(flow) > xblocks(flow) > > ## can also show gaps: > plot(flow, type = "s") > xblocks(time(flow), is.na(flow), col = "gray") > > ## Example of alternating colors, here showing calendar months > flowdates <- as.Date("2000-01-01") + as.numeric(time(flow)) > flowz <- zoo(coredata(flow), flowdates) > plot(flowz) > xblocks(flowz, months, ## i.e. months(time(flowz)), + col = gray.colors(2, start = 0.7), border = "slategray") > lines(flowz) > > ## Example of multiple series. > ## set up example data > z <- ts(cbind(A = 0:5, B = c(6:7, NA, NA, 10:11), C = c(NA, 13:17))) > > ## show data coverage only (highlighting gaps) > plot(z, panel = function(x, ...) + xblocks(x, col = "darkgray")) > > ## draw gaps in darkgray > plot(z, type = "s", panel = function(x, ...) { + xblocks(time(x), is.na(x), col = "darkgray") + lines(x, ...); points(x) + }) > > ## Example of overlaying blocks from a different series. > ## Are US presidential approval ratings linked to sunspot activity? > ## Set block height to plot blocks along the bottom. > plot(presidents) > xblocks(sunspot.year > 50, height = 2) > > > > cleanEx() > nameEx("xyplot.zoo") > ### * xyplot.zoo > > flush(stderr()); flush(stdout()) > > ### Name: xyplot.zoo > ### Title: Plot zoo Series with Lattice > ### Aliases: xyplot.zoo xyplot.its xyplot.tis llines.zoo llines.its > ### llines.tis lpoints.zoo lpoints.its lpoints.tis ltext.zoo ltext.its > ### ltext.tis panel.lines.zoo panel.lines.ts panel.lines.its > ### panel.lines.tis panel.points.zoo panel.points.ts panel.points.its > ### panel.points.tis panel.text.zoo panel.text.ts panel.text.its > ### panel.text.tis panel.plot.default panel.plot.custom > ### panel.segments.zoo panel.segments.ts panel.segments.its > ### panel.segments.tis panel.rect.zoo panel.rect.ts panel.rect.its > ### panel.rect.tis panel.polygon.zoo panel.polygon.ts panel.polygon.its > ### panel.polygon.tis > ### Keywords: hplot ts > > ### ** Examples > > if(require("lattice") & require("grid")) { + + suppressWarnings(RNGversion("3.5.0")) + set.seed(1) + z <- zoo(cbind(a = 1:5, b = 11:15, c = 21:25) + rnorm(5)) + + # plot z using same Y axis on all plots + xyplot(z, scales = list(y = list(relation = "same", alternating = FALSE))) + + # plot a double-line-width running mean on the panel of b. + # Also add a grid. + # We show two ways to do it. + + # change strip background to levels of grey + # If you like the defaults, this can be omitted. + strip.background <- trellis.par.get("strip.background") + trellis.par.set(strip.background = list(col = grey(7:1/8))) + + + # Number 1. Using trellis.focus. + print( xyplot(z) ) + trellis.focus("panel", 1, 2, highlight = FALSE) + # (or just trellis.focus() for interactive use) + z.mean <- rollmean(z, 3) + panel.lines(z.mean[,2], lwd = 2) + panel.grid(h = 10, v = 10, col = "grey", lty = 3) + trellis.unfocus() + + # Number 2. Using a custom panel routine. + xyplot(z, panel = function(x, y, ...) { + if (packet.number() == 2) { + panel.grid(h = 10, v = 10, col = "grey", lty = 3) + panel.lines(rollmean(zoo(y, x), 3), lwd = 2) + } + panel.xyplot(x, y, ...) + }) + + # plot a light grey rectangle "behind" panel b + trellis.focus("panel", 1, 2) + grid.rect(x = 2, w = 1, default.units = "native", + gp = gpar(fill = "light grey")) + # do.call("panel.xyplot", trellis.panelArgs()) + do.call("panel.lines", trellis.panelArgs()[1:2]) + trellis.unfocus() + # a better method is to use a custom panel function. + # see also panel.xblocks() and layer() in the latticeExtra package. + + # same but make first panel twice as large as others + lopt <- list(layout.heights = list(panel = list(x = c(2,1,1)))) + xyplot(z, lattice.options = lopt) + # add a grid + update(trellis.last.object(), type = c("l", "g")) + + # Plot all in one panel. + xyplot(z, screens = 1) + # Same with default styles and auto.key: + xyplot(z, superpose = TRUE) + + # Plot first two columns in first panel and third column in second panel. + # Plot first series using points, second series using lines and third + # series via overprinting both lines and points + # Use colors 1, 2 and 3 for the three series (1=black, 2=red, 3=green) + # Make 2nd (lower) panel 3x the height of the 1st (upper) panel + # Also make the strip background orange. + p <- xyplot(z, screens = c(1,1,2), type = c("p", "l", "o"), col = 1:3, + par.settings = list(strip.background = list(col = "orange"))) + print(p, panel.height = list(y = c(1, 3), units = "null")) + + # Example of using a custom axis + # Months are labelled with smaller ticks for weeks and even smaller + # ticks for days. + Days <- seq(from = as.Date("2006-1-1"), to = as.Date("2006-8-8"), by = "day") + z1 <- zoo(seq(length(Days))^2, Days) + Months <- Days[format(Days, "%d") == "01"] + Weeks <- Days[format(Days, "%w") == "0"] + print( xyplot(z1, scales = list(x = list(at = Months))) ) + trellis.focus("panel", 1, 1, clip.off = TRUE) + panel.axis("bottom", check.overlap = TRUE, outside = TRUE, labels = FALSE, + tck = .7, at = as.numeric(Weeks)) + panel.axis("bottom", check.overlap = TRUE, outside = TRUE, labels = FALSE, + tck = .4, at = as.numeric(Days)) + trellis.unfocus() + + trellis.par.set(strip.background = strip.background) + + # separate the panels and suppress the ticks on very top + xyplot(z, between = list(y = 1), scales = list(tck = c(1,0))) + + # left strips but no top strips + xyplot(z, screens = colnames(z), strip = FALSE, strip.left = TRUE) + + # plot list of zoo objects using different x scales + z.l <- list( + zoo(cbind(a = rnorm(10), b = rnorm(10)), as.Date("2006-01-01") + 0:9), + zoo(cbind(c = rnorm(10), d = rnorm(10)), as.Date("2006-12-01") + 0:9) + ) + zm <- do.call(merge, z.l) + xlim <- lapply(zm, function(x) range(time(na.omit(x)))) + xyplot(zm, xlim = xlim, scale = list(relation = "free")) + # to avoid merging see xyplot.list() in the latticeExtra package. + + } Loading required package: lattice Loading required package: grid > > ## Not run: > ##D ## playwith (>= 0.9) > ##D library("playwith") > ##D > ##D z3 <- zoo(cbind(a = rnorm(100), b = rnorm(100) + 1), as.Date(1:100)) > ##D playwith(xyplot(z3), time.mode = TRUE) > ##D # hold down Shift key and drag to zoom in to a time period. > ##D # then use the horizontal scroll bar. > ##D > ##D # set custom labels; right click on points to view or add labels > ##D labs <- paste(round(z3,1), index(z3), sep = "@") > ##D trellis.par.set(user.text = list(cex = 0.7)) > ##D playwith(xyplot(z3, type = "o"), labels = labs) > ##D > ##D # this returns indexes into times of clicked points > ##D ids <- playGetIDs() > ##D z3[ids,] > ##D > ##D ## another example of using playwith with zoo > ##D # set up data > ##D dat <- zoo(matrix(rnorm(100*100),ncol=100), Sys.Date()+1:100) > ##D colnames(dat) <- paste("Series", 1:100) > ##D > ##D # This will give you a spin button to choose the column to plot, > ##D # and a button to print out the current series number. > ##D playwith(xyplot(dat[,c(1,i)]), parameters = list(i = 1:100, > ##D do_something = function(playState) print(playState$env$i)) > ##D > ## End(Not run) > > > > > cleanEx() detaching ‘package:grid’, ‘package:lattice’ > nameEx("yearmon") > ### * yearmon > > flush(stderr()); flush(stdout()) > > ### Name: yearmon > ### Title: An Index Class for Monthly Data > ### Aliases: yearmon as.yearmon as.yearmon.default as.yearmon.numeric > ### as.yearmon.integer as.yearmon.date as.yearmon.dates as.yearmon.Date > ### as.yearmon.timeDate as.yearmon.jul as.yearmon.POSIXt > ### as.yearmon.character as.yearmon.factor as.Date as.Date.numeric > ### as.Date.ts as.Date.yearmon as.POSIXct.yearmon as.POSIXlt.yearmon > ### as.list.yearmon as.numeric.yearmon as.character.yearmon > ### as.data.frame.yearmon c.yearmon cycle.yearmon format.yearmon > ### is.numeric.yearmon mean.yearmon print.yearmon range.yearmon > ### summary.yearmon unique.yearmon [.yearmon [[.yearmon MATCH.yearmon > ### Ops.yearmon Summary.yearmon Sys.yearmon -.yearmon xtfrm.yearmon > ### Keywords: ts > > ### ** Examples > > Sys.setenv(TZ = "GMT") > > x <- as.yearmon(2000 + seq(0, 23)/12) > x [1] "Jan 2000" "Feb 2000" "Mar 2000" "Apr 2000" "May 2000" "Jun 2000" [7] "Jul 2000" "Aug 2000" "Sep 2000" "Oct 2000" "Nov 2000" "Dec 2000" [13] "Jan 2001" "Feb 2001" "Mar 2001" "Apr 2001" "May 2001" "Jun 2001" [19] "Jul 2001" "Aug 2001" "Sep 2001" "Oct 2001" "Nov 2001" "Dec 2001" > > as.yearmon("mar07", "%b%y") [1] "Mar 2007" > as.yearmon("2007-03-01") [1] "Mar 2007" > as.yearmon("2007-12") [1] "Dec 2007" > > # returned Date is the fraction of the way through > # the period given by frac (= 0 by default) > as.Date(x) [1] "2000-01-01" "2000-02-01" "2000-03-01" "2000-04-01" "2000-05-01" [6] "2000-06-01" "2000-07-01" "2000-08-01" "2000-09-01" "2000-10-01" [11] "2000-11-01" "2000-12-01" "2001-01-01" "2001-02-01" "2001-03-01" [16] "2001-04-01" "2001-05-01" "2001-06-01" "2001-07-01" "2001-08-01" [21] "2001-09-01" "2001-10-01" "2001-11-01" "2001-12-01" > as.Date(x, frac = 1) [1] "2000-01-31" "2000-02-29" "2000-03-31" "2000-04-30" "2000-05-31" [6] "2000-06-30" "2000-07-31" "2000-08-31" "2000-09-30" "2000-10-31" [11] "2000-11-30" "2000-12-31" "2001-01-31" "2001-02-28" "2001-03-31" [16] "2001-04-30" "2001-05-31" "2001-06-30" "2001-07-31" "2001-08-31" [21] "2001-09-30" "2001-10-31" "2001-11-30" "2001-12-31" > as.POSIXct(x) [1] "2000-01-01 GMT" "2000-02-01 GMT" "2000-03-01 GMT" "2000-04-01 GMT" [5] "2000-05-01 GMT" "2000-06-01 GMT" "2000-07-01 GMT" "2000-08-01 GMT" [9] "2000-09-01 GMT" "2000-10-01 GMT" "2000-11-01 GMT" "2000-12-01 GMT" [13] "2001-01-01 GMT" "2001-02-01 GMT" "2001-03-01 GMT" "2001-04-01 GMT" [17] "2001-05-01 GMT" "2001-06-01 GMT" "2001-07-01 GMT" "2001-08-01 GMT" [21] "2001-09-01 GMT" "2001-10-01 GMT" "2001-11-01 GMT" "2001-12-01 GMT" > > # given a Date, x, return the Date of the next Friday > nextfri <- function(x) 7 * ceiling(as.numeric(x - 1)/7) + as.Date(1) > > # given a Date, d, return the same Date in the following month > # Note that as.Date.yearmon gives first Date of the month. > d <- as.Date("2005-1-1") + seq(0,90,30) > next.month <- function(d) as.Date(as.yearmon(d) + 1/12) + + as.numeric(d - as.Date(as.yearmon(d))) > next.month(d) [1] "2005-02-01" "2005-03-03" "2005-04-02" "2005-05-01" > > # 3rd Friday in last month of the quarter of Date x > ## first day of last month of quarter > y <- as.Date(zoo::as.yearmon(zoo::as.yearqtr(x), frac = 1)) > ## number of days to first Friday > n <- sapply(y, function(z) which(format(z + 0:6, "%w") == "5")) - 1 > ## add number of days to third Friday > y + n + 14 [1] "2000-03-17" "2000-03-17" "2000-03-17" "2000-06-16" "2000-06-16" [6] "2000-06-16" "2000-09-15" "2000-09-15" "2000-09-15" "2000-12-15" [11] "2000-12-15" "2000-12-15" "2001-03-16" "2001-03-16" "2001-03-16" [16] "2001-06-15" "2001-06-15" "2001-06-15" "2001-09-21" "2001-09-21" [21] "2001-09-21" "2001-12-21" "2001-12-21" "2001-12-21" > > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > z <- zoo(rnorm(24), x, frequency = 12) > z Jan 2000 Feb 2000 Mar 2000 Apr 2000 May 2000 Jun 2000 -0.62645381 0.18364332 -0.83562861 1.59528080 0.32950777 -0.82046838 Jul 2000 Aug 2000 Sep 2000 Oct 2000 Nov 2000 Dec 2000 0.48742905 0.73832471 0.57578135 -0.30538839 1.51178117 0.38984324 Jan 2001 Feb 2001 Mar 2001 Apr 2001 May 2001 Jun 2001 -0.62124058 -2.21469989 1.12493092 -0.04493361 -0.01619026 0.94383621 Jul 2001 Aug 2001 Sep 2001 Oct 2001 Nov 2001 Dec 2001 0.82122120 0.59390132 0.91897737 0.78213630 0.07456498 -1.98935170 > as.ts(z) Jan Feb Mar Apr May Jun 2000 -0.62645381 0.18364332 -0.83562861 1.59528080 0.32950777 -0.82046838 2001 -0.62124058 -2.21469989 1.12493092 -0.04493361 -0.01619026 0.94383621 Jul Aug Sep Oct Nov Dec 2000 0.48742905 0.73832471 0.57578135 -0.30538839 1.51178117 0.38984324 2001 0.82122120 0.59390132 0.91897737 0.78213630 0.07456498 -1.98935170 > > ## convert data fram to multivariate monthly "ts" series > ## 1.read raw data > Lines.raw <- "ID Date Count + 123 20 May 1999 1 + 123 21 May 1999 3 + 222 1 Feb 2000 2 + 222 3 Feb 2000 4 + " > DF <- read.table(text = Lines.raw, skip = 1, + col.names = c("ID", "d", "b", "Y", "Count")) > ## 2. fix raw date > DF$yearmon <- as.yearmon(paste(DF$b, DF$Y), "%b %Y") > ## 3. aggregate counts over months, convert to zoo and merge over IDs > ag <- function(DF) aggregate(zoo(DF$Count), DF$yearmon, sum) > z <- do.call("merge.zoo", lapply(split(DF, DF$ID), ag)) > ## 4. convert to "zooreg" and then to "ts" > frequency(z) <- 12 > as.ts(z) 123 222 May 1999 4 NA Jun 1999 NA NA Jul 1999 NA NA Aug 1999 NA NA Sep 1999 NA NA Oct 1999 NA NA Nov 1999 NA NA Dec 1999 NA NA Jan 2000 NA NA Feb 2000 NA 6 > > xx <- zoo(seq_along(x), x) > > ## aggregating over year > as.year <- function(x) as.numeric(floor(as.yearmon(x))) > aggregate(xx, as.year, mean) 2000 2001 6.5 18.5 > > > > > cleanEx() > nameEx("yearqtr") > ### * yearqtr > > flush(stderr()); flush(stdout()) > > ### Name: yearqtr > ### Title: An Index Class for Quarterly Data > ### Aliases: yearqtr as.yearqtr as.yearqtr.default as.yearqtr.numeric > ### as.yearqtr.integer as.yearqtr.date as.yearqtr.dates as.yearqtr.Date > ### as.yearqtr.timeDate as.yearqtr.jul as.yearqtr.POSIXt > ### as.yearqtr.character as.yearqtr.factor as.yearqtr.yearqtr > ### as.Date.yearqtr as.POSIXct.yearqtr as.POSIXlt.yearqtr as.list.yearqtr > ### as.numeric.yearqtr as.character.yearqtr as.data.frame.yearqtr > ### c.yearqtr cycle.yearqtr format.yearqtr is.numeric.yearqtr > ### mean.yearqtr print.yearqtr range.yearqtr summary.yearqtr > ### unique.yearqtr [.yearqtr [[.yearqtr MATCH.yearqtr Ops.yearqtr > ### Summary.yearqtr Sys.yearqtr -.yearqtr xtfrm.yearqtr > ### Keywords: ts > > ### ** Examples > > Sys.setenv(TZ = "GMT") > > x <- as.yearqtr(2000 + seq(0, 7)/4) > x [1] "2000 Q1" "2000 Q2" "2000 Q3" "2000 Q4" "2001 Q1" "2001 Q2" "2001 Q3" [8] "2001 Q4" > > format(x, "%Y Quarter %q") [1] "2000 Quarter 1" "2000 Quarter 2" "2000 Quarter 3" "2000 Quarter 4" [5] "2001 Quarter 1" "2001 Quarter 2" "2001 Quarter 3" "2001 Quarter 4" > as.yearqtr("2001 Q2") [1] "2001 Q2" > as.yearqtr("2001 q2") # same [1] "2001 Q2" > as.yearqtr("2001-2") # same [1] "2001 Q2" > > # returned Date is the fraction of the way through > # the period given by frac (= 0 by default) > dd <- as.Date(x) > format.yearqtr(dd) [1] "2000 Q1" "2000 Q2" "2000 Q3" "2000 Q4" "2001 Q1" "2001 Q2" "2001 Q3" [8] "2001 Q4" > as.Date(x, frac = 1) [1] "2000-03-31" "2000-06-30" "2000-09-30" "2000-12-31" "2001-03-31" [6] "2001-06-30" "2001-09-30" "2001-12-31" > as.POSIXct(x) [1] "2000-01-01 GMT" "2000-04-01 GMT" "2000-07-01 GMT" "2000-10-01 GMT" [5] "2001-01-01 GMT" "2001-04-01 GMT" "2001-07-01 GMT" "2001-10-01 GMT" > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > zz <- zoo(rnorm(8), x, frequency = 4) > zz 2000 Q1 2000 Q2 2000 Q3 2000 Q4 2001 Q1 2001 Q2 2001 Q3 -0.6264538 0.1836433 -0.8356286 1.5952808 0.3295078 -0.8204684 0.4874291 2001 Q4 0.7383247 > as.ts(zz) Qtr1 Qtr2 Qtr3 Qtr4 2000 -0.6264538 0.1836433 -0.8356286 1.5952808 2001 0.3295078 -0.8204684 0.4874291 0.7383247 > > > > > cleanEx() > nameEx("zoo") > ### * zoo > > flush(stderr()); flush(stdout()) > > ### Name: zoo > ### Title: Z's Ordered Observations > ### Aliases: zoo with.zoo range.zoo print.zoo as.zoo.factor summary.zoo > ### str.zoo is.zoo [.zoo [<-.zoo $.zoo $<-.zoo subset.zoo head.zoo > ### tail.zoo Ops.zoo t.zoo cumsum.zoo cumprod.zoo cummin.zoo cummax.zoo > ### mean.zoo median.zoo na.contiguous na.contiguous.data.frame > ### na.contiguous.list na.contiguous.default na.contiguous.zoo scale.zoo > ### xtfrm.zoo names.zoo names<-.zoo quantile.zoo rev.zoo transform.zoo > ### ifelse.zoo dim<-.zoo index2char index2char.default index2char.numeric > ### index2char.POSIXt > ### Keywords: ts > > ### ** Examples > > suppressWarnings(RNGversion("3.5.0")) > set.seed(1) > > ## simple creation and plotting > x.Date <- as.Date("2003-02-01") + c(1, 3, 7, 9, 14) - 1 > x <- zoo(rnorm(5), x.Date) > plot(x) > time(x) [1] "2003-02-01" "2003-02-03" "2003-02-07" "2003-02-09" "2003-02-14" > > ## subsetting with numeric indexes > x[c(2, 4)] 2003-02-03 2003-02-09 0.1836433 1.5952808 > ## subsetting with index class > x[as.Date("2003-02-01") + c(2, 8)] 2003-02-03 2003-02-09 0.1836433 1.5952808 > > ## different classes of indexes/times can be used, e.g. numeric vector > x <- zoo(rnorm(5), c(1, 3, 7, 9, 14)) > ## subsetting with numeric indexes then uses observation numbers > x[c(2, 4)] 3 9 0.4874291 0.5757814 > ## subsetting with index class can be enforced by I() > x[I(c(3, 9))] 3 9 0.4874291 0.5757814 > > ## visualization > plot(x) > ## or POSIXct > y.POSIXct <- ISOdatetime(2003, 02, c(1, 3, 7, 9, 14), 0, 0, 0) > y <- zoo(rnorm(5), y.POSIXct) > plot(y) > > ## create a constant series > z <- zoo(1, seq(4)[-2]) > > ## create a 0-dimensional zoo series > z0 <- zoo(, 1:4) > > ## create a 2-dimensional zoo series > z2 <- zoo(matrix(1:12, 4, 3), as.Date("2003-01-01") + 0:3) > > ## create a factor zoo object > fz <- zoo(gl(2,5), as.Date("2004-01-01") + 0:9) > > ## create a zoo series with 0 columns > z20 <- zoo(matrix(nrow = 4, ncol = 0), 1:4) > > ## arithmetic on zoo objects intersects them first > x1 <- zoo(1:5, 1:5) > x2 <- zoo(2:6, 2:6) > 10 * x1 + x2 2 3 4 5 22 33 44 55 > > ## $ extractor for multivariate zoo series with column names > z <- zoo(cbind(foo = rnorm(5), bar = rnorm(5))) > z$foo 1 2 3 4 5 -0.04493361 -0.01619026 0.94383621 0.82122120 0.59390132 > z$xyz <- zoo(rnorm(3), 2:4) > z foo bar xyz 1 -0.04493361 0.91897737 NA 2 -0.01619026 0.78213630 -0.05612874 3 0.94383621 0.07456498 -0.15579551 4 0.82122120 -1.98935170 -1.47075238 5 0.59390132 0.61982575 NA > > ## add comments to a zoo object > comment(x1) <- c("This is a very simple example of a zoo object.", + "It can be recreated using this R code: example(zoo)") > ## comments are not output by default but are still there > x1 1 2 3 4 5 1 2 3 4 5 > comment(x1) [1] "This is a very simple example of a zoo object." [2] "It can be recreated using this R code: example(zoo)" > > # ifelse does not work with zoo but this works > # to create a zoo object which equals x1 at > # time i if x1[i] > x1[i-1] and 0 otherwise > (diff(x1) > 0) * x1 2 3 4 5 2 3 4 5 > > ## zoo series with duplicated indexes > z3 <- zoo(1:8, c(1, 2, 2, 2, 3, 4, 5, 5)) Warning in zoo(1:8, c(1, 2, 2, 2, 3, 4, 5, 5)) : some methods for “zoo” objects do not work if the index entries in ‘order.by’ are not unique > plot(z3) > ## remove duplicated indexes by averaging > lines(aggregate(z3, index(z3), mean), col = 2) > ## or by using the last observation > lines(aggregate(z3, index(z3), tail, 1), col = 4) > > ## x1[x1 > 3] is not officially supported since > ## x1 > 3 is of class "zoo", not "logical". > ## Use one of these instead: > x1[which(x1 > 3)] 4 5 4 5 > x1[coredata(x1 > 3)] 4 5 4 5 > x1[as.logical(x1 > 3)] 4 5 4 5 > subset(x1, x1 > 3) 4 5 4 5 > > ## any class supporting the methods discussed can be used > ## as an index class. Here are examples using complex numbers > ## and letters as the time class. > > z4 <- zoo(11:15, complex(real = c(1, 3, 4, 5, 6), imag = c(0, 1, 0, 0, 1))) > merge(z4, lag(z4)) z4 lag(z4) 1+0i 11 12 3+1i 12 13 4+0i 13 14 5+0i 14 15 6+1i 15 NA > > z5 <- zoo(11:15, letters[1:5]) > merge(z5, lag(z5)) z5 lag(z5) a 11 12 b 12 13 c 13 14 d 14 15 e 15 NA > > # index values relative to 2001Q1 > zz <- zooreg(cbind(a = 1:10, b = 11:20), start = as.yearqtr(2000), freq = 4) > zz[] <- mapply("/", as.data.frame(zz), coredata(zz[as.yearqtr("2001Q1")])) > > > ## even though time index must be unique zoo (and read.zoo) > ## will both allow creation of such illegal objects with > ## a warning (rather than ana error) to give the user a > ## chance to fix them up. Extracting and replacing times > ## and aggregate.zoo will still work. > ## Not run: > ##D # this gives a warning > ##D # and then creates an illegal zoo object > ##D z6 <- zoo(11:15, c(1, 1, 2, 2, 5)) > ##D z6 > ##D > ##D # fix it up by averaging duplicates > ##D aggregate(z6, identity, mean) > ##D > ##D # or, fix it up by taking last in each set of duplicates > ##D aggregate(z6, identity, tail, 1) > ##D > ##D # fix it up via interpolation of duplicate times > ##D time(z6) <- na.approx(ifelse(duplicated(time(z6)), NA, time(z6)), na.rm = FALSE) > ##D # if there is a run of equal times at end they > ##D # wind up as NAs and we cannot have NA times > ##D z6 <- z6[!is.na(time(z6))] > ##D z6 > ##D > ##D x1. <- x1 <- zoo (matrix (1:12, nrow = 3), as.Date("2008-08-01") + 0:2) > ##D colnames (x1) <- c ("A", "B", "C", "D") > ##D x2 <- zoo (matrix (1:12, nrow = 3), as.Date("2008-08-01") + 1:3) > ##D colnames (x2) <- c ("B", "C", "D", "E") > ##D > ##D both.dates = as.Date (intersect (index (t1), index (t2))) > ##D both.cols = intersect (colnames (t1), colnames (t2)) > ##D > ##D x1[both.dates, both.cols] > ##D ## there is "[.zoo" but no "[<-.zoo" however four of the following > ##D ## five examples work > ##D > ##D ## wrong > ##D ## x1[both.dates, both.cols] <- x2[both.dates, both.cols] > ##D > ##D # 4 correct alternatives > ##D # #1 > ##D window(x1, both.dates)[, both.cols] <- x2[both.dates, both.cols] > ##D > ##D # #2. restore x1 and show a different way > ##D x1 <- x1. > ##D window(x1, both.dates)[, both.cols] <- window(x2, both.dates)[, both.cols] > ##D > ##D # #3. restore x1 and show a different way > ##D x1 <- x1. > ##D x1[time(x1) ##D > ##D > ##D # #4. restore x1 and show a different way > ##D x1 <- x1. > ##D x1[time(x1) ##D > ##D > ## End(Not run) > > > > > cleanEx() > nameEx("zooreg") > ### * zooreg > > flush(stderr()); flush(stdout()) > > ### Name: zooreg > ### Title: Regular zoo Series > ### Aliases: zooreg frequency.zooreg frequency.zoo deltat.zooreg deltat.zoo > ### cycle.zooreg cycle.zoo as.zooreg as.zooreg.default as.zooreg.ts > ### as.zooreg.its as.zooreg.xts as.ts.zooreg as.zoo.zooreg as.zooreg.zoo > ### index<-.zooreg time<-.zooreg lag.zooreg > ### Keywords: ts > > ### ** Examples > > ## equivalent specifications of a quarterly series > ## starting in the second quarter of 1959. > zooreg(1:10, frequency = 4, start = c(1959, 2)) 1959 Q2 1959 Q3 1959 Q4 1960 Q1 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 1 2 3 4 5 6 7 8 9 10 > as.zoo(ts(1:10, frequency = 4, start = c(1959, 2))) 1959 Q2 1959 Q3 1959 Q4 1960 Q1 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 1 2 3 4 5 6 7 8 9 10 > zoo(1:10, seq(1959.25, 1961.5, by = 0.25), frequency = 4) 1959 Q2 1959 Q3 1959 Q4 1960 Q1 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 1 2 3 4 5 6 7 8 9 10 > > ## use yearqtr class for indexing the same series > z <- zoo(1:10, yearqtr(seq(1959.25, 1961.5, by = 0.25)), frequency = 4) > z 1959 Q2 1959 Q3 1959 Q4 1960 Q1 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 1 2 3 4 5 6 7 8 9 10 > z[-(3:4)] 1959 Q2 1959 Q3 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 1 2 5 6 7 8 9 10 > > ## create a regular series with a "Date" index > zooreg(1:5, start = as.Date("2000-01-01")) 2000-01-01 2000-01-02 2000-01-03 2000-01-04 2000-01-05 1 2 3 4 5 > ## or with "yearmon" index > zooreg(1:5, end = yearmon(2000)) Jan 1996 Jan 1997 Jan 1998 Jan 1999 Jan 2000 1 2 3 4 5 > > ## lag and diff (as diff is defined in terms of lag) > ## act differently on zoo and zooreg objects! > ## lag.zoo moves a point to the adjacent time whereas > ## lag.zooreg moves a point by deltat > x <- c(1, 2, 3, 6) > zz <- zoo(x, x) > zr <- as.zooreg(zz) > lag(zz, k = -1) 2 3 6 1 2 3 > lag(zr, k = -1) 2 3 4 7 1 2 3 6 > diff(zz) 2 3 6 1 1 3 > diff(zr) 2 3 1 1 > > ## lag.zooreg wihtout and with na.pad > lag(zr, k = -1) 2 3 4 7 1 2 3 6 > lag(zr, k = -1, na.pad = TRUE) 1 2 3 4 6 7 NA 1 2 3 NA 6 > > ## standard methods available for regular series > frequency(z) [1] 4 > deltat(z) [1] 0.25 > cycle(z) 1959 Q2 1959 Q3 1959 Q4 1960 Q1 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 2 3 4 1 2 3 4 1 2 3 > cycle(z[-(3:4)]) 1959 Q2 1959 Q3 1960 Q2 1960 Q3 1960 Q4 1961 Q1 1961 Q2 1961 Q3 2 3 2 3 4 1 2 3 > > zz <- zoo(1:6, as.Date(c("1960-01-29", "1960-02-29", "1960-03-31", + "1960-04-29", "1960-05-31", "1960-06-30"))) > # this converts zz to "zooreg" and then to "ts" expanding it to a daily > # series which is 154 elements long, most with NAs. > ## Not run: > ##D length(as.ts(zz)) # 154 > ## End(Not run) > # probably a monthly "ts" series rather than a daily one was wanted. > # This variation of the last line gives a result only 6 elements long. > length(as.ts(aggregate(zz, as.yearmon, c))) # 6 [1] 6 > > zzr <- as.zooreg(zz) > > dd <- as.Date(c("2000-01-01", "2000-02-01", "2000-03-01", "2000-04-01")) > zrd <- as.zooreg(zoo(1:4, dd)) > > > > > ### *