
R version 4.2.2 Patched (2022-11-10 r83330) -- "Innocent and Trusting"
Copyright (C) 2022 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.

  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("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.date 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 head.ts tail.ts
> ### 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))
> 
> 
> 
> 
> ### * <FOOTER>
> ###
> cleanEx()
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
Time elapsed:  1.909 0.039 1.948 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')
