From 3d9e124c0e58684ba3301ce3b4b7e7ae9fbe68a3 Mon Sep 17 00:00:00 2001 From: azeileis Date: Tue, 29 Sep 2009 23:49:04 +0000 Subject: [PATCH] moved main zoo package to new zoo directory git-svn-id: svn://r-forge.r-project.org/svnroot/zoo/pkg/zoo@609 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- .Rbuildignore | 5 + COPYING | 340 +++++++++++ COPYRIGHTS | 14 + DESCRIPTION | 19 + NAMESPACE | 317 ++++++++++ NEWS | 547 +++++++++++++++++ R/MATCH.R | 10 + R/ORDER.R | 14 + R/Ops.zoo.R | 51 ++ R/aggregate.zoo.R | 50 ++ R/as.Date.ts.R | 15 + R/as.zoo.R | 177 ++++++ R/as.zoo.tis.R | 23 + R/barplot.zoo.R | 7 + R/coredata.R | 72 +++ R/index.R | 93 +++ R/index2char.R | 17 + R/is.regular.R | 118 ++++ R/make.unique.R | 57 ++ R/merge.zoo.R | 350 +++++++++++ R/multitime.R | 112 ++++ R/na.approx.R | 22 + R/na.locf.R | 69 +++ R/na.spline.R | 19 + R/na.trim.R | 18 + R/plot.zoo.R | 213 +++++++ R/read.zoo.R | 144 +++++ R/rollapply.R | 74 +++ R/rollmean.R | 156 +++++ R/window.zoo.R | 114 ++++ R/xyplot.zoo.R | 206 +++++++ R/yearmon.R | 210 +++++++ R/yearqtr.R | 228 +++++++ R/zoo.R | 246 ++++++++ R/zooreg.R | 75 +++ R/zzz.R | 13 + THANKS | 16 + WISHLIST | 133 +++++ demo/00Index | 1 + demo/zoo-overplot.R | 333 +++++++++++ inst/CITATION | 19 + inst/doc/MSFT.rda | Bin 0 -> 10850 bytes inst/doc/demo1.txt | 20 + inst/doc/demo2.txt | 20 + inst/doc/sunw.rda | Bin 0 -> 16694 bytes inst/doc/zoo-faq.Rnw | 494 +++++++++++++++ inst/doc/zoo-quickref.Rnw | 354 +++++++++++ inst/doc/zoo-refcard-raw.tex | 88 +++ inst/doc/zoo-refcard.pdf | Bin 0 -> 47501 bytes inst/doc/zoo-refcard.tex | 8 + inst/doc/zoo.Rnw | 1088 ++++++++++++++++++++++++++++++++++ inst/doc/zoo.bib | 91 +++ man/MATCH.Rd | 33 ++ man/ORDER.Rd | 38 ++ man/aggregate.zoo.Rd | 149 +++++ man/as.zoo.Rd | 73 +++ man/coredata.Rd | 52 ++ man/frequency.Rd | 35 ++ man/index.Rd | 72 +++ man/is.regular.Rd | 76 +++ man/lag.zoo.Rd | 66 +++ man/make.par.list.Rd | 54 ++ man/make.unique.approx.Rd | 35 ++ man/merge.zoo.Rd | 130 ++++ man/multitime.Rd | 70 +++ man/na.approx.Rd | 61 ++ man/na.locf.Rd | 60 ++ man/na.trim.Rd | 45 ++ man/plot.zoo.Rd | 272 +++++++++ man/read.zoo.Rd | 174 ++++++ man/rollapply.Rd | 88 +++ man/rollmean.Rd | 67 +++ man/window.zoo.Rd | 67 +++ man/xyplot.zoo.Rd | 259 ++++++++ man/yearmon.Rd | 140 +++++ man/yearqtr.Rd | 125 ++++ man/zoo.Rd | 381 ++++++++++++ man/zooreg.Rd | 171 ++++++ 78 files changed, 9673 insertions(+) create mode 100644 .Rbuildignore create mode 100644 COPYING create mode 100644 COPYRIGHTS create mode 100644 DESCRIPTION create mode 100644 NAMESPACE create mode 100644 NEWS create mode 100644 R/MATCH.R create mode 100644 R/ORDER.R create mode 100644 R/Ops.zoo.R create mode 100644 R/aggregate.zoo.R create mode 100644 R/as.Date.ts.R create mode 100644 R/as.zoo.R create mode 100644 R/as.zoo.tis.R create mode 100644 R/barplot.zoo.R create mode 100644 R/coredata.R create mode 100644 R/index.R create mode 100644 R/index2char.R create mode 100644 R/is.regular.R create mode 100644 R/make.unique.R create mode 100644 R/merge.zoo.R create mode 100644 R/multitime.R create mode 100644 R/na.approx.R create mode 100644 R/na.locf.R create mode 100644 R/na.spline.R create mode 100644 R/na.trim.R create mode 100644 R/plot.zoo.R create mode 100644 R/read.zoo.R create mode 100644 R/rollapply.R create mode 100644 R/rollmean.R create mode 100644 R/window.zoo.R create mode 100644 R/xyplot.zoo.R create mode 100644 R/yearmon.R create mode 100644 R/yearqtr.R create mode 100644 R/zoo.R create mode 100644 R/zooreg.R create mode 100644 R/zzz.R create mode 100644 THANKS create mode 100644 WISHLIST create mode 100644 demo/00Index create mode 100644 demo/zoo-overplot.R create mode 100644 inst/CITATION create mode 100644 inst/doc/MSFT.rda create mode 100644 inst/doc/demo1.txt create mode 100644 inst/doc/demo2.txt create mode 100644 inst/doc/sunw.rda create mode 100644 inst/doc/zoo-faq.Rnw create mode 100644 inst/doc/zoo-quickref.Rnw create mode 100644 inst/doc/zoo-refcard-raw.tex create mode 100644 inst/doc/zoo-refcard.pdf create mode 100644 inst/doc/zoo-refcard.tex create mode 100644 inst/doc/zoo.Rnw create mode 100644 inst/doc/zoo.bib create mode 100644 man/MATCH.Rd create mode 100644 man/ORDER.Rd create mode 100644 man/aggregate.zoo.Rd create mode 100644 man/as.zoo.Rd create mode 100755 man/coredata.Rd create mode 100644 man/frequency.Rd create mode 100644 man/index.Rd create mode 100644 man/is.regular.Rd create mode 100644 man/lag.zoo.Rd create mode 100644 man/make.par.list.Rd create mode 100644 man/make.unique.approx.Rd create mode 100644 man/merge.zoo.Rd create mode 100644 man/multitime.Rd create mode 100644 man/na.approx.Rd create mode 100644 man/na.locf.Rd create mode 100644 man/na.trim.Rd create mode 100644 man/plot.zoo.Rd create mode 100644 man/read.zoo.Rd create mode 100644 man/rollapply.Rd create mode 100644 man/rollmean.Rd create mode 100644 man/window.zoo.Rd create mode 100644 man/xyplot.zoo.Rd create mode 100644 man/yearmon.Rd create mode 100644 man/yearqtr.Rd create mode 100644 man/zoo.Rd create mode 100644 man/zooreg.Rd diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..57d4829 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,5 @@ +R/fBasics.R +R/misc.zoo.R +man/defaultfrequency.Rd +inst/doc/.*\.log +inst/doc/.*\.dvi diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..d60c31a --- /dev/null +++ b/COPYING @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/COPYRIGHTS b/COPYRIGHTS new file mode 100644 index 0000000..ca8dc48 --- /dev/null +++ b/COPYRIGHTS @@ -0,0 +1,14 @@ +COPYRIGHT STATUS +---------------- + +This bulk of this code is + + Copyright (C) 2004-2008 Achim Zeileis, Gabor Grothendieck + +and R/na.approx.R which is + + Copyright (C) 2004 Achim Zeileis, Gabor Grothendieck, Sundar Dorai-Raj + +All code is subject to the GNU General Public License, Version 2. See +the file COPYING for the exact conditions under which you may +redistribute it. diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..3b91c7b --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,19 @@ +Package: zoo +Version: 1.6-0 +Date: 2008-09-14 +Title: Z's ordered observations +Author: Achim Zeileis, Gabor Grothendieck +Maintainer: Achim Zeileis +Description: An S3 class with methods for totally ordered indexed + observations. It is particularly aimed at irregular time series + of numeric vectors/matrices and factors. zoo's key design goals + are independence of a particular index/date/time class and + consistency with ts and base R by providing methods to extend + standard generics. +Depends: R (>= 2.4.1), stats +Suggests: coda, chron, DAAG, fame, fCalendar, fSeries, fts, its, lattice, strucchange, + timeDate, timeSeries, tseries, xts +Imports: stats, utils, graphics, grDevices, lattice +LazyLoad: yes +License: GPL-2 +URL: http://R-Forge.R-project.org/projects/zoo/ diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..b8b29e0 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,317 @@ +## name spaces needed for S3 methods +import("stats", "utils", "graphics", "lattice", "grDevices") + +export( +## zoo core functionality + "zoo", + "zooreg", + "as.zoo", + "as.zoo.default", + "as.zooreg", + "as.zooreg.default", + "cbind.zoo", + "rbind.zoo", + "is.zoo", + "merge.zoo", + "read.zoo", + "rev.zoo", + "write.zoo", + "xtfrm.zoo", + +## plotting + "plot.zoo", + "make.par.list", + "panel.plot.default", + "panel.plot.custom", + +## new time series functionality + "coredata", + "coredata.default", + "coredata<-", + "frequency<-", + "index", + "index2char", + "index<-", + "is.regular", + "time<-", + +## rolling operations + "rollapply", + "rollmax", + "rollmax.default", + "rollmean", + "rollmean.default", + "rollmedian", + "rollmedian.default", + +## NA operations + "na.approx", + "na.approx.default", + "na.locf", + "na.locf.default", + "na.spline", + "na.spline.default", + "na.trim", + "na.trim.default", + +## make.unique operations + "make.unique.approx", + "make.unique.approx.default", + +## new index classes + "yearmon", + "as.yearmon", + "as.yearmon.default", + "Sys.yearmon", + "yearqtr", + "as.yearqtr", + "as.yearqtr.yearqtr", + "as.yearqtr.default", + "format.yearqtr", + "Sys.yearqtr", + "multitime", + "as.multitime", + "as.multitime.default", + "xtfrm.multitime", + +# *** temporary -- change these to S3Method when lattice creates generics + "panel.lines.ts", + "panel.lines.its", + "panel.lines.tis", + "panel.lines.zoo", + "panel.points.ts", + "panel.points.its", + "panel.points.tis", + "panel.points.zoo", + "panel.segments.ts", + "panel.segments.its", + "panel.segments.tis", + "panel.segments.zoo", + "panel.text.ts", + "panel.text.its", + "panel.text.tis", + "panel.text.zoo", + "panel.rect.ts", + "panel.rect.its", + "panel.rect.tis", + "panel.rect.zoo", + "panel.arrows.ts", + "panel.arrows.its", + "panel.arrows.tis", + "panel.arrows.zoo", + "panel.polygon.ts", + "panel.polygon.its", + "panel.polygon.tis", + "panel.polygon.zoo", + +## auxiliary generics/methods + "MATCH", + "MATCH.default", + "ORDER", + "ORDER.default") + +## methods for class zoo + S3method("Ops", "zoo") + S3method("[", "zoo") + S3method("$", "zoo") + S3method("$<-", "zoo") + S3method("aggregate", "zoo") + S3method("as.data.frame", "zoo") + S3method("as.list", "zoo") + S3method("as.matrix", "zoo") + S3method("as.ts", "zoo") + S3method("as.vector", "zoo") + S3method("barplot", "zoo") + S3method("c", "zoo") + S3method("coredata", "zoo") + S3method("coredata<-", "zoo") + S3method("cummax", "zoo") + S3method("cummin", "zoo") + S3method("cumprod", "zoo") + S3method("cumsum", "zoo") + S3method("cycle", "zoo") + S3method("deltat", "zoo") + S3method("diff", "zoo") + S3method("end", "zoo") + S3method("frequency", "zoo") + S3method("frequency<-", "zoo") + S3method("head", "zoo") + S3method("index", "zoo") + S3method("index<-", "zoo") + S3method("is.regular", "zoo") + S3method("lag", "zoo") + S3method("lines", "zoo") + S3method("na.contiguous", "zoo") + S3method("names", "zoo") + S3method("names<-", "zoo") + S3method("plot", "zoo") + S3method("points", "zoo") + S3method("print", "zoo") + S3method("range", "zoo") + S3method("rollapply", "zoo") + S3method("rollmax", "zoo") + S3method("rollmean", "zoo") + S3method("rollmedian", "zoo") + S3method("scale", "zoo") + S3method("split", "zoo") + S3method("subset", "zoo") + S3method("start", "zoo") + S3method("str", "zoo") + S3method("summary", "zoo") + S3method("t", "zoo") + S3method("tail", "zoo") + S3method("time", "zoo") + S3method("time<-", "zoo") + S3method("window", "zoo") + S3method("window<-", "zoo") + S3method("with", "zoo") + S3method("xyplot", "zoo") + +## methods for class zooreg + S3method("as.ts", "zooreg") + S3method("deltat", "zooreg") + S3method("frequency", "zooreg") + S3method("frequency<-", "zooreg") + S3method("lag", "zooreg") + S3method("time<-", "zooreg") + S3method("index<-", "zooreg") + S3method("is.regular", "zooreg") + +## methods for class ts + S3method("coredata", "ts") + S3method("coredata<-", "ts") + S3method("index", "ts") + S3method("is.regular", "ts") + S3method("rollapply", "ts") + S3method("rollmax", "ts") + S3method("rollmean", "ts") + S3method("rollmedian", "ts") + S3method("xyplot", "ts") + +## methods for class irts + S3method("coredata", "irts") + S3method("coredata<-", "irts") + +## methods for class its + S3method("coredata", "its") + S3method("coredata<-", "its") + S3method("xyplot", "its") + +## methods for class tis + S3method("xyplot", "tis") + +## methods for class multitime + S3method("coredata", "multitime") + S3method("index", "multitime") + S3method("as.character", "multitime") + S3method("MATCH", "multitime") + S3method("ORDER", "multitime") + S3method("Ops", "multitime") + S3method("[", "multitime") + S3method("c", "multitime") + S3method("as.numeric", "multitime") + S3method("as.Date", "multitime") + S3method("as.yearmon", "multitime") + S3method("as.yearqtr", "multitime") + S3method("make.unique", "multitime") + +## methods for class yearmon + S3method("-", "yearmon") + S3method("Axis", "yearmon") + S3method("MATCH", "yearmon") + S3method("Ops", "yearmon") + S3method("Summary", "yearmon") + S3method("[", "yearmon") + S3method("as.Date", "yearmon") + S3method("as.POSIXct", "yearmon") + S3method("as.POSIXlt", "yearmon") + S3method("as.character", "yearmon") + S3method("as.numeric", "yearmon") + S3method("as.data.frame", "yearmon") + S3method("axis", "yearmon") + S3method("c", "yearmon") + S3method("cycle", "yearmon") + S3method("format", "yearmon") + S3method("is.numeric", "yearmon") + S3method("mean", "yearmon") + S3method("print", "yearmon") + S3method("range", "yearmon") + S3method("summary", "yearmon") + S3method("unique", "yearmon") + +## methods for class yearqtr + S3method("-", "yearqtr") + S3method("Axis", "yearqtr") + S3method("MATCH", "yearqtr") + S3method("Ops", "yearqtr") + S3method("Summary", "yearqtr") + S3method("[", "yearqtr") + S3method("as.Date", "yearqtr") + S3method("as.POSIXct", "yearqtr") + S3method("as.POSIXlt", "yearqtr") + S3method("as.character", "yearqtr") + S3method("as.numeric", "yearqtr") + S3method("as.data.frame", "yearqtr") + S3method("axis", "yearqtr") + S3method("c", "yearqtr") + S3method("cycle", "yearqtr") + S3method("format", "yearqtr") + S3method("is.numeric", "yearqtr") + S3method("mean", "yearqtr") + S3method("print", "yearqtr") + S3method("range", "yearqtr") + S3method("summary", "yearqtr") + S3method("unique", "yearqtr") + +## methods for class timeDate/timeSeries + S3method("MATCH", "timeDate") + S3method("ORDER", "timeDate") + S3method("as.zoo", "timeSeries") + +## methods for misc classes + S3method("index", "default") + S3method("index2char", "default") + S3method("is.regular", "default") + S3method("index2char", "numeric") + S3method("na.contiguous", "data.frame") + S3method("na.contiguous", "list") + S3method("ORDER", "chron") + S3method("ORDER", "dates") + S3method("ORDER", "times") + +## coercion to classes Date, list, multitime, yearmon, yearqtr, zoo, zooreg + S3method("as.Date", "ts") + S3method("as.list", "ts") + S3method("as.yearmon", "date") + S3method("as.yearmon", "Date") + S3method("as.yearmon", "timeDate") + S3method("as.yearmon", "jul") + S3method("as.yearmon", "POSIXt") + S3method("as.yearmon", "character") + S3method("as.yearmon", "dates") + S3method("as.yearmon", "integer") + S3method("as.yearmon", "numeric") + S3method("as.yearmon", "factor") + S3method("as.yearqtr", "date") + S3method("as.yearqtr", "Date") + S3method("as.yearqtr", "timeDate") + S3method("as.yearqtr", "jul") + S3method("as.yearqtr", "POSIXt") + S3method("as.yearqtr", "character") + S3method("as.yearqtr", "dates") + S3method("as.yearqtr", "integer") + S3method("as.yearqtr", "numeric") + S3method("as.yearqtr", "factor") + S3method("as.zoo", "factor") + S3method("as.zoo", "fts") + S3method("as.zoo", "irts") + S3method("as.zoo", "its") + S3method("as.zoo", "mcmc") + S3method("as.zoo", "ts") + S3method("as.zoo", "xts") + S3method("as.zoo", "zoo") + S3method("as.zoo", "zooreg") + S3method("as.zooreg", "tis") + S3method("as.zooreg", "ts") + S3method("as.zooreg", "xts") + S3method("as.zooreg", "zoo") diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..5c59543 --- /dev/null +++ b/NEWS @@ -0,0 +1,547 @@ +Changes in Version 1.6-0 + + o tis graphics support + + o workaround to eliminate as.Date.numeric() warning when zoo loads + + o read.zoo() now optionally accepts a data frame for the file argument + + o new function make.unique.approx() for resolving duplicate index values. + Also new make.unique argument to read.zoo(). + + o better error message in read.zoo() if NAs found in index + + o read.zoo() now accepts a split argument that allows reading in of datasets + in long format (where long is as defined in R's reshape command) + + o Methods for cbind(), merge(), rbind(), and c() now ignore NULL arguments + + o fixed unique.yearmon and unique.yearqtr + + o plot.zoo now accepts vector lwd + + o rev.zoo + + +Changes in Version 1.5-8 + + o bug fixes in unique() methods for yearmon/yearqtr + + +Changes in Version 1.5-7 + + o added "zoo" methods for xtfrm(), split(), and subset() + + o as.zoo() methods for "xts", "tis", "fts", and "mcmc" objects (the other + direction being handled by the respective packages) + + o improvements in yearmon and yearqtr: + - added range(), unique(), and is.numeric() methods + - is.numeric() methods return FALSE + - as.yearmon() now also accepts "%b %Y" as a default format so + as.yearmon(as.character(ym)) where ym is yearmon now works + + o fixed strip argument in xyplot() method (thanks to Christian Gunning) + + o lag() method for "zooreg" objects now has an na.pad argument, + like the corresponding "zoo" method. Additinal bug fix. + + o head() and tail() methods now allow second argument to be negative + + o added is.na argument to na.trim() + + o ORDER() methods for "chron", "dates", and "times" objects added. + Without these order has become very slow when using older versions of + the chron package (although the most recent version of chron has no + slowdown even without this fix as it implements xtfrm()). + + +Changes in Version 1.5-6 + + o changed dependency in coercion functions and vignettes from + fCalendar/fSeries to timeDate/timeSeries + + +Changes in Version 1.5-5 + + o documentation enhancements for new Rd parser + + +Changes in Version 1.5-4 + + o improvments in read.zoo() + + o updates in zoo FAQ + + o small bug fix in plot.zoo() (ylim handling) + + o small bug fixes in axis.yearmon() and axis.yearqtr() + + o small bug fixes in aggregate.zoo() + + o extended examples for plot.zoo(), xyplot.zoo(), aggregate.zoo() + + o interactive plots/demos using the packages "TeachingDemos" + (plot.zoo) and "playwith" (xyplot.zoo) + + o mean.yearmon and Sys.yearmon are defined. Similarly for yearqtr. + + o min, max and range methods for yearmon are defined via Summary + +Changes in Version 1.5-3 + + o export as.Date.numeric() so that it does not get shadowed + by the new as.Date.numeric() in "stats" (from 2.7.0 on). + Both functions are almost identical, the version in zoo + just sets the default origin = 1970-01-01. + + o added some glue for communication between "zoo" and "timeSeries": + new MATCH() and ORDER() methods for "timeDate", new as.zoo() + method for "timeSeries" objects (the inverse will be added to + fSeries). + + o improved the zoo vignette, updating/correcting the information + about timeDate and timeSeries. + + +Changes in Version 1.5-2 + + o read.zoo has new aggregate function argument to aggregate duplicate times + + o new with.zoo method added + + o FAQ updated + + +Changes in Version 1.5-0 + + o new $.zoo and $<-.zoo methods + + o read.zoo now passes format and tz to FUN if they are specified. If + FUN is not specified but tz and format specified then POSIXct translation + is done with respect to the specified format string. + + o months.yearmon, quarters.yearmon, cycle.yearmon methods added + + o months.yearqtr, quarters.yearqtr, cycle.yearqtr methods added + + o as.yearqtr.character now accepts %q and default formats are + "%Y Q%q", "%Y q%q" and "%Y-%q". + + o yearqtr.factor and yearmon.factor added + + o as.yearmon.yearqtr now has frac argument consistent with as.Date.yearmon + + o format.yearqtr and as.character.yearqtr performance speedup for the + common case of default format. + + +Changes in Version 1.4-2 + + o The processing of regular series in aggregate.zoo() + was changed. By default, a regular series is only + created if the original series was regular. Otherwise, + a regular series is only created if indicated (by + setting argument regular = TRUE or by supplying a + specific frequency). + + o zoo FAQ vignette added + + o axis.yearqtr and axis.yearmon improved. They no longer + use axis.Date. + + o as.yearmon.character accepts "%Y-%m" default format (as well + as prior default of "%Y-%m-%d") + + o new summary() methods for yearmon/yearqtr objects which + simply report the summary of the underlying numeric vector. + + o na.locf.default now uses fromLast= (consistent with the R + duplicated function). It is similar to the rev= argument + (which will be deprecated). + + o comparisons between yearmon variables and character variables + that can be coerced to yearmon via as.yearmon now work. This + also lets character variables be used in start= and end= + arguments of window.zoo for zoo series with a yearmon index + (since window.zoo already allows such usage for any index class + that can be compared to character). Similarly for yearqtr. + + +Changes in Version 1.4-1 + + o replaced by() calls by tapply() due to fixes in R + 2.6.1-patched that caused errors in plot.zoo(). + + +Changes in Version 1.4-0 + + o added a write.zoo() function that writes zoo series to + a text file via write.table(). The index is included in + the first column so that it can be easily read again + using read.zoo(). + + o read.zoo() has a new argument index.column (default: 1) + which can be used to specify in which column of a data + file the index/time is stored. + + o rapply() was removed from zoo - after being deprecated + since zoo 1.2-0 (and R 2.4.0) and replaced by rollapply(). + + o improved str() method for "zoo" and "zooreg" series, now + gives explicit information about class, start and end, + as well as data, index (and frequency). + + o zoo() now has a default first argument like ts() has. + By default, zoo() is now zoo(NULL) and returns an empty + series. This differs somewhat from the default ts() + and zooreg() that return ts(NA) zooreg(NA), respectively. + + o added ... arguments to the as.POSIXct and as.POSIXlt + methods + + o implementation of as.Date.numeric() has been modified: + being backward compatible with the old zoo:::as.Date.numeric(). + It now matches the new (2.7.0 to be) base:::as.Date.numeric(), + but also sets a default "origin" argument (1970-01-01). + + o plot.type argument of plot.zoo() now chooses its default + value via the screen argument. + + +Changes in Version 1.3-2 + + o merge.zoo() has been improved so that unnecessary checking of + frequencies is avoided for "zoo" objects. + + +Changes in Version 1.3-1 + + o as.yearmon() can take format arguments that do not involve day, + e.g. as.yearmon("2007-01", "%Y-%m") + + o added as.data.frame() methods for "yearmon" and "yearqtr" + objects + + +Changes in Version 1.3-0 + + o checking for non-unique index entries has been improved: + zoo() throws a warning if a series with non-unique index entries + is created. merge() gives a more useful error message. + + o inconsistencies when checking for regularity of series have been + resolved: is.regular(), frequency(), frequency<-() etc. all behave + consistently now. + + o custom panel functions in plot.zoo can now refer to + parent.frame()$panel.number to determine the current panel. Also + added an example of this to ?plot.zoo. + + o read.zoo() will behave consistently when the file contains no data. + + o column names (if any) are checked now in rbind.zoo(), producing a + similar behaviour as in rbind.data.frame() + + +Changes in Version 1.2-2 + + o the order of arguments (... now come after FUN) in rollapply has + been changed to allow unnamed additional arguments to be specified + for FUN. Previously they had to be named. + + o bug in as.ts.zooreg fixed + +Changes in Version 1.2-1 + + o One of the examples on ?xyplot.zoo does not run with the + R 2.4.0 lattice. It is currently placed in \dontrun{} + (see comments in ?xyplot.zoo). + + +Changes in Version 1.2-0 + + o rapply() was re-named to rollapply() because from R 2.4.0 on, + base R provides a function rapply() for recursive (not rolling) + application of functions, which was already described in the Green + Book. zoo::rapply() still exists for backward compatibility, however, + it is flagged as deprecated and now dispatches to rollapply() methods. + + o added methods for xyplot() from package "lattice" for classes "zoo", + "ts", "its". These functions are still under development and the + interface and functionality might be modified/extended in future + releases. + + o new function make.par.list() (which was previously a local function + parm() in zoo's plot() method) for processing named argument lists. + Useful in plotting routines like the plot() and xyplot() methods, + see ?make.par.list. + + o subscripting by a "zoo" object whose data is logical is now defined, e.g. + z <- zoo(1:10); z[z > 3] + However, assignment such as + z[z > 3] <- 2 * z[z > 3] + does not work. + + o fixed a bug in zoo() when ordered factors are supplied ("ordered" + class was dropped) + + o fixed bug in subscripting for drop = TRUE and length of result is 1 + + o fixed bug in na.trim(x, "right") + + o all= argument of merge.zoo is coerced to logical so one can do this: + merge(zoo(2:4, 2:4), zoo(1:3), all = 0:1) + + +Changes in Version 1.1-1 + + o added na.spline() generic and default method for replacing + NAs via cubic spline interpolation + + o rbind() method now exported explicitly again + + +Changes in Version 1.1-0 + + o added a NAMESPACE, many S3 methods are not exported explicitly + anymore + + o new argument `regular' in read.zoo() which is set to FALSE. Only if + set to TRUE the series read is coerced to "zooreg" (if possible), + which was the previous default behaviour. + + o suppressWarnings() was added in is.regular() and frequency() functions + which try() to convert indexes to numerics which might lead to errors + or warnings and NAs (e.g., for characters), both should be fully suppressed + now. + + +Changes in Version 1.0-7 + + o added a `...' argument to as.data.frame() method for + complying with R 2.4.0 + + o improved handling of `by' argument in aggregate() method + + +Changes in Version 1.0-6 + + o ?zoo now explicitly points out that the index of + zoo objects should have unique observations (aka + time stamps). + + o The summary() was fixed to work also with duplicated + indexes. + + o scale() method added. + + o lines(x, y, ...) now supported. + + o points added. + + o -.yearmon and -.yearqtr added. + + o axis.yearmon and axis.yearqtr added. + + o Axis.yearmon and Axis.yearqtr added. + + o na.trim generic and default method added. + +Changes in Version 1.0-5 + + o added a `y' argument to plot.zoo() that allows to + generate scatter plots of univariate "zoo" series + (just as plot.ts(x, y = NULL, ...) does) + + o fixed the usage of %in% in the window() methods, + now call MATCH() (rather than match()) directly. + + +Changes in Version 1.0-4 + + o added a `rev' argument to na.locf() which allows to + eliminate NAs by NOCB (next observation carried backward). + + +Changes in Version 1.0-3 + + o added a barplot.zoo() method + + o fixed frequency.zoo() which returned NA instead of NULL + for indexes of class "character" + + o added an example to zoo-quickref for querying daily + exchange rates from oanda.com via get.hist.quote(). + This contains a worked example how to omit weekends + from daily series. + + o added an na.pad argument to diff.zoo() method + + +Changes in Version 1.0-2 + + o Small enhancements of plot.zoo() + + o Bug fixes in na.locf.default(), as.data.frame.zoo(), + lag.zoo(), lag.zooref(). + + +Changes in Version 1.0-1 + + o Convenience function read.zoo() for reading "zoo" series directly + from plain text files. + + o New vignette `zoo-quickref' with a quick reference particularly + aimed at (daily) financial series (contributed by Ajay Shah). + + o plot.zoo now has screens=, widths= and heights= arguments for controlling + which series are plotted in which graphs and widths and heights of graphs. + The ylim= argument has been enhanced. + + o argument k= can be vector in lag.zoo (suggested by Roger Koenker) + + o na.locf.default bug fixed + + +Changes in Version 1.0-0 + + o This release accompanies the publication in the Journal of Statistical + Software ("zoo: S3 Infrastructure for Regular and Irregular Time Series", + JSS, 14(6), 1-27) that essentially corresponds to the vignette contained + in the package. Please use this paper to cite zoo in publications. + + o aggregate.zoo allows a function as the argument for computing + the aggregation groups. The return value is coerced to "zooreg" + if it is.regular. + + o extended NA handling for lists and data.frames: na.locf.data.frame, + na.locf.list, na.contiguous.data.frame, na.contiguous.list + + o pair notation, e.g. c(1985,2), for "zooreg" series is now also + allowed in window.zoo and window<-.zoo. + + o fixed bug in rapply: result was transposed when by.column = FALSE and + a non-scalar function FUN was used. + + +Changes in Version 0.9-9 + + o regular "zoo" series: objects of class "zooreg" (inheriting from "zoo") + can be used to store strictly regular series (similar to "ts" objects) + or series with an underlying regularity (as before but with observations + omitted). They have a frequency attribute that can be used for conversion + between "zoo" and "ts". The function is.regular() can be used for + checking the regularity of a series. + + o improved merge() method: merge.zoo now accepts non-zoo arguments + (other than first) if all non-zoo args have the same NROW value + as the first argument (or are scalar). In that case the non-zoo + args are given the index of the first series. Scalars are added + for the full index of the merged series. + + o merge() zoo can now optionally return a "data.frame" that contains + the numeric columns as "zoo" series and the "zoo" objects created + from factors converted back to "factor". + + o [.zoo allows now indexing using observations from the index scale + (and not only observation numbers). + + o rapply, rollmean, rollmax, rollmedian to perform rolling analyses + + o extended functionality to plot.zoo type argument + + o when plot.zoo used with one series list(...) can be omitted from + various plotting parameter arguments + + o print.zoo documentation fix for R 2.1.0 + + o yearmon and yearqtr datetime classes + + o head.ts, tail.ts + + o c.zoo, range.zoo + + o coredata.default, coredata.ts + + +Changes in Version 0.9-1 + + o new generic functions ORDER() and MATCH() (with + order() and match() as the default) so that zoo() + can handle arbitrary index/time classes when + suitable methods for the generic function c(), + length(), order(), match() and subsetting [, are + supplied. + + o improved printing of "zoo" objects and added + a summary() method. + + o extended coercion functionality to and from + "zoo" objects. "its" objects can be coerced to + "zoo" and vice versa. "zoo" objects can be + coerced to vector, matrix, data.frame or list. + + o added functionality to extract/assign to + the coredata() of a "zoo" object. + + o added/improved functionality to extract/assign + to the window() of a "zoo" object. + + o added/improved functionality to extract/assign + to the index() or time() of a "zoo" object. + + o added lag(), diff(), start(), end(), head(), + tail() methods. + + o improved plot.zoo() by more flexible expansion + of plotting parameters such as col, lty and pch. + + o added a cbind() method for "zoo" objects (almost + synonymous with merge()) + + o NA handling for "zoo" objects via na.omit(), + na.contiguous(), na.approx() and na.locf(). + + o na.locf() generic function with default method (suitable + for "zoo" objects) which implements Last Observation + Carried Forward. + + o na.approx() generic function with default method (suitable + for "zoo" objects) which implements elimination of NAs + by interpolation. + + o added mathematical methods: group generic functions + for "zoo" objects, t(), cumsum(), cumprod(), cummin(), + and cummax(). + + o added model.frame.AsIs and model.frame.zoo to support + regression based on zoo objects, in particular with lm() + (but also many other regression functions). + + o Zero length vector zoo objects may have non-zero index vectors + intended to be used in merge to extend zoo objects. zoo + changed to enable the creation of such objects by omitting + first argument. + + o added a vignette explaining the new features + + +Changes in Version 0.2-0 + + o zoo() now has defaults for both arguments x and order.by, + which mimic the default behaviour of ts(). + + o added new aggregate.zoo() method for computing summary + statistics of "zoo" objects along a coarser index grid. + + o improved merge.zoo() in three directions: + 1. handling of "zoo" objects with zero columns, + 2. naming of columns in the merged "zoo" object + which behaves more like merge.data.frame(); + a corresponding suffixes argument has also been added, + 3. introced a fill argument which allows to fill gaps + by another value than NA. + + o improved documentation with extended examples + diff --git a/R/MATCH.R b/R/MATCH.R new file mode 100644 index 0000000..8e3a02e --- /dev/null +++ b/R/MATCH.R @@ -0,0 +1,10 @@ +MATCH <- function(x, table, nomatch = NA, ...) + UseMethod("MATCH") + +MATCH.default <- function(x, table, nomatch = NA, ...) + match(x, table, nomatch = nomatch, ...) + +MATCH.timeDate <- function(x, table, nomatch = NA, ...) { + stopifnot(require("timeDate")) + match(as.POSIXct(x), as.POSIXct(table), nomatch = nomatch, ...) +} diff --git a/R/ORDER.R b/R/ORDER.R new file mode 100644 index 0000000..94630fd --- /dev/null +++ b/R/ORDER.R @@ -0,0 +1,14 @@ +ORDER <- function(x, ...) + UseMethod("ORDER") + +ORDER.default <- function(x, ..., na.last = TRUE, decreasing = FALSE) + order(x, ..., na.last = na.last, decreasing = decreasing) + +ORDER.timeDate <- function(x, ...) { + stopifnot(require("timeDate")) + order(as.POSIXct(x), ...) +} + +ORDER.chron <- ORDER.dates <- ORDER.times <- function(x, ...) { + order(as.numeric(x), ...) +} diff --git a/R/Ops.zoo.R b/R/Ops.zoo.R new file mode 100644 index 0000000..687ecc5 --- /dev/null +++ b/R/Ops.zoo.R @@ -0,0 +1,51 @@ +Ops.zoo <- function (e1, e2) +{ + e <- if (missing(e2)) { + NextMethod(.Generic) + } + else if (any(nchar(.Method) == 0)) { + NextMethod(.Generic) + } + else { + merge(e1, e2, all = FALSE, retclass = NULL) + NextMethod(.Generic) + } + if (is.null(attr(e, "index"))) + zoo(e, index(e1), attr(e1, "frequency")) + else + e +} + +t.zoo <- function(x) + t(as.matrix.zoo(x)) + +cumsum.zoo <- function(x) +{ + if (length(dim(x)) == 0) x[] <- cumsum(coredata(x)) + else x[] <- apply(coredata(x), 2, cumsum) + return(x) +} + + +cumprod.zoo <- function(x) +{ + if (length(dim(x)) == 0) x[] <- cumprod(coredata(x)) + else x[] <- apply(coredata(x), 2, cumprod) + return(x) +} + + +cummin.zoo <- function(x) +{ + if (length(dim(x)) == 0) x[] <- cummin(coredata(x)) + else x[] <- apply(coredata(x), 2, cummin) + return(x) +} + + +cummax.zoo <- function(x) +{ + if (length(dim(x)) == 0) x[] <- cummax(coredata(x)) + else x[] <- apply(coredata(x), 2, cummax) + return(x) +} diff --git a/R/aggregate.zoo.R b/R/aggregate.zoo.R new file mode 100644 index 0000000..75bb134 --- /dev/null +++ b/R/aggregate.zoo.R @@ -0,0 +1,50 @@ +aggregate.zoo <- function(x, by, FUN, ..., regular = NULL, frequency = NULL) +{ + ## index processing + my.unique <- function(x) x[MATCH(x, x) == seq_len(length(x))] + my.sort <- function(x) x[order(x)] + if(is.function(by)) by <- by(index(x)) + if(!is.list(by)) by <- list(by) + + ## sanity checks and option processing + stopifnot(length(time(x)) == length(by[[1]])) + if(is.null(frequency)) { + if(is.null(regular)) regular <- inherits(x, "zooreg") + } else { + if(identical(regular, FALSE)) warning(paste(sQuote("regular"), "is ignored")) + regular <- TRUE + } + + ## aggregate data + df <- aggregate(coredata(x), by, match.fun(FUN), ...) + if(length(unique(as.character(df[,1]))) == length(df[,1])) + row.names(df) <- df[, 1] + df <- df[, -1] + if(is.matrix(x)) df <- as.matrix(df) + + ## regularity processing, set up return value + ix <- my.sort(my.unique(by[[1]])) + rval <- zoo(df, ix) + + if(regular) { + freq <- ifelse(is.null(frequency), frequency(rval), frequency) + rval <- zoo(df, ix, freq) + } + + return(rval) +} + +# works even if zoo series has duplicates among its times +split.zoo <- function(x, f, drop = FALSE, ...) { + ix <- time(x) + xc <- coredata(x) + if (length(dim(xc)) < 2) { + lapply(split(seq_along(xc), f, drop = drop, ...), + function(ind) zoo(xc[ind], ix[ind])) + } else { + lapply(split(seq_len(nrow(xc)), f, drop = drop, ...), + function(ind) zoo(xc[ind, , drop = drop], ix[ind])) + } +} + + diff --git a/R/as.Date.ts.R b/R/as.Date.ts.R new file mode 100644 index 0000000..2d0aa3b --- /dev/null +++ b/R/as.Date.ts.R @@ -0,0 +1,15 @@ +# as.Date.numeric <- function (x, origin = "1970-01-01", ...) +# as.Date(origin, ...) + x + +as.Date.ts <- function(x, offset = 0, ...) { + time.x <- unclass(time(x)) + offset + if (frequency(x) == 1) + as.Date(paste(time.x, 1, 1, sep = "-")) + else if (frequency(x) == 4) + as.Date(paste((time.x + .001) %/% 1, 3*(cycle(x)-1)+1, 1, sep = "-")) + else if (frequency(x) == 12) + as.Date(paste((time.x + .001) %/% 1, cycle(x), 1, sep = "-")) + else + stop("unable to convert ts time to Date class") +} + diff --git a/R/as.zoo.R b/R/as.zoo.R new file mode 100644 index 0000000..828f8ca --- /dev/null +++ b/R/as.zoo.R @@ -0,0 +1,177 @@ +as.zoo <- function(x, ...) +{ + UseMethod("as.zoo") +} + +as.zoo.default <- function(x, ...) +{ + zoo(structure(x, dim = dim(x)), index(x), ...) +} + +as.zoo.factor <- function(x, ...) +{ + zoo(x, ...) +} + +as.zoo.fts <- function(x, ...) +{ + stopifnot(require("fts")) + zoo(as.matrix(x), attr(x, "dates")) +} + +as.zoo.irts <- function(x, ...) +{ + zoo(x$value, x$time, ...) +} + +as.zoo.its <- function(x, ...) +{ + index <- attr(x, "dates") + class(x) <- attr(x, "dates") <- NULL + zoo(x, index, ...) +} + +# as.mcmc.default can handle other direction +as.zoo.mcmc <- function(x, ...) +{ + stopifnot(require("coda")) + as.zoo(as.ts(x, ...)) +} + +as.zoo.timeSeries <- function(x, ...) { + stopifnot(require("timeSeries")) + zoo(as.matrix(x), timeSeries::time(x), ...) +} + +as.zoo.xts <- function(x, ...) { + stopifnot(require("xts")) + zoo(coredata(x), order.by = index(x), ...) +} + +as.zooreg.xts <- function(x, ...) { + stopifnot(require("xts")) + as.zooreg(as.zoo(x, ...)) +} + +as.zoo.zoo <- function(x, ...) x + +## This should be in its now. +## as.its.zoo <- function(x) { +## stopifnot(require("its")) +## index <- index(x) +## stopifnot(inherits(index, "POSIXct")) +## its(coredata(x), index) +## } + +as.vector.zoo <- function(x, mode = "any") + as.vector(as.matrix(x), mode = mode) + +as.matrix.zoo <- function(x, ...) +{ + y <- as.matrix(coredata(x), ...) + if (length(y) > 0) + colnames(y) <- if (length(colnames(x)) > 0) + colnames(x) + else { + lab <- deparse(substitute(x)) + if (NCOL(x) == 1) + lab + else paste(lab, 1:NCOL(x), sep = ".") + } + if(is.null(row.names(y))) row.names(y) <- index2char(index(x), frequency = attr(x, "frequency")) + return(y) +} + +as.data.frame.zoo <- function(x, row.names = NULL, optional = FALSE, ...) +{ + y <- as.data.frame(coredata(x), optional = optional) + if(NCOL(x) > 0 && !optional) { + colnames(y) <- if (length(colnames(x)) > 0) + colnames(x) + else { + lab <- deparse(substitute(x)) + if (NCOL(x) == 1) lab + else paste(lab, 1:NCOL(x), sep = ".") + } + } + if (!is.null(row.names)) row.names(y) <- row.names + else { + tmp <- index2char(index(x), frequency = attr(x, "frequency")) + if (NROW(y) > 0 && !any(duplicated(tmp))) row.names(y) <- tmp + } + return(y) +} + +as.list.zoo <- function(x, ...) { + if (length(dim(x)) == 0) list(x) + else lapply(as.data.frame(x), zoo, index(x), attr(x, "frequency")) +} + +as.list.ts <- function(x, ...) { + if (is.matrix(x)) + lapply(as.data.frame(x), ts, + start = start(x), end = end(x), freq = frequency(x)) + else + list(x) +} + + +## regular series coercions + +as.zooreg <- function(x, ...) +{ + UseMethod("as.zooreg") +} + +as.zooreg.default <- function(x, ...) +{ + as.zooreg(as.zoo(x, ...)) +} + +as.zooreg.ts <- as.zoo.ts <- function(x, ...) +{ + xtsp <- tsp(x) + zooreg(coredata(x), start = xtsp[1], end = xtsp[2], frequency = xtsp[3]) +} + +as.ts.zooreg <- function(x, ...) +{ + freq <- frequency(x) + deltat <- 1/freq + # round. <- function(x) deltat * round(x/deltat) + round. <- function(x) deltat * floor(x/deltat+0.5) + tt <- round.(as.numeric(time(x))) + tt2 <- round.(seq(head(tt,1), tail(tt,1), deltat)) + xx <- merge(zoo(coredata(x), tt), zoo(, tt2)) + ts(coredata(xx), start = tt[1], frequency = freq) +} + +as.ts.zoo <- function(x, ...) +{ + if(is.regular(x)) { + attr(x, "frequency") <- frequency(x) + return(as.ts.zooreg(x)) + } else { + warning(paste(sQuote("x"), "does not have an underlying regularity")) + return(ts(coredata(x))) + } +} + +as.zoo.zooreg <- function(x, ...) { + attr(x, "frequency") <- NULL + class(x) <- "zoo" + return(x) +} + +as.zooreg.zoo <- function(x, ...) +{ + freq <- frequency(x) + if(!is.null(freq)) { + attr(x, "frequency") <- freq + class(x) <- c("zooreg", "zoo") + } else { + warning(paste(sQuote("x"), "does not have an underlying regularity")) + x <- zooreg(coredata(x)) + } + return(x) +} diff --git a/R/as.zoo.tis.R b/R/as.zoo.tis.R new file mode 100644 index 0000000..fd2ae05 --- /dev/null +++ b/R/as.zoo.tis.R @@ -0,0 +1,23 @@ +as.zoo.tis <- function(x, ...) { + as.zoo(as.zooreg(x, ...)) +} + +as.zoo.tis <- function(x, class = "ti", ...) { + if (class == "ti") { + as.zoo(as.zooreg(x, class = "ti", ...)) + } else if (class == "numeric") { + zoo(stripTis(x), time(ti(x), offset = 0)) + } else { + asFun <- paste("as", class, sep = ".") + zoo(stripTis(x), + do.call(asFun, list(POSIXct(ti(x), offset = 0, tz = "GMT"))), ...) + } +} + +as.zooreg.tis <- function(x, class = "ti", ...) { + if (class == "ti") + zooreg(stripTis(x), start = start(x), ...) + else + as.zooreg(as.zoo(x, class = class, ...)) +} + diff --git a/R/barplot.zoo.R b/R/barplot.zoo.R new file mode 100644 index 0000000..b0f9c87 --- /dev/null +++ b/R/barplot.zoo.R @@ -0,0 +1,7 @@ +barplot.zoo <- function(height, names = NULL, ...) +{ + x <- coredata(height) + if(!is.null(dim(x))) x <- t(x) + if(is.null(names)) names <- index2char(index(height)) + barplot(x, names = names, ...) +} diff --git a/R/coredata.R b/R/coredata.R new file mode 100644 index 0000000..06fdcdc --- /dev/null +++ b/R/coredata.R @@ -0,0 +1,72 @@ +coredata <- function(x, ...) + UseMethod("coredata") + +coredata.default <- function(x, ...) x + +coredata.zoo <- function(x, ...) +{ + attr(x, "class") <- attr(x, "oclass") + attr(x, "index") <- attr(x, "oclass") <- attr(x, "frequency") <- NULL + return(x) +} + +coredata.ts <- function(x, ...) +{ + x <- unclass(x) + attr(x, "tsp") <- NULL + return(x) +} + +coredata.irts <- function(x, ...) +{ + return(x$value) +} + +coredata.its <- function(x, ...) +{ + stopifnot("package:its" %in% search() || require("its", quietly = TRUE)) + return(x@.Data) +} + + +"coredata<-" <- function(x, value) +{ + UseMethod("coredata<-") +} + +"coredata<-.zoo" <- function(x, value) +{ + stopifnot(length(x) == length(value)) + if(!(is.vector(value) || is.factor(value) || is.matrix(value) || is.data.frame(value))) + stop(paste(dQuote("value"), ": attempt to assign illegal coredata to zoo object")) + if(is.matrix(value) || is.data.frame(value)) value <- as.matrix(value) + + x[] <- value + attr(x, "oclass") <- attr(value, "class") + return(x) +} + +"coredata<-.ts" <- function(x, value) +{ + stopifnot(length(x) == length(value)) + dim(value) <- dim(x) + x[] <- value + return(x) +} + +"coredata<-.irts" <- function(x, value) +{ + stopifnot(length(x$value) == length(value)) + dim(value) <- dim(x$value) + x$value[] <- value + return(x) +} + +"coredata<-.its" <- function(x, value) +{ + stopifnot("package:its" %in% search() || require("its", quietly = TRUE)) + stopifnot(length(x@.Data) == length(value)) + dim(value) <- dim(x@.Data) + x@.Data[] <- as.matrix(value) + return(x) +} diff --git a/R/index.R b/R/index.R new file mode 100644 index 0000000..c13a58e --- /dev/null +++ b/R/index.R @@ -0,0 +1,93 @@ +index <- function(x, ...) +{ + UseMethod("index") +} + +index.default <- function(x, ...) +{ + seq_len(NROW(x)) +} + +index.zoo <- function(x, ...) +{ + attr(x, "index") +} + +index.ts <- function(x, ...) +{ + xtsp <- tsp(x) + seq(xtsp[1], xtsp[2], by = 1/xtsp[3]) +} + +time.zoo <- function(x, ...) +{ + index(x) +} + +"index<-" <- function(x, value) +{ + UseMethod("index<-") +} + +"time<-" <- function(x, value) +{ + UseMethod("time<-") +} + +"index<-.zoo" <- function(x, value) +{ + if(length(index(x)) != length(value)) + stop("length of index vectors does not match") + attr(x, "index") <- value + return(x) +} + +"time<-.zooreg" <- "index<-.zooreg" <- function(x, value) +{ + if(length(index(x)) != length(value)) + stop("length of index vectors does not match") + + ## check whether new index still conforms with + ## frequency, if not: drop frequency + d <- try(diff(as.numeric(value)), silent = TRUE) + ok <- if(class(d) == "try-error" || length(d) < 1 || any(is.na(d))) FALSE + else { + deltat <- min(d) + dd <- d/deltat + if(identical(all.equal(dd, round(dd)), TRUE)) { + freq <- 1/deltat + if(freq > 1 && identical(all.equal(freq, round(freq)), TRUE)) freq <- round(freq) + identical(all.equal(attr(x, "frequency") %% freq, 0), TRUE) + } else { + FALSE + } + } + if(!ok) { + attr(x, "frequency") <- NULL + class(x) <- class(x)[-which(class(x) == "zooreg")] + } + + attr(x, "index") <- value + return(x) +} + +"time<-.zoo" <- function(x, value) +{ + if(length(index(x)) != length(value)) + stop("length of time vectors does not match") + attr(x, "index") <- value + return(x) +} + +start.zoo <- function(x, ...) +{ + if (length(index(x)) > 0) index(x)[1] + else NULL +} + +end.zoo <- function(x, ...) +{ + lx <- length(index(x)) + if (lx > 0) index(x)[lx] + else NULL +} diff --git a/R/index2char.R b/R/index2char.R new file mode 100644 index 0000000..4c5ee1e --- /dev/null +++ b/R/index2char.R @@ -0,0 +1,17 @@ +index2char <- function(x, ...) UseMethod("index2char") + +index2char.default <- function(x, ...) as.character(x) + +index2char.numeric <- function(x, frequency = NULL, digits = getOption("digits") - 3, ...) +{ + freq <- frequency + if(is.null(freq)) return(as.character(round(x, digits = digits))) + if(length(x) < 1) return(character(0)) + d <- diff(x) + if(freq > 1 && identical(all.equal(freq, round(freq)), TRUE)) freq <- round(freq) + if(identical(all.equal(freq*d, round(freq*d)), TRUE)) { + if(freq == 1) return(as.character(round(x))) + else return(paste(floor(x), "(", round((x - floor(x)) * freq) + 1, ")", sep = "")) + } else + return(as.character(round(x, digits = digits))) +} diff --git a/R/is.regular.R b/R/is.regular.R new file mode 100644 index 0000000..be58270 --- /dev/null +++ b/R/is.regular.R @@ -0,0 +1,118 @@ +is.regular <- function(x, strict = FALSE) { + UseMethod("is.regular") +} + +is.regular.zoo <- function(x, strict = FALSE) +{ + delta <- suppressWarnings(try(diff(as.numeric(index(x))), silent = TRUE)) + if(class(delta) == "try-error" || any(is.na(delta))) FALSE + else if(length(delta) < 1) FALSE + else if(strict) identical(all.equal(delta, rep.int(delta[1], length(delta))), TRUE) + else { + delta <- unique(delta) + rval <- identical(all.equal(delta/min(delta), round(delta/min(delta))), TRUE) + if(!rval && identical(all.equal(delta, round(delta)), TRUE)) rval <- TRUE + rval + } +} + +is.regular.ts <- function(x, strict = FALSE) TRUE + +is.regular.zooreg <- function(x, strict = FALSE) +{ + if(strict) is.regular.zoo(x, strict = TRUE) else TRUE +} + +is.regular.default <- function(x, strict = FALSE) { + is.regular(as.zoo(x), strict = strict) +} + +frequency.zooreg <- function(x, ...) +{ + attr(x, "frequency") +} + +frequency.zoo <- function(x, ...) +{ + ## check whether frequency is available + freq <- attr(x, "frequency") + if(!is.null(freq) || length(index(x)) < 2) return(freq) + + ## check regularity + delta <- suppressWarnings(try(diff(as.numeric(index(x))), silent = TRUE)) + reg <- if(class(delta) == "try-error" || any(is.na(delta))) FALSE + else { + delta <- unique(delta) + rval <- identical(all.equal(delta/min(delta), round(delta/min(delta))), TRUE) + if(rval) freq <- 1/min(delta) + else if(identical(all.equal(delta, round(delta)), TRUE)) { + ## special case: integer indexes + ## get frequency as greatest common divisor (of differences) + gcd <- function(x) { + gcd0 <- function(a, b) ifelse(b==0 | a==b, a, gcd0(b, a %% b)) + if(length(x) < 2) x <- c(x, as.integer(0)) + if(length(x) < 3) { + return(gcd0(x[1], x[2])) + } else { + x <- sapply(1:(length(x) - 1), function(i) gcd0(x[i], x[i+1])) + gcd(x) + } + } + freq <- 1/gcd(delta) + rval <- TRUE + } + rval + } + if(!reg) return(NULL) + if(freq > 1 && identical(all.equal(freq, round(freq)), TRUE)) freq <- round(freq) + return(freq) +} + +"frequency<-" <- function(x, value) + UseMethod("frequency<-") + +"frequency<-.zoo" <- function(x, value) { + delta <- suppressWarnings(try(diff(as.numeric(index(x))), silent = TRUE)) + freqOK <- if(class(delta) == "try-error" || any(is.na(delta))) FALSE + else if(length(delta) < 1) TRUE + else identical(all.equal(delta*value, round(delta*value)), TRUE) + stopifnot(freqOK) + if(value > 1 && identical(all.equal(value, round(value)), TRUE)) value <- round(value) + attr(x, "frequency") <- value + class(x) <- c("zooreg", "zoo") + return(x) +} + +"frequency<-.zooreg" <- function(x, value) { + delta <- diff(as.numeric(index(x))) + stopifnot(identical(all.equal(delta*value, round(delta*value)), TRUE)) + attr(x, "frequency") <- value + return(x) +} + +deltat.zoo <- function(x, ...) +{ + rval <- frequency.zoo(x, ...) + if(is.null(rval)) NULL else 1/rval +} + +deltat.zooreg <- function(x, ...) +{ + 1/frequency.zooreg(x, ...) +} + +cycle.zooreg <- function(x, ...) +{ + freq <- frequency(x) + ix <- as.numeric(index(x)) + d <- diff(ix) + if(!identical(all.equal(freq*d, round(freq*d)), TRUE)) + stop(paste(sQuote("cycle"), "not available for", sQuote("x"))) + return(zoo(round((ix - floor(ix)) * freq) + 1, order.by = index(x), freq)) +} + +cycle.zoo <- function(x, ...) +{ + if(is.regular(x)) cycle.zooreg(x) + else stop(sQuote("x"), "is not regular") +} diff --git a/R/make.unique.R b/R/make.unique.R new file mode 100644 index 0000000..8d79bfe --- /dev/null +++ b/R/make.unique.R @@ -0,0 +1,57 @@ + +if (FALSE) { +make.unique.incr <- function(x, incr, ...) { + UseMethod("make.unique.incr") +} + +make.unique.incr.Date <- function(x, incr, ...) { + make.unique.incr.default(x, incr = 1, ...) +} + +make.unique.incr.yearmon <- function(x, incr, ...) { + make.unique.incr.default(x, incr = 1/12, ...) +} + +make.unique.incr.yearqtr <- function(x, incr, ...) { + make.unique.incr.default(x, incr = 1/4, ...) +} + +make.unique.incr.default <- function(x, incr, quantile = 1, ...) { + n <- length(x) + if (n < 2) return(x) + o <- ORDER(x) + xo <- x[o] + d <- as.numeric(xo[-1] - xo[-n]) + d <- d[d != 0] + stopifnot(length(d) > 0) + mind <- min(d) + if (missing(incr)) incr <- mind / n + FUN = function(x) { + n <- length(x) + # arg of ceiling is a convex combination of 1-n and 0 + x[1] + incr * seq(ceiling((1-n) * quantile), length = n) + } + y <- ave(x, x, FUN = FUN) + if (!identical(ORDER(y), o)) stop("Algorithm failed", call. = TRUE) + y +} +} + +make.unique.approx <- function(x, ...) { + UseMethod("make.unique.approx") +} + +make.unique.approx.default <- function(x, quantile = 1, ...) { + o <- ORDER(x) + xo <- x[o] + d <- as.numeric(xo - xo[1]) + y <- ave(d, d, FUN = function(x) { + n <- length(x) + if (n > 1) replace(x, -ceiling(n * quantile + 1 - quantile), NA) + else x + }) + y <- na.approx(y) + x[o] <- xo[1] + y + x +} + diff --git a/R/merge.zoo.R b/R/merge.zoo.R new file mode 100644 index 0000000..1b72e33 --- /dev/null +++ b/R/merge.zoo.R @@ -0,0 +1,350 @@ +rbind.zoo <- function(..., deparse.level = 1) +{ + + args <- Filter(Negate(is.null), list(...)) + indexes <- do.call("c", lapply(args, index)) + + my.table <- function(x) { + x <- x[ORDER(x)] + table(MATCH(x,x)) + } + if(max(my.table(indexes)) > 1) stop("indexes overlap") + + ncols <- sapply(args, NCOL) + if(!all(ncols == ncols[1])) stop("number of columns differ") + + ## process colnames() if any + nams <- lapply(args, colnames) + namsNULL <- sapply(nams, is.null) + if(all(namsNULL)) namsOK <- TRUE else { + if(sum(namsNULL) > 0) namsOK <- FALSE else { + nam1 <- nams[[1]] + namsID <- sapply(nams, function(x) identical(x, nam1)) + if(all(namsID)) namsOK <- TRUE else { + namsSORT <- sapply(nams, function(x) identical(sort(x), sort(nam1))) + if(!all(namsSORT)) namsOK <- FALSE else { + namsOK <- TRUE + for(i in which(!namsID)) args[[i]] <- args[[i]][,nam1] + } + } + } + } + if(!namsOK) warning("column names differ") + + if((ncols[1] > 1) | !all(sapply(args, function(a) is.null(dim(a))))) + rval <- zoo(do.call("rbind", lapply(args, coredata)), indexes) + else + rval <- zoo(do.call("c", lapply(args, coredata)), indexes) + + freq <- if(!("zooreg" %in% unlist(sapply(args, class)))) NULL + else { + freq <- c(frequency(rval), unlist(sapply(args, frequency))) + if((length(freq) == (length(args)+1)) && + identical(all.equal(max(freq)/freq, round(max(freq)/freq)), TRUE)) + max(freq) else NULL + } + if(!is.null(freq)) { + attr(rval, "frequency") <- freq + class(rval) <- c("zooreg", class(rval)) + } + return(rval) +} + +c.zoo <- function(...) { + rbind.zoo(...) +} + +cbind.zoo <- function(..., all = TRUE, fill = NA, suffixes = NULL) +{ + merge.zoo(..., all = all, fill = fill, suffixes = suffixes, retclass = "zoo") +} + +merge.zoo <- function(..., all = TRUE, fill = NA, suffixes = NULL, retclass = c("zoo", "list", "data.frame")) +{ + if (!is.null(retclass)) retclass <- match.arg(retclass) + # cl are calls to the args and args is a list of the arguments + cl <- as.list(match.call()) + cl[[1]] <- cl$all <- cl$fill <- cl$retclass <- cl$suffixes <- NULL + args <- list(...) + + # remove NULL args + isnull <- sapply(args, is.null) + cl <- cl[!isnull] + args <- args[!isnull] + + parent <- parent.frame() + + is.plain <- function(x) + all(class(x) %in% c("array", "integer", "numeric", "factor", "matrix", "logical")) + + is.scalar <- function(x) is.plain(x) && length(x) == 1 + + # ensure all ... plain args are of length 1 or have same NROW as arg 1 + stopifnot(all(sapply(args, function(x) is.zoo(x) || !is.plain(x) || + (is.plain(x) && (NROW(x) == NROW(args[[1]]) || is.scalar(x)))))) + + scalars <- sapply(args, is.scalar) + + if(!is.zoo(args[[1]])) args[[1]] <- as.zoo(args[[1]]) + for(i in seq_along(args)) + if (is.plain(args[[i]])) + args[[i]] <- zoo(args[[i]], index(args[[1]]), attr(args[[1]], "frequency")) + else if (!is.zoo(args[[i]])) + args[[i]] <- as.zoo(args[[i]]) + + ## retain frequency if all series have integer multiples of the same frequency + ## and at least one of the original objects is a "zooreg" object + freq <- if(!("zooreg" %in% unlist(sapply(args, class)))) NULL + else { + freq <- unlist(sapply(args, frequency)) + if((length(freq) == length(args)) && + identical(all.equal(max(freq)/freq, round(max(freq)/freq)), TRUE)) + max(freq) else NULL + } + + # use argument names if suffixes not specified + if (is.null(suffixes)) { + makeNames <- function(l) { + nm <- names(l) + fixup <- if (is.null(nm)) + seq_along(l) + else nm == "" + dep <- sapply(l[fixup], function(x) deparse(x)[1]) + if (is.null(nm)) + return(dep) + if (any(fixup)) + nm[fixup] <- dep + nm + } + suffixes <- makeNames(as.list(substitute(list(...)))[-1]) + } + if (length(suffixes) != length(cl)) { + warning("length of suffixes and does not match number of merged objects") + suffixes <- rep(suffixes, length.out = length(cl)) + } + + # extend all to a length equal to the number of args + all <- rep(as.logical(all), length.out = length(cl)) + + ## check indexes: + indexlist <- lapply(args, index) + ## 1. for non-unique entries + index_duplicates <- function(x) length(unique(MATCH(x, x))) < length(x) + if(any(sapply(indexlist, index_duplicates))) + stop("series cannot be merged with non-unique index entries in a series") + ## 2. for differing classes + indexclasses <- sapply(indexlist, function(x) class(x)[1]) + if (!all(indexclasses == indexclasses[1])) + warning(paste("Index vectors are of different classes:", + paste(indexclasses, collapse = " "))) + + # fn to get the unique elements in x, in sorted order, using only + # [, match, length and order + sort.unique <- function(x) { + x <- x[MATCH(x, x) == seq_len(length(x))] + x[ORDER(x)] + } + + # fn to get intersection of each element in list of lists + intersect.list <- function(list) { + my.table <- function(x) { + x <- x[ORDER(x)] + table(MATCH(x, x)) + } + union <- do.call("c", list) + sort.unique(union)[which(my.table(union) == length(list))] + } + indexintersect <- intersect.list(indexlist) + + # get the indexes of the final answer which is the union of + # all indexes of args corresponding to all=TRUE with the intersection + # of all indexes + indexunion <- do.call("c", indexlist[all]) + + indexes <- if(is.null(indexunion)) indexintersect + else sort.unique(c(indexunion, indexintersect)) + # previously, we used to do: + # if (is.null(indexunion)) indexunion <- do.call("c", indexlist)[0] + # indexes <- sort.unique(c(indexunion, indexintersect)) + + ## check whether resulting objects still got the same frequency + if(!is.null(freq)) { + freq <- c(frequency(zoo(,indexes)), freq) + freq <- if((length(freq) == 2) && identical(all.equal(max(freq)/freq, round(max(freq)/freq)), TRUE)) + max(freq) else NULL + } + + # the f function does the real work + # it takes a zoo object, a, and fills in a matrix corresponding to + # indexes with the values in a. ret.zoo is TRUE if it is to return + # a zoo object. If ret.zoo is FALSE it simply returns with the matrix + # just calculated. + # match0 is convenience wrapper for MATCH with nomatch=0 default + match0 <- function(a, b, nomatch = 0, ...) MATCH(a, b, nomatch = nomatch, ...) + f <- if (any(all)) { + function(a, ret.zoo = TRUE) { + if (length(a) == 0 && length(dim(a)) == 0) + return(if(ret.zoo) { + rval <- zoo(, indexes) + attr(rval, "frequency") <- freq + if(!is.null(freq)) class(rval) <- c("zooreg", class(rval)) + rval + } else numeric()) + z <- matrix(fill, length(indexes), NCOL(a)) + if (length(dim(a)) > 0) + z[match0(index(a), indexes), ] <- a[match0(indexes, index(a)), , drop = FALSE] + else { + z[match0(index(a), indexes), ] <- a[match0(indexes, index(a))] + z <- z[, 1, drop=TRUE] + } + if (ret.zoo) { + z <- zoo(z, indexes) + attr(z, "oclass") <- attr(a, "oclass") + attr(z, "levels") <- attr(a, "levels") + attr(z, "frequency") <- freq + if(!is.null(freq)) class(z) <- c("zooreg", class(z)) + } + return(z) + } + + } else { + # if all contains only FALSE elements then the following f is used + # instead of the prior f for performance purposes. If all contains + # only FALSE then the resulting index is the intersection of the + # index of each argument so we can just return a[index] or a[index,]. + # Also if we are not to return a zoo object then unclass it prior to return. + function(a, ret.zoo = TRUE) { + if (!ret.zoo) class(a) <- NULL + if (length(dim(a)) == 0) { + if (length(a) == 0) { + rval <- if(ret.zoo) zoo(, indexes) else numeric() + } else + rval <- as.zoo(a[match0(indexes, attr(a, "index"))]) + } else + rval <- as.zoo(a[match0(indexes, attr(a, "index")), , drop=FALSE]) + if(is.zoo(rval) && !is.null(freq)) { + attr(rval, "frequency") <- freq + class(rval) <- unique(c("zooreg", class(rval))) + } + return(rval) + } + } + + # if retclass is NULL do not provide a return value but instead + # update each argument that is a variable, i.e. not an expression, + # in place. + if (is.null(retclass)) { + for(vn in cl) { + if (is.name(vn)) + tryCatch( + eval(substitute(v <- f(v), list(f = f, v = vn)), parent), + condition = function(x) {} + ) + } + invisible(return(NULL)) + } + + # apply f to each arg, put result of doing this on all args in list rval + # and then cbind that list together to produce the required matrix + rval <- lapply(args, f, ret.zoo = retclass %in% c("list", "data.frame")) + for(i in which(scalars)) rval[[i]] <- rval[[i]][] <- zoo(coredata(rval[[i]])[1], index(rval[[1]]), freq) + names(rval) <- suffixes + if (retclass == "list") { + return(rval) + } + if (retclass == "data.frame") { + ## transform list to data.frame + ## this is simple if all list elements are vectors, but with + ## matrices a bit more effort seems to be needed: + charindex <- index2char(index(rval[[1]]), frequency = freq) + nam1 <- names(rval) + rval <- lapply(rval, as.list) + todf <- function(x) { + class(x) <- "data.frame" + attr(x, "row.names") <- charindex + return(x) + } + rval <- lapply(rval, todf) + ## name processing + nam2 <- sapply(rval, function(z) 1:NCOL(z)) + for(i in 1:length(nam2)) nam2[[i]] <- paste(names(nam2)[i], nam2[[i]], sep = ".") + nam1 <- unlist(ifelse(sapply(rval, NCOL) > 1, nam2, nam1)) + rval <- do.call("cbind", rval) + names(rval) <- nam1 + ## turn zoo factors into plain factors + is.zoofactor <- function(x) !is.null(attr(x, "oclass")) && attr(x, "oclass") == "factor" + for(i in 1:NCOL(rval)) if(is.zoofactor(rval[,i])) rval[,i] <- coredata(rval[,i]) + return(rval) + } + # remove zero length arguments + rval <- rval[sapply(rval, function(x) length(x) > 0)] + # if there is more than one non-zero length argument then cbind them + # Note that cbind will create matrices, even when given a single vector, + # so its important not to use it in the single vector case. + rval <- if (length(rval) > 1) + do.call("cbind", rval) + else if (length(rval) > 0) + rval[[1]] + # return if vector since remaining processing is only for column names + if (length(dim(rval)) == 0) { + # fixed bug: coredata was missing + rval <- zoo(coredata(rval), indexes) + attr(rval, "frequency") <- freq + if(!is.null(freq)) class(rval) <- c("zooreg", class(rval)) + return(rval) + } + + # processing from here on is to compute nice column names + if (length(unlist(sapply(args, colnames))) > 0) { + fixcolnames <- function(a) { + if (length(a) == 0) + return(NULL) + if (length(dim(a)) ==0) { + return("") + } else { + rval <- colnames(a) + if (is.null(rval)) { + rval <- paste(1:NCOL(a), suffixes[i], sep = ".") + } + else { + rval[rval == ""] <- as.character(which(rval == "")) + } + return(rval) + } + } + zoocolnames <- lapply(args, fixcolnames) + zcn <- unlist(zoocolnames) + fixme <- lapply(zoocolnames, function(x) x %in% zcn[duplicated(zcn)]) + f <- function(i) { + rval <- zoocolnames[[i]] + rval[rval == ""] <- suffixes[i] + rval + } + zoocolnames <- lapply(seq_along(args), f) + f <- function(i) ifelse(fixme[[i]], paste(zoocolnames[[i]], + suffixes[i], sep = "."), zoocolnames[[i]]) + if (any(duplicated(unlist(zoocolnames)))) + zoocolnames <- lapply(seq_along(args), f) + colnames(rval) <- make.unique(unlist(zoocolnames)) + } else { + fixcolnames <- function(a) { + if (length(a) == 0) + return(NULL) + if (NCOL(a) < 2) + return("") + else return(paste(".", 1:NCOL(a), sep = "")) + } + zoocolnames <- lapply(args, fixcolnames) + zoocolnames <- unlist(lapply(seq_along(args), function(i) + if (!is.null(zoocolnames[[i]])) # NULL returned if false + paste(suffixes[i], zoocolnames[[i]], sep = "")) + ) + colnames(rval) <- make.unique(zoocolnames) + } + # rval <- zoo(rval, indexes) + rval <- zoo(coredata(rval), indexes) + attr(rval, "frequency") <- freq + if(!is.null(freq)) class(rval) <- c("zooreg", class(rval)) + return(rval) +} + diff --git a/R/multitime.R b/R/multitime.R new file mode 100644 index 0000000..34f1a51 --- /dev/null +++ b/R/multitime.R @@ -0,0 +1,112 @@ +multitime <- function(x, ...) as.multitime(x, ...) + +as.multitime <- function(x, ...) UseMethod("as.multitime") +as.multitime.default <- function(x, index, ...) { + class(x) <- c("multitime", setdiff(class(x), "multitime")) + if (!missing(index)) attr(x, "index") <- index + x +} +coredata.multitime <- function(x, ...) { + attr(x, "index") <- NULL + class(x) <- setdiff(class(x), "multitime") + x +} +index.multitime <- function(x, ...) attr(x, "index") + +as.character.multitime <- function(x, ...) { + if (is.null(index(x))) coredata(x) else + paste(as.character(coredata(x)), "(", as.character(index(x)), ")", sep = "") +} + +MATCH.multitime <- function(x, table, nomatch = NA, ...) { + # TODO: this assumes we have unique character representation for + # class of coredata and index. Need to find better way to do this. + cx <- coredata(x) + ctable <- coredata(table) + if (is.null(ctable)) return(match(cx, ctable, nomatch, ...)) + tochar <- function(x) paste(coredata(x), index(x), paste = "\1") + match(paste(cx, index(x), sep = "\1"), + paste(coredata(table), index(table), sep = "\1"), nomatch, ...) +} + +ORDER.multitime <- function(x, ...) { + if (is.null(index(x))) ORDER(coredata(x), ...) + else order(ORDER(coredata(x)), ORDER(index(x)), ...) +} + +xtfrm.multitime <- function(x) { + if (is.null(index(x))) xtfrm(coredata(x)) + else { + xindex <- xtfrm(index(x)) + (max(xindex) + 1) * xtfrm(coredata(x)) + xindex + } +} + +Ops.multitime <- function (e1, e2) +{ + e <- NextMethod(.Generic) + if (is.null(index(e))) as.multitime(e) + else as.multitime(e, index(e)) +} + +"[.multitime" <- function(x, i, j, drop = TRUE, ...) +{ + if (is.null(index(x))) { + as.multitime(coredata(x)[i, ...]) + } else { + as.multitime(coredata(x)[i, ...], index(x)[i, ...]) + } +} + +c.multitime <- function(...) { + L <- list(...) + Lc <- lapply(L, coredata) + Li <- lapply(L, index) + lens <- sapply(Li, length) + if (sum(lens == 0) != length(L) && sum(lens > 0) != length(L)) + stop(paste("incompatible lengths of index values in c.multitime:", + paste(lens, collapse = " "))) + as.multitime(do.call("c", Lc), do.call("c", Li)) +} + +as.numeric.multitime <- function(x, ...) { + cx <- coredata(x) + if (is.numeric(cx)) cx else as.numeric(cx) +} + +as.Date.multitime <- function(x, ...) { + cx <- coredata(x) + if (inherits(cx, "Date")) cx + else { + ix <- index(x) + if (inherits(ix, "Date")) ix else as.Date(cx) + } +} + +as.yearmon.multitime <- function(x, ...) { + cx <- coredata(x) + if (inherits(cx, "yearmon")) cx + else { + ix <- index(x) + if (inherits(ix, "yearmon")) ix else as.yearmon(cx) + } +} + +as.yearqtr.multitime <- function(x, ...) { + cx <- coredata(x) + if (inherits(cx, "yearqtr")) cx + else { + ix <- index(x) + if (inherits(ix, "yearqtr")) ix else as.yearqtr(cx) + } +} + +make.unique.multitime <- function(x, index, sign = -1 , ...) { + if (missing(index)) { + index <- if (sign > 0) seq_along(x) - MATCH(x, x) + else rev(match(rev(x), rev(x)) - seq_along(x)) + } + as.multitime(x, index, ...) +} + + diff --git a/R/na.approx.R b/R/na.approx.R new file mode 100644 index 0000000..73c03b3 --- /dev/null +++ b/R/na.approx.R @@ -0,0 +1,22 @@ +na.approx <- function(object, ...) UseMethod("na.approx") + +# interpolates object along along which defaults to index(object) +# along has to be numeric, is otherwise coerced +na.approx.default <- function(object, along = index(object), na.rm = TRUE, ...) +{ + along <- as.numeric(along) + na.approx.0 <- function(y) { + na <- is.na(y) + if(all(!na)) return(y) + y[na] <- approx(along[!na], y[!na], along[na], ...)$y + return(y) + } + + object[] <- if (length(dim(object)) == 0) na.approx.0(object) + else apply(object, 2, na.approx.0) + if (na.rm) { + out <- na.omit(object) + attr(out, "na.action") <- NULL + out + } else object +} diff --git a/R/na.locf.R b/R/na.locf.R new file mode 100644 index 0000000..5a17aab --- /dev/null +++ b/R/na.locf.R @@ -0,0 +1,69 @@ +na.locf <- function(object, na.rm = TRUE, ...) + UseMethod("na.locf") + +na.locf.default <- function(object, na.rm = TRUE, fromLast, rev, ...) { + na.locf.0 <- function(x) { + L <- !is.na(x) + idx <- if (fromLast) + rev(c(NA,rev(which(L)))[cumsum(rev(L))+1]) + else + c(NA,which(L))[cumsum(L)+1] + # na.index(x,i) returns x[i] except if i[j] is NA then + # x[i[j]] is NA too + na.index <- function(x, i) { + L <- !is.na(i) + x[!L] <- NA + x[L] <- coredata(x)[i[L]] + x + } + na.index(x, idx) + } + if (!missing(rev)) { + warning("na.locf.default: rev= deprecated. Use fromLast= instead.") + if (missing(fromLast)) fromLast <- rev + } else if (missing(fromLast)) fromLast <- FALSE + rev <- base::rev + object[] <- if (length(dim(object)) == 0) + na.locf.0(object) + else + apply(object, length(dim(object)), na.locf.0) + if (na.rm) na.omit(object) else object +} + +na.contiguous.data.frame <- +na.contiguous.zoo <- function(object, ...) +{ + if (length(dim(object)) == 2) + good <- apply(!is.na(object), 1, all) + else good <- !is.na(object) + if (!sum(good)) + stop("all times contain an NA") + tt <- cumsum(!good) + ln <- sapply(0:max(tt), function(i) sum(tt == i)) + seg <- (seq_along(ln)[ln == max(ln)])[1] - 1 + keep <- (tt == seg) + st <- min(which(keep)) + if (!good[st]) + st <- st + 1 + en <- max(which(keep)) + omit <- integer(0) + n <- NROW(object) + if (st > 1) + omit <- c(omit, 1:(st - 1)) + if (en < n) + omit <- c(omit, (en + 1):n) + cl <- class(object) + if (length(omit)) { + object <- if (length(dim(object))) + object[st:en, ] + else object[st:en] + attr(omit, "class") <- "omit" + attr(object, "na.action") <- omit + if (!is.null(cl)) + class(object) <- cl + } + object +} + +na.contiguous.list <- function(object, ...) + lapply(object, na.contiguous) diff --git a/R/na.spline.R b/R/na.spline.R new file mode 100644 index 0000000..e4a88f8 --- /dev/null +++ b/R/na.spline.R @@ -0,0 +1,19 @@ +na.spline <- function(object, ...) UseMethod("na.spline") + +# interpolates object along along which defaults to index(object) +# along has to be numeric, is otherwise coerced +na.spline.default <- function(object, along = index(object), na.rm = TRUE, ...) +{ + along <- as.numeric(along) + na.spline.0 <- function(y) { + na <- is.na(y) + if(all(!na)) return(y) + y[na] <- splinefun(along[!na], y[!na], ...)(along[na]) + return(y) + } + + object[] <- if (length(dim(object)) == 0) na.spline.0(object) + else apply(object, 2, na.spline.0) + if (na.rm) na.omit(object) else object +} + diff --git a/R/na.trim.R b/R/na.trim.R new file mode 100644 index 0000000..5c09e33 --- /dev/null +++ b/R/na.trim.R @@ -0,0 +1,18 @@ +na.trim <- function(object, ...) UseMethod("na.trim") +na.trim.default <- function (object, sides = c("both", "left", "right"), + is.na = c("any", "all"), ...) +{ + is.na <- match.arg(is.na) + nisna <- if (is.na == "any" || length(dim(object)) < 2) { + complete.cases(object) + } else rowSums(!is.na(object)) > 0 + idx <- switch(match.arg(sides), left = cumsum(nisna) > 0, + right = rev(cumsum(rev(nisna) > 0)>0), + both = (cumsum(nisna) > 0) & rev(cumsum(rev(nisna)) > 0)) + if (length(dim(object)) < 2) + object[idx] + else + object[idx,] +} + + diff --git a/R/plot.zoo.R b/R/plot.zoo.R new file mode 100644 index 0000000..3f817e0 --- /dev/null +++ b/R/plot.zoo.R @@ -0,0 +1,213 @@ +make.par.list <- function(nams, x, n, m, def, recycle = sum(unnamed) > 0) { +##FIXME: should defaults for n, m, def be available? + +# if nams are the names of our variables and x is a parameter +# specification such as list(a = c(1,2), c(3,4)) then +# create a new list which uses the named variables from x +# and assigns the unnamed in order. For the remaining variables +# assign them the default value if recycle = FALSE or recycle the +# unnamed variables if recycle = TRUE. The default value for +# recycle is TRUE if there is at least one unnamed variable +# in x and is false if there are only named variables in x. +# n is the length of the series and m is the total number of series +# It only needs to know whether m is 1 or greater than m. +# def is the default value used when recycle = FALSE +# recycle = TRUE means recycle unspecified values +# recycle = FALSE means replace values for unspecified series with def +# Within series recycling is done even if recycle=FALSE. + # Should we allow arbirary names in 1d case? + # if (m > 1) stopifnot(all(names(x) %in% c("", nams))) + if (!is.list(x)) x <- if (m == 1) list(x) else as.list(x) + y <- vector(mode = "list", length = length(nams)) + names(y) <- nams + in.x <- nams %in% names(x) + unnamed <- if (is.null(names(x))) rep(TRUE, length(x)) else names(x) == "" + if (!recycle) y[] <- def + y[in.x] <- x[nams[in.x]] + if (recycle) { + stopifnot(sum(unnamed) > 0) + y[!in.x] <- rep(x[unnamed], length.out = sum(!in.x)) ## CHECK, this was: x[unnamed] + } else { + y[which(!in.x)[seq_len(sum(unnamed))]] <- x[unnamed] + } + lapply(y, function(y) if (length(y)==1) y else rep(y, length.out = n)) +} + +plot.zoo <- function(x, y = NULL, screens, plot.type, panel = lines, + xlab = "Index", ylab = NULL, main = NULL, xlim = NULL, ylim = NULL, + xy.labels = FALSE, xy.lines = NULL, + oma = c(6, 0, 5, 0), mar = c(0, 5.1, 0, 2.1), + col = 1, lty = 1, lwd = 1, pch = 1, type = "l", + nc, widths = 1, heights = 1, ...) +{ + ## if y supplied: scatter plot y ~ x + if(!is.null(y)) { + if(NCOL(x) > 1 || NCOL(y) > 1) stop("scatter plots only for univariate zoo series") + xyzoo <- merge.zoo(x, y, all = FALSE) + xy <- coredata(xyzoo) + xy <- xy.coords(xy[,1], xy[,2]) + + xlab <- if(missing(xlab)) deparse(substitute(x)) else xlab + ylab <- if(missing(ylab)) deparse(substitute(y)) else ylab + xlim <- if(is.null(xlim)) range(xy$x[is.finite(xy$x)]) else xlim + ylim <- if(is.null(ylim)) range(xy$y[is.finite(xy$y)]) else ylim + if(is.null(main)) main <- "" + do.lab <- if(is.logical(xy.labels)) xy.labels else TRUE + if(is.null(xy.lines)) xy.lines <- do.lab + ptype <- if(do.lab) "n" else if(missing(type)) "p" else type + + plot.default(xy, type = ptype,col = col, pch = pch, main = main, + xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, ...) + if(do.lab) text(xy, col = col, + labels = if(!is.logical(xy.labels)) xy.labels else index2char(index(xyzoo)), ...) + if(xy.lines) lines(xy, col = col, lty = lty, lwd = lwd, type = if(do.lab) "c" else "l", ...) + + return(invisible(xyzoo)) + } + ## Else : no y, only x + + recycle <- function(a, len, nser) + rep(lapply(as.list(a), rep, length.out = len), length.out = nser) + # same as range except it passes pairs through + range2 <- function(x, ...) if (length(x) == 2) x else range(x, ...) + if (missing(plot.type)) { + plot.type <- if (missing(screens)) "multiple" + else if (length(unique(screens) == 1)) "single" + else "multiple" + } + plot.type <- match.arg(plot.type, c("multiple", "single")) + nser <- NCOL(x) + if (missing(screens)) { + screens <- if (plot.type == "single") 1 else seq_len(nser) + } + dots <- list(...) + x.index <- index(x) + if(is.ts(x.index)) x.index <- as.vector(x.index) + cn <- if (is.null(colnames(x))) paste("V", seq_len(nser), sep = "") + else colnames(x) + + screens <- make.par.list(cn, screens, NROW(x), nser, 1) + screens <- as.factor(unlist(screens))[drop = TRUE] + ngraph <- length(levels(screens)) + if(nser > 1 && (plot.type == "multiple" || ngraph > 1)) { + if (ngraph == 1) { + screens <- as.factor(seq(nser)) + ngraph <- nser + } + if(is.null(main)) main <- deparse(substitute(x)) + main.outer <- TRUE + if(is.null(ylab)) ylab <- colnames(x)[!duplicated(screens)] + if(is.null(ylab)) ylab <- paste("Series", which(!duplicated(screens))) + ylab <- rep(ylab, length.out = ngraph) + lty <- rep(lty, length.out = nser) + lwd <- rep(lwd, length.out = nser) + col <- make.par.list(cn, col, NROW(x), nser, 1) + pch <- make.par.list(cn, pch, NROW(x), nser, par("pch")) + type <- make.par.list(cn, type, NROW(x), nser, "l") + if (!is.null(ylim)) { + if (is.list(ylim)) ylim <- lapply(ylim, range2, na.rm = TRUE) + else ylim <- list(range2(ylim, na.rm = TRUE)) + ylim <- lapply(make.par.list(cn, ylim, 2, nser, NULL), function(x) + if (is.null(x) || length(na.omit(x)) == 0) NULL + else range2(x, na.rm = TRUE)) + } + panel <- match.fun(panel) + if(missing(nc)) nc <- if(ngraph > 4) 2 else 1 + oldpar <- par(no.readonly = TRUE) + on.exit({ par(oldpar) }) + nr <- ceiling(ngraph / nc) + layout(matrix(seq(nr*nc), nr), widths = widths, heights = heights) + par(mar = mar, oma = oma) + # TRUE if all elements of L are the same -- else FALSE + allsame <- function(L) { + f <- function(x, y) if (identical(x, y)) x + !is.null(Reduce(f, L)) + } + # idx is vector of indices into ylim. + # If the entries indexed by it are all the same then use that common value; + # otherwise, if the ylim are specified use the range of the ylim values; + # otherwise, use the range of the data + f <- function(idx) if (allsame(ylim)) ylim[idx][[1]] + else if (!is.null(ylim) && length(idx) > 0 && + length(unlist(ylim[idx])) > 0) range(ylim[idx], finite = TRUE) + else range(x[, idx], na.rm = TRUE) + # ranges is indexed by screen + ranges <- tapply(1:ncol(x), screens, f) + for(j in seq_along(levels(screens))) { + panel.number <- j + range. <- rep(ranges[[j]], length.out = length(time(x))) + if(j%%nr==0 || j == length(levels(screens))) { + args <- list(x.index, range., xlab = "", ylab = ylab[j], + xlim = xlim, ylim = ylim[[j]], ...) + args$type <- "n" + do.call("plot", args) + mtext(xlab, side = 1, line = 3) + } else { + # args <- list(x.index, range., axes = FALSE, xlab = "", + args <- list(x.index, range., xaxt = "n", xlab = "", + ylab = ylab[j], xlim = xlim, ylim = ylim[[j]], ...) + args$type <- "n" + do.call("plot", args) + box() + # axis(2, xpd = NA) + } + + for(i in which(screens == levels(screens)[j])) + panel(x.index, x[, i], col = col[[i]], pch = pch[[i]], lty = lty[i], lwd = lwd[i], type = type[[i]], ...) + } + } else { + if(is.null(ylab)) ylab <- deparse(substitute(x)) + if(is.null(main)) main <- "" + main.outer <- FALSE + if(is.null(ylim)) ylim <- range(x, na.rm = TRUE) + else ylim <- range2(c(ylim, recursive = TRUE), na.rm = TRUE) + + lty <- rep(lty, length.out = nser) + lwd <- rep(lwd, length.out = nser) + col <- make.par.list(cn, col, NROW(x), nser, 1) + pch <- make.par.list(cn, pch, NROW(x), nser, par("pch")) + type <- make.par.list(cn, type, NROW(x), nser, "l") + + dummy <- rep(range(x, na.rm = TRUE), + length.out = length(index(x))) + + args <- list(x.index, dummy, xlab = xlab, ylab = ylab[1], ylim = ylim, xlim = xlim, ...) + args$type <- "n" + do.call("plot", args) + box() + y <- as.matrix(x) + for(i in 1:nser) { + panel(x.index, y[, i], col = col[[i]], pch = pch[[i]], lty = lty[i], + lwd = lwd[i], type = type[[i]], ...) + } + } + title(main, outer = main.outer) + return(invisible(x)) +} + +lines.zoo <- function(x, y = NULL, type = "l", ...) +{ + if (is.null(y)) { + if(NCOL(y) == 1) lines(index(x), x, type = type, ...) + else stop("Can't plot lines for multivariate zoo object") + } else + lines(coredata(cbind(x,y)), type = type, ...) +} + +points.zoo <- function(x, y = NULL, type = "p", ...) + lines(x, y, type = type, ...) + + +plot.tis <- function(x, ...) eval.parent(substitute(plot(as.zoo(x), ...))) + +plot.ti <- function (x, y, xlab = "", ...) +{ + x <- POSIXct(x) + NextMethod() +} + +points.ti <- lines.ti <- function(x, ...) { + x <- POSIXct(x) + NextMethod() +} + diff --git a/R/read.zoo.R b/R/read.zoo.R new file mode 100644 index 0000000..b91cb09 --- /dev/null +++ b/R/read.zoo.R @@ -0,0 +1,144 @@ +read.zoo <- function(file, format = "", tz = "", FUN = NULL, + regular = FALSE, index.column = 1, drop = TRUE, make.unique = NULL, + split = NULL, aggregate = FALSE, ...) +{ + ## `file' and `...' is simply passed to read.table + ## the first column is interpreted to be the index, the rest the coredata + ## it is transformed to an arbitrary index class by `FUN' + ## defaults for `FUN' are guessed and are numeric, Date or POSIXct + + ## read data + rval <- if (is.data.frame(file)) file else read.table(file, ...) + + ## if `file' does not contain data + if(NROW(rval) < 1) { + if(is.data.frame(rval)) rval <- as.matrix(rval) + if(NCOL(rval) > 1) rval <- rval[,-index.column, drop = drop] + rval <- zoo(rval) + return(rval) + } + + ## extract index + if(NCOL(rval) < 1) stop("data file must specify at least one column") + + ## extract index, retain rest of the data + if (NCOL(rval) == 1) ix <- seq_len(NROW(rval)) + else { + ix <- rval[,index.column] + split.values <- if (!is.null(split)) { + if (is.finite(split)) rval[, split] + else { + s <- split + split <- 0 + if (s == Inf) ave(ix, ix, FUN = seq_along) + else if (s == -Inf) ave(ix, ix, FUN = function(x) rev(seq_along(x))) + else ix + } + } + rval <- rval[,-c(split, index.column), drop = drop] + } + if(is.factor(ix)) ix <- as.character(ix) + if(is.data.frame(rval)) rval <- as.matrix(rval) + + ## index transformation functions + toDate <- if(missing(format)) function(x, ...) as.Date(format(x, scientific = FALSE)) + else function(x, format) as.Date(format(x, scientific = FALSE), format = format) + toPOSIXct <- if (missing(format)) { + function(x, tz) as.POSIXct(format(x, scientific = FALSE), tz = tz) + } else function(x, format, tz) { + as.POSIXct(strptime(format(x, scientific = FALSE), tz = tz, format = format)) + } + toDefault <- function(x, ...) { + rval <- try(toPOSIXct(x), silent = TRUE) + if(inherits(rval, "try-error")) + rval <- try(toDate(x), silent = TRUE) + else { + hms <- as.POSIXlt(rval) + hms <- hms$sec + 60 * hms$min + 3600 * hms$hour + if(isTRUE(all.equal(hms, rep.int(hms[1], length(hms))))) { + rval2 <- try(toDate(x), silent = TRUE) + if(!inherits(rval2, "try-error")) rval <- rval2 + } + } + if(inherits(rval, "try-error")) rval <- rep(NA, length(x)) + return(rval) + } + toNumeric <- function(x, ...) x + + ## setup default FUN + if(is.null(FUN)) { + FUN <- if (!missing(tz)) toPOSIXct + else if (!missing(format)) toDate + else if (is.numeric(ix)) toNumeric + else toDefault + } + FUN <- match.fun(FUN) + + ## compute index from (former) first column + ix <- if (missing(format)) { + if (missing(tz)) FUN(ix) else FUN(ix, tz = tz) + } else { + if (missing(tz)) FUN(ix, format = format) + else FUN(ix, format = format, tz = tz) + } + + if (!is.null(make.unique)) { + make.unique <- match.fun(make.unique) + ix <- make.unique(ix) + } + + ## sanity checking + if(any(is.na(ix))) { + idx <- which(is.na(ix)) + msg <- if (length(idx) == 1) + paste("index has bad entry at data row", idx) + else if (length(idx) <= 100) + paste("index has bad entries at data rows:", paste(idx, collapse = " ")) + else paste("index has", length(idx), "bad entries at data rows:", + paste(head(idx, 100), collapse = " "), "...") + stop(msg) + } + if(length(ix) != NROW(rval)) stop("index does not match data") + + ## setup zoo object and return + ## Suppress duplicates warning if aggregate specified + if(identical(aggregate, TRUE)) { + agg.fun <- mean + } else if(identical(aggregate, FALSE)) { + agg.fun <- NULL + } else { + agg.fun <- match.fun(aggregate) + if(!is.function(agg.fun)) stop(paste("invalid specification of", sQuote("aggregate"))) + } + remove(list = "aggregate") + + if (is.null(split)) { + rval <- if (!is.null(agg.fun)) aggregate(zoo(rval), ix, agg.fun) + else zoo(rval, ix) + if(regular && is.regular(rval)) rval <- as.zooreg(rval) + } else { + split.matrix <- split.data.frame + rval <- split(rval, split.values) + ix <- split(ix, split.values) + rval <- mapply(zoo, rval, ix) + if(regular) { + rval <- lapply(rval, function(x) if (is.regular(x)) as.zooreg(x) else x) + } + if (!is.null(agg.fun)) rval <- + lapply(seq_along(rval), function(z) aggregate(z, time(z), agg.fun)) + rval <- do.call(merge, rval) + } + + return(rval) +} + +write.zoo <- function(x, file = "", index.name = "Index", + row.names = FALSE, col.names = NULL, ...) +{ + if(is.null(col.names)) col.names <- !is.null(colnames(x)) + dx <- as.data.frame(x) + stopifnot(all(names(dx) != index.name)) + dx[[index.name]] <- index(x) + dx <- dx[, c(ncol(dx), 1:(ncol(dx)-1))] + write.table(dx, file = file, row.names = row.names, col.names = col.names, ...) +} diff --git a/R/rollapply.R b/R/rollapply.R new file mode 100644 index 0000000..c8a55d7 --- /dev/null +++ b/R/rollapply.R @@ -0,0 +1,74 @@ +rollapply <- function(data, width, FUN, ..., by = 1, ascending = TRUE, + by.column = TRUE, na.pad = FALSE, align = c("center", "left", "right")) + UseMethod("rollapply") + +## up to zoo 1.2-0 rollapply was called rapply(), it was deprecated +## up to zoo 1.3-x and removed in zoo 1.4-0. +## +## rapply <- function(data, width, FUN, ..., by = 1, ascending = TRUE, +## by.column = TRUE, na.pad = FALSE, align = c("center", "left", "right")) +## { +## .Deprecated("rollapply") +## UseMethod("rollapply") +## } + +rollapply.zoo <- function(data, width, FUN, ..., by = 1, ascending = TRUE, by.column = TRUE, na.pad = FALSE, + align = c("center", "left", "right")) { + itt <- 0 + embedi <- function(n, k, by = 1, ascending = FALSE) { + # n = no of time points, k = number of columns + # by = increment. normally = 1 but if = b calc every b-th point + # ascending If TRUE, points passed in ascending order else descending. + # Note that embed(1:n, k) corresponds to embedi(n, k, by = 1, rev = TRUE) + # e.g. embedi(10, 3) + s <- seq(1, n-k+1, by) + lens <- length(s) + cols <- if (ascending) 1:k else k:1 + matrix(s + rep(cols, rep(lens,k))-1, lens) + } + + if (by.column && by == 1 && ascending && length(list(...)) < 1) + switch(deparse(substitute(FUN)), + mean = return(rollmean(data, width, na.pad = na.pad, align = align)), + max = return(rollmax(data, width, na.pad = na.pad, align = align)), + median = return(rollmedian(data, width, na.pad = na.pad, align = align))) + + ## evaluate FUN only on coredata(data) + cdata <- coredata(data) + nr <- NROW(cdata) + width <- as.integer(width)[1] + stopifnot( width > 0, width <= nr ) + + ## process alignment + align <- match.arg(align) + n1 <- switch(align, + "left" = { width - 1}, + "center" = { floor(width/2) }, + "right" = { 0 }) + tt <- index(data)[seq((width-n1), (nr-n1), by)] + + FUN <- match.fun(FUN) + e <- embedi(nr, width, by, ascending) + res <- if (is.null(dim(cdata))) { + xx <- sapply(1:nrow(e), function(i) FUN(cdata[e[i,]], ...)) + if (! is.null(dim(xx))) xx <- t(xx) + zoo(xx, tt, if (by == 1) attr(data, "frequency")) + } else if (by.column) { + # e <- embedi(nr, width, by, ascending) + zoo( sapply( 1:ncol(cdata), function(i) + apply( e, 1, function(st) FUN(cdata[st,i], ...) ) ), + tt, if (by == 1) attr(data, "frequency") + ) + } else { + rval <- apply(embedi(nr, width, by, ascending), 1, function(st) FUN(cdata[st,], ...)) + if(!is.null(dim(rval))) rval <- t(rval) + zoo(rval, tt, if (by == 1) attr(data, "frequency")) + } + res <- if (na.pad) merge(res, zoo(,index(data), attr(data, "frequency"))) else res + if(by.column && !is.null(dim(cdata))) colnames(res) <- colnames(cdata) + return(res) +} + +rollapply.ts <- function(data, width, FUN, by = 1, ascending = TRUE, by.column = TRUE, na.pad = FALSE, ...) + as.ts(rollapply(as.zoo(data), width = width, FUN = FUN, by = by, ascending = ascending, + by.column = by.column, na.pad = na.pad, ...)) diff --git a/R/rollmean.R b/R/rollmean.R new file mode 100644 index 0000000..e7ad887 --- /dev/null +++ b/R/rollmean.R @@ -0,0 +1,156 @@ +# rollmean, rollmax, rollmedian (, rollmad) based on code posted by Jarek Tuszynski at +# https://www.stat.math.ethz.ch/pipermail/r-help/2004-October/057363.html +# ToDo: rollmad, currently rollapply() can be used + +rollmean <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) + UseMethod("rollmean") + +rollmean.default <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) +{ + x <- unclass(x) + n <- length(x) + y <- x[k:n] - x[c(1, 1:(n-k))] # difference from previous + y[1] <- sum(x[1:k]) # find the first + # apply precomputed differencest sum + rval <- cumsum(y)/k + if (na.pad) { + rval <- switch(match.arg(align), + "left" = { c(rval, rep(NA, k-1)) }, + "center" = { c(rep(NA, floor((k-1)/2)), rval, rep(NA, ceiling((k-1)/2))) }, + "right" = { c(rep(NA, k-1), rval) }) + } + return(rval) +} + +rollmean.zoo <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) +{ + stopifnot(k <= NROW(x)) + index.x <- index(x) + if(!na.pad) { + n <- length(index.x) + ix <- switch(match.arg(align), + "left" = { 1:(n-k+1) }, + "center" = { floor((1+k)/2):ceiling(n-k/2) }, + "right" = { k:n }) + index.x <- index.x[ix] + } + if(length(dim(x)) == 0) + return(zoo(rollmean.default(coredata(x), k, na.pad, align), index.x, attr(x, "frequency"))) + else + return(zoo(apply(coredata(x), 2, rollmean.default, k=k, na.pad=na.pad, align=align), + index.x, attr(x, "frequency"))) +} + +rollmean.ts <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) + as.ts(rollmean(as.zoo(x), k = k, na.pad = na.pad, align = align, ...)) + + +rollmax <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) + UseMethod("rollmax") + +rollmax.default <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) +{ + n <- length(x) + rval <- rep(0, n) + a <- 0 + for (i in k:n) { + rval[i] <- if (is.na(a) || is.na(rval[i=1]) || a==rval[i-1]) + max(x[(i-k+1):i]) # calculate max of window + else + max(rval[i-1], x[i]); # max of window = rval[i-1] + a <- x[i-k+1] # point that will be removed from window + } + rval <- rval[-seq(k-1)] + if (na.pad) { + rval <- switch(match.arg(align), + "left" = { c(rval, rep(NA, k-1)) }, + "center" = { c(rep(NA, floor((k-1)/2)), rval, rep(NA, ceiling((k-1)/2))) }, + "right" = { c(rep(NA, k-1), rval) }) + } + return(rval) +} + +rollmax.zoo <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) +{ + stopifnot(k <= NROW(x)) + index.x <- index(x) + if(!na.pad) { + n <- length(index.x) + ix <- switch(match.arg(align), + "left" = { 1:(n-k+1) }, + "center" = { floor((1+k)/2):ceiling(n-k/2) }, + "right" = { k:n }) + index.x <- index.x[ix] + } + if (length(dim(x)) == 0) + return(zoo(rollmax.default(coredata(x), k, na.pad, align), index.x, attr(x, "frequency"))) + else + return(zoo(apply(coredata(x), 2, rollmax.default, k=k, na.pad = na.pad, align=align), index.x, + attr(x, "frequency"))) +} + +rollmax.ts <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) + as.ts(rollmax(as.zoo(x), k = k, na.pad = na.pad, align = align, ...)) + + + +rollmedian <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) + UseMethod("rollmedian") + +rollmedian.default <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) +{ + ## interfaces runmed from `stats' + stopifnot(k <= length(x), k %% 2 == 1) + n <- length(x) + m <- k %/% 2 + rval <- runmed(x, k, ...) + attr(rval, "k") <- NULL + rval <- rval[-c(1:m, (n-m+1):n)] + if (na.pad) { + rval <- switch(match.arg(align), + "left" = { c(rval, rep(NA, k-1)) }, + "center" = { c(rep(NA, floor((k-1)/2)), rval, rep(NA, ceiling((k-1)/2))) }, + "right" = { c(rep(NA, k-1), rval) }) + } + return(rval) +} + +rollmedian.zoo <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) { + stopifnot(all(!is.na(x)), k <= NROW(x), k %% 2 == 1) + # todo: + # rather than abort we should do a simple loop to get the medians + # for those columns with NAs. + index.x <- index(x) + m <- k %/% 2 + n <- NROW(x) + align <- match.arg(align) + + if(!na.pad) { + n <- length(index.x) + ix <- switch(align, + "left" = { 1:(n-k+1) }, + "center" = { floor((1+k)/2):ceiling(n-k/2) }, + "right" = { k:n }) + index.x <- index.x[ix] + } + + rollmedian0 <- function(x, k, na.pad, ...) { + x <- runmed(x, k, ...)[-c(seq(m),seq(to=n,len=m))] + if (na.pad) { + x <- switch(align, + "left" = { c(x, rep(NA, k-1)) }, + "center" = { c(rep(NA, floor((k-1)/2)), x, rep(NA, ceiling((k-1)/2))) }, + "right" = { c(rep(NA, k-1), x) }) + } + return(x) + } + if (length(dim(x)) == 0) + return(zoo(rollmedian0(coredata(x), k, na.pad = na.pad, ...), index.x, + attr(x, "frequency"))) + else + return(zoo(apply(coredata(x), 2, rollmedian0, k = k, na.pad = na.pad, ...), + index.x, attr(x, "frequency"))) +} + +rollmedian.ts <- function(x, k, na.pad = FALSE, align = c("center", "left", "right"), ...) + as.ts(rollmedian(as.zoo(x), k = k, na.pad = na.pad, align = align, ...)) diff --git a/R/window.zoo.R b/R/window.zoo.R new file mode 100644 index 0000000..5fa35c7 --- /dev/null +++ b/R/window.zoo.R @@ -0,0 +1,114 @@ +window.zoo <- function(x, index. = index(x), start = NULL, end = NULL, ...) +{ + all.indexes <- index(x) + in.index <- MATCH(all.indexes, index., nomatch = 0) > 0 + + if(length(start) == 2 && !is.null(attr(x, "frequency")) && is.numeric(all.indexes)) { + freq <- attr(x, "frequency") + start <- floor(start[1]*freq + (start[2] - 1) + .0001)/freq + } + if(length(end) == 2 && !is.null(attr(x, "frequency")) && is.numeric(all.indexes)) { + freq <- attr(x, "frequency") + end <- floor(end[1]*freq + (end[2] - 1) + .0001)/freq + } + + if(is.null(start)) { + if(is.null(end)) { + wi <- which(MATCH(all.indexes, index., nomatch = 0) > 0) + return(x[wi,,]) + } else { + wi <- which(in.index & all.indexes <= end) + return(x[wi,,]) + } + } else { + if(is.null(end)) { + wi <- which(in.index & all.indexes >= start) + } else { + wi <- which(in.index & all.indexes >= start & all.indexes <= end) + } + return(x[wi,,]) + } +} + +"window<-.zoo" <- function(x, index. = index(x), start = NULL, end = NULL, ..., value) +{ + ix <- index(x) + stopifnot(all(MATCH(index., ix, nomatch = 0) > 0)) + + if(length(start) == 2 && !is.null(attr(x, "frequency")) && is.numeric(ix)) { + freq <- attr(x, "frequency") + start <- floor(start[1]*freq + (start[2] - 1) + .0001)/freq + } + if(length(end) == 2 && !is.null(attr(x, "frequency")) && is.numeric(ix)) { + freq <- attr(x, "frequency") + end <- floor(end[1]*freq + (end[2] - 1) + .0001)/freq + } + + if (!is.null(start)) index. <- index.[index. >= start] + if (!is.null(end)) index. <- index.[index. <= end] + + wi <- which(MATCH(ix, index., nomatch = 0) > 0) + if (length(dim(x)) == 0) + x[wi] <- value + else + x[wi,] <- value + return(x) +} + +lag.zoo <- function(x, k = 1, na.pad = FALSE, ...) +{ + if (length(k) > 1) { + if (is.null(names(k))) names(k) <- paste("lag", k, sep = "") + return(do.call("merge.zoo", lapply(k, lag.zoo, x = x, ...))) + } + nr <- NROW(x) + if (k != round(k)) { + k <- round(k) + warning("k is not an integer") + } + if (k == 0) return(x) + if (abs(k) > nr) k <- nr + if (k > 0) { + xx <- x[-seq(1, length = k),,] + attr(xx, "index") <- index(x)[-seq(to = nr,length = k)] + } else { + xx <- x[-seq(to = nr, length = -k),,] + attr(xx, "index") <- index(x)[-seq(1, length = -k)] + } + if (na.pad) merge(zoo(,time(x)), xx, all = c(TRUE, FALSE)) else xx +} + + + +lag.zooreg <- function(x, k = 1, na.pad = FALSE, ...) +{ + if (length(k) > 1) { + if (is.null(names(k))) names(k) <- paste("lag", k, sep = "") + return(do.call("merge.zoo", lapply(k, lag.zooreg, x = x, na.pad = na.pad, ...))) + } + x0 <- x + nr <- NROW(x) + freq <- attr(x, "frequency") + + if (k != round(k)) warning("k is not an integer") + k <- round(k) + + ix <- index(x) + ix <- if(identical(class(ix), "numeric") | identical(class(ix), "integer")) + floor(freq*ix - k + .0001)/freq else ix - k/freq + index(x) <- ix + + if (na.pad) merge(x, zoo(, time(x0))) else x +} + +diff.zoo <- function(x, lag = 1, differences = 1, arithmetic = TRUE, na.pad = FALSE, ...) +{ + ix <- index(x) + stopifnot(lag >= 1, differences >= 1) + if (!arithmetic) x <- log(x) + for(i in 1:differences) { + x <- x - lag(x, k = -lag, ...) + } + if (!arithmetic) x <- exp(x) + if (na.pad) merge(zoo(,ix), x, all = c(TRUE, FALSE)) else x +} diff --git a/R/xyplot.zoo.R b/R/xyplot.zoo.R new file mode 100644 index 0000000..c83af75 --- /dev/null +++ b/R/xyplot.zoo.R @@ -0,0 +1,206 @@ +panel.plot.default <- function(x, y, subscripts, groups, panel = panel.xyplot, + col = 1, type = "p", pch = 20, lty = 1, lwd = 1, ...) +{ + col <- rep(as.list(col), length = nlevels(groups)) + type <- rep(as.list(type), length = nlevels(groups)) + pch <- rep(as.list(pch), length = nlevels(groups)) + lty <- rep(as.list(lty), length = nlevels(groups)) + lwd <- rep(as.list(lwd), length = nlevels(groups)) + + for(g in 1:nlevels(groups)) { + idx <- g == groups[subscripts] + if (any(idx)) panel(x[idx], y[idx], ..., + col = col[[g]], type = type[[g]], pch = pch[[g]], + lty = lty[[g]], lwd = lwd[[g]]) + } +} + +panel.plot.custom <- function(...) { + args <- list(...) + function(...) { + dots <- list(...) + # do.call("panel.plot.default", lattice:::updateList(dots, args)) + do.call("panel.plot.default", modifyList(dots, args)) + } +} + +xyplot.its <- +xyplot.ts <- +xyplot.zoo <- function(x, data, + screens = seq_len(NCOL(x)), + default.scales = list(y = list(relation = "free")), + layout = NULL, xlab = "Index", ylab = NULL, + lty = trellis.par.get("plot.line")$lty, + lwd = trellis.par.get("plot.line")$lwd, + pch = trellis.par.get("plot.symbol")$pch, + type = "l", + col = trellis.par.get("plot.line")$col, + strip = TRUE, + panel = panel.plot.default, ...) +{ + x <- as.zoo(x) + if (length(dim(x)) < 2) x <- zoo(matrix(coredata(x),,1), time(x)) + + cn <- if (is.null(colnames(x))) paste("V", seq_len(NCOL(x)), sep = "") + else colnames(x) + screens <- make.par.list(cn, screens, NROW(x), NCOL(x), 1) + screens <- as.factor(unlist(screens))[drop = TRUE] + lty <- make.par.list(cn, lty, NROW(x), NCOL(x), trellis.par.get("plot.line")$lty) + lwd <- make.par.list(cn, lwd, NROW(x), NCOL(x), trellis.par.get("plot.line")$lwd) + pch <- make.par.list(cn, pch, NROW(x), NCOL(x), trellis.par.get("plot.symbol")$pch) + type <- make.par.list(cn, type, NROW(x), NCOL(x), "l") + col <- make.par.list(cn, col, NROW(x), NCOL(x), trellis.par.get("plot.line")$col) + + tt <- rep(time(x), NCOL(x)) + x <- coredata(x) + screens <- rep(screens, length = NCOL(x)) + fac <- factor(rep(screens, each = NROW(x))) + if(is.null(layout)) { + nc <- ceiling(nlevels(fac)/5) + nr <- ceiling(nlevels(fac)/nc) + layout <- c(nc, nr) + } + + fo <- if(NCOL(x) == 1) x ~ tt else x ~ tt | fac + + if (isTRUE(strip)) { + isnotdup <- !duplicated(screens) + strip <- cn[isnotdup][order(screens[isnotdup])] + } + if (is.character(strip)) + strip <- strip.custom(factor.levels = rep(strip, length(unique(screens)))) + + if(is.null(ylab) || length(ylab) == 1) { + xyplot(fo, panel = panel, groups = factor(col(x)), + type = type, default.scales = default.scales, + layout = layout, xlab = xlab, ylab = ylab, pch = pch, + col = col, lty = lty, lwd = lwd, strip = strip, ...) + } else { + ylab <- rep(ylab, length = length(unique(screens))) + xyplot(fo, panel = panel, groups = factor(col(x)), + type = type, default.scales = default.scales, + layout = layout, xlab = xlab, ylab = "", pch = pch, + strip.left = strip.custom(horizontal = FALSE, + factor.levels = ylab), strip = strip, ...) + } +} + +xyplot.tis <- function(x, data, + screens = seq_len(NCOL(x)), + default.scales = list(y = list(relation = "free")), + layout = NULL, xlab = "Index", ylab = NULL, + lty = trellis.par.get("plot.line")$lty, + lwd = trellis.par.get("plot.line")$lwd, + pch = trellis.par.get("plot.symbol")$pch, + type = "l", + col = trellis.par.get("plot.line")$col, + strip = TRUE, + panel = panel.plot.default, ...) +{ + x <- aggregate(as.zoo(x), POSIXct, force) + if (length(dim(x)) < 2) x <- zoo(matrix(coredata(x),,1), time(x)) + + cn <- if (is.null(colnames(x))) paste("V", seq_len(NCOL(x)), sep = "") + else colnames(x) + screens <- make.par.list(cn, screens, NROW(x), NCOL(x), 1) + screens <- as.factor(unlist(screens))[drop = TRUE] + lty <- make.par.list(cn, lty, NROW(x), NCOL(x), trellis.par.get("plot.line")$lty) + lwd <- make.par.list(cn, lwd, NROW(x), NCOL(x), trellis.par.get("plot.line")$lwd) + pch <- make.par.list(cn, pch, NROW(x), NCOL(x), trellis.par.get("plot.symbol")$pch) + type <- make.par.list(cn, type, NROW(x), NCOL(x), "l") + col <- make.par.list(cn, col, NROW(x), NCOL(x), trellis.par.get("plot.line")$col) + + tt <- rep(time(x), NCOL(x)) + x <- coredata(x) + screens <- rep(screens, length = NCOL(x)) + fac <- factor(rep(screens, each = NROW(x))) + if(is.null(layout)) { + nc <- ceiling(nlevels(fac)/5) + nr <- ceiling(nlevels(fac)/nc) + layout <- c(nc, nr) + } + + fo <- if(NCOL(x) == 1) x ~ tt else x ~ tt | fac + + if (isTRUE(strip)) { + isnotdup <- !duplicated(screens) + strip <- cn[isnotdup][order(screens[isnotdup])] + } + if (is.character(strip)) + strip <- strip.custom(factor.levels = rep(strip, length(unique(screens)))) + + if(is.null(ylab) || length(ylab) == 1) { + xyplot(fo, panel = panel, groups = factor(col(x)), + type = type, default.scales = default.scales, + layout = layout, xlab = xlab, ylab = ylab, pch = pch, + col = col, lty = lty, lwd = lwd, strip = strip, ...) + } else { + ylab <- rep(ylab, length = length(unique(screens))) + xyplot(fo, panel = panel, groups = factor(col(x)), + type = type, default.scales = default.scales, + layout = layout, xlab = xlab, ylab = "", pch = pch, + col = col, lty = lty, lwd = lwd, outer = TRUE, + strip.left = strip.custom(horizontal = FALSE, + factor.levels = ylab), strip = TRUE, ...) + } +} + + +panel.lines.ts <- +panel.lines.its <- +panel.lines.tis <- +panel.lines.zoo <- function(x, ...) { + x <- as.zoo(x) + panel.lines(time(x), coredata(x), ...) +} + +panel.points.ts <- +panel.points.its <- +panel.points.tis <- +panel.points.zoo <- function(x, ...) { + x <- as.zoo(x) + panel.points(time(x), coredata(x), ...) +} + +panel.segments.ts <- +panel.segments.its <- +panel.segments.tis <- +panel.segments.zoo <- function(x0, x1, ...) { + x0 <- as.zoo(x0) + x1 <- as.zoo(x1) + panel.segments(time(x0), coredata(x0), time(x1), coredata(x1), ...) +} + +panel.text.ts <- +panel.text.its <- +panel.text.tis <- +panel.text.zoo <- function(x, ...) { + x <- as.zoo(x) + panel.text(time(x), coredata(x), ...) +} + +panel.rect.ts <- +panel.rect.its <- +panel.rect.tis <- +panel.rect.zoo <- function(x0, x1, ...) { + x0 <- as.zoo(x0) + x1 <- as.zoo(x1) + panel.rect(time(x0), coredata(x0), time(x1), coredata(x1), ...) +} + +panel.arrows.ts <- +panel.arrows.its <- +panel.arrows.tis <- +panel.arrows.zoo <- function(x0, x1, ...) { + x0 <- as.zoo(x0) + x1 <- as.zoo(x1) + panel.rect(time(x0), coredata(x0), time(x1), coredata(x1), ...) +} + +panel.polygon.ts <- +panel.polygon.its <- +panel.polygon.tis <- +panel.polygon.zoo <- function(x, ...) { + x <- as.zoo(x) + panel.polygon(time(x), coredata(x), ...) +} diff --git a/R/yearmon.R b/R/yearmon.R new file mode 100644 index 0000000..e9369b1 --- /dev/null +++ b/R/yearmon.R @@ -0,0 +1,210 @@ +## class creation +yearmon <- function(x) structure(floor(12*x + .0001)/12, class = "yearmon") + +## coercion to yearmon: always go via numeric +as.yearmon <- function(x, ...) UseMethod("as.yearmon") +as.yearmon.default <- function(x, ...) as.yearmon(as.numeric(x)) +as.yearmon.numeric <- function(x, ...) yearmon(x) +as.yearmon.integer <- function(x, ...) structure(x, class = "yearmon") +as.yearmon.yearqtr <- function(x, frac = 0, ...) { + if (frac == 0) yearmon(as.numeric(x)) else + as.yearmon(as.Date(x, frac = frac), ...) +} +as.yearmon.dates <- +as.yearmon.Date <- +as.yearmon.POSIXt <- function(x, ...) as.yearmon(with(as.POSIXlt(x, tz="GMT"), 1900 + year + mon/12)) +# as.jul.yearmon <- function(x, ...) jul(as.Date(x, ...)) # jul is from fame pkg +as.yearmon.timeDate <- +as.yearmon.jul <- function(x, ...) as.yearmon(as.Date(x, ...)) +as.yearmon.factor <- function(x, ...) as.yearmon(as.character(x), ...) +as.yearmon.character <- function(x, format = "", ...) { + if (format == "") { + nch <- nchar(gsub("[^-]", "", x)) + nch[is.na(x)] <- NA + nch <- na.omit(nch) + if (length(table(nch)) != 1) + stop("yearmon variable can only have one format") + format <- if (all(nch == 0)) "%B %Y" + else if (all(nch == 1)) "%Y-%m" else "%Y-%m-%d" + } + has.short.keys <- rep(regexpr("%[mbByY%]", format) > 0, length(x)) + has.no.others <- regexpr("%", gsub("%[mbByY%]", "", format)) < 0 + z <- ifelse(has.short.keys & has.no.others, + as.Date( paste("01", x, sep = "-"), paste("%d", format, sep = "-"), ... ), + as.Date(x, format, ...)) + as.yearmon(as.Date(z)) +} +as.yearmon.ti <- function(x, ...) as.yearmon(as.Date(x), ...) + +## coercion from yearmon +# returned Date is the fraction of the way through the period given by frac +as.Date.yearmon <- function(x, frac = 0, ...) { + x <- unclass(x) + year <- floor(x + .001) + month <- floor(12 * (x - year) + 1 + .5 + .001) + dd.start <- as.Date(paste(year, month, 1, sep = "-")) + dd.end <- dd.start + 32 - as.numeric(format(dd.start + 32, "%d")) + as.Date((1-frac) * as.numeric(dd.start) + frac * as.numeric(dd.end), origin = "1970-01-01") +} +as.POSIXct.yearmon <- function(x, tz = "", ...) as.POSIXct(as.Date(x), tz = tz, ...) +as.POSIXlt.yearmon <- function(x, tz = "", ...) as.POSIXlt(as.Date(x), tz = tz, ...) +as.numeric.yearmon <- function(x, ...) unclass(x) +as.character.yearmon <- function(x, ...) format.yearmon(x, ...) +as.data.frame.yearmon <- function(x, row.names = NULL, optional = FALSE, ...) +{ + nrows <- length(x) + nm <- paste(deparse(substitute(x), width.cutoff = 500), collapse = " ") + if (is.null(row.names)) { + if (nrows == 0) + row.names <- character(0) + else if(length(row.names <- names(x)) == nrows && !any(duplicated(row.names))) { + } + else if(optional) row.names <- character(nrows) + else row.names <- seq_len(nrows) + } + names(x) <- NULL + value <- list(x) + if(!optional) names(value) <- nm + attr(value, "row.names") <- row.names + class(value) <- "data.frame" + value +} + +## other methods for class yearmon +c.yearmon <- function(...) + as.yearmon(do.call("c", lapply(list(...), as.numeric))) + +cycle.yearmon <- function(x, ...) as.numeric(months(x)) + +format.yearmon <- function(x, format = "%b %Y", ...) +{ + if (length(x) == 0) return(character(0)) + xx <- format(as.Date(x), format = format, ...) + names(xx) <- names(x) + xx +} + +print.yearmon <- function(x, ...) { + print(format(x), ...) + invisible(x) +} + +months.yearmon <- function(x, abbreviate) { + months(as.Date(x), abbreviate) +} + +quarters.yearmon <- function(x, abbreviate) { + quarters(as.Date(x), abbreviate) +} + +"[.yearmon" <- function (x, ..., drop = TRUE) +{ + cl <- oldClass(x) + class(x) <- NULL + val <- NextMethod("[") + class(val) <- cl + val +} + +MATCH.yearmon <- function(x, table, nomatch = NA, ...) + match(floor(12*as.numeric(x) + .001), floor(12*as.numeric(table) + .001), nomatch = nomatch, ...) + +Ops.yearmon <- function(e1, e2) { + e1 <- as.numeric(as.yearmon(e1)) + e2 <- as.numeric(as.yearmon(e2)) + rval <- NextMethod(.Generic) + if(is.numeric(rval)) rval <- as.yearmon(rval) + return(rval) +} + +"-.yearmon" <- function (e1, e2) +{ + if (!inherits(e1, "yearmon")) + stop("Can only subtract from yearmon objects") + if (nargs() == 1) + return(- as.numeric(e1)) + if (inherits(e2, "yearmon")) + return(as.numeric(e1) - as.numeric(e2)) + if (!is.null(attr(e2, "class"))) + stop("can only subtract yearmon objects and numbers from yearmon objects") + structure(unclass(as.yearmon(e1)) - e2, class = "yearmon") +} + +is.numeric.yearmon <- function(x) FALSE + +Axis.yearmon <- function(x = NULL, at = NULL, ..., side, labels = NULL) + axis.yearmon(x = x, at = at, ..., side = side, labels = TRUE) + +axis.yearmon <- function (side, x, at, format, labels = TRUE, ..., N1 = 25, N2 = 2) { + # If years in range > N1 then only years shown. + # If years in range > N2 then month ticks are not labelled. + mat <- missing(at) || is.null(at) + if (!mat) # at not missing + x <- as.yearmon(at) + else x <- as.yearmon(x) + range <- par("usr")[if (side%%2) + 1:2 + else 3:4] + # range[1] <- ceiling(range[1]) + # range[2] <- floor(range[2]) + d <- range[2] - range[1] + z <- c(range, x[is.finite(x)]) + class(z) <- "yearmon" + if (d > N1) { # axis has years only + z <- structure(pretty(z), class = "yearmon") + } else if (d > N2) { # axis has all years and unlabelled months + z <- seq(min(x), max(x), 1/12) + # z <- seq(floor(min(x)), ceiling(max(x))) + } else { # years and months + z <- seq(min(x), max(x), 1/12) + } + if (!mat) + z <- x[is.finite(x)] + z <- z[z >= range[1] & z <= range[2]] + z <- sort(unique(z)) + class(z) <- "yearmon" + if (identical(labels, TRUE)) { + if (missing(format)) format <- c("%Y", "%b") + if (length(format) == 1) format <- c(format, "") + if (d <= N2) labels <- format.yearmon(z, format = format[2]) + idx <- format.yearmon(z, format = "%m") == "01" + labels <- rep(NA, length(z)) + labels[idx] <- format.yearmon(z[idx], format = format[1]) + } else if (identical(labels, FALSE)) + labels <- rep("", length(z)) + axis(side, at = z, labels = labels, ...) +} + +summary.yearmon <- function(object, ...) + summary(as.numeric(object), ...) + +### + +## convert from package date +as.yearmon.date <- function(x, ...) { + as.yearmon(as.Date(x, ...)) +} + +mean.yearmon <- function (x, ...) as.yearmon(mean(unclass(x), ...)) + +Summary.yearmon <- function (..., na.rm) +{ + ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) + if (!ok) stop(.Generic, " not defined for yearmon objects") + val <- NextMethod(.Generic) + class(val) <- oldClass(list(...)[[1]]) + val +} + +Sys.yearmon <- function() as.yearmon(Sys.Date()) + +range.yearmon <- function(..., na.rm = FALSE) { + as.yearmon(range.default(..., na.rm = na.rm)) +} + +unique.yearmon <- function(x, incomparables = FALSE, ...) { + as.yearmon(unique.default(x, incomparables = incomparables, ...)) +} + + + diff --git a/R/yearqtr.R b/R/yearqtr.R new file mode 100644 index 0000000..9dd4fbc --- /dev/null +++ b/R/yearqtr.R @@ -0,0 +1,228 @@ +## class creation +yearqtr <- function(x) structure(floor(4*x + .001)/4, class = "yearqtr") + +## coercion to yearqtr: always go via numeric +as.yearqtr <- function(x, ...) UseMethod("as.yearqtr") +as.yearqtr.default <- function(x, ...) as.yearqtr(as.numeric(x)) +as.yearqtr.numeric <- function(x, ...) structure(floor(4*x + .0001)/4, class = "yearqtr") +as.yearqtr.integer <- function(x, ...) structure(x, class = "yearqtr") + +# as.jul.yearqtr <- function(x, ...) jul(as.Date(x, ...)) # jul is from fame +as.yearqtr.jul <- # jul is in fame package +as.yearqtr.timeDate <- +as.yearqtr.dates <- +as.yearqtr.Date <- +as.yearqtr.POSIXt <- function(x, ...) as.yearqtr(as.yearmon(x)) +as.yearqtr.yearqtr <- function(x, ...) x + +as.yearqtr.factor <- function(x, ...) as.yearqtr(as.character(x), ...) +as.yearqtr.character <- function(x, format, ...) { + non.na <- x[!is.na(x)] + if (length(non.na) == 0) + return(structure(rep(NA, length(x)), class = "yearqtr")) + if (missing(format) || format == "") { + format <- if (all(regexpr("q", non.na) > 0)) { "%Y q%q" + } else if (all(regexpr("Q", non.na) > 0)) { "%Y Q%q" + } else "%Y-%q" + } + y <- if (regexpr("%[qQ]", format) > 0) { + format <- sub("%q", "%m", format) + y <- as.numeric(as.yearmon(x, format)) + m0 <- round(12 * (y %% 1)) + floor(y) + ifelse(m0 > 3, NA, m0/4) + } else as.yearmon(x, format) + as.yearqtr(y) +} +as.yearqtr.ti <- function(x, ...) as.yearqtr(as.Date(x), ...) + +## coercion from yearqtr +# returned Date is the fraction of the way through the period given by frac +as.Date.yearqtr <- function(x, frac = 0, ...) { + x <- unclass(x) + year <- floor(x + .001) + month <- floor(12 * (x - year) + 1 + .5 + .001) + dd.start <- as.Date(paste(year, month, 1, sep = "-")) + dd.end <- dd.start + 100 - as.numeric(format(dd.start + 100, "%d")) + as.Date((1-frac) * as.numeric(dd.start) + frac * as.numeric(dd.end), origin = "1970-01-01") +} +as.POSIXct.yearqtr <- function(x, tz = "", ...) as.POSIXct(as.Date(x), tz = tz, ...) +as.POSIXlt.yearqtr <- function(x, tz = "", ...) as.POSIXlt(as.Date(x), tz = tz, ...) +as.numeric.yearqtr <- function(x, ...) unclass(x) +as.character.yearqtr <- function(x, ...) format.yearqtr(x, ...) +as.data.frame.yearqtr <- function(x, row.names = NULL, optional = FALSE, ...) +{ + nrows <- length(x) + nm <- paste(deparse(substitute(x), width.cutoff = 500), collapse = " ") + if (is.null(row.names)) { + if (nrows == 0) + row.names <- character(0) + else if(length(row.names <- names(x)) == nrows && !any(duplicated(row.names))) { + } + else if(optional) row.names <- character(nrows) + else row.names <- seq_len(nrows) + } + names(x) <- NULL + value <- list(x) + if(!optional) names(value) <- nm + attr(value, "row.names") <- row.names + class(value) <- "data.frame" + value +} + + +## other methods for class yearqtr +c.yearqtr <- function(...) { + as.yearqtr(do.call("c", lapply(list(...), as.numeric))) +} + +cycle.yearqtr <- function(x, ...) as.numeric(quarters(x)) + +format.yearqtr <- function(x, format = "%Y Q%q", ...) +{ + if (length(x) == 0) return(character(0)) + # like gsub but replacement and x may be vectors the same length + gsub.vec <- function(pattern, replacement, x, ...) { + y <- x + for(i in seq_along(x)) { + y[i] <- gsub(pattern, replacement[i], x[i], ...) + } + y + } + x <- as.yearqtr(x) + x <- unclass(x) + year <- floor(x + .001) + qtr <- floor(4*(x - year) + 1 + .5 + .001) + if (format == "%Y Q%q") return(paste(year, " Q", qtr, sep = "")) + # TODO: speed up the following + xx <- gsub.vec("%q", qtr, rep(format, length(qtr))) + xx <- gsub.vec("%Y", year, xx) + xx <- gsub.vec("%y", sprintf("%02d", year %% 100), xx) + xx <- gsub.vec("%C", year %/% 100, xx) + names(xx) <- names(x) + xx +} + + +months.yearqtr <- function(x, abbreviate) { + months(as.Date(x), abbreviate) +} + +quarters.yearqtr <- function(x, abbreviate) { + quarters(as.Date(x), abbreviate) +} + + +print.yearqtr <- function(x, ...) { + print(format(x), ...) + invisible(x) +} + +"[.yearqtr" <- function (x, ..., drop = TRUE) +{ + cl <- oldClass(x) + class(x) <- NULL + val <- NextMethod("[") + class(val) <- cl + val +} + +MATCH.yearqtr <- function(x, table, nomatch = NA, ...) + match(floor(4*as.numeric(x) + .001), floor(4*as.numeric(table) + .001), nomatch = nomatch, ...) + +Ops.yearqtr <- function(e1, e2) { + e1 <- as.numeric(as.yearqtr(e1)) + e2 <- as.numeric(as.yearqtr(e2)) + rval <- NextMethod(.Generic) + if(is.numeric(rval)) rval <- as.yearqtr(rval) + return(rval) +} + + +"-.yearqtr" <- function (e1, e2) +{ + if (!inherits(e1, "yearqtr")) + stop("Can only subtract from yearqtr objects") + if (nargs() == 1) + return(- as.numeric(e1)) + if (inherits(e2, "yearqtr")) + return(as.numeric(e1) - as.numeric(e2)) + if (!is.null(attr(e2, "class"))) + stop("can only subtract yearqtr objects and numbers from yearqtr objects") + structure(unclass(as.yearqtr(e1)) - e2, class = "yearqtr") +} + +is.numeric.yearqtr <- function(x) FALSE + +Axis.yearqtr <- function(x = NULL, at = NULL, ..., side, labels = NULL) + axis.yearqtr(x = x, at = at, ..., side = side, labels = TRUE) + + +axis.yearqtr <- function (side, x, at, format, labels = TRUE, ..., N1 = 25, N2 = 7) { + # If years in range > N1 then only years shown. + # If years in range > N2 then quarter ticks are not labelled. + mat <- missing(at) || is.null(at) + if (!mat) # at not missing + x <- as.yearqtr(at) + else x <- as.yearqtr(x) + range <- par("usr")[if (side%%2) + 1:2 + else 3:4] + # range[1] <- ceiling(range[1]) + # range[2] <- floor(range[2]) + d <- range[2] - range[1] + z <- c(range, x[is.finite(x)]) + class(z) <- "yearqtr" + if (d > N1) { # axis has years only + z <- structure(pretty(z), class = "yearqtr") + } else if (d > N2) { # axis has all years and unlabelled quarters + z <- seq(min(x), max(x), 0.25) + # z <- seq(floor(min(x)), ceiling(max(x))) + } else { # years and quarters + z <- seq(min(x), max(x), 0.25) + } + if (!mat) + z <- x[is.finite(x)] + z <- z[z >= range[1] & z <= range[2]] + z <- sort(unique(z)) + class(z) <- "yearqtr" + if (identical(labels, TRUE)) { + if (missing(format)) format <- c("%Y", "Q%q") + if (length(format) == 1) format <- c(format, "") + if (d <= N2) labels <- format.yearqtr(z, format = format[2]) + idx <- format.yearqtr(z, format = "%q") == "1" + labels <- rep(NA, length(z)) + labels[idx] <- format.yearqtr(z[idx], format = format[1]) + } else if (identical(labels, FALSE)) + labels <- rep("", length(z)) + axis(side, at = z, labels = labels, ...) +} + +summary.yearqtr <- function(object, ...) + summary(as.numeric(object), ...) + +## convert from package date +as.yearqtr.date <- function(x, ...) { + as.yearqtr(as.Date(x, ...)) +} + +mean.yearqtr <- function (x, ...) as.yearqtr(mean(unclass(x), ...)) + +Summary.yearqtr <- function (..., na.rm) +{ + ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) + if (!ok) stop(.Generic, " not defined for yearqtr objects") + val <- NextMethod(.Generic) + class(val) <- oldClass(list(...)[[1]]) + val +} + +Sys.yearqtr <- function() as.yearqtr(Sys.Date()) + +range.yearqtr <- function(..., na.rm = FALSE) { + as.yearqtr(range.default(..., na.rm = na.rm)) +} + +unique.yearqtr <- function(x, incomparables = FALSE, ...) { + as.yearqtr(unique.default(x, incomparables = incomparables, ...)) +} + diff --git a/R/zoo.R b/R/zoo.R new file mode 100644 index 0000000..95108fb --- /dev/null +++ b/R/zoo.R @@ -0,0 +1,246 @@ +zoo <- function (x = NULL, order.by = index(x), frequency = NULL) +{ + #Z: why do we need this?# if (is.data.frame(x)) stop("first argument to zoo may not be a data frame") + ## process index "order.by" + if(length(unique(MATCH(order.by, order.by))) < length(order.by)) + warning(paste("some methods for", dQuote("zoo"), + "objects do not work if the index entries in", sQuote("order.by"), "are not unique")) + index <- ORDER(order.by) + order.by <- order.by[index] + + if(missing(x) || is.null(x)) + x <- numeric() + else if (is.vector(x)) + x <- rep(x, length.out = length(index))[index] + else if (is.factor(x)) + x <- factor(rep(as.character(x), length.out = length(index))[index], + levels = levels(x), ordered = is.ordered(x)) + else if (is.matrix(x) || is.data.frame(x)) + x <- (x[rep(1:NROW(x), length.out = length(index)), , + drop = FALSE])[index, , drop = FALSE] + else stop(paste(dQuote("x"), ": attempt to define illegal zoo object")) + if(is.matrix(x) || is.data.frame(x)) x <- as.matrix(x) + + if(!is.null(frequency)) { + delta <- suppressWarnings(try(diff(as.numeric(order.by)), silent = TRUE)) + freqOK <- if(class(delta) == "try-error" || any(is.na(delta))) FALSE + else if(length(delta) < 1) TRUE + else identical(all.equal(delta*frequency, round(delta*frequency)), TRUE) + if(!freqOK) { + warning(paste(dQuote("order.by"), "and", dQuote("frequency"), + "do not match:", dQuote("frequency"), "ignored")) + frequency <- NULL + } else { + if(frequency > 1 && identical(all.equal(frequency, round(frequency)), TRUE)) + frequency <- round(frequency) + } + } + + attr(x, "oclass") <- attr(x, "class") + attr(x, "index") <- order.by + attr(x, "frequency") <- frequency + class(x) <- if(is.null(frequency)) "zoo" else c("zooreg", "zoo") + return(x) +} + +print.zoo <- function (x, style = ifelse(length(dim(x)) == 0, + "horizontal", "vertical"), quote = FALSE, ...) +{ + style <- match.arg(style, c("horizontal", "vertical", "plain")) + if (is.null(dim(x)) && length(x) == 0) style <- "plain" + if (length(dim(x)) > 0 && style == "horizontal") style <- "plain" + if (style == "vertical") { + # y <- format(eval(as.matrix(x), parent.frame(n = 3))) + y <- as.matrix(coredata(x)) + if (length(colnames(x)) < 1) { + colnames(y) <- rep("", NCOL(x)) + } + rownames(y) <- index2char(index(x), frequency = attr(x, "frequency")) + print(y, quote = quote, ...) + } + else if (style == "horizontal") { + y <- as.vector(x) + names(y) <- index2char(index(x), frequency = attr(x, "frequency")) + print(y, quote = quote, ...) + } + else { + x.index <- index(x) + cat("Data:\n") + print(coredata(x)) + cat("\nIndex:\n") + print(x.index) + } + invisible(x) +} + +summary.zoo <- function(object, ...) +{ + y <- as.data.frame(object) + if (length(colnames(object)) < 1) { + lab <- deparse(substitute(object)) + colnames(y) <- if (NCOL(object) == 1) lab + else paste(lab, 1:NCOL(object), sep=".") + } + if (NROW(y) > 0) { + summary(cbind(data.frame(Index = index(object)), y), ...) + } else summary(data.frame(Index = index(object)), ...) +} + + +is.zoo <- function(object) + inherits(object, "zoo") + +str.zoo <- function(object, ...) +{ + cls <- if(inherits(object, "zooreg")) "zooreg" else "zoo" + if(NROW(object) < 1) cat(paste(sQuote(cls), "series (without observations)\n")) else { + cat(paste(sQuote(cls), " series from ", start(object), " to ", end(object), "\n", sep = "")) + cat(" Data:") + str(coredata(object), ...) + cat(" Index: ") + str(index(object), ...) + if(cls == "zooreg") cat(paste(" Frequency:", attr(object, "frequency"), "\n")) + } +} + +"[.zoo" <- function(x, i, j, drop = TRUE, ...) +{ + if(!is.zoo(x)) stop("method is only for zoo objects") + x.index <- index(x) + rval <- coredata(x) + if(missing(i)) i <- 1:NROW(rval) + + ## also support that i can be index: + ## if i is not numeric/integer/logical, it is interpreted to be the index + if (all(class(i) == "logical")) + i <- which(i) + else if (inherits(i, "zoo") && all(class(coredata(i)) == "logical")) { + i <- which(coredata(merge(zoo(,time(x)), i))) + } else if(!((all(class(i) == "numeric") || all(class(i) == "integer")))) + i <- which(MATCH(x.index, i, nomatch = 0) > 0) + + if(length(dim(rval)) == 2) { + drop. <- if (length(i) == 1) FALSE else drop + rval <- if (missing(j)) rval[i, , drop = drop., ...] + else rval[i, j, drop = drop., ...] + if (drop && length(rval) == 1) rval <- c(rval) + rval <- zoo(rval, x.index[i]) + } else + rval <- zoo(rval[i], x.index[i]) + + attr(rval, "oclass") <- attr(x, "oclass") + attr(rval, "levels") <- attr(x, "levels") + attr(rval, "frequency") <- attr(x, "frequency") + if(!is.null(attr(rval, "frequency"))) class(rval) <- c("zooreg", class(rval)) + + return(rval) +} + +"$.zoo" <- function(object, x) { + if(length(dim(object)) != 2) stop("not possible for univariate zoo series") + if(is.null(colnames(object))) stop("only possible for zoo series with column names") + wi <- pmatch(x, colnames(object)) + if(is.na(wi)) NULL else object[, wi] +} + +"$<-.zoo" <- function(object, x, value) { + if(length(dim(object)) != 2) stop("not possible for univariate zoo series") + if(is.null(colnames(object))) stop("only possible for zoo series with column names") + wi <- match(x, colnames(object)) + if(is.na(wi)) { + object <- cbind(object, value) + colnames(object)[NCOL(object)] <- x + } else { + if(is.null(value)) { + object <- object[, -wi, drop=FALSE] + } else { + object[, wi] <- value + } + } + object +} + +head.zoo <- function(x, n = 6, ...) { + stopifnot(length(n) == 1L) + xlen <- NROW(x) + n <- if (n < 0L) + max(NROW(x) + n, 0L) + else min(n, xlen) + if (length(dim(x)) == 0) x[seq_len(n)] + else x[seq_len(n),, drop = FALSE] +} + +tail.zoo <- function(x, n = 6, ...) { + stopifnot(length(n) == 1L) + xlen <- NROW(x) + n <- if (n < 0L) + max(xlen + n, 0L) + else min(n, xlen) + if (length(dim(x)) == 0) x[seq.int(to = xlen, length.out = n)] + else x[seq.int(to = xlen, length.out = n),, drop = FALSE] +} + +range.zoo <- function(..., na.rm = FALSE) + range(sapply(list(...), coredata), na.rm = na.rm) + + +scale.zoo <- function (x, center = TRUE, scale = TRUE) { + x[] <- xs <- scale(coredata(x), center = center, scale = scale) + attributes(x) <- c(attributes(x), attributes(xs)) + x +} + +with.zoo <- function(data, expr, ...) { + stopifnot(length(dim(data)) == 2) + eval(substitute(expr), as.list(data), enclos = parent.frame()) +} + +xtfrm.zoo <- function(x) coredata(x) + +subset.zoo <- function (x, subset, select, drop = FALSE, ...) +{ + if (missing(select)) + vars <- TRUE + else { + nl <- as.list(1:ncol(x)) + names(nl) <- colnames(x) + vars <- eval(substitute(select), nl, parent.frame()) + } + if (missing(subset)) { + subset <- rep(TRUE, NROW(x)) + } else { + e <- substitute(subset) + if("time" %in% colnames(x)) { + xdf <- as.data.frame(x) + subset <- eval(e, xdf, parent.frame()) + xdf$time <- time(x) + subset2 <- eval(e, xdf, parent.frame()) + if(!identical(subset, subset2)) + warning("'time' is a column in 'x' (not the time index)") + } else { + subset <- eval(e, cbind(as.data.frame(x), time = time(x)), parent.frame()) + } + if (!is.logical(subset)) stop("'subset' must be logical") + } + x[subset & !is.na(subset), vars, drop = drop] +} + +names.zoo <- function(x) { + cx <- coredata(x) + if(is.matrix(cx)) colnames(cx) else names(cx) +} + +"names<-.zoo" <- function(x, value) { + if(is.matrix(coredata(x))) { + colnames(x) <- value + } else { + names(coredata(x)) <- value + } + x +} + +rev.zoo <- function(x) { + zoo(coredata(x), time(x)[rev(ORDER(time(x)))]) +} + + diff --git a/R/zooreg.R b/R/zooreg.R new file mode 100644 index 0000000..77b8b4b --- /dev/null +++ b/R/zooreg.R @@ -0,0 +1,75 @@ +zooreg <- function(data, start = 1, end = numeric(), frequency = 1, + deltat = 1, ts.eps = getOption("ts.eps"), order.by = NULL) +{ + ## choose frequency/deltat + if (missing(frequency)) frequency <- 1/deltat + else if(missing(deltat)) deltat <- 1/frequency + if (frequency > 1 && abs(frequency - round(frequency)) < ts.eps) + frequency <- round(frequency) + + ## check data and choose default + if (missing(data) || is.null(data)) data <- NA + if(!(is.vector(data) || is.factor(data) || is.matrix(data) || is.data.frame(data))) + stop(paste(dQuote("data"), ": attempt to define illegal zoo object")) + if(is.matrix(data) || is.data.frame(data)) data <- as.matrix(data) + + ## if no index (i.e., order.by) is specified: behave as ts() + ## else: behave as zoo() + if (is.null(order.by)) { + if(!any(c(is.vector(data), is.factor(data), is.matrix(data), is.data.frame(data)))) + stop(paste(dQuote("data"), ": attempt to define illegal zoo object")) + ndata <- NROW(data) + + ## convenience function + numORint <- function(x) identical(class(x), "numeric") | identical(class(x), "integer") + + ## choose start/end + if (length(start) > 1) start <- start[1] + (start[2] - 1)/frequency + if (length(end) > 1) end <- end[1] + (end[2] - 1)/frequency + if (missing(end)) { + ostart <- start + oend <- NULL + start <- as.numeric(start) + end <- start + (ndata - 1)/frequency + } else if(missing(start)) { + ostart <- NULL + oend <- end + end <- as.numeric(end) + start <- end - (ndata - 1)/frequency + } else{ + ostart <- start + oend <- NULL + start <- as.numeric(start) + end <- as.numeric(end) + } + if (start > end) stop("start cannot be after end") + + ## check whether lengths of data and index match + order.by <- seq(start, end, by = deltat) + if(identical(all.equal(start*frequency, round(start*frequency)), TRUE)) { + order.by <- floor(frequency*order.by + .0001)/frequency + } + + ## support also non-numeric indexes + if(!is.null(ostart) && !numORint(ostart)) + order.by <- ostart + (order.by - start) + if(!is.null(oend) && !numORint(oend)) + order.by <- oend + (order.by - end) + + nobs <- length(order.by) + ## nobs <- floor((end - start) * frequency + 1.01) + if (nobs != ndata) { + if(is.vector(data)) data <- rep(data, length.out = nobs) + else if(is.factor(data)) data <- factor(rep(as.character(data), length.out = nobs), labels = levels(data)) + else if(is.matrix(data) || is.data.frame(data)) data <- data[rep(1:ndata, length.out = nobs), , drop = FALSE] + } + + attr(data, "oclass") <- attr(data, "class") + attr(data, "index") <- order.by + attr(data, "frequency") <- frequency + class(data) <- c("zooreg", "zoo") + return(data) + } else { + return(zoo(data, order.by, frequency)) + } +} diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..f5514d3 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,13 @@ +.onLoad <- function(libname, pkgname) { + assignInNamespace("as.Date.numeric", function (x, origin, ...) { + if (missing(origin)) origin <- "1970-01-01" + as.Date(origin, ...) + x + }, ns = "base") +} + +.onUnload <- function(libpath) { + assignInNamespace("as.Date.numeric", function (x, origin, ...) { + if (missing(origin)) stop("'origin' must be supplied") + as.Date(origin, ...) + x + }, ns = "base") +} diff --git a/THANKS b/THANKS new file mode 100644 index 0000000..0b3261f --- /dev/null +++ b/THANKS @@ -0,0 +1,16 @@ +The authors would like to thank the following people for ideas, +testing and feedback regarding zoo: + Whit Armstrong + Matthieu Cormec + Spencer Graves + Sundar Dorai-Raj + Dirk Eddelbuettel + Christian Gunning + Kurt Hornik + Roger Koenker + Thomas McCallum + Murali.MENON@fortisinvestments.com + Deepayan Sarkar + Enrico Schumann + Ajay Shah + Jarek Tuszynski diff --git a/WISHLIST b/WISHLIST new file mode 100644 index 0000000..8ce7160 --- /dev/null +++ b/WISHLIST @@ -0,0 +1,133 @@ +FEATURES +******** + + o rbind.zoo() currently ignores the column names (if any), + should behave like rbind.data.frame() in this case. + + o design: re-think shared design of parameter and panel + functions for plotting. + + o bugs: rollmax, rollmedian give Error for k=1. + + o zoo methods for dbReadTable and dbWriteTable to facilitate + using zoo objects with DBI + + o register S3 methods and use namespaces so that this works: + f <- local(function(x) zoo::index(x), baseenv()) + + o provide a [<-.zoo method that is fully consistent with [.zoo + so that the following works: + a <- zoo(matrix(1:10,5,2), 2001:2005) + a[I(2003), 2] <- NA + (Note: as in window<-.zoo) + + o preserve attributes in [.zoo and possibly certain other + zoo methods + + o allow plot.zoo to accept a list of zoo objects -- this would + be particularly useful in the case of line plots of multiple series + with different time bases since NAs are introduced by merging + and they can cause the drawn lines to be undesirably broken. + (Current workaround is to use na.approx.) + + o more graphical facilities, e.g., a pairs function, make + plot.zoo(x, y) work with multivariate series (plotting every + combination of plot(x[,i], y[,j])) + + o incorporate runmean in package caMassClass + + o allow log to be specified per plot in plot.zoo + + o performance enhancement when using arithmetic on zoo objects. Check + if they have same index first. + + o speedup for indexing strictly regular series. Test with is.regular first. + set.seed(1) + + x <- ts(rnorm(5000)) + xz <- as.zoo(x) + system.time({ ################################ + for(i in 1:5000) if (is.regular(x)) + x[(i - tsp(x)[1])*frequency(x) + 1] <- 0 + else + window(xz, start = i, end = i) <- 0 + }, + gc = TRUE) + system.time( for (i in 1:5000) xz[I(i)] <- 0, gc = TRUE ) + system.time( for (i in 1:5000) window(xz, start=i, end=i) <- 0, + gc = TRUE + + o zoo() + - support zoo data.frame objects (and zoo list objects) + - fully support zoo factor objects [limited support already + available] + - idea: new class "Zoo" that is not a matrix plus attribute + but a list with slots "coredata", "index" and "frequency". + + o merge() + - names not processed correctly when retclass = "list" + + o misc functions + - interface to additional statistical routines such as the ones + referenced in: + http://CRAN.R-project.org/doc/contrib/Ricci-refcard-ts.pdf + [Z: with as.ts.zoo() most of the functions work directly + by coercing the first argument to "ts"] + + o QA: regression test suite + + o make.par.list. names, other than correspondence names, are + not allowed on x. Perhaps this should be allowed if m = 1 + or perhaps it should be allowed if x is not a list and + correspondence names only allowed for lists. + + o rollapply.default + + o as of lattice 0.12-14 lattice:::updateList could be replaced with + modifyList + + + o read.zoo. The following situations have all appeared on r-help: + - the index is of the form yyyy-mm-dd hh:mm:ss at the beginning of each + line but sep is whitespace. To handle this read.zoo would have to + figure out special cases in which there is whitespace in the + format and use two columsn rather than one. I think it would be + good enough if it only handled a single whitespace. + - header does not have a component corresponding to the index. It + would be nice if read.zoo could automatically figure out that situation + and handle it. + - the date format is yyyy.mm . In that case it would be convenient + if it were possible to specify: + read.zoo(..., FUN = as.yearmon, format = "%Y.%m") + and, in general, if format were passed to FUN if both are specified. + + o identify.zoo + + o allow index.column in read.zoo to be a vector in which case it + pastes them together so that 9999-99-99 99:99:99 99 99 99 + can be read directly as dates and times. + + o add class= arg to as.zoo.ts + + o cut/seq/floor/ceiling/round/trunc on yearmon/yearqtr objects + + +INTERFACES +********** + + o provide fCalendar interface routine to the Rmetrics projects + + + +DOCUMENTATION & COMMUNICATION +***************************** + + o R news article based on the vignette + + o some data to include with zoo + + o more examples for the help files + + o as of R 2.6.0 the example in aggregate.zoo.Rd that uses + duplicates(..., fromLast=) could be taken out of the \dontrun{} + diff --git a/demo/00Index b/demo/00Index new file mode 100644 index 0000000..42045b3 --- /dev/null +++ b/demo/00Index @@ -0,0 +1 @@ +zoo-overplot Plot time series in black with certain regions in red. diff --git a/demo/zoo-overplot.R b/demo/zoo-overplot.R new file mode 100644 index 0000000..25a63f4 --- /dev/null +++ b/demo/zoo-overplot.R @@ -0,0 +1,333 @@ + +# From: +# http://www.nabble.com/Re%3A-mark-areas-on-time-series-plot-p23112841.html + +Lines <- '"Time","IEMP (rand/US$) Index","Distress" +01/08/81,-0.02,0 +01/09/81,0.08,0 +01/10/81,-0.09,0 +01/11/81,0.05,0 +01/12/81,0.11,0 +01/01/82,0.05,0 +01/02/82,-0.04,0 +01/03/82,0.07,0 +01/04/82,0.07,0 +01/05/82,0,0 +01/06/82,0.06,0 +01/07/82,-0.02,0 +01/08/82,0.07,0 +01/09/82,-0.11,0 +01/10/82,0.04,0 +01/11/82,-0.36,0 +01/12/82,-0.01,0 +01/01/83,-0.21,0 +01/02/83,-0.16,1 +01/03/83,0.19,1 +01/04/83,-0.06,1 +01/05/83,0.06,1 +01/06/83,0.13,1 +01/07/83,-0.01,1 +01/08/83,0,1 +01/09/83,-0.01,1 +01/10/83,0.06,1 +01/11/83,0.09,1 +01/12/83,0.04,1 +01/01/84,0.02,1 +01/02/84,-0.01,1 +01/03/84,0.03,1 +01/04/84,0.03,1 +01/05/84,0,1 +01/06/84,0.03,1 +01/07/84,0.13,1 +01/08/84,0.18,1 +01/09/84,0.07,1 +01/10/84,0.12,1 +01/11/84,-0.16,1 +01/12/84,0.13,1 +01/01/85,-0.06,1 +01/02/85,-0.07,1 +01/03/85,0.04,1 +01/04/85,-0.12,1 +01/05/85,-0.01,1 +01/06/85,-0.17,1 +01/07/85,0.09,1 +01/08/85,0.08,1 +01/09/85,0.08,1 +01/10/85,-0.07,1 +01/11/85,-0.01,1 +01/12/85,-0.01,1 +01/01/86,-0.26,1 +01/02/86,-0.11,1 +01/03/86,0.02,1 +01/04/86,0.01,1 +01/05/86,0.04,1 +01/06/86,0.12,1 +01/07/86,-0.05,0 +01/08/86,-0.08,0 +01/09/86,-0.17,0 +01/10/86,-0.06,0 +01/11/86,0,0 +01/12/86,0.02,0 +01/01/87,-0.16,0 +01/02/87,-0.05,0 +01/03/87,-0.04,0 +01/04/87,0.01,0 +01/05/87,0.03,0 +01/06/87,0.01,0 +01/07/87,0,0 +01/08/87,0.02,0 +01/09/87,0,0 +01/10/87,-0.02,0 +01/11/87,0.02,0 +01/12/87,0.01,0 +01/01/88,0.02,0 +01/02/88,0.09,0 +01/03/88,0.09,0 +01/04/88,0.04,0 +01/05/88,0.09,0 +01/06/88,-0.05,0 +01/07/88,0.11,0 +01/08/88,0.08,0 +01/09/88,-0.04,0 +01/10/88,0.08,0 +01/11/88,0.01,0 +01/12/88,-0.02,0 +01/01/89,0,0 +01/02/89,0.07,0 +01/03/89,0.06,0 +01/04/89,0.03,0 +01/05/89,0.09,0 +01/06/89,0.02,0 +01/07/89,-0.04,0 +01/08/89,-0.01,0 +01/09/89,0.01,0 +01/10/89,-0.01,0 +01/11/89,-0.03,0 +01/12/89,-0.02,0 +01/01/90,-0.02,0 +01/02/90,0,0 +01/03/90,0.01,0 +01/04/90,0.04,0 +01/05/90,-0.01,0 +01/06/90,0.01,0 +01/07/90,-0.02,0 +01/08/90,-0.05,0 +01/09/90,0,0 +01/10/90,-0.01,0 +01/11/90,-0.03,0 +01/12/90,0.02,0 +01/01/91,-0.01,0 +01/02/91,-0.03,0 +01/03/91,0.04,0 +01/04/91,0.05,0 +01/05/91,0.01,0 +01/06/91,0.04,0 +01/07/91,0.01,0 +01/08/91,-0.02,0 +01/09/91,-0.02,0 +01/10/91,-0.02,0 +01/11/91,-0.04,0 +01/12/91,0.02,0 +01/01/92,-0.05,0 +01/02/92,-0.01,0 +01/03/92,0.01,0 +01/04/92,-0.04,0 +01/05/92,-0.08,0 +01/06/92,0,0 +01/07/92,-0.08,0 +01/08/92,-0.08,0 +01/09/92,0.04,0 +01/10/92,0.02,0 +01/11/92,0.04,0 +01/12/92,0.06,0 +01/01/93,0,0 +01/02/93,0,0 +01/03/93,0.04,0 +01/04/93,-0.05,0 +01/05/93,0.08,0 +01/06/93,0.04,0 +01/07/93,0.05,0 +01/08/93,0,0 +01/09/93,0,0 +01/10/93,-0.09,0 +01/11/93,-0.03,0 +01/12/93,-0.09,0 +01/01/94,0.01,0 +01/02/94,0.02,0 +01/03/94,0.05,0 +01/04/94,0.07,0 +01/05/94,0.07,0 +01/06/94,-0.01,0 +01/07/94,-0.03,0 +01/08/94,-0.08,0 +01/09/94,0.06,0 +01/10/94,-0.03,0 +01/11/94,0.01,0 +01/12/94,0,0 +01/01/95,-0.01,0 +01/02/95,0.02,0 +01/03/95,0,0 +01/04/95,0.07,0 +01/05/95,-0.03,0 +01/06/95,0.02,0 +01/07/95,-0.01,0 +01/08/95,0,0 +01/09/95,0.01,0 +01/10/95,-0.02,0 +01/11/95,-0.03,0 +01/12/95,0,0 +01/01/96,-0.01,0 +01/02/96,0.05,1 +01/03/96,0.08,1 +01/04/96,0.16,1 +01/05/96,0.1,1 +01/06/96,-0.07,1 +01/07/96,0.03,1 +01/08/96,0.06,1 +01/09/96,-0.05,1 +01/10/96,0.01,1 +01/11/96,0.03,0 +01/12/96,0.04,0 +01/01/97,-0.07,0 +01/02/97,-0.06,0 +01/03/97,-0.02,0 +01/04/97,-0.02,0 +01/05/97,-0.1,0 +01/06/97,-0.01,0 +01/07/97,0,0 +01/08/97,-0.01,0 +01/09/97,-0.01,0 +01/10/97,-0.01,0 +01/11/97,0.04,0 +01/12/97,0.01,0 +01/01/98,-0.01,0 +01/02/98,-0.05,0 +01/03/98,-0.04,0 +01/04/98,0.01,0 +01/05/98,0.1,1 +01/06/98,0.2,1 +01/07/98,0.25,1 +01/08/98,0.1,1 +01/09/98,-0.08,0 +01/10/98,-0.11,0 +01/11/98,-0.07,0 +01/12/98,0.01,0 +01/01/99,-0.02,0 +01/02/99,-0.02,0 +01/03/99,-0.02,0 +01/04/99,-0.07,0 +01/05/99,0.03,0 +01/06/99,-0.06,0 +01/07/99,-0.07,0 +01/08/99,0,0 +01/09/99,-0.06,0 +01/10/99,-0.02,0 +01/11/99,0,0 +01/12/99,0,0 +01/01/00,-0.07,0 +01/02/00,0.03,0 +01/03/00,0.02,0 +01/04/00,0.04,0 +01/05/00,0.09,0 +01/06/00,-0.03,0 +01/07/00,-0.01,0 +01/08/00,0.01,0 +01/09/00,0.03,0 +01/10/00,0.04,0 +01/11/00,0.02,0 +01/12/00,0,0 +01/01/01,0,0 +01/02/01,0.01,0 +01/03/01,0.02,0 +01/04/01,0.03,0 +01/05/01,-0.02,0 +01/06/01,-0.04,1 +01/07/01,-0.01,1 +01/08/01,0.01,1 +01/09/01,-0.01,1 +01/10/01,0.06,1 +01/11/01,0.04,1 +01/12/01,0.21,1 +01/01/02,0.02,0 +01/02/02,-0.01,0 +01/03/02,0.07,0 +01/04/02,0.01,0 +01/05/02,-0.04,0 +01/06/02,-0.01,0 +01/07/02,-0.01,0 +01/08/02,0.07,0 +01/09/02,0.04,0 +01/10/02,-0.02,0 +01/11/02,-0.07,0 +01/12/02,-0.05,0 +01/01/03,-0.03,0 +01/02/03,-0.02,0 +01/03/03,-0.03,0 +01/04/03,-0.03,0 +01/05/03,-0.06,0 +01/06/03,-0.05,0 +01/07/03,-0.04,0 +01/08/03,-0.07,0 +01/09/03,-0.09,0 +01/10/03,-0.13,0 +01/11/03,-0.09,0 +01/12/03,0,0 +01/01/04,0.06,0 +01/02/04,-0.02,0 +01/03/04,-0.02,0 +01/04/04,-0.04,0 +01/05/04,0.04,0 +01/06/04,-0.05,0 +01/07/04,-0.05,0 +01/08/04,-0.02,0 +01/09/04,0.01,0 +01/10/04,-0.01,0 +01/11/04,-0.07,0 +01/12/04,-0.04,0 +01/01/05,0.02,0 +01/02/05,0,0 +01/03/05,-0.02,0 +01/04/05,-0.02,0 +01/05/05,0.01,0 +01/06/05,0.06,0 +01/07/05,-0.01,0 +01/08/05,-0.04,0 +01/09/05,-0.01,0 +01/10/05,0.03,0 +01/11/05,0.02,0 +01/12/05,-0.06,0 +01/01/06,-0.06,0 +01/02/06,-0.01,0 +01/03/06,0.02,0 +01/04/06,-0.02,0 +01/05/06,0.04,0 +01/06/06,0.13,0 +01/07/06,0.07,0 +01/08/06,-0.02,0 +01/09/06,0.08,0 +01/10/06,0.06,0 +01/11/06,-0.05,0 +01/12/06,-0.01,0 +01/01/07,0.05,0 +01/02/07,-0.04,0 +01/03/07,0.01,0 +01/04/07,-0.02,0 +01/05/07,0.01,0 +01/06/07,0.06,0 +01/07/07,-0.05,0 +01/08/07,0.07,0 +01/09/07,0,0 +01/10/07,-0.01,0 +01/11/07,0.02,0 +01/12/07,0.02,0 +01/01/08,0,0 +01/02/08,0.08,0' + +library(zoo) +z <- read.zoo(textConnection(Lines), format = "%d/%m/%y", sep = ",", +header = TRUE, col.names = c("", "IEMP", "Distress")) + +plot(cbind(z$IEMP, ifelse(z$Distress, z, NA)), col = 1:2, screen = 1, +ylab = "IEMP") +legend("bottomright", c("Normal", "Distress"), lty = 1, col = 1:2) + diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000..a331e49 --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,19 @@ +citHeader("To cite zoo in publications use:") + +citEntry(entry="Article", + title = "zoo: S3 Infrastructure for Regular and Irregular Time Series", + author = personList(as.person("Achim Zeileis"), + as.person("Gabor Grothendieck")), + journal = "Journal of Statistical Software", + year = "2005", + volume = "14", + number = "6", + pages = "1--27", + url = "http://www.jstatsoft.org/v14/i06/", + + textVersion = + paste("Achim Zeileis and Gabor Grothendieck (2005).", + "zoo: S3 Infrastructure for Regular and Irregular Time Series.", + "Journal of Statistical Software, 14(6), 1-27.", + "URL http://www.jstatsoft.org/v14/i06/") +) diff --git a/inst/doc/MSFT.rda b/inst/doc/MSFT.rda new file mode 100644 index 0000000000000000000000000000000000000000..ed7194a408d2d630eeea48e409b82e11484166fe GIT binary patch literal 10850 zcmW-Hc~}yN^M1FLC6$?#C|%}us9RRz1(lUsmTvh`b5p6T+}2F+Mg%esJW?wwYeT7A zGxOFI4+IqzO@qnD;6ciAV8@~O1^Y=W@yw5Yw%)Il?fU?#u`~S8wwZQmsxPJiO zC8Fn#wa<55KegfLgNcxnr|C`_QTLZ321Z;Lw=yLC)yuY&Wu{MmZ(qKW`+S37nb(`A z=~vU&J)u21kd*moxAm~u@oP>{jkz$#^w$KQ^x z95cxL{H)dy%n0&&jo1ZD@Ael1WWEHB%$S27_e&(t*GgDRSCyidq3F?WMjk@woq}HE z%UpTQhp1vEU4M+N-cT4q2>W6v)Umz0>q*4hu#E&;*$HXP59ONXLE?gzN7c-#An5lD zq3%)GXvAwAWBTtz>_%|}svCVMF}9znjY=e|-?f#@auV-IT)w(Py=gN}!@ljgPYFVQ zXAR0BIt6eJgtm&BP6jmC^;&4d3b#IIlpmNk^knC|?hYd>8d?n)7h$398PAYWX~%AM zp+=26+$T-a#D>2c^lj2P(H&h3Y9LU98ifz&**3g1hb4WY#%)yMPGD)o_H}wgAXaR3 zzLrB-K&tep_dKgF8Usfuaj4rZak5B&5V_GiAn~jq)H8ZogmerhwpHwPyhF8F3B|!! z{$n$Z4=IKgNunXUnsr0o!86S161B|yi?o6*f}?>QGK!hNg_K}W-CHY+n{htLf3n9zur3U$cpUjM!dx}l`VZDJ57AImv=0OQm-G!DBT;@nFpH_3TGRp4Hmp4+)ridvc@SeST3=+YsRPz;^|jZ^4YxPTg# ztd|py>hIFJbRKp3UQJ>_&VX~(?E_>!pgdOLv^Tq$%8_xi;MXa%k8R zF>d~uRl7+K&6e7=j87r>=_OOL}pMtR1GJ z=zS8oG&L+{QRj0i$7m9{i**FmIyIt-xG(S@#vXV?j9H`hqJ__%A2tA#%5@?%h|PZB zwiB}jiafrwTM%d{G_a2^ka`G zLKiloGU}E`=(aAd)y+w4#(7FrJHq8#!B!>f2D8Nj_p8L?5NHrDN*kUP{0U~V819{` zxyGF+@4_}vth6Xk*Y9Kqq!MKm?X+dM9^<6v$^>1Z+{lLR;7T)(o1kI9I&G8;@A(Qq zxh@stu5y|q#oP=H$4ZKHtaXBPRz35Ehj@MTM}t|5t~NgKPbxbt{#`d@kZqzVD*!ho zQ8q>vDM?K$D9HRg=t&RlNx#iRzw#E$$+6&kEO7E&$9?~H!>yrB!vU;qOv(!9t?lGH zQ!cLvG5(B4G*jz@BK|*WUBtHu6&5>+o74{bAKYpLY-N{WnT#aTo$PeHVqvDZB+YF^Z#}IFH##VkLW;! zY42pP%PhFbzJZ`wBN^*4=vV9$q6EKIgrRi+VZICW*|9YAe}Et3@-Dz3uWo-hoGKF(fu4lpzdy9rGM^5&DFP#PO-K& z;@|KjDl3=JA92=8Z`~6k^^k)9OSx~23_Q>JvqnGbB#r-5p1$7Tf0Lb=e~ND^a9^&A z61?2YM7|M6V}CGAgw}S+Rsr*Z%U<}u9@|gmuWF)W?F2sh;zlyRM?7nN1M9SOI3{vP?k&XRzfplh3Pm5@!$pO&)^%K9GLFA;w{w8L&4==X8+taR-V0YT_gUusLTWzJbazKvzr(9UhM_^ z)1CHjWBEC{MJRS-!nGo7OuA3qbiVX8D3j({F$){v-*KSy{}qb0Rb7p8(G=0cgpK>} z!~R)pdCKBA&M6d~{5rMRCppj`Mk5#53=ul#uB4(XAq~4J0qFG$k*Kie9Dbg9B?Vt8_ zHN3_}J-oM+R!w$7%s+}@K!8;qbSa?jHMRN9P7ghXgGRKt6tNtr4A>vKsB>c{;zXl( zb^i*Nnl`L;`Cg};L{nq#tWI)2mti~^?$wIcYY-}Y=&8zSS4x|eZF-eCXf&VN+n7R% zZHJgg02W*gyJXJtawmP3?q>oYl%>u?U`g2JZstiQquhjHj&f$TYTzLWfpBE(HOh*k z@#aGei$1BjY_&0|a}gCJ=1CQwaL)NG)v zg{Md71b!K105Lxsl}-QlitqVU);g(#d&u;AUclN$-Gjh9kNr?{qHG-o2+8I-s+@~$ zgx4N}tUWp)c?u9FxbY0*#R%IP$=jmdPfzqz)~8@j7s!e&kw&4MLdL9=RjU2UWh0*k_}AVDw|HP3QA<+KXI%Py%AuL&4}zdt)8Ner}3e^&3T?YL{Nuo#$r%pj+KpK{y*V&~GhtrJ%vH$VEX;voW**;A4rfn{H3EDez0N!A{CQ5cBLA@)CiO-pAiUso!`1 zuPt$-43O&>`EarMV5-mJ0r}!`)MGB?ifH0#BYbAk>HlF>Ue6%gWhB2~>EGZ~=GwZ& zgR1-wZWdE(nl3zUNzooeMvQswlkC3HdcrGmdctmt_I);rm1ektpHbsdx$C=(pqBz? z1ez7i_SME&_h9T=m9Dcw3O@GQG?e}-6yqd)#SN!XggWC%)Z2Kk1d;Oj>d2a1RRM`F z zJeBh$=O!S}mWJW_*YFbz+Zit4|5myDjQ}8OE20L-muMlNev`gRXHA`}w{%y6SXqSt z#vZzX_MAm|F5a5yi8*Mlu*L~k*K6(NvKY>h~9a&e${{dLM2(8&1af$YXy}&wr7Ib9>=RlaU zSTGjMJ$1Ec{Wr%4zaC^tm*xwG7QWFF%LlZXT6<*Y!XJUT_t2d#4Uks;DnwKE0BUh& z66+}%ehNmdgY^T*yMjZnZV|skpC(M2k0Ua#odHN!LmSpd_pWEb?r24WO_?Dav6+&V z>FgMPddMj#!FR+4UKy~`sy2$gJJo-#Ixb8bpQ}~yI~C)}-U7nbLQ{S8mu99H{_jTL zr6F9D2emym2SO|_OQv*G#EPoi4De=&q9zzU#Q_h#P?i*V*}GmeM*pniX-w~%ktFGq zkIDE?CSGUdLiJHd#74qK*>FS-qa@02h~dkqtY1O&BNZ{)&iKsZuJ9hva^H;m{vEprKV#}ogG!i+r0|Mayuo5m;_ ze_uHoX;seXc8a@e!nBXGqKnU=yvKZ#1`b=ItJ*jMVBHzEC%6B*llQT)Q`LC^rpo8_ zopTj?39%64`+-sqcl4(nT>gTstbXEiicNSmZ|=NQS!)Wph_Q0I76J+i+$k@9K_c>i zk!VQd;*WUX7-7}?CQ^AXf1{u)%Mx8Oe_g4@?O}fh(Cp;chlV}5Vi1u-tkoaz!ppBL zP6Y@YF|8g}2_<$v;wJtn_1PHu@K7q0>cf*$I8Q{v0Znq8TMyOD%TV%L`dX>=ig-?^mesTM7JpN@)d>g#n%gv+ls|nDDhWxg3 ztXI8isctWHzDMi=Uz)p}gZ|ds(4lwcK75goU|v;nM_BaLUC2Y~Hjoo9cu!(3u`+^s zh6e+Ny>t6Y=0K3DUWN;N%lI{JZ1rA{IHfEUJ@#{9=C_uMq|r8F8tVL)7T&`5U9^pj z|E(GGO)mHwPYMPXy=eZUPgT?^hVf!FYuu_zs|J_z^M?9q{6P@M{Gj$B{LhJ?y6+k8 z7dRtrnxU^$IFymymo=To4*#(7*hF00oR{vH{z_wirp%IaS{Qmp_ZeITe=!J3F)af& zZ6nufE#b##BjyQHobP97I}Ha&S1;*^u?u^Pk_G4Wq0-)ikjnQap;BYSl?sxi4DoBM z99(?+<3E_6i@av1OAwD4Cc1eR^FLj9AjEU_FEjQ1g>$SceDHRw6Rur1WKz!F|3vZVnz{0X z@ZynaVWWBz6gJhfL;8mM^{H&zc-0!l>};~6Y_1ar?HLvtf%TI@h@WoYQP>hQ ze(CIz5!A0PnCj3i>3%H$5ru2q$R*gmwOJWC|>d}&$WZ4G2MB^}omr&OgQ(+z;5u`KBWWqo92%8Di zb147jjpS>8;}>UBjkn5X8O+B{t zgyv8Ve=wh(EJKp)t}odcT$h5y%f*w6b=A@|;xA6f2b$u?7LkI#mFGE&;F4twXG>fw z{*+;d5HBTMeodL$aG{yB>k}@O*(y*(H@YnrKL$Su%mIB(Is#q`apm0M( zf{kpA3dFz_s6JJ$mj9Ouf7DU$#LwuqcPoifIi8sT&wDGKIA$qTW*GibeCtVY_r7Gi z{)p&U34NU^lQR`f*T2kWd((FNuS>|^WWNs7rIJS%bZkD2f&F(;L4`C|i; z72K6-&V+Y3o|FH$&N^W?aPn8FY{2~|^IK%lGu(hCh^r6B9Rf=vr={{co-+sZZp)#M z?|lz-1}UpoAx(2SB}Wl~10Nzf26jcH3E}WdwSWeDK}ft!D7FDI32u6&5I9(2a~9hP z#husEjNNwTGqxs_h-mN~6T?0>Ru@xUx(c`7H&u0OpIN+Sz2iT! zEyUWYdp|Rbh;L~pRF66SsrE4o`tXImt>g%vcSFWCqNV1p><#~?ax@%%#m?%2@(+&b zL$@Q^ec=95Qng`KtAp!SjTewqJbyz_n8ca7ZSR%E7aMC;Tr2H=B1bJ;8ui^_GKEj0 z{Nj@*p;V2JQH|UMyjR3a2W-_FWA1DLEk>4 zv<9txzW6Lkv$g4%b||?(cLV!k;{04Fr;G>IBZ9S=@DB$TmSNCp*VsRm;ck>OCNI47 z*D-%YZ$_uqA+H32Hu#@GUtfsA+xh523|qz>rQB0o)fvQd?PC!+&)mXm8!3e&*=i3~ zwQ!HXaUp>{Dp7|NYur^aVlytQjqhpS{pFj?3E2jOe%b{=@TrFF_bro1HKB+R zU+9$M?)Bp9X6=oJ{{=?vqZ^HTp8sY;4LTZ;a19U0biA^->#X6*;=XL&s&1(u8D5@7 z7>^uYN4Raj5q8i;B(b*+eggenJ9{S)Y*_-{)be5vw85Je@m}Em5#{q2LGsuu=(FVc z*O&uijS^Y_-p-Q+u#25+(SC|zhpy9YtU8!jJ;@)>f$o7_>u_vQBozb{E+gI(?z19# z(=c|uVUMgve5ic=zsYguFt(L#c0bew;L#;({9(-9b%r>}PnU`9Q5bqbyjw}-Z@@5Q zfU>+T%NY$0PwaIyTi6Y}C+uwRNNV`%tGnF(M2*gP+;UuV1b8?$M{%(`hA#v1QI>q^ ztZdLZ@=&04<7K(3f2Veh@>0Itu>Ui~{~nd`l;^1-4U8%64*Wf;+R5-bCwbmh80KVj zzt3a+ECzKxn1FZGS*n>BoHNo=;fG`&2?r9FS2xW zjwYRVO)FVOd=vF)3pCFq`Yr6G9CzTW5%oM+{&8Uie9Z`|K>RI^E@oW9`1Ju!8Fr$0 z+-qN3rindkz>AR$BZe7~S~gz}`>-xxNN56*^7)M@KD)#)uRM)|{*#=-!1Z%zPH zSt^g?f}hLz)qR~=Zi+n#>g$TTW0-%*kOCxxge)Y*F0ABi-^jF0v{UBD<9PfXVcLAT z>I}WVYHVI$+nA(hoRCNYyx9ww0Z0xnJ5;hTo8{kEb7hyXsI?8e|BCa5j7thT(F25tik>B{}lUjsr zJ~0!1!=3KJWAmWH7>4pzs~VHKWSwKRF1NR7FZy(y33j}TkxY~JRROSO=2;#CLFm86EvXQ{%`=#Fu3WwJHu2_Tdo;jP`UMPn z6Xll?!F7!7ZPz_QOM9;ULk~YFI1i=GB)(f2`CeaU7W0QW;B27ZO`0IfMX!@1TFMY+ z@wa)jimwW)w9x}``8@hP>9!9m^AHa)o~aZ6&aPV#eEjEbEW62OK0>w$aN9}aFm@>N zldN8;F9+BlmNL~JX`sDUy5H~Pq2g}wgOPZf9R$c+lj^r;?^w=l(yiufi zX7`OYvLuSbp=7fd+*ogJFrV1I!$a3cCaiNBIaMixW&do)t5cMJM(P8%@SoGsnNJhKkSiH| zR!^AujO=3$|kd}_UV1dS`{(rs5b)Mly! zVpc0JYQyE8(&jYvTmRSm{ukH;UE3TAVluJu0$lr?M{BFUb6lD%1?XbL2eg*R=GpSZ zVS)b+29*}mYOFngsMFr$45HR6{r(jH4>t4=DYM|}?fI>KG#gN#ywDhk`qC6kPQ{p3 zO$o4iEmchImlC76EGIoWHWXjzKp(n;CtQX4incTk&VZ*cgNAlU=O4*~1 zG{&X8?K$!tQgB#h)coEgyI3n*Aae%-8jdajno!Y=S{>K}-a#Aj7C|Z; z;rJMkFzi9+w7@OWG^gx05D?J@w*l3!=6C#WY=^N^V}c}pFWDb#OmE4PaWMmuxsI~6 zjFspyeeP4<7ydai7+J$fPRVy^WS4aF%!T5M!S}#t<`icdHy30HN%%y^7*UFxxg~fR zDOqiYY@AwW;tmd2yy;SCZftm5JdwIV{J^Tji(Cq+O^f=90>ds@qQV>fIRVwUG@25P zvy+TU9t?Wi8!O>qe6Z|uc5}#K03`ggqbPhukU;U$HboZ8{bPRjqop&E?|(6bS@A;E zd-JDJHkGD@;mf^P+PB)lCTU}65_T2)py8Namx^c!Q@=+6n+bc=VB|+h?fEs9FPW16 z<&bT9aGbyz#T`CADq1L82WlJ5jg346A#iSG5KSg@sl-<~rdH3KOXV%eRej1PaXNN4 z%n_J9f1vZ%j#$_{dL?={*4q-8GHS%BJx-7~d1;$ES+*JCa*8$oXhxBkn?I9>*=FZL zS0G4QOUyVtrjT?Uv;ljN^l9F+b56d9*|d0swB*B$Wx^*GJRiY!85#4*>2k3@z7N?T z`M_$m%*vCyYJUfo?PWIS-cnv2w|@vKL?0oQE?(2L?EA;ijacA+9T)XaW6;e#kj<3e z=&_o;pFzC@p?(`?aLzcJQj00t5&1@`|KRRD>c+WT57Q<7QsZa!&*Wkz>ai>}8Cs|H z#GFbT(7hWlsX|#mwyA2!ER(_>NquHiHO@vvxeyq>lpp2s>*zVzbwJ<8T{}4>c^iNS z4DukLT{Hgi8w&tjGalsk)0itp%c_r+z&5 zq?Zp3RIEHAgLYtz`7`4skFBJbJ`kCNz+V3x*G2nm-ed8_;0#VGR_cEj{AO4IYK@QE zV)VG`B^2GsK{Tn5*#ji#obm|AtJHiHJkEyC{+7ltbCVj|kQB=)6>QQxx{YE9Pl|_+h}2=*horot##vZy zo$p!_bIp)~bBX4ReY6G~b)BV}&;nuyXIvJW4XQV}E0;1ck$H$TpVd_kfo7BUe(Oj; z(XbYFiyJ5QeS@OCe^(C9Buefoo?VYvqfJ-WHR+Dkgi_rfTJDfghV8|l;$4qP(BG5Q z-y#c-ZK?vqfiT$H6WW`9zsZ7Eo9IK9F^Qh|>MYQRwbzeuE`nWLa0@@sH%x~c-bSXrdesOTf%)E zyg=5lob**|fsJV&Gwov)xW;f|ggB=EYcg%ii&_?Z8!>VSK8;*kOTDURO zdL}0sUgsbQ-w~Zbdlg{Fny9|b{$?bfo5#lwODa0e7L7lN-@*u1RdMC=V0eBs zqrB+6*B+}~{?Re$ic?Si9<1!J3XEWPGpsjMsof@3Ljr)*TfF#o{y1o1 zJc6qm%8zocd|=X3toB$MbWs~Q@d|;;)pkLR7h9^nvc(gI_8nKDq3Zsn2o5@jw1G2* zCPAgf6Jr^s0-0-pxb8Kd7mHn$__ra5<_+qsioEaqHEx^XXpoJn?Ih_II=Ga$F*lcK zTTW2By+ z!E6m~4LTstys}1N8AGd2wg_+s2t&&dlgkVChK|*3SCl4BNOAlF&4y66=Z2ii=>N4# zFX}dHCQw;1u)Sp&gqaY>Y<|Wy3$A*N*3X?ZNU|kU{#6#Qhzm?QR0MiYR$yjn>3Ihi z?z9-$XbVj9%?FK)=bb(n{yA$|8_iuYbyf}8qQMxeR6blpP&TC=mGYVTAdv8=^#I-dNrRbn|rAC&d`}bh|%+3eE$Mq-c4&)YoC#6A(UH8B_V zoJ|7vM7alEPB#8v85nyu(bjM!#5{~^S^{k!sWNk^P;7?+$I^#3JIedj0zZ1IrK}G& zR?Q#Ak<=d@K#?CHjmMY%ilP2+Vuz(0${DVzig|yq;>J0rq1N=hBJ-9t!Pt);gOv5! z&?L87%$J;k-${p5rSiMoSiY}TyN~I#3`s=qVJ<$8RfMt?8Lfmm3ewf&GIr=*j@zrv zpq)8Gy;-51We(lOSZ8-~C>^Ot?L1%}Nj_182|*tzAbnGl5ty6k$%j@S7~E)}zD%h`|h-7B)e3*QXlVa^QRlL zw>s4!8QHQ33korta4|#Z!Nw4dHL395l44+E=v3NXJIZG|vpTg3WFA>)L}4pFr&SPMrZyeqDS4 z?$BoABAyiXk|zjXFyN&h@V$e18yLG?_(~|X=w$v%(7Q_CB3382`%Y; z%t3En=!|ih@~VcAvp2UEQnM4wP7A&`<)i$Elj9U|#8pZ|uQudxb5T=p(2!$om|!MWJcyADk9>a&E2#EhJwAF_AX^By4S7mwPa9 z<|*m+%t(-sx!&!{Li3#M@SLDRUTn=KLh5>AX2%BV;va$cJvW@8yztWA#F(P?Lp~SY zq?PchGRN!qX8@DvnZaU_?lW(~MUM;<4(2JWTSXigU)W|jnf zQXprOJglk}Jwy4F#Z2Ln9_Uuc9fxVX5s#AsjnFqy%KdVLT{`Pp15_W3s~xE<<^ zn)YP|#&xyNz%b*8_^tq&;T2j-I$7$iSCKF1?=71Tx7;52!??0p+bn!(xb;Q$Js(Dc Xdb12n>1zFiVWn|y^o&LMvSt4VlXLyo literal 0 HcmV?d00001 diff --git a/inst/doc/demo1.txt b/inst/doc/demo1.txt new file mode 100644 index 0000000..aaa73bd --- /dev/null +++ b/inst/doc/demo1.txt @@ -0,0 +1,20 @@ +10 Feb 2005|43.78 +11 Feb 2005|43.79 +14 Feb 2005|43.72 +15 Feb 2005|43.76 +16 Feb 2005|43.82 +17 Feb 2005|43.74 +18 Feb 2005|43.84 +21 Feb 2005|43.82 +22 Feb 2005|43.72 +23 Feb 2005|43.72 +24 Feb 2005|43.70 +25 Feb 2005|43.69 +28 Feb 2005|43.64 +01 Mar 2005|43.72 +02 Mar 2005|43.70 +03 Mar 2005|43.65 +04 Mar 2005|43.71 +07 Mar 2005|43.69 +09 Mar 2005|43.67 +10 Mar 2005|43.58 diff --git a/inst/doc/demo2.txt b/inst/doc/demo2.txt new file mode 100644 index 0000000..0dd30f1 --- /dev/null +++ b/inst/doc/demo2.txt @@ -0,0 +1,20 @@ +Daily,10 Feb 2005,2063.35,4379.20 +Daily,11 Feb 2005,2082.05,4382.90 +Daily,14 Feb 2005,2098.25,4391.15 +Daily,15 Feb 2005,2089.95,4367.25 +Daily,17 Feb 2005,2061.90,4320.15 +Daily,18 Feb 2005,2055.55,4318.15 +Daily,21 Feb 2005,2043.20,4262.25 +Daily,22 Feb 2005,2058.40,4326.10 +Daily,23 Feb 2005,2057.10,4346.00 +Daily,24 Feb 2005,2055.30,4337.00 +Daily,25 Feb 2005,2060.90,4305.75 +Daily,28 Feb 2005,2103.25,4388.20 +Daily,01 Mar 2005,2084.40,4382.25 +Daily,02 Mar 2005,2093.25,4470.00 +Daily,03 Mar 2005,2128.85,4515.80 +Daily,04 Mar 2005,2148.15,4549.55 +Daily,07 Mar 2005,2160.10,4618.05 +Daily,08 Mar 2005,2168.95,4666.70 +Daily,09 Mar 2005,2160.80,4623.85 +Daily,10 Mar 2005,2167.40,4648.05 diff --git a/inst/doc/sunw.rda b/inst/doc/sunw.rda new file mode 100644 index 0000000000000000000000000000000000000000..65057bb4d7b2bfbd3960da8cbcea11efce46104a GIT binary patch literal 16694 zcmbuFd9+l;wTCZLRJcRmIf+qYqM6lb5{)LlY6TIIK|l}?L}o!o0YN})WpYFm5d=gK zQ9(ci5k!>12~-3XML-Y`2Lu#voko*5ysC4)Uv+X>`RBb}tJl8YId!Ub?Y(R7s?)b+ zgSKbYZCf`lFRx}^&6;_6HEO#*Yr8-4YUJgmj`J{RNWY2lZT`~i=oD_l?Rldk9xH%OQJyC<$l zSE&61{xdDyukd$U988z{;j%BL%NLam-*fSzbVdAF%X9_fmb;7YPPz=e%44<8PwRSl ze7jM)O#S>R{^Z6-p9(*l^9QCYnOCL8q5sNwIwz$o)t-529%blXhMr+OwUa&2uZ;Pt zeJSIVVy6=HESAJh#q?8*ekpI>Ia|}kv3bhUDeRE))+!s3PBEVp^9xLWDeRI$&lGkK z@(uslm@Yx@Qtp@Xd?|J*MK8rg3GGT4zXW}Yy*t<4oep~ApA>dWale@BYA-va&?ki- zQs_~H{fn?y5%&wRM?i*fGfpw~4)@VNMVwT(S4wtNT%d>Ip?W{XiW}@yOgzf&p?~y9X+DZG>4Uz( zZs=D?e?jtmk^HRt*td{=U6%2mbOCw=KVjd{4!;&L&)_e{FJON8_%$E9=QE#r*sCt> z>k&8gc&;AtTfn%Ao1mY@Mc**K=0zO;*SO(%=`Z^g5f6&z6!r;mj{Owh;W_jSaj1CE zdQseH-4G{X9Q+vKNO^>QLww5r*eS()L!2w_6d%|j#1D2(sUO9^##j8(Zy1+;RDVK# zlz!-2%sfk&cL`idzahU852fg#yjDhhB$r2|%UQqWv@gT1W%L^)_9$0fLZ49YXdmhY zek@1NP^aKB;xE)w^bd@k%dwm4pXy3Ec2)Zd+Ep;$a`KP#DW|^@=242Df;|{t^}2%l z<(en+33ZuyRA5hCub_P;>n7Y+d)8|O{tx!yTxA2ko@EB&Mg@et~b=B;@#UW$HGTvy!) zd5`%jU#c!EUl%ft@^AG#8}hZrAzy|5tLHKNqJ5F<8CdhxJjol{w}g669BBV0KdYVm z682>pS9un_LSDolVPC=e4f#>}a9!hS|CQ1_u~`HgiJ`~Zi275x{|97Z1%DB@MLZWIe%5&Mr|NJ%_Q_}5eEd+4xT=S~`SdTT_y~GPU+G6)3HukuQM`pX zQG7C9sB?@fyQnTphW#u024+2m`J6Otul%ccK<}{6R2*r2QYS(@ z%CGn>=&QWL^C5n)cQNw`@vZf)ahP8T^HAKD&|f$|pihbFHhwAQM#b>fEUMP|o~R7t}t~S@aHdLi-Es8}=Kzu6n|J%CV=; zxf-{E_F+8yEPd22?2qtUuoLke`q#W=FU?DON+0Z6E-Aaxf3PokR{IdyJM1sio_&g* zOVk*V*7>?zdTGAcBkW6s5`&Y_;uPZ@c$OmT-j!Z}y# zlIz9zJ>*~X59e~$b6CGTS3M6X52olp?AMuR=nuWLFE7Tw;k=IBO0atg{w=}3T8G8t z^T`JR_<4B>mK${-v+Z9U-6dyz+9mj-EQF7tn7wAEH;G@-;HF$6xAK=X~Y; zLe($q5bB}kC%a;o;6GS(ROj}PFBv!FWz|{rCn>whUdq$Dj^9EarJeLBCT@=!hwG}p zsym7&)u~`-;xE{Vbyk3Vb)GJw-vay^>`c5Buzq!3*7>`Dc-C{l{u)R95hwZhU3EO4 zcJ&y)E_tageyWR|>fy)m9P`RYO0V!>l=~To3Otl`nK%d5HC)^Lvo^qeOX^d6(kHQs%95Ovu}`FT?I3f3uEtP7C#q z{#1u_u2)@1!qL4SATITs-us4gIQoTsh3Xs6l`)R={jbmAKh;g?6Bs*&_a3qXel5ih zq5k5huuqYmnm6`RT@UAO)>ld7;sZM?9`sx(^U`@Yd1IS>1;!MA1=sd3a zuJuMkB26io!pO}Z93-z3M*ZE!V-Rt77@P3~4uJ`xqSL16Q z+81hm(o1m`_8s)Ec$5tLB-MBFg6g~WKVkn}&A+-I?2g{SzN(L^&ssOMQ~j16p}rD- zA#N2viW~K-{kGy!{VU(#5A`n@#!;T4o!)PSeFSkG@_^z~d4;&sc_F;#L$9OG@8})! z6ZX{ah^5NQ?E6&bL;d5r>SoCI=oRuj`A79HyuVhxBhQ8QtglcXi2Lx~SM?IV9d(|^ zj;epsPy2+hZ(tnh73w*5*6-fb;cCCl*Xq`*uT!MJef>}N-@32+{r*3GzCYGA>DRe$ z_d)KS|MA1O``&&10l@#(AOFPPd_ebp`nyrDp4aeqttS25FaL3qI`#YXAJn~C-*tNR z>(+f(^1lIj-=^1Jka4Z^((CJc;bkU~4ZLvNAd|?8yl~twlgNv`aC~tlk&V1?+$fXC z#>h)Oy6cz1P2i?*Gq@St9BvM`fLp*V;g)bK_;R>4+!}5Jw}IOt+i|@e+#bFX?f`dy zJHj2|PH-pqYWQlnGu#F43U`IO!QJ2*w9_lA4J*TUDrKE{0ezOauK z&;8*3@BnxqJP^JP9xTcAA@C6RdUz=8Ld$*9>xaQNz&F4n;1TdhcqDuyJPN)Ez6p+n z>puhE!u?y|(eP+^3_KPd2akit!{g!G;M?Ha;oIRm;JYNbJ^`KpPlPAJ_rUkSlaTju z{XTdyJQPl2bxQ{e~TY4CJ-Iy?iO0nbD}#Px^ZS@3N5VfbNq4m<~*3(tigg&&0< zgCB?I!Smqx@O*dyyZ~MZFN7DtPr{4g#qd+`Q}9xFDf~42G`tLc23`&?hgZNW;Fa)7 z_&NAFcoqDDB-dBNtKqfqT6i724t^1S34R%V8GZ$R1zr!Yhd00*;Md^S;Wywn;EnJ` zcoVz{-VASs--6$U-+|wOx4>KA_u%*7t?*X(eRvzZ9o`P_fOo(<;hpdN-Vg7G55NcDgYZH45c~!FCHy6P7(NVF!Bwz@Eu2Lj z;rbEyYxwJ!s~7*SeL4>s12WTho2> z-Pg^*@0@D+>!n2p82+(c&&FPeD&DidAtKTn)JJY}L&7kzT(H?wo{7n?u6 z`hwex&9+;*dF0rjpZ(5HWWTXHryTix@6U|2&s;S7wY5jfk6L~G=C(=`6}GAU<4HqI zR4}G#jq@fsyVO}#V~(?vzg^+d^_QBc?xRi47(K#7#ec5-dE+}xyFs zI?-4^`*WJ)So8k&S?9rF#_r#<__kTUHukROAO5Xddt;Nci?KIv-4Tud&e)AJNAElJ zNn_VPeQw)S7h}D86K*$lhd1nn#y*&VSjdGIsvi+v`nHf7W z4lH9A$ARPG$c0a?i=q+0|H2i;<Q#mD%bAIKfgD-OU~YYRW%%J?CjUpj4tVK ztRJ=0F}ZlV|GBBJ?sem3yn)Ykae2z%Ruk;e?OawFz0cV_PGc>MeSEF=tg*{Jc*T^J zxcL0Xao0Y3r?CwOxs{MLwoB8uznb^0v420?uRLR2qdKc<=48BlPB8ZRc%c}3j$ar> z#=1$nrEYBB4*y)R&E=Us(McztHZ&*6o0dFa+xkH3YV5Er-`Qsx8aw3FhHl9l>lV3N z0LG4J{L6FK9CYi`WrZ`2H`b@6!K;k*Y3bfMx#yNlb}QShQ%Rqm`$W0*^u$9hqa15& z9L^2g`tu9X#l81l_sPcY%6n^hWjnXd?^rM}f2otv_-~&*#aN#ocAwd z{VKhrrLl@f7j#!%VT|?5>VhgKYdyJqf66`Q6Y!13y48K;yI&X^r!(i@*gQWsw*A=g zlXklJk$-*qyYMArlXp~3UgRQStF!mV8%`+OXYBu6*#3*I?zwccM;>3>+E`ain$~dZ zTztvOtNvo#cyT!PFqV8A@|E(I@{8giPPZ=Z?~D~U)~_NrA^ZBj%9jl~U~KY^&e`n? zf5liAZ0Y40V_)oCnr=4N<-a%pjE%$C-wJZSa){je9$n%x>t(t4RGj*>_xioLIFvo&VTZW< z?_aJxlC!Jo!K2IS75(}-V-=TLhsyV#ctsvE_WgyvMNVpeFmF=5-Mii~c6nR~ja7g1 zyRG}?9OtL)aRBDzE+4=yUN)D`bE!EOpK%&+c}43XE^9rFCGXkf9jl4_@@Tu)M9ztB z;pFy9H~@9Xa0-C?5PJ`vY75&1ZB#ys!0ubSu@ zzYq&dg#V)0{beTd*)F}pM6ub=Gf`Zoo0*7p8M)QFWb)@G!p;$K9>v>;#wMZ;MlaXC zxqn_S6A{l5c8vTk=kz5eA`e9PGr|wi?%0qfVjmU7<^Kc|9r|be?>pRUvK2nzZ!_8C zU8%{EPqT5k=w!0&`?A!Btj~65j5gU8w>XdPFi7fnk@U)?4_^xm2a}-iR_@ym-d|X50gFf zZf^;bt^bF)&J`x>cQMVccl{>&uPpnGZ1PUpWXb1Q@Gc=F7sB=7`fvld0elgB5!?`N2wx0e3^#%s!I!|7 zz>VR?@TKsja1*!*+!SsKH-nqO&Ee+oW$M;i8@LU8 z1$+hE7H$i-gWJLF;r8&A@Re`}xC7h~?g(E6Uj^$l*a^Ox`&YxA;m&XuxC`7B?h3o3 zoBO2KcgrNwpSV4D&m^*k7mj;m64}!W$2~KNyv7U1*JKje%L~W7GKuW%h2!3tL|*HK z<7+dC?Bj*wKAA-J^}=!AOd|Vv;kaKWk^ac}UN|0@N#u22IKD2E z$U$B>9+XMsU@sgG&Lnb(7mkNy5_!EBj<3%oa;O)Mhh`Ev%nQfEGKsvw3&%HP5;@!p z$HOy;9N~rI5t&4e^uqDTOd@ae!tsrnM2_;pu}=Lr!8c`+>#=b6Gw{v+vg4cKTi{#Z z(eP+^3_J!N3y+1z!QT{`{2p&WcYsges~Hz1)d5|g&%+)fTzLJ;OX#mcm_NJeh_{T zo(a!{AA%o(XTh`J+3;-mVfbNq4m<~b1bzgb3(tigg&&0FI1YQa+g`b9>hL^$1;Ah}x;N|dgcm=!y zeinWfUJ0*+pM#%+SHY{`=i%q!7vLA*)$nR~4ZH?k3$KOO!Rz1`;TPeT;FsW+;g{i8 z;8);R;aB1H@OpRyya9d>= +library("zoo") +@ + +\mysection[1. I know that duplicate times are not allowed but my data has them. What do I do?]{1. I know that duplicate times are not allowed but my data has them. What do I do?} + +\pkg{zoo} objects should not normally contain duplicate times. +If you try to create such an object using +\pkg{zoo} or \code{read.zoo} then warnings will be issued but +the objects will be created. The user then has the opportunity +to fix them up -- typically by using \code{aggregate.zoo} +or \code{duplicated}. + +Merging is not well defined for duplicate series with duplicate +times and rather than give an undesired or unexpected result, +\code{merge.zoo} issues an error message if it encounters +such illegal objects. Since \code{merge.zoo} +is the workhorse behind many \pkg{zoo} functions, a significant +portion of \pkg{zoo} will not accept +duplicates among the times. Typically duplicates are eliminated by +(1)~averaging over them, (2)~taking the last among each run of duplicates +or (3)~interpolating the duplicates and deleting ones on the end that +cannot be interpolated. These three approaches are shown here +using the \code{aggregate.zoo} function. Another way to do this +is to use the \code{aggregate} argument of \code{read.zoo} which +will aggregate the zoo object read in by \code{read.zoo} all in one step. + +Note that in the example code below that \code{force} is the identity +function (i.e. it just returns its argument). It +is an \pkg{R} core function: + +A \code{"zoo"} series with duplicated indexes +<>= +z <- suppressWarnings(zoo(1:8, c(1, 2, 2, 2, 3, 4, 5, 5))) +z +@ +Fix it up by averaging duplicates: +<>= +aggregate(z, force, mean) +@ +Or, fix it up by taking last in each set of duplicates: +<>= +aggregate(z, force, tail, 1) +@ +Fix it up via interpolation of duplicate times +<>= +time(z) <- na.approx(ifelse(duplicated(time(z)), NA, time(z)), na.rm = FALSE) +@ +If there is a run of equal times at end they +wind up as \code{NA}s and we cannot have \code{NA} times. +<>= +z[!is.na(time(z))] +@ + +An alternative to aggregating the data is to make the times unique +by changing them slightly. The facilities here are limited to +time classes for +which addition by a number makes sense. See the \code{make.unique.approx} +and \code{make.unique.incr} functions which use interpolation or +incrementing by a fixed number. Interpolation has the further restriction +that the interpolated result must make sense. For example, it makes sense to +interpolate \code{"POSIXct"} variables but not \code{"Date"} variables since +the interpolation may fall between dates. +Also see the \code{make.unique} +argument to \code{read.zoo} which allows one to read in the data +and make it unique all in one operation. + +The \code{read.zoo} command has an \code{aggregate} argument that +supports arbitrary summarization. For example, in the following +we take the last value among any duplicate times and sum the volumes +among all duplicate times. We do this by reading the data twice, +once for each aggregate function. In this example, the first three +columns are junk that we wish to suppress which is why we specified +\code{colClasses}; however, in most cases that argument would not +be necessary. +<>= +Lines <- "1|BHARTIARTL|EQ|18:15:05|600|1 +2|BHARTIARTL|EQ|18:15:05|600|99 +3|GLENMARK|EQ|18:15:05|238.1|5 +4|HINDALCO|EQ|18:15:05|43.75|100 +5|BHARTIARTL|EQ|18:15:05|600|1 +6|BHEL|EQ|18:15:05|1100|11 +7|HINDALCO|EQ|18:15:06|43.2|1 +8|CHAMBLFERT|EQ|18:15:06|46|10 +9|CHAMBLFERT|EQ|18:15:06|46|90 +10|BAJAUTOFIN|EQ|18:15:06|80|100" + +library(zoo) +library(chron) + +tail1 <- function(x) tail(x, 1) +cls <- c("NULL", "NULL", "NULL", "character", "numeric", "numeric") +nms <- c("", "", "", "time", "value", "volume") + +z <- read.zoo(textConnection(Lines), aggregate = tail1, + FUN = times, sep = "|", colClasses = cls, col.names = nms) + +# re-read using sum +z2 <- read.zoo(textConnection(Lines), aggregate = sum, + FUN = times, sep = "|", colClasses = cls, col.names = nms) + +z$volume <- z2$volume +z +@ + + +\mysection[2. When I try to specify a log axis to plot.zoo a warning is issued. What is wrong?]{2. When I try to specify a log axis to \code{plot.zoo} a warning is issued. What is wrong?} + +Arguments that are part of \code{...} are passed to the \code{panel} +function and +the default \code{panel} function, \code{lines}, does not accept \code{log}. +Either +ignore the warning, use \code{suppressWarnings} +(see \code{?suppressWarnings}) or create +your own panel function which excludes the \code{log}: + +<>= +z <- zoo(1:100) +plot(z, log = "y", panel = function(..., log) lines(...)) +@ + +\mysection[3. How do I create right and a left vertical axes in plot.zoo?]{3. How do I create right and a left vertical axes in \code{plot.zoo}?} + +The following shows an example of creating a plot containing a single +panel and both left and right axes. + +<>= +set.seed(1) +z.Date <- as.Date(paste(2003, 02, c(1, 3, 7, 9, 14), sep = "-")) +z <- zoo(cbind(left = rnorm(5), right = rnorm(5, sd = 0.2)), z.Date) + +plot(z[,1], xlab = "Time", ylab = "") +opar <- par(usr = c(par("usr")[1:2], range(z[,2]))) +lines(z[,2], lty = 2) + +axis(side = 4) +legend("bottomright", lty = 1:2, legend = colnames(z), bty="n") +par(opar) +@ + +\begin{figure}[htbp] +\begin{center} +<>= +<> +@ +\caption{\label{fig:plot-axes} Left and right \code{plot.zoo} axes.} +\end{center} +\end{figure} + + +\mysection[4. I have data frame with both numeric and factor columns. How do I convert that to a "zoo" object?]{4. I have data frame with both numeric and factor columns. How do I convert that to a \code{"zoo"} object?} + +A \code{"zoo"} object may be (1) a numeric vector, (2) a numeric matrix or +(3) a factor but may not contain both a numeric vector and factor. +You can do one of the following. + +Use two \code{"zoo"} variables instead: + +<>= +DF <- data.frame(time = 1:4, x = 1:4, f = factor(letters[c(1, 1, 2, 2)])) +zx <- zoo(DF$x, DF$time) +zf <- zoo(DF$f, DF$time) +@ + +These could also be held in a \code{"data.frame"} again: + +<>= +DF2 <- data.frame(x = zx, f = zf) +@ + +Or convert the factor to numeric and create a single \code{"zoo"} series: + +<>= +z <- zoo(data.matrix(DF[-1]), DF$time) +@ + +\mysection[5. Why does lag give slightly different results on a "zoo" and a "zooreg" series which are otherwise the same?]{5. Why does lag give slightly different results on a \code{"zoo"} and a \code{"zooreg"} series which are otherwise the same?} + +To be definite let us consider the following examples, noting how +both \code{lag} and \code{diff} give a different answer with the same +input except its class is \code{"zoo"} in one case and \code{"zooreg"} in +another: + +<>= +z <- zoo(11:15, as.Date("2008-01-01") + c(-4, 1, 2, 3, 6)) +zr <- as.zooreg(z) + +lag(z) +lag(zr) + +diff(log(z)) +diff(log(zr)) +@ + +\code{lag.zoo} and \code{lag.zooreg} work differently. For \code{"zoo"} +objects the lagged version is obtained by moving values +to the adjacent time point that exists in the series but for \code{"zooreg"} +objects the time is lagged by \code{deltat}, the time between adjacent +regular times. + +A key implication is that \code{"zooreg"} can lag a point to a time point +that did not previously exist in the series and, in particular, can lag +a series outside of the original time range whereas that is not possible +in a \code{"zoo"} series. + +Note that \code{lag.zoo} has an \code{na.pad=} argument which in some +cases may be what is being sought here. + +The difference between \code{diff.zoo} and \code{diff.zooreg} stems from +the fact that \code{diff(x)} is defined in terms of \code{lag} like +this: \code{x-lag(x,-1)}. + +\mysection[6. How do I subtract the mean of each month from a "zoo" series?]{6. How do I subtract the mean of each month from a \code{"zoo"} series?} + +Suppose we have a daily series. +To subtract the mean of Jan 2007 from each day in that month, +subtract the mean of Feb 2007 from each day in that month, etc. +try this: + +<>= +set.seed(123) +z <- zoo(rnorm(100), as.Date("2007-01-01") + seq(0, by = 10, length = 100)) +z.demean1 <- z - ave(z, as.yearmon(time(z))) +@ + +This first generates some artificial data and then employs \code{ave} to compute +monthly means. + +To subtract the mean of all Januaries from each January, etc. +try this: + +<>= +z.demean2 <- z - ave(z, format(time(z), "%m")) +@ + +\mysection[7. How do I create a monthly series but still keep track of the dates?]{7. How do I create a monthly series but still keep track of the dates?} + +Create a \proglang{S}3 subclass of \code{"yearmon"} called \code{"yearmon2"} that +stores the dates as names on the time vector. It will be sufficient to create +an \code{as.yearmon2} generic together with an +\code{as.yearmon2.Date} methods as well as the inverse: +\code{as.Date.yearmon2}. + +<>= +# as.yearmon2 generic and as.yearmon2.Date method +as.yearmon2 <- function(x, ...) UseMethod("as.yearmon2") +as.yearmon2.Date <- function(x, ...) { + y <- as.yearmon(with(as.POSIXlt(x, tz = "GMT"), 1900 + year + mon/12)) + names(y) <- x + structure(y, class = c("yearmon2", class(y))) +} +@ + +\code{as.Date.yearmon2} is inverse of \code{as.yearmon2.Date} + +<>= +as.Date.yearmon2 <- function(x, frac = 0, ...) { + if (!is.null(names(x))) return(as.Date(names(x))) + x <- unclass(x) + year <- floor(x + .001) + month <- floor(12 * (x - year) + 1 + .5 + .001) + dd.start <- as.Date(paste(year, month, 1, sep = "-")) + dd.end <- dd.start + 32 - as.numeric(format(dd.start + 32, "%d")) + as.Date((1-frac) * as.numeric(dd.start) + frac * as.numeric(dd.end), origin = "1970-01-01") +} +@ + +This new class will act the same as \code{"yearmon"} +stores and allows recovery of the dates using \code{as.Date} and +\code{aggregate.zoo}. + +<>= +dd <- seq(as.Date("2000-01-01"), length = 5, by = 32) +z <- zoo(1:5, as.yearmon2(dd)) +z +aggregate(z, as.Date, force) +@ + +\mysection[8. How are axes added to a plot created using plot.zoo?]{8. How are axes added to a plot created using \code{plot.zoo}?} + +On single panel plots \code{axis} or \code{Axis} can be used just as with any +classic graphics plot in \proglang{R}. + +The following example adds custom axis for single panel plot. +It labels months but uses the larger year for January. +Months, quarters and years should have successively larger ticks. + +<>= +z <- zoo(0:500, as.Date(0:500)) +plot(z, xaxt = "n") +tt <- time(z) +m <- unique(as.Date(as.yearmon(tt))) +jan <- format(m, "%m") == "01" +mlab <- substr(months(m[!jan]), 1, 1) +axis(side = 1, at = m[!jan], labels = mlab, tcl = -0.3, cex.axis = 0.7) +axis(side = 1, at = m[jan], labels = format(m[jan], "%y"), tcl = -0.7) +axis(side = 1, at = unique(as.Date(as.yearqtr(tt))), labels = FALSE) + +# vertical grid lines +abline(v = m, col = grey(0.8), lty = 2) +@ + +A multivariate series can either be generated as (1)~multiple single panel +plots: + +<>= +z3 <- cbind(z1 = z, z2 = 2*z, z3 = 3*z) +opar <- par(mfrow = c(2, 2)) +tt <- time(z) +m <- unique(as.Date(as.yearmon(tt))) +jan <- format(m, "%m") == "01" +mlab <- substr(months(m[!jan]), 1, 1) +for(i in 1:ncol(z3)) { + plot(z3[,i], xaxt = "n", ylab = colnames(z3)[i], ylim = range(z3)) + axis(side = 1, at = m[!jan], labels = mlab, tcl = -0.3, cex.axis = 0.7) + axis(side = 1, at = m[jan], labels = format(m[jan], "%y"), tcl = -0.7) + axis(side = 1, at = unique(as.Date(as.yearqtr(tt))), labels = FALSE) +} +par(opar) +@ + +or (2)~as a multipanel plot. In this case any custom axis must be +placed in a panel function. + +<>= +plot(z3, screen = 1:3, xaxt = "n", nc = 2, ylim = range(z3), + panel = function(...) { + lines(...) + panel.number <- parent.frame()$panel.number + nser <- parent.frame()$nser + # place axis on bottom panel of each column only + if (panel.number %% 2 == 0 || panel.number == nser) { + tt <- list(...)[[1]] + m <- unique(as.Date(as.yearmon(tt))) + jan <- format(m, "%m") == "01" + mlab <- substr(months(m[!jan]), 1, 1) + axis(side = 1, at = m[!jan], labels = mlab, tcl = -0.3, cex.axis = 0.7) + axis(side = 1, at = m[jan], labels = format(m[jan], "%y"), tcl = -0.7) + axis(side = 1, at = unique(as.Date(as.yearqtr(tt))), labels = FALSE) + } +}) +@ + +\mysection[9. Why is nothing plotted except axes when I plot an object with many NAs?]{9. Why is nothing plotted except axes when I plot an object with many \code{NA}s?} + +Isolated points surrounded by \code{NA} values do not form lines: + +<>= +z <- zoo(c(1, NA, 2, NA, 3)) +plot(z) +@ + +So try one of the following: + +Plot points rather than lines. +<>= +plot(z, type = "p") +@ + +Omit \code{NA}s and plot that. +<>= +plot(na.omit(z)) +@ + +Fill in the \code{NA}s with interpolated values. +<>= +plot(na.approx(z)) +@ + +Plot points with lines superimposed. +<>= +plot(z, type = "p") +lines(na.omit(z)) +@ + +Note that this is not specific to \pkg{zoo.} If we +plot in \proglang{R} without \pkg{zoo} we get the same behavior. + +\mysection[10. Does zoo work with Rmetrics?]{10. Does \pkg{zoo} work with \pkg{Rmetrics}?} + +Yes. \code{timeDate} class objects from the \pkg{timeDate} package can be used +directly as the index of a \code{zoo} series and \code{as.timeSeries.zoo} and +\code{as.zoo.timeSeries} can convert back and forth between objects of +class \code{zoo} and class \code{timeSeries} from the \pkg{timeSeries} package. + +<>= +library("timeDate") +dts <- c("1989-09-28", "2001-01-15", "2004-08-30", "1990-02-09") +tms <- c( "23:12:55", "10:34:02", "08:30:00", "11:18:23") +td <- timeDate(paste(dts, tms), format = "%Y-%m-%d %H:%M:%S") + +library("zoo") +z <- zoo(1:4, td) +zz <- merge(z, lag(z)) +plot(zz) + +library("timeSeries") +zz +as.timeSeries(zz) +as.zoo(as.timeSeries(zz)) +@ + +<>= +detach("package:timeDate") +detach("package:timeSeries") +@ + +\mysection[11. What other packages use zoo?]{11. What other packages use \pkg{zoo}?} + +\begin{tabular}{|l|p{10cm}|} \hline +\multicolumn{2}{|l|}{\emph{Depends}} \\ \hline +\pkg{AER} & Applied econometrics with \proglang{R} \\ +\pkg{BootPR} & Bootstrap prediction intervals and bias-corrected forecasting \\ +\pkg{dyn} & Time-series regression \\ +\pkg{dynlm} & Dynamic linear regression \\ +\pkg{fda} & Functional data analysis \\ +\pkg{FinTS} & Companion to Tsay's ``Analysis of financial time series'' \\ +\pkg{fUtilities} & \pkg{Rmetrics} function utilities \\ +\pkg{fxregime} & Exchange rate regime analysis \\ +\pkg{lmtest} & Testing linear regression models \\ +\pkg{party} & Recursive partytioning toolbox \\ +\pkg{PerformanceAnalytics} & Econometric tools for performance and risk analysis \\ +\pkg{quantmod} & Quantitative financial modelling framework \\ +\pkg{RBloomberg} & \proglang{R}/\pkg{Bloomberg} interface \\ +\pkg{sandwich} & Robust covariance matrix estimators \\ +\pkg{strucchange} & Testing, monitoring, and dating structural changes \\ +\pkg{tis} & Regular time series package, previously part of fame package \\ +\pkg{tripEstimation} & Metropolis sampler and supporting functions for + estimating animal movement from archival tags and satellite fixes \\ +\pkg{tseries} & Time series analysis and computational finance \\ +\pkg{VhayuR} & R Interface to the Vhayu time series database \\ +\pkg{xts} & Extensible time series \\ \hline +\multicolumn{2}{|l|}{\emph{Suggests}} \\ \hline +\pkg{gsubfn} & Utilities for strings and function arguments \\ +\pkg{pscl} & Political Science Computational Laboratory, Stanford University \\ +\pkg{TSSQLite} & Time series database interface extentions for \pkg{SQLite} \\ +\pkg{TSdbi} & Time series database interface \\ +\pkg{Zelig} & Everyone's statistical software \\ \hline +\multicolumn{2}{|l|}{\emph{Uses or Used with}} \\ \hline +\pkg{timeDate} & \pkg{Rmetrics} date and time functions: \code{timeDate} usable with \code{zoo} \\ \hline +\pkg{grid} & Graphics infrastructure: use with \code{xyplot.zoo} \\ \hline +\pkg{its} & Irregular time series: \code{as.its.zoo}, \code{as.zoo.its} \\ \hline +\pkg{lattice} & \pkg{grid}-based graphics: use with \code{xyplot.zoo} \\ \hline +\pkg{playwith} & Interactive graphics: works with \code{xylot.zoo} \\ \hline +\pkg{timeSeries} & \pkg{Rmetrics} time series functions: \code{as.timeSeries.zoo}, \code{as.zoo.timeSeries} \\ \hline +\pkg{YaleToolkit} & Data exploration tools from Yale University: accepts \code{"zoo"} input \\ \hline +\end{tabular} + +\end{document} diff --git a/inst/doc/zoo-quickref.Rnw b/inst/doc/zoo-quickref.Rnw new file mode 100644 index 0000000..a370bf6 --- /dev/null +++ b/inst/doc/zoo-quickref.Rnw @@ -0,0 +1,354 @@ +\documentclass[article,nojss]{jss} +\DeclareGraphicsExtensions{.pdf,.eps} +\newcommand{\mysection}[1]{\subsubsection[#1]{\textbf{#1}}} + +%% need no \usepackage{Sweave} + +\author{Ajay Shah\\National Institute of Public\\Finance and Policy, India \And + Achim Zeileis\\Wirtschaftsuniversit\"at Wien \And + Gabor Grothendieck\\GKX Associates Inc.} +\Plainauthor{Ajay Shah, Achim Zeileis, Gabor Grothendieck} + +\title{\pkg{zoo} Quick Reference} +\Plaintitle{zoo Quick Reference} + +\Keywords{irregular time series, daily data, weekly data, returns} + +\Abstract{ + This vignette gives a brief overview of (some of) the functionality contained + in \pkg{zoo} including several nifty code snippets when dealing + with (daily) financial data. For a more complete overview of the + package's functionality and extensibility see + \cite{zoo:Zeileis+Grothendieck:2005} (contained as vignette ``zoo'' in the + package), the manual pages and the reference card. +} + +\Address{ + Ajay Shah\\ + National Institute of Public Finance and Policy, India\\ + E-mail: \email{ajayshah@mayin.org}\\ + + Achim Zeileis\\ + Wirtschaftsuniversit\"at Wien\\ + E-mail: \email{Achim.Zeileis@R-project.org}\\ + + Gabor Grothendieck\\ + GKX Associates Inc.\\ + E-mail: \email{ggrothendieck@gmail.com} +} + +\begin{document} + +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{zoo Quick Reference} +%\VignetteDepends{zoo,tseries} +%\VignetteKeywords{irregular time series, daily data, weekly data, returns} +%\VignettePackage{zoo} + + +<>= +library("zoo") +library("tseries") +online <- FALSE ## if set to FALSE the local copy of + ## is used instead of get.hist.quote() +options(prompt = "R> ") +@ + +\mysection{Read a series from a text file} + +To read in data in a text file, \code{read.table()} and associated +functions can +be used as usual with \code{zoo()} being called subsequently. +The convenience function \code{read.zoo} is a simple wrapper to these +functions that assumes the index is in the first column of the file +and the remaining columns are data. + +Data in \code{demo1.txt}, where each row looks like +\begin{verbatim} + 23 Feb 2005|43.72 +\end{verbatim} +can be read in via +<>= +inrusd <- read.zoo("demo1.txt", sep = "|", format="%d %b %Y") +@ +The \code{format} argument causes the first column to be transformed +to an index of class \code{"Date"}. + +The data in \code{demo2.txt} look like +\begin{verbatim} + Daily,24 Feb 2005,2055.30,4337.00 +\end{verbatim} +and requires more attention because of the format of +the first column. +<>= +tmp <- read.table("demo2.txt", sep = ",") +z <- zoo(tmp[, 3:4], as.Date(as.character(tmp[, 2]), format="%d %b %Y")) +colnames(z) <- c("Nifty", "Junior") +@ + +\mysection{Query dates} + +To return all dates corresponding to a series +\code{index(z)} or equivalently +<>= +time(z) +@ +can be used. The first and last date can be obtained by +<>= +start(z) +end(inrusd) +@ + +\mysection{Convert back into a plain matrix} + +To strip off the dates and just return a plain vector/matrix +\code{coredata} can be used +<>= +plain <- coredata(z) +str(plain) +@ + +\mysection{Union and intersection} + +Unions and intersections of series can be computed by \code{merge}. The +intersection are those days where both series have time points: +<>= +m <- merge(inrusd, z, all = FALSE) +@ +whereas the union uses all dates and fills the gaps where one +series has a time point but the other does not +with \code{NA}s (by default): +<>= +m <- merge(inrusd, z) +@ + +\code{cbind(inrusd, z)} is almost equivalent to the \code{merge} +call, but may lead to inferior naming in some situations +hence \code{merge} is preferred + +To combine a series with its lag, use +<>= +merge(inrusd, lag(inrusd, -1)) +@ + +\mysection{Visualization} + +By default, the \code{plot} method generates a graph for each +series in \code{m} +\begin{center} +\setkeys{Gin}{width=0.7\textwidth} +<>= +plot(m) +@ +\end{center} + +but several series can also be plotted in a single window. +\begin{center} +\setkeys{Gin}{width=0.7\textwidth} +<>= +plot(m[, 2:3], plot.type = "single", col = c("red", "blue"), lwd = 2) +@ +\end{center} + +\mysection{Select (a few) observations} + +Selections can be made for a range of dates of interest +<>= +m[as.Date("2005-03-10")] +@ + +\mysection{Handle missing data} + +Various methods for dealing with \code{NA}s are available, including +linear interpolation +<>= +interpolated <- na.approx(m) +@ +`last observation carried forward', +<>= +m <- na.locf(m) +m +@ +and others. + +\mysection{Prices and returns} + +To compute log-difference returns in \%, the following +convenience function is defined +<>= +prices2returns <- function(x) 100*diff(log(x)) +@ +which can be used to convert all columns (of prices) into returns. +<>= +r <- prices2returns(m) +@ + +A 10-day rolling window standard deviations (for all columns) can +be computed by +<>= +rollapply(r, 10, sd) +@ + +To go from a daily series to the series of just the last-traded-day of each month +\code{aggregate} can be used +<>= +prices2returns(aggregate(m, as.yearmon, tail, 1)) +@ + +Analogously, the series can be aggregated to the last-traded-day of each week +employing a convenience function \code{nextfri} that computes for each \code{"Date"} +the next friday. +<>= +nextfri <- function(x) 7 * ceiling(as.numeric(x-5+4) / 7) + as.Date(5-4) +prices2returns(aggregate(na.locf(m), nextfri, tail, 1)) +@ + +\mysection{Query Yahoo! Finance} + +When connected to the internet, Yahoo! Finance can be easily queried using +the \code{get.hist.quote} function in +<>= +library("tseries") +@ + +<>= +if(online) { + sunw <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31") + sunw2 <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31", + compression = "m", quote = "Close") + eur.usd <- get.hist.quote(instrument = "EUR/USD", provider = "oanda", start = "2004-01-01", end = "2004-12-31") + save(sunw, sunw2, eur.usd, file = "sunw.rda") +} else { + load("sunw.rda") +} +@ + +From version 0.9-30 on, \code{get.hist.quote} by default returns \verb/"zoo"/ series with +a \verb/"Date"/ attribute (in previous versions these had to be transformed from \verb/"ts"/ +`by hand'). + +A daily series can be obtained by: +<>= +sunw <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31") +@ + +A monthly series can be obtained and transformed by +<>= +sunw2 <- get.hist.quote(instrument = "SUNW", start = "2004-01-01", end = "2004-12-31", + compression = "m", quote = "Close") +@ + +Here, \verb/"yearmon"/ dates might be even more useful: +<>= +time(sunw2) <- as.yearmon(time(sunw2)) +@ + +The same series can equivalently be computed from the daily series via +<>= +sunw3 <- aggregate(sunw[, "Close"], as.yearmon, tail, 1) +@ + +The corresponding returns can be computed via +<>= +r <- prices2returns(sunw3) +@ +where \code{r} is still a \verb/"zoo"/ series. + + +\mysection{Query Oanda} + +Similarly you can obtain historical exchange rates from \url{http://www.oanda.com/} +using \code{get.hist.quote}. + +A daily series of EUR/USD exchange rates can be queried by +<>= +eur.usd <- get.hist.quote(instrument = "EUR/USD", provider = "oanda", start = "2004-01-01", end = "2004-12-31") +@ + +This contains the exchange rates for every day in 2004. However, it is common practice +in many situations to exclude the observations from weekends. To do so, we +write a little convenience function which can determine for a vector of \code{"Date"} +observations whether it is a weekend or not + +<>= +is.weekend <- function(x) ((as.numeric(x)-2) %% 7) < 2 +@ + +Based on this we can omit all observations from weekends +<>= +eur.usd <- eur.usd[!is.weekend(time(eur.usd))] +@ + +The function \code{is.weekend} introduced above exploits the fact that a \code{"Date"} +is essentially the number of days since 1970-01-01, a Thursday. A more intelligible +function which yields identical results could be based on the \code{"POSIXlt"} class + +<>= +is.weekend <- function(x) { + x <- as.POSIXlt(x) + x$wday > 5 | x$wday < 1 +} +@ + +\mysection{Summaries} + +Here we create a daily series and then find the series of +quarterly means and standard deviations and also for weekly +means and standard deviations where we define weeks to end +on Tuesay. + +We do the above separately for mean and standard deviation, binding +the two results together and then show a different approach in +which we define a custom \code{ag} function that can accept multiple +function names as a vector argument. + +<>= +date1 <- seq(as.Date("2001-01-01"), as.Date("2002-12-1"), by = "day") +len1 <- length(date1) +set.seed(1) # to make it reproducible +data1 <- zoo(rnorm(len1), date1) + +# quarterly summary + +data1q.mean <- aggregate(data1, as.yearqtr, mean) +data1q.sd <- aggregate(data1, as.yearqtr, sd) +head(cbind(mean = data1q.mean, sd = data1q.sd), main = "Quarterly") + +# weekly summary - week ends on tuesday + +# Given a date find the next Tuesday. +# Based on formula in Prices and Returns section. +nexttue <- function(x) 7 * ceiling(as.numeric(x - 2 + 4)/7) + as.Date(2 - 4) + +data1w <- cbind( + mean = aggregate(data1, nexttue, mean), + sd = aggregate(data1, nexttue, sd) +) +head(data1w) + +### ALTERNATIVE ### + +# Create function ag like aggregate but takes vector of +# function names. + +FUNs <- c(mean, sd) +ag <- function(z, by, FUNs) { + f <- function(f) aggregate(z, by, f) + do.call(cbind, sapply(FUNs, f, simplify = FALSE)) +} + +data1q <- ag(data1, as.yearqtr, c("mean", "sd")) +data1w <- ag(data1, nexttue, c("mean", "sd")) + +head(data1q) +head(data1w) +@ + +\bibliography{zoo} + +\end{document} + diff --git a/inst/doc/zoo-refcard-raw.tex b/inst/doc/zoo-refcard-raw.tex new file mode 100644 index 0000000..5976d41 --- /dev/null +++ b/inst/doc/zoo-refcard-raw.tex @@ -0,0 +1,88 @@ +\begin{tabular}{rp{9cm}} +\multicolumn{2}{l}{\textbf{Creation}} \\ +\code{zoo(x, order.by)} & creation of a \code{"zoo"} object + from the observations \code{x} (a vector or a matrix) and an index + \code{order.by} by which the observations are ordered. \\ +& For computations on arbitrary index classes, methods to the + following generic functions are assumed to work: combining \code{c()}, + querying length \code{length()}, subsetting \code{[}, ordering + \code{ORDER()} and value matching \code{MATCH()}. For pretty + printing an \code{as.character} and/or \code{index2char} method + might be helpful.\\[0.5cm] + +\multicolumn{2}{l}{\textbf{Creation of regular series}} \\ +\code{zoo(x, order.by, freq)} & works as above but creates a \code{"zooreg"} + object which inherits from \code{"zoo"} if the frequency \code{freq} complies + with the index \code{order.by}. An \code{as.numeric} method has to be + available for the index class.\\ +\code{zooreg(x, start, end, freq)} & creates a \code{"zooreg"} series + with a numeric index as above and has (almost) the same interface as + \code{ts()}.\\[0.5cm] + +\multicolumn{2}{l}{\textbf{Standard methods}} \\ +\code{plot} & plotting \\ +\code{lines} & adding a \code{"zoo"} series to a plot \\ +\code{print} & printing \\ +\code{summary} & summarizing (column-wise) \\ +\code{str} & displaying structure of \code{"zoo"} objects \\ +\code{head}, \code{tail} & head and tail of \code{"zoo"} objects \\[0.5cm] + +\multicolumn{2}{l}{\textbf{Coercion}} \\ +\code{as.zoo} & coercion to \code{"zoo"} is available for objects + of class \code{"ts"}, \code{"its"}, \code{"irts"} (plus a default + method).\\ +\code{as.}\textit{class}\code{.zoo} & coercion from \code{"zoo"} to + other classes. Currently available for \textit{class} in \code{"matrix"}, + \code{"vector"}, \code{"data.frame"}, \code{"list"}, \code{"irts"}, + \code{"its"} and \code{"ts"}. \\ +\code{is.zoo} & querying wether an object is of class \code{"zoo"} \\[0.5cm] + +\multicolumn{2}{l}{\textbf{Merging and binding}} \\ +\code{merge} & union, intersection, left join, right join along indexes\\ +\code{cbind} & column binding along the intersection of the index\\ +\code{c}, \code{rbind} & combining/row binding (indexes may not overlap)\\ +\code{aggregate} & compute summary statistics along a coarser grid of indexes \\[0.5cm] + +\multicolumn{2}{l}{\textbf{Mathematical operations}} \\ +\code{Ops} & group generic functions performed along the intersection of indexes\\ +\code{t} & transposing (coerces to \code{"matrix"} before) \\ +\code{cumsum} & compute (columnwise) cumulative quantities: sums + \code{cumsum()}, products \code{cumprod()}, maximum \code{cummax()}, + minimum \code{cummin()}.\\[0.5cm] +\end{tabular} + +\newpage + +\begin{tabular}{rp{9cm}} +\multicolumn{2}{l}{\textbf{Extracting and replacing data and index}} \\ +\code{index, time} & extract the index of a series\\ +\code{index<-}, \code{time<-} & replace the index of a series\\ +\code{coredata}, \code{coredata<-} & extract and replace the data associated with a \code{"zoo"} object\\ +\code{lag} & lagged observations \\ +\code{diff} & arithmetic and geometric differences \\ +\code{start, end} & querying start and end of a series \\ +\code{window, window<-} & subsetting of \code{"zoo"} objects + using their index\\[0.5cm] + +\multicolumn{2}{l}{\textbf{\code{NA} handling}} \\ +\code{na.omit} & omit \code{NA}s \\ +\code{na.contiguous} & compute longest sequence of non-\code{NA} observations \\ +\code{na.locf} & impute \code{NA}s by carrying forward the last observation\\ +\code{na.approx} & impute \code{NA}s by interpolation\\[0.5cm] +\code{na.trim} & remove leading and/or trailing \code{NA}s\\[0.5cm] + +\multicolumn{2}{l}{\textbf{Rolling functions}} \\ +\code{rollapply} & apply a function to rolling margin of an array \\ +\code{rollmean} & more efficient functions for computing the rolling mean, median + and maximum are \code{rollmean()}, \code{rollmedian()} and \code{rollmax()}, respectively\\[0.5cm] + +\multicolumn{2}{l}{\textbf{Methods for regular series}} \\ +\code{is.regular} & checks whether a series is weakly (or strictly if \code{strict = TRUE}) + regular \\ +\code{frequency}, \code{deltat} & extracts the frequency or its reciprocal value + respectively from a series, for \code{"zoo"} series the functions try to determine + the regularity and frequency in a data-driven way\\ +\code{cycle} & gives the position in the cycle of a regular series \\[0.5cm] + + +\end{tabular} diff --git a/inst/doc/zoo-refcard.pdf b/inst/doc/zoo-refcard.pdf new file mode 100644 index 0000000000000000000000000000000000000000..77c9bca09c693a30d207bb647b81631f6b6fbece GIT binary patch literal 47501 zcmeFX1yEewwl0c<1Shyd;}E2A3GVK0fd(3ATpG6!EI0%Rngn-u3j`8^y9IZ5cX*xr z`#*c1w_lxe>eZ`yx9VQHi#6w1bIdiyT&w5zjj;xunv@JH2OBpk4}cxuXl8>dBm~rj zSU{}-d^|uoFvQ9l3gBSp1xi4mu4-TxNk@ApM+dM26u=LZbhLAH(R2ctgMm_DcZfMy zLskN)1a`23DRb~~2moauc2KYjP{s}f1xta=9WB5jBCb#uFvuR&bM_#;UBO53W%n7} zt9O93A4Et`Jg=%o-WG;rn$Zvjzh}~TuSZXCi)vRdbT!LqxW`rpzk zKd^=4x&pR53L@eZq8i zcNZBMndqy6R8GQk zV~P>;K{0o_aC*<*-`$-)9cs%>;-t(c(tVMucK-e%a_=(fv)|Q4Dc5Y*Ee)Dhj7yoa z*6~pg$bThIr$k+x+K!AHqug&J|E@%tkv*?iQGkc1i#ai&yNh>}5?}lKs7AcT=2UL7 zL4E=u0r7?ufuKF=n7A}H{FpjhSXfwJqDD!{;Ka=RB2JF{Zd#CL z`?m~r>4Wwbjj|ka=He=8{EbfzH8nL*C$d?ls&a!-N+(>CD|(ie`V-MXngu+QE0;WF z^;Dc{QVNQEsh72l`vYgo%VNYkGd%Qd*)h2?GBS)+wSDnCE382Plf4~v^_$KME?4Im z!(MWR=ar-zn(3zNhlk~AjKB10Bx%0X8nB9r51ZrNEd035u`K09#yIb}#d_;Xx&M|g zXT{0mTO|32c9wsVLRWMw_BX;2iYtGaAfw$hZ-bZRGBQAVbgq20zHG2m?1T8ZfxnFD zKx8DEdbHT522+7ojVg$ep=QCUsi}^qcVAvK^)^Qpj!{K~(dgx@vqp_%cZcZ{T9}zh ze1mXvynb!-3ytDfk}4YHa$A>8+8**zDa9xnYh!E-rxV9Jyt`1hMEgfz51#W|<_L6Z ze=T+Fj|y#-m8O<5nV&yo@KI27`*(Wiui@hqyXlD6+N`be>Y5<~(X2)C6G6!OGtN%5 zP8hv1H6f{RRTUK#Pt0DwY~^XBcX>GxaNL7ia?#+;?L2&Ue4Sgw8wPbsMtqj}8!I^1eLU2issx6061<}55RAtAwEI%g`y`Tivf z2b_nR=u(Q`G@UA!zPkcCOCB-)t6OhLc3|}JHps7$`CYe?e10b_gLSZeQvXJP_NYWw zoD!6e1fxz11J7}sYn$q|evuX#Jf#%MG;Z!FR0k)iRy%sKo7qGA1a2bYt4xKB`IICdwF&!>pD|yj`n}Kl^eoBObHn1~ z#<1Lt>^Xhe<4c<4vehWPHf}-+df^ISd&I=)T~~?n4hQ*y*u=+DM6ERk4sEBwiIx5d zMz>PR1CBBdI4u?eVQVx2;)?yy?=-t33u6m zKtwIHo4hzc9ZQmefx4dgtdNT1V*}n^Kyw(5Gy8RI3so8hXb#A_)b#vB|z#%X4#vP413U zdu}3GSlGd~oi@2-(Gni^;jE<{c9*uT4RhG^|JrOR67loo z#98L-Dfw78Egsos#6ucm1ul5$9Lwk_5z4c|=yjPEPpWNCJbDy>q_L)%7M|2aA6I7_9Xh zEqVXHMNJMa-v0(Q)7llx#qq*e?d@qlou8j?ZDe9HC%?A8A2sCOvS7zcj-acn3;W4eY)$N4930rc zIkP&}C4_-Anc$H&LR!()7W9DOv%I%>@HbYK8ob#~IG4zKg0S-iBHYgJ^(Hqq=xi-dF123a`*=PUW%u{@D@j^} z`nz{9eiGWr?Fj1`sseNRthSw$N$%5rSz20}(=##g7{AqKoe4%@65;1pvvH?D%~ZMz zqRLZ7)SxZNeSteDo=uzC7v7ik@tjs#TkLjvYHC}YRbBUXhEmn~2hq}V&p`4^vaSR? z&qU>DTA}POuNW?=PUPe=FC~aSwQ?p{VM^HB*=2nBLesgs`-*uz=@Pc@gNS%dm}hP3 z68B^YlU-F) zV;;3|rDbLTdp4;i-cQsNZE&Nb*$;o@vF_ZI#J!|EQ=w-LN|6n+q9J~*nWj|xJ>f@qxl^-;0HOYw%9dA6*c0m z&CL%fzVEmOMT30~E)>?`d*M+m=@}TpK_V7$&nMV%;YYvb20l33DgH2sjXWZajfIz@ z68sdSEsox~y=`5lvxZ-CEesAuaP?Br$=Q@Js7lM<6B+<{M#H_u-x5Y~)yy~RjtDcKnI6AS+d=&ldr7iLlu}gdyXeqB%qd&$p`M7ST(CR{M?+4hi893{ zBxL8ev%da=)R40Ry7j^Rn?@2ok(g7zT5}J3t)z@gt`uwnJM+ZHAK^7t;#iwc~F9n-GsJpw)f@Vfnmo%+(vr0iu`t}TN zf9S3grk4L8Ul)eKKYs83<>46U32!2Fj{k4l9p8U!cL1O!04VFI`A~VZCWk(;nVWw$N-O@Y-ICb_Jy=_M(tzI%#giHfL|CHrnEw01`8%y8D980 zdKj1Jqos9Q;WDMkFB|o}H2osNg-6Z0U!8O9eyb}bI5>wPShj;3W}nXQ`wt3$q9}FC z5%OSy1}rox()?Qe35n{y?XH7|ihj|UlDfj=?#Td$C-}ki+9pu3^O#Y~_$H_;IemO{ z#9qf%e-Av}896TOo|ws3Bh&0}>pQ>2x8$$$kOuU}FdQN^;xs)*-VA!EHK& z3r)d$BXfhp=&2lv)S%laQZZ#9_cRslb@UTs7`xvjLQKzeAhY_77Xnn9u% zQtp^wZQA>kK17Q8a7%Q)r?b2hd(Bx@o8HqiW?Ku-mvogp@jOUcPZ0%ID5PrnhRE#_ zc=UD3q4pK&W`TB2t1!N&w8y-tWD8;A{PFjYP~O>=f|iC3JdZ34*1+i%j5&1lXioR? z(VJEQNw^{z;ME}wF@p2*=O4tP`&F49yE&cSgd)xH9&N%=Cl?U9)??QCUk;ez2~fX= zu1flEwOP%+;1#e}(R@QO%8TQYCBQMDyYKS^$5y8gq;mF>0 z^Q4R`IO~w6+HMTKFZW0JK0qYSoDU!F9Bd+sz>RChzBhki75dx>dtjSB=*}ebKy>An z*+?{WiO{x@?h`l5OKT5HBet2Zlr_o`>rRCRB1tT5Cc*N_P z$>w@`6gP14a4r5SDnLa5=}Q8mK;u>NcEelAkCWP5D{Z#g(?f7MsdBy9Sal-xFU4Dy zMW4~xdwPV+31)l@To7pBHt`quj7p7P$~-6+8^jlPwtUsh9@4}V za1P-a^A)Pjx=clG(GB8_aH_@1L-?XHOJfJ9PMR~8H-7MArkoN4fP_jiylJ>|PO-wDt>MS~XdBBmnNn)MqG6HRJ;jYc*!Z~+UnmZ;$et4| zhWE_sjqbwdexNE?wT_~(qE64+$a|`l$7AXYPcf4y9AW(G;-62ZN->PkslRtS7xzu< zodkzxjJk5CMuE)AfRm$0P^4a`VhqKl2OwwEQj~R5lelL=d zKI!G1ZO_pe^L`C2;@`&`*%VRY$~(msG3H<%kmY@$?QYH|vV!GZ*+Pd4d@F&JDoH0R zqfC4Q_Rp85e{E%iL~XCKIgCPagqz3&5Ov2Kzw*0e4SzB>-Cyoli2wDlXyqX?@u^4o zXwIumo$I@6u2A>9S1rXaBA#q~(S%9i!}jQhWu@?Iw2fLIc1I=qu^MtP9oGop?~vX7qBQ)b}YyT{!Dm&?U#kRDMA=pC)w?cm*fv1VQfAbo{dc0Y`#)=`HP~H03OGT9KD(tB8kq`lhk2taKD(800h&Xl6SdRR-#W&W?yo8Z)x_U>UJuscm^-g?FCXE4 zntL0AC65x}(ojW90~k8L+Y+0IxxA*PP@r1E;JBs9bOLYV3=F&_*ay#V)-_c5=#A7p z^4C{~8@*BBD(3Nb5=}3A+p<52Im7WE1FnjfVoUd>3`& zqkTHGc5YV)`3Ny-Aa@?q_~>89mTzRV+u^%~rD3_UdaiCBjoF#))|RmvNUpLOL5}zp zWwUQ;CSWP7wP$YU?F`dwIWRTDn#Omi_+@G@^!t8gCQi1wU?FndNspO@1{rOMSKE&% zTaf)nNL!OGhNaU17~d&0BU8{kb|B#%t<|mj5-%q9f!#17)8~Hf=`-BnI2EVg=}3^; z-X2rBpO4q>Ecs_XGU25tricbvIZb+0wpnuIy!r<^wW%{-g8eP1ueeudnp1JQ&PZ@s z1=*fNkX31>21Y+6?{ZT)k0j#sj6T=B7mwBgAVoxl>|!Vfw}O}wuc|xg!$@I4*5c`l z(wEmbD_+Hx@lNZljha17bX-e6FS$!dC<30Zl##OvYm+-mBM2_PHrDvI6Dgpp@e7p6 zloLTmswc@ZlPS|?9ES5vDv_e=i+J$65=WWV?7>%>$$H#(4t3?sxScJDD{>z1OmS>f zYS699CQOUdcnqZmxs>3za7!S54uoh@NEh5z(e|jb7vG%}UKXhS#HfiLnEcgH(IGSX z^KP}G@|7*xYA>RR=yeSu@b!XkPv0Y)GS;t=TC=xCty8!Wqu09lnoLIz=WF)&HyLFF zv$wZDeEgwT0Rr5@nE%FCfAdmUnEr=;YI!+<0YEj76&Mwkx^{rVlGv`W)b?-YiVD;K zyE?kLn1fvb0)GjV!4?pZgrg_G@b?HF0UkC^K3)JnHwPQPfH5j6P|MoQ-VE?NX%5p? z1G)T8iF0xM>57N|{-(db1%F@vKWH*gPu~C_zz$2W^RWqV@cIR8s6 zE-p59PX2$>`fc~$my&_G2lE-mt2wy=9Dj`b-R1{y{6*A(GB8s)|5yu?bMXRT!+sNZ zpbS5N^Eb!;-Q*GgaQ#`G-+UgZ=Hh6s35Eg;VM{0_0|07)Jz-S;U##Z(J;mP!{QVYy zhv$Dx^}p&VI=5xJJF;z{_|8voC z;j6I&<+4c_lw)S9O@QxGoZbiXkb+mF;<5FP7|JAToM@V-S1Mp7W2?0Rmk4@Mbm3n& zCBZiAWSbn@7~HxWuMJ5lMZf;$0vRP~>;b4rqxznp@O{rwk`@;H;J@WhD$7}0kR;aW z-cx5Xoi>?&Tl~1xSvQ3Dk#1b!L+6p}AsusZ#7E6>ptIJ8@JcWabM=j=2Yf?4X~MNB z;tyegcDh3hq}<-R&C*vUJ7Ienz?(d+sJ;G?mw9tanRT&EXHu!l-8ce0ITl6^p;=)q zHcbN8N$wUmP(ag{)*k~J4(QBiDiLjnvjIJCe7^SYp4H>s4Hhwz%_ap$qm6wu(e+yRRP0c#Re?{Lx=V`@%fEq-$?7n({m@4ktmvZ-H9Im`}Zr@dS|XH^fUdN&h( zSj1ijFQglP#TO@J(ByuH23b=q9OSk*@@zqmDz(Y+NzM`)Qu7y(%vvmY&04J*f6Usk z2dUi}JN0$P4zOA?#eg33CnV78T(%g=+Up?|e#h5G+@Rg0B0|K2$b~$;>brW!NY>_yHH8Vaz!4B>DLidY&Gpz&`&*n!>Oswp@Gx)?d7gR@3v|xcCqRkfOkVzPd}_FNXxR) zzWEtxi|F+?vwbf1h{eN7>Gks;{8k<;E|yF8$bDiI2H*CYgO|x(=-FXUvP#luC0xkj zD9HD#%R~FukTF*=GxO0)&LDgY@ijM%P$Ak@Em7*0aJHau^JR3AONO*f zi?4PdHb!R`Tc-Tu=4NXFUJ_L}-(!D`AK4bwIIAbv6jr|YaXScl!~RlIdO;Oh3J#;%cii%=8uuSt}#wPw*N7a6Y|~|y0?7Vjv;nq7C#}= z#K(l7R=Zn^d~bG>A*!x`za1VJA+Bm3DH?uI7j4-FlZQl7kuc4*=nHP(kJ6Bg8!y8G? z?Jt_M-+x&o1R{I4qOWbfB!7W5kvi;v`G{HLaIj;(Jr6(mqR~HSkC##nO((4PITg2= z1*MQr8hPz2-lFvuMo!TA2|lE)xZt|gJNt5psd?MewQZ518n+gWScH65&20=}wgY8B z_Vysy8+$t_2*zT-u>VRRdov3VP!9rBg8(%lRuLvbwFZhy165()zdEjNPEIbcYXHHX=5`=^ zptGAJ6b#dG`CXa-bbzriu!}3i$^qyKt2MCuJ-rhcM&ulzK#)DGHK-OMP)?kOsBWzJ%9=bw2fvzxD9e{tTCV&nQ*g$hwjRedzus!6j)?ZFoIC{WFIlF=E zV5Wgxp%6#d+a#Fi?+y?I1&RYDfRaEdpfpehC<~MW$^#XEia;fxGEfDm3RDBC12uq} zKrNs)PzR_B)C1}R4PZ+RGPec8ZVAl2zt`zc=N~8j^41*UV(w;dX$SWFecM3he-`V{ z@IPZgKr^5@&;kha4QK_l210-~KwF?4&>rXjbObs9oq;YuS0EJV26P8{06l?TKyM)I zcl!Irf$jestlb=}KrU|fb|5z>5DKxg00S)`uxHQ};tKrxb^S2YfJ1=qZ`=NrEpz@WUH^+Ma{%}`c>d0kbHZpl zFZbU)E&vY~=ieO|ap&RspC-@`G;D>m_9zaM66Gel||9$xtgd4HR1M z{~RD8a0LxChLR*J*SU!^M$@=4hH&Dbs+Y?{dZ1LsDr-c7>Mb~RVeSP>kN}~r@taR| zQ(;#(PhYOQzFgd!xSCT2km`~MKD#unY2hk>LSvFxXJQd#awdX16YXa;ck(K&~ zcx?OV5-KY7nJ>tw4SPhaN`tu8;ZlM;-7SP(pkS=MvpxQJMoYHc7c79B)QNzC=Rh=& z2vK7~ANiszZR#L|3I(%^wcn7BW>S)2xSE-gpuPpfg{n1~B9lc_!kxD=00}-}thRlG zwDvfb5vAa=av_!LS3*$wl*WFs$Oy>=?ZA1H8oHCPoSiOJUgR{si0$|#0~+cF(q1Hs zgoLxNK3P3uKHvYJlBl_WM1vK3j z{21~>eDxb3iUlkullXN>XPpvr?nibt1eqDHw(IpygBpG2QiN*+owhFMnc7akWVzqh;q1E}J|}4@Q$G zTO$hm3goTVONH-QgonB~DcpL{hlfa=m;yasMs}Ez*^?6%Yf*$D)-t+MBL$^jWtuY6{4r*s_qw#sU?O#%i&S;CJ(r`sJiRV@yL< zr04G2c}JZl(=9UDvfA80GfMeMBzH6`-(KIPGoaUY_xfr>Z3nPO@|^_%eMH&Rpj z?f%xc4z&65SvGq_!GdLc&SH=AK^;vy>+cg63(S%b(sugS;F=npZ7IkA!~$bnGz$Z4 z;K*V3-9wQRmAx9hiVOLGALexu1wmcUngTm7YWj%!`ERX(aG#>sagOl#z5I&^+6-)> zb|Z+-naF1ILz$T)Z4516E>f0fh6viRxP1d+%YAXzei>55=)(6@zAe#hSj)cE>I*sh zs2vnBHj4g!UW~nU9mDUZZw7kWgqN<5A=>d9mwP^Gv(Kc>ffL+QEFyGA;*4^QGqJYXX}xNrV)2Kx ztJispWrY{RZt|%1!kvHv^P0DD>i#_pt&Ji9ZruFhO)|j5fY@fAc zUo?TrcPCxDa%&|&Z1?D-@_RED=1Msuj%V|=4X28JRW$>vDNBag{xpLXGVEfN=Ed9O z{cO#;AZHFYGQ7;!zT7I~WOaB(J<*ZEiC5kv(<*MMxZSndpI^*yUlHsJ#xL;rKzAy| zSk1>5d(bA~*C>5mS{S&9f4ZIDuGp%G)bVt#F-o7bow^Hz^pEEAQk*)n*ooSk zgbXG38}^$NWW-doPBSE`9K0G;{Ic&Nnoh)@?9lzm&%C%&)>YjWGE_73tLZANG|%7n zu_NkgLI1H&didx0z44N5Evx3SFjd3PDy}Y%{J~sfuDzpA5wk%NkoV!f-wB6VV#?RY z;#onqf^!t2&8{P@M+4#qQ)ehbZdqHzdl+9WeG=F(m#>>@G{l6LQ!d2<6MVe9e=xQ} zmKe%|4_J)M^uHbVr(XjT+cp4P1wJ|cU1+Q88&zpRR8?Bbw_CPM=0)EHD88#d z@7XH^Xcx?VNZ?H#H(ryM{Wk`#h^V`ME02^yQZiM5GxjiYQtEP;-zSig`HtE8 zH-wey*P4;yOFsS^@vovZG*gEY;K)zPy6)zY2QIL$8NSWqF7X3|q0?3OSZy;yZ(iWM z4sqbR@Nm)RGZERN&)!gztTMM?Tq-wD=|&k<_08}-NGM;~!2ggBs%ft5Nxd7K$@Ti6Q$Ly6)O$ZoA|xX66VFMTPHV&D}Cya1Ec1D zIvl^b(VxO(R{+VIZf{|NrJPTci30S532!047F$mt(7&%FFxu-FMU$M18j9KTQgo>c{84@)Bd z-!3N)1=&H&#T~5dz_6jPk(yAjy$*nv9~G$gkLkF%V7~sIK;lnMnU#Z=3&6_B!w%r! z;N}Gg@WOJ+zl$KOTmiqWfO-Er*UAV4!I-!m(3R;gU06Le81RQV{;M;8Rs-e?sv!@@ z@02b#@9(w$&mT^n->du24>zm?!}#wa4X%IBlK*{I{x=FAEgWGXsmuQf9{*49`2TyR zL3xUXK2_^=**bch|d_j zdZ@;Dc=(14;h6+NN1a|Efk$#8wREJ9qBE-jS%e^7vKgPxk*m8;``Ou|$yJm5XQ4fE z*O;nBflZ^xKpo96$-d_{NQq$*^ZcItUQ%$JHnT$Wa1<&I4iLNN&xwgf#xS0R^cXb5 zOT!6ucDBNKW#X?QoZwS5B)u8vABm~20sE85u%;F%Z)j(@r zyr#0zGkgdCTFv(5$Y44y0O>hm?NgrPr+j4rvPAPG=0zDEQP5piaXLH`3niVM@@v$rgr?sb8ZWs4d~3{%y@e@ zH>>zdK4ZtNfRaa^8^_I?!S{#X#NNEsoqvCM3ZSQMd-4O{QeJ%s(v!3odnpK4@fPq6 z=XuTfPnisgXDD#KUT}c-7$azK=Mu=S&Jvjp@A2TW86M#b8PV@5Fr@bdk`I=u0^**4 z&mQ{k=i%6_6p3CUJfCfTh&jF2J^!-sz!xP~ANpEA|1ky`u5thCr-Q(_B`R?#w$+zn z_WohPa7N{(in@0JGzh@Q;%A|cD!5WwA8wW3qo)SQBU3Rw0jX4oryUVNQgkItv{8k3 zK2`JYrP4)TReBf~nD`DRKD~yCKexvdf;KK-^48zO zhnKEJzdVCL3X_2^D&Vl-PP!j-r$gX7-*rAd-6;tp_jHjL(xSaw-rOX>*}N09Ilz?6 z;B06&5q;mi-#$YS?8z7?2F&ES+{c@^1s6)%`2FgJYq}rBf$CU5T0;3R(k{d6yQ#QN zdX_uk@d>B$Y`&Z15lc0uZ>MvAZb&RYGI*#B-3WNz^drx&ed)aN*T69(n_H+??QGG> z-=DZTY+6Iqs~-5al%tLNnxl7H(&JKnn8GMQU&jN@HIQIuk2!X>A~oxsMCd88>DObv z$td62*=q2RxH*=aHc{j>$Oi#pC&RMQD)hUV0@_ z&bSD~C6k8haHxlj?sBC=xPL4s4)vS=Axr%E@*Z0%=+%bFb_9mO_oofOpbKdx=z^%C zL{`g{A&jLU#y~qyF&+JeDrpnj8`S*ZYao^qzUV0nJz>QzXfQ#@RRob&ih>| z=p6?zZ-Id0`7>tovW<3)zVpt|?WQ+l)g?+avMt{twYWZD#^InjynSxfe|U|WH2${s z!FT;9st-adcUEF_ra8J9T^VJ?{HW)W>(a(_6KQ+loC28jK_M(&Hs0Sy`t!jUf56Am znbvf-`Sq(j4@PMwOGb_l@6g*9iMQJ&b*;H69mMt(qsrc|^tINxFYKsNsFRa01hItG z%qzGwM%GgB*pWMX-<@s^*b(BKG6N`*V{nT_%qJ0ftVh~B#A|Y*G2Q$JFTNw zw-1L!zbYo%*KP;hpm1Gq86Lqomc``Wh2U(&jQ$FF+u9gu9CK-lAy8O=x;Oc-qcp5& znUxs3k>zk+m!9UhE?BmGT7p2Le-Yi7;*c7{P%}7eFsobYiQvc9V8D2i*Q}~Viw`ge znL8*iKw92D@Y9NJomK}Lgp%>;Fst2Dj(A3E=F>`ea)TIq6rYI zdI+CP=4)voov>+ptgnk$hhBI(njBd#giWixzMaA)2VfP#18eT59+-8Y8fUIT)v8io zK#LZ7Y`o5w&!AO)9C$a>GOxwGr1kh|%u3$}SicdbAoj^1;9|Y=n#=GToIUi4&Ro)b z!>_M>!s6BUv8T-7^ZUyc^4y?Fo;Pna@jI{e1AIS7lizDfEwKoxV8xt`On(m`O~%8i^>V=?0Z1 z-HP3UUA6=`845ST(S;I?ZFIW#8Jg)ohFUy&la#K_g$zC}aB+*g8i=sqnJ>L(YdP9q zzBpM$est{8<9EJUqLDFa9rakp`!L&CfaVgaQ*F|iRAYjyGya}&snp<&vW*qPXLPBC z&wIPy0*aapt7HeapS@!Vt7dS^@hB925bDg6~e0Hjq!q;Igf7cjo96G7kq8~ zi>MQ}ZDGx8-N=p;PvT}m^iTS25^wArlzwT_YdZw%)hJce)Tkc?S6G^SzQo8F*^`dB zbP(nxX_*LTvQ_YBfN-z^TvwIj{VKCAtBYL&aJf)&jCe3E5?JcE#0in)C{K%;sg>y< zM-f3)mG6zUjJOZoad*iH5^=up6g_r+5q|@@cXDFvxUF&dAW2{q7xDZMtxFf|#c$zY zu~`*J(aXmjSxjh5?i8!Nf8~J{oxLPU=iR!jfx>ajkp0W0B1p z?WyW#_Xe15cd%nAk2H9&Xt0|(kK4Qz>kJn1iyE)Iq@(-j+_HvyzWObo<~uT&tw10o zpScCtypi<0fkK2|7}^3_lrPtK>f)J~BB;w^=s&vo@aQ9!J|X{(=pJ!Bgc{Q5G9R4G z*I&M(ji(1$_p@fYb(N>lSG2jQE$Pog9p2q;5>C5hI^rl(UkmkPnPvTmIXpBG>+-WX z*CFA}QtsD}Tnewv%7HFN;;*qiq-8jX(hEo%XAHdte!YnC$zq|CRg{N{hy-N^->0NK z#^l2<*j`)=f^by4p^oC4ORq#tnNb;C87MwsGOZYrG<jGLXt*tz_Ox>YbT20bVl(Q@iw zQA_--d*f8Njb7OnRkf6er?d^vqusz;+v-t=@X=S$_O1LTemgF@ZVoQ}4@M#?dZPaN zv5f%_c1R}KyBEi^`Zbj|DxBq9G2|x0Q_~fM0N4A)JpgjeaLc)fbWhLwn&x(ZlGkF|^j@ej~ zxCK8Xy;jilTF5LFtWb42xvRHlLq(z8a7LPB<)q21&+lJ$X0=)g`3ab(D(_`7=EPfN z=C$oW<5iE5GWLY@woyqr3QseFKC>`Y;CvrYmZTsn9BIOzbz+(DphjvFY0?kV2@CIi zKh zxaUag?~>lB&G2~hLD9dWPw}&ki4Ci=9k;bo%)j#c*hIrDtsP z;)@FVfNAYjf7La1t}b)BIELN4?>&?@ptf5Mf2v_~tT#8u!W+F^gM2vDyDn~cgF#o& z@8dQzMkyg{+=DL=+V_bd%6VGRMV`yi3qE!0@3_Z7#|e`*x3ZsB=5BCWL{_SSEVAhF z05%`8?r|E);sTpr2-@`{&i1Re6pwqHtSS65oQ#PdcJj{SDGbq58dxC6%jB1~rzfW$ zl=!_5CK+xUGMjT*QSm1mQ#g zsoDd?$aiy4#k%rbt)D$G?B=z3wIP$I%;zuJ1LQ&7S;U z1&9~buy+PYViqzr(xc0esw-X#q<-ij_VzkUZ(+C?qeg&h55C?@<7!rx35=pdIdvV{ zu!b8ZN`bW9aZm8xW`uZ%aMf+iwoglz3p>BbQMQ2Ez-=WX3zMUqJi=KyIV1*O+fG{Z z6foW+p{`ucy?<50nxsA#hZ@c(K0v2mxm#`s5R&yYUbpn=(F1jtXuqkdu&siK<`jwB1^r94`P2QryWU*pem zGLeJgQcqe$Hxi>}8pUGlvPMki30^l7%hk(mXf9YNd*OIP%>GsW!^@mGbWAg2-N`0j zm~A?;D~;Z9FR=t0t#olH855YrjbCYILM zm5TYTg$@Q1Z^vA{)KPil2sL}7b8(L6Y!bB=hUsdCTE3AdFa7jPDESm~<=Cs%M0q#) zBmcF3=`?pZ<`)!0g>dBo{uo(uDawF%0k;Noy&LUg<;oFOJHr!_ARYEz$D;uj!<2Et z9Er=>j97Atyy6Wb5|tuZmjXc7mYbl&%qF_V)T++;&$6Yha%6M5F$1}JP0Wub-W~8M zKdvk)E3<7U7kz&ELW}GrEZkCVm1*Y0_h6NU1dd8?g9Orum1y*x&)=8An;hmamIZmk zYrr#c4~NIlkm3HQrS@B=o?K#i*ucwS`P~+7Up;3IS7G%~>;79juVK#P`q(W6ytK|9DK5>(L6%Ui zpQ0lZdo|?JLMNMCuLHVEJh+Dw{P0db5V%?p`Ry>~=Q23FxggRQIykav0xE((C{4zc zjTC|VmI+SZ8#%EAey6^?4_=I&tK^msq^^XXqFnEc-`+M#MTUJSxb1+;NkFqSV0`XK zWKE9ta9Hp0R{rz4B^=p;$>Nj|hv_Q~v&ot*Vs}zBwFrk|35GcpafLnJ&f=Fu`85VLWl*IJvS=1h}PbxK-HA4FG=-aMo0gcjZ!)OGfwq3@F}@XLE3( zbl{;_y(?S!TH4(P58kEUV`!WqwiLiAayFHhtnVe+zd8Pah>ErrLo*T29P4Ap6sLk< zUJr>-J4|D*mN@wI!XRV*K)E3&(mvMobdr4n)XSaO8^(Q#E z!IUj=jAGbb)Ag#Mqd>b)^VY(!qu|uIP%?ZRSWpewd4@%89BZB7BpnwcMO^y+S@Kvl zoyo~qo{;oaM9z+4;dfpszq@VD9OQy1*4-H(yvOP%TvUwu$ggo%8MeB4@U}5ud5fR> zetvN~xJjcubuHpJZMnDT=Q&HgT6p+tkaj8i@D*pK3dH*=s4Nc1;J(o0z`kQW=xyF+ zS&7hf*hv5I+OQ-ece3u}2FoeV8d$;cwC&eZ^3g7L42|GXa$R$(*!~u<`&E1iO`*wm z5mUKe)o7ynMZuh~Io0Zi!6vKXFZ1ak%#3lw;JP3AR7jgs>S}Tcj5WT~spdnc7C9(2A+&bmFSSi+O@r_g=o_7sFS>y&))k5~ zpyb|Kfv-CiN_gYeGZwwew6b8CnU`Nm4S)Kle%{o(v=B(@e;^b%yrDT^nc-Xyr)_qa znr_T;@n&F854n|7ngv)y1Uir2Hjt$+h5kBu(JeR4L(RaO1QkvZ#YcVdj{HP1Gr~Uw zwH4*NU8dn}xbv{u%g!VNY=qgILGthWeb^ym z$ohtnf&9u}Dc=aKr&EEd?lC#|_e2vrnwL5%EGj;)IkP65i=?ySxq4-xym=>jJh&SG z4oc7DsufYYi=AR4@ZbBnLT3E&c z?cOZ~z;-^0AE&(q(YHkOxQV-y>WOmcXBC{RNC*ywhN|l8Lbh0QylDkE0u7vqCsE0T z&r`2-=Ve>Nn+eB^Y3^A0!QZpZx#%rCnN($DXzMDHxylepa^(rEUVWJwr2j~d!zxEt zd$zZ|(&h)aUJqE9mY7ECryagp3cy&*zo>f)ph&hwO&4z*8gJa) z-QC@t#@*fB-QC@x@y6ZV-QB%$c=X<9pS#bUbLZWec=I9#A|sdO$}B3YBB=Vlf6eNM z^qD-ye$3CV#F`ieoxM`YrN4R>y;78?T+bixv83^Z7aMpP9uBqljdp?=_MC855(qsD z^bnvc?X9xnQ`1utwvj8SU78$Hh(sqqdl~|TWYs$I^Z%8|~;*bPk*-gDV~| zh<7reJc%nONvR^$VXxro-DqDV2&YJ3)^7yT6FQ$Y|I{;eh~6M17t(W zNqQSk+4T0!vt_>K4{>-4)UVtn7Juou#x3;-)S60)>ORdSWH+kB5T~!fYdKXuEKDm61<^jip@3)cTSyd6Hz=pXtkw2XG+ugJ-30@9hm~VG>yD^6}~^8Z)(^KJ(fO$7WWtaLy61 zO{|Z@Hr_Rv=|C~OkTZ}myqQpZ9$j=Sh7RU254Q|1;I4}Eeaw2J@YvKcRk-R_YlbNO zHLmG(^`-7D)h3E+-QZm%H%wQ)OJWi;^n7&BDkcEI&GRaC1&HGMHm_+f9uPDN^SZXf z=U#R@CD-d0jlvo$kAHlVsXY*TRs8N5hbLhNDLlcKR7`Fi#Tdo-jgUib$c5>WQD*sX z`i}XHb!&6fB}61m8}2ymU6p)bE@w&J`i2n$os1y1SNP3}p7Z8%2b#fE(hLFV**);Z zB#mLW0h}StGa=0|Rtuf7#?zF@^-pg6TzMpu&s$Pg90Z7YgJzjZG~kZ;ikUA%>eu3X zjnH=Jn7~_xt>5pF`A=8uV;E$IR(>?YsX6NO9?yp~%@l@kBW~=L3ZKNbnY$KK21Y|n zHgdOhMt#4tRV7U#X+-03LMHa!12#mLNri`T)jPr&v4u|7Vm3ocb!UvIWCWqkJT1&M zM?3t~DnJulMw48(yA$9L(ICFZt!et1teV;3I;&{m(2;7d?{ispA-1P4xJqle(Ew+$r82_D36jE;^*>NFs+-zZ-OsH`(9A%{kN6pC8 zfjMlX$~G^>MWpQGuu#h1p9!|M(yM`j?Eo^oaZMr z@-+NRrcIX1>>VL8%cxdv?|_PzJv=|$KG~TzdBuPcjZ2l=^BfpS5?{}rN@_M(P+C6A zJSS;pff-a5H= zktSeM>aG|Ei1H&mn3XHH_;1R`$HUcXfXsb@}V$zWJ}ikXW=Cwu6RHTcK*8Ks3E5NmfE-F%E2t@@Ug)JA>3{SMG&FO` zkfIC?;?^FnmKpj?J8HGR9e+iH_Q}%_{?!d701>#4@h5%2JrB)-q7ikj6QeXRCvnWq>r|`+kQ3HJwMj zb9nQ{bTyFw-0inxMQZ>&DXcF)X{Fia2jxeB zylx%ylP)W#z#CO)0Nb&%vZT$h5pzJ)qdLMXLOkO~Ig1od-Vko~`yN)m+w!vtCsr%l zdUR=8k3$iikK*0nts{dByBsvZ*hVY4uu`SHiInrVd@?pO^5{6Tp;3~q z00eqiTdeHuz9mJU7?gjzQFZj;nyBlIH zKVdu9-nLoZjWa^k??945>1f;PD{>4vEfo~Yz7`n-dEFSGXgdm!hA9^6q1z=5bOKNQN92rLr*Ma z<>Z`Tt6fPmBJvmWjQCq-u%W!k?0~gwh1w1K_h+wy8?NcbG{tjnYvN`?cY9lpK$>?c zb!pTM(mLKPu{HE}ytQpt86lAA_MDYIkIQ3?;rW-#K(#ih=JCQEe+#Mg=%@`#R~MS# z=g$yF(3iQ^AlFez4%{coUD1Rjhm5{HBG z<1tO(2y(6bNp41)81A(BZWZvNLB4QQMQ0hb+&d%w)&$fhGbiw;X4+X?Q3mIu;K$|r zU(fPmgSvobW}@c&^|2xAP?Ia^jZW(vJ$HAOQ!!(9Rv+JC$b*J5qu@FMCc!sb3odRR zFD5sSI@KBP)X>01RIqbNtarkP%xy_f=Q|Dy>$`1WA;fq~F61uf$q3@A0S(cHjG`c$_$Tg?8Pdtm+3Q@20++;;CTJ` z@b>*6fmHSPO`>Hfi6mJC@PAp~`4_zKPYm-v z{%)Td_#Y(aCtk?kW&Oi>`wy7#zgJ>l{q)H{x8I}bSy*uyK4W zAKsqvXN>XhaO3|kl|8*rd+$%t@LzmAU3+~~(?6v>8b>RGPp47e+RpG#!S8?D*!z73 z!#~}?PwMrL+Fvf@=h^;~wD9^iM4FH>An1A?KM=?w9KBv2nGSjEI$2!B0} zi9sIZ~O0|R^I1>m89CynkMDFX=h;mV~|5&A(Qh}lI$ObifX?+*+j2=K~liwC#|7mS<( zU@y>>`wKP;zzH;}GmaO44HX>I4A=?O#E%OLmwE`BS;yFidkhTnTJQ>JFC!Ds&0EO@ z;0_lX{wGUc5^8WZjt*4AHHfOfS#A}phqtS|eS<$B?+4_nTl3pP91F;WFC(bV$13p` z0Mi+igOdn=CH^y;$9f%6Ch(cj4;YP)WzFT$Wi_a?8%mUlld2?*d&dw*QC>=aM6uq~X00*_Wq2sQ-A3v-7+8p~xkKOeZ@B}R4 z-Sc>g4IR4l{$Tikqa#wmNTHgW$Hv8_1On*Y)&YUNdBhb%yUM@;aBK*C1j6kQ?e%D@ zqLnd#0APzp1>iu#Jgmk-MgqEOcJJoIYh0M{u6)Hp0s?wm>#_+cXXu-_bx!!$oc6Xn z;n6ktf{_vq_2?{!)^+G(WAF3x9X1r#Jk}kq?u~>n0_pnB_pKLS)G5ftrt~j_<&+E!3S~U1^^*KX?nM&)@`4THbs`wH|ojOQAl8wqSeX z+Rbu(@a|EzeI7({$pe2pa>xRStM&BmE2-8e0mVs0HOuPB7mpEsu@r)yIVgNF6S!u|cNLSSR|W86u04;TRGI&f)=(j#bD zG=Q~;DKPO1DYCR8=bm6q$-X%0=1~k=Le0#5?I2vy)q%J->=lZ-I3c&r1_!_J=3K!0Mtm zFAqUPPxc2s*g@%M|Ox>wE08a0(_B zGXyr*92L;=ARtij#0j!E!wnPfU>neMq(UxgbKGC8#j|KoMb?C7kcFa|M}8epwznRXr8p%xjL%h~Sul7L>-7aIJ;3 z=H_dFYvgi5<+kllV7KW`tVn^4vZvx>Y*7BTnhrO$zU!7!;PO1l$xqmteCHsvfj@foiag_A8}~zB*;tC!S)tJp)te4E2f7 zv}FMRXid*B;xA{xD;6%$*zA%sZ8;6<-0?<#iK?4y>PV)Qq_W;ZSo^Lcu8iu43Z2y$ zDbG_wUV+69+)f5$YiV&=s#Nc)gab=mJ?YF*A}&tHO$_0-DsD`BL(e4Y^FZa1i9Cqm zY;uhKb#R%>rYJih#p+iwOVkcElCZAo2LhkP^VCNr{hNX31gzqb&exxlxt?fX!Y4WFb6+#T`7sNV#6FB7`|~cs z`-SD&tY}}yI)`b-w`%NngR`P~K?GKa+FQ=IaR>v6fMLHJ0N1&eFHe)uR$Gv0RY>Fem?P1+V)yh{4URWt)ZzGJUFYL%Cf;$b|T|3kxgCPr;N`&jZ!PC6 zTV$ZWbb^#u;vi)hTi%a{lQ7WTSP4z@UPkhvG+w$Z{g@S^7&Kj_R7z_uQOoGy0s72_ z#+~FoeU7tt-*QU{cdgk3A-G%5I5sEY<1gFlD>|)2kM#M4PlNO=RMXInvC7#@85jv5 zh3QBe)5VNSL9ZOSiMo_r?zZpA$WTbD5YXHluPb70dyn-_=`*R~vr^ibfd$(BD;?^b zsn*kMcy|_R-(0{o(w+=!fPOBXYljvWXF7n)JL(`K z1EV+s#RA5{?AeVG0tTCr!ePZ6z2*M`WBByIX?M)b=&MMqrfDo4LaAwB}kVwWmeN9FhY~uT`g6opf&V5gq;YYZ94y z{@t9v^^FVeyb{8W1M~d6|7OPpqSIqe=M9Rg3{~VZ{mO?3 zB8$j#t$@0WNph#Ab+lG-V_EO3T3Wr~!O)@1K3+0jSkInA#&Zq+w~;(4*MT15d|y{S zs)%5e4yz#Ts8WX`tF>iOFHQ3#dJODT6I3D2;hmj=_3?FDbF1TOj0`nz@VTf_b%l9J zg3fb$*QB3W9^8`3*_qXxBlkamUfMZkBMAf+Jbjsm0d;QJQg(>axlR^>e;fsOw>nzS z!?2~8;PPF%D+MGIvHM&zAeROs$y8{VYxWdMPB%RrZ3-!IpbfJJDl)hTA=f-XS#6^7 zEJyCKul8h*l*w50MXHaqos*H3jglLNMx`LY_uJ!OP=1mYcPLhY^=l%qY2A7NfN z>~%Gfl zJlaxlY}gp8GPLq~z0M$3rHihRJESb_pjKmgd=LHV$YVu)hd$Y_f2aRa>xWnphGUNWl<+`>!dr)`wOLD69u{F}xyi07q3ZQN>D)mrpB1K|r>nm)Q2+!3q zw;zW`HQ1J16l}bTNezZVG}FdkKP`8nrCkX`@e+s%LoRF2&@g`69qKbubVEC|B_ji; zVsjEaWK)AR=Eqr?Dj~UCYb|{#9e--~ULGj(tPN%krXa~%^?EkQ}4BQNySbun6abJp;qyo^5L z7%DFECM@4LgL-5i9f68$$i6ZcrCsYH>bD7_R|>gO8=dqUyERW5!wqwpqa>%xMGVYX zYjdi4W;sP2IXR%$)CQK@QORCQf8kKn*X46^L%};D%62_8h=!F(pXx5Xg2038t>J9N z9kISe?1#nvK5^mk#puMsl#0@bM-yEUcwx>XubQ3gZrH+~o1q*IYeV#*^3c3KTduBp zBa9^8ohG`{-9%Lq)#K7WA2y7tv3IU?(+ewu`U8o{6D!Q|M!0d+<%sLSqkt9S>K04x z)ecE}B;(rr+dFxl^``cSrQI%3F;{lVmZfZ~qgaGyRh^!_10l+*(ty#+a%0?~5SUC} zvvd1)oPwO+ky{qbLy3Vc#l38YDSenc5?~1u@EYc)t##3?X zzXR!EH$kH;xSIIdtcd9uFS@=3jBtF>wknzIeMYV`s}B{5S6L`Rpq(I7wLG+x+bHs{ zALkOCj9aU@b|R$>`VtIf9CR;rcGMb;OrQmI%Sv-1;2-6A`CT^ZXDvLF6AY@wPOz9> z!6aovRVmlABBM!oK9sJap)Z2+N}jMOQ=XyIM=sq7t;Sl%r9j_2=M|{3sKDCmF3PkR@sxejV~ek! z3e-A|+uO{%ZD3jiG-_Ftnsf%U^!e$ry)cV3a}*{<=tlf-+X{HwEN3{!IXTA)}O6 zb#}Pq$0v~zOmRFSj_I|$X_l2jsmT^f&qvooWL~$mOgQot@z+(&@j$#`yq=kc8|RYW z6z(e!j2oPF6t(IbMy?IS?v7`S*uS9KmQJ|NwNA9ILGCE$%-stAfo2jdtf@wdP^cD=}@CWY=w^?PtZ4SB-U%X(_SWOmM z|5i0JBV#@KT`E#__&d+y=24odn2QDUrf#mj|lGosPREf!1rg_p{}ed7rF*Ut!da32Kcy9PWSlwh& zfc6q0IBtFIlnT$Bc_Te}p?aYGbWIMv+v@@t!>m8@m^VEIx8wThmd``KA$EL&JXxFkVhvMARnyCjGEb*8hVT9l6tn$Ek!wIV2F;v0~U z>`i(pLWlY0zLcF|x`p$Ij-sn$(!m8zakpKzP@Fq-vMK@op|B14?F!A2> zwr|`pjZ}mj{F-YZ^|9#acDI~T)WF2P!O5h`@`U>={e4-(*HSrGrom$rMJ!P zECEXck=~%=Wbz{-8CN6fQYb+oSK`)qdyv!26+L*0vObL2jtf_4rKc`eWiq&V0ql8$jf(cdtM+8s1}^~zXi^O*l$ zIx#2(yZTFUIia>WaN7fl_1IY$e2&(|vWXo|HHIrLtrwNiRq*M1hz{EME!4dza>JqB zsMT5s4z^(x#qprv<$^z|fwe#(u%Sn0*3d;AeDs(z9R!1H5W4U<0l6hl(jwOFce;i@s#Y^BOKx1?1flX5#{o>B%U7P9P)UhM-?bLxzR zqbtL2S5}Svg1_Z?t_<4osz6DcJ|tY5;*YF8RpSh zfCemmunGoKeaOGSoG1+oc=1nx4Jw0;Yj3-6LS%|!-~wR1=A?}z`YpHdHbSuC?X)HF zXPh#l%SHzme_B&+OljnN6NJBP(lvwPuA&$z&jfr4mgh`Lh6Fv#caDP9%+ZDP7i>OOD4iv`-FpZa0gII=3+ zRD0;*t(d(wdcR_{-l{rKD$zV6(`eO`^ylRn@|dkzZr0CLNh(is&32IYB@ZZZ0|mL4 zN6@itur-uzz=U1wWm3*%j!4Xdv*u#`T!mtBdJ>q=oFosVls5Ui79eGJEO)CS=Gt17 z79j46hVRIPb}b28K|A(U*l_i}agqs`J>hYdJk2dFsK{ubU1&`ZRXsVza}tlo zYpY2PHpt@QyB@s-!br-Mmb)^y^+Qv&Jp9L@SO4JMiAh1BGxva+V8TR0A$T6GZ&6qw z>j_~5SHH4fk`(CY0T_wmLC-n_6FNui&S_%#eVxmI>mX5;L`6EL8PBDrmY#~%Eg?F^ z={fFDd|#$9!c@nkC$!F;Z@SXfBf2&?x=D8SJ|{7((-6X|>ISKBU(CX~_f*OP`P zfd~-2ms<-*2OJ1I?eY~k0Ax0Dz*92%GjV)7E>}r-%bPHoyIP5z7lOVCrNC4M>nQ2n zaGh{Zkd#lz&&k)GQ3J<`citP&rx5Je`+NSX&h(2Z8tPRHJEL346_y<8f)3L{5w}}? zPJhb8j{FnMUum=2-?mmSC8f3xZvbTo-3Sj=M?Z)ExGs)G1`JV3$ z7HA4?gzD83x}hi^~oKT>s;3I-1wTVTjr+TMx;3UOC zVpw;~rAyHhcbT|6Lc(w<)DnyiC27}B1KA6dDCUfepZUv?>Ybc`Bp}@HjcoFaOnA{f zr33lAE`GtA;X`^rkXVd+d2VZ&#IqA4ihfR1+UViC;cW=>$4P^s=TY6%CuujUjAE*> z#zBJOBI4kbQ@_H>Lh5p(D%&)6I+9BAQhN=jw5$`dE~eZVFWyA)d23{)PgB8jzv<1) z4IHqUIIpXISN;yxv58>NxV`I91s8~L=P;!=jagDe&uI00>6w?&s^n<511W`Uzwmq- zh`%?=g}B(;Hy0_Iu=6yvKw_C_2i7JpKop2UKRvaB&H4<)U_}K7`d0gT8GRgplofX$ zu9ctB4@YmUpx<|wc(O5`*j{PT%#W9f+kgZajdtGFg%lIv-2enJ4d*_)Li--*z28;1h*c64;G+C-OPGQSv+E&CQGwX=Y5P1FxpnU9fF z^JnV_H8YX08AY7dVxOL#PMxy4D=|bQ6uAxhnQBwbipaEDJ7%9JDJQmLUKTPye}119 zzSNoD(A{j&@gtUppYKIBCuG^9d$5(OaNq`g^|pULiy5sWV+3cwiloKuX^V<4^TQsa zmC?(K=%vS!NTB+xF=L1-L7r@62_b7+mHr{BG(pioNsBv++Rj(im!AvSzxdub2+XwW7h#S= znB$tcAq-^_3D;C$UXlRoeWRs19>fx3CQ9!z?gDB!fEol@7#ESLP#Y90b7&L9(b$6NnOpxj3~m z%c%T1{qSzJgTq!`$2`=Gs$KQ|;_4njq%)ysHt*itxx_8nmFYg~c$@Y>92LRReW-S?G4A7Cps#st8IO4!F`0e*~s9gmw1i6#@G zU$R|xEopQIokS~b0iOuMI%>@sRy2WNUxxI@isekeGiH8F+m;s%hj*g zqwAl>r*%5w-tB$3DC~2I0RqMR;htwS!;nC6=-X6x2T-vsc*nJxG%a6w_y_p1^>3lL z+U65&*ypk6;hjWvVHouLDOU&v`(> z6AUeYWJHeL3qzB_oslq3)-`Jp?+*PUSKP??RJj&0TrhJUzuTHE8bYbx6m^V8cbiGC z@_+*93|&(FOnUTOUtXfpFEbpsV=7OK4l&AEBD^-DENWLUj*EU3QjNel z&V%j1c=AEGz4&Fjlc^=un>meXKmv_5y=~u7t1->>1T<>>G}zqMUb`Z}8^Y3U{)o%6 zw|fpV-pBPl2~Ri}8B_xRNXd@nb#rtKMA2^s6DloTXnNS+@P@FtxJ3J#I-t9Kq78doi@;Vs`c`CamGrEdOG!qUMiLt~v!VjM;bK=83 zc8cRRo)ldgZb#@y4i{tZo6KGtC7-o1l*29+V!5s_cg$M14dX3sJa2X@=AH@CeM9dR zdt7PEw2I_jQ6nP`lj1C80Zug|ZQsSVNXj;8K#k(wxC*gX8!Vq|{rjtPzR@AORt&WX zEnz>f?(Sd{`T#9;HQ-RU8yUI4KH*o8=-yLWCm|trC;IJ=HkqNKa?-cUZ$h+8yO!3F z;ZxY(V(W2yePTEoBHbE=PiliVEvepZAfGmF%`Z-dkQoyRw%xn)3eBl=5h~0@0AI~` z)EQ@n37kV7(AW9-UQc&6a>&%UqdtgvjEqL)K7guv2TdH^VkWJxqt%ru^Ez#*btf8B zU;mUl=<`E?MNd6eOn&C3sQRVK#*+gjmn*SPeljC-Ur^Jz50LN)^p)pz>-7WdLx%B( zZII7)7A-368pL5IfPk)F=l=+S{(T*o{}u%L2O=l`8FBbe2$bP71o7WOpp1X6u=Dri zM>#ouQQ_aokBa|}0{t`k|37HPKk&i7aJ;`L(BI7I-;y7HSO1y(NdFr_{afCf9(Gn_h-wW zqyK9A>)5~c|8CxYJ>p;I{ny&xXZ?5O|2+G@8}mPF`zHWO|9hst?zn$)V05&fx7DAu zPjHl#{*xj8cN`cq)8~uhzsrHe8)_zKJzVm&a1aJ#+XaDv_U9I0K*;HVp?&@Yp@9~( z3beF>6kv#%!pBm_!U{nM1@xZZdS9&Ga?(t?I&vSjRH44K{#rSGST(;44;EPDeFQ`@ zg;C&R&kqz561)UJYQQDV)A1<*M}x*Y*p?IQu9&hZsEb2Jclv@$PC)@C>#Md2ZPmdM zhv3{L-^U3cQ~(7A+Egb3>=X9tO(X`4&Dt$%gF#{JlZ3p2ec+(bI{*nt%e&I0YZ3vz z1qcK<^7k6CUXFM_QAe9|7%0 zysv|utw^sd02Lupklp*_oX8LFRDayBA4K^L)=%*8?o;X)1R!y%yi9Ux^f zQa>hy0l~8l#AX%&$A=0*=ylOoTnv~u%scR1sFo$`gZMa|t+G>07#d*aBe)L`*T3`l zz<^KrBL*74;0RcbZWzU3%PFda`Dt&lk zzE1}BTQgHp5<|R~$AR!F^N$>QPcqsCwYK!mB>=?f(5kA7A2`nqU~A1J4{-#R!P&i>6lFbsMl{0WkMfkx92!xwrTe+E8O-$Z=L|lmEC` z*~`Pv4Dx`o4qv~GTc*le*RYn{uj@3|JQyM2T_qont@VGc;IWZBmK(NjO{6O{w7+ckE5$s&A?sXEz|^(GPtB@el^oYf z+H2}@Q1WmdJl|$qSbaq0$h`*^h_E7Ljm7lH(n0q5R10835YTg9^|hhH4SA#mMWi~r z&5^#*YwTzp?A1c#q%ww#>;3s)>n-sGwD(dLcq4?mUwE(Bh$H(Xzb$}Pl(Ads90J9@ z`K^w;xL-!EY9(b1s-d}!bBiTb6c^jMb<=;B>f9F8zXNjz*rmmt0VhdR+RjH|JvGn8 z;s*}0a)gVZ3+5J4@L+&t%~0m#Pw8vxe0~+Py+&abNA&v{(jkGODZxR^tean1<*MD~ z)!U%!lVO&&*3Pmq-lxfvsF7n(cvZ7tjj(6nG_|BwKo`)J#4ZT^VZ1Gq95!GFVik2x zT-|F2badOSR2eO$AgRKj9VFrY5|XG#m03=>m9&S<*J=SA@}?=mL^Xt6islH^CG-8#n=DSU8B-!v zcjdR3$#G#d>szr;D%{iO_9_vAiREgST2N$?3R5wDBMT{**O*UpsdUzrjgNhPx2FK% z+=Wo)_!PHR-c9DhZBe7TFl7q#gAcx){081A_$i$jLPjT&sc$unZP@l+ayikZWlb~(7kio8r|evsbqtZZQFnUgqCwV@6DIwd z6`mZgCXv?;CWY}j{uW|vn>Wr7M}k%JymOHLqNQG(k*dwYbZZjc`dZ>_BAL(vjTqsaNfLa5WMeN-M#2*2(&>6AjMo7M?V|))EUP4#yM=SnEMm< zX3m!K>jq9|uZPahrlU1!;^z&zQ=QFU7Ce6^-Aq*Ls||MtTl0?VKuDV$nmD;L<(dle z?Fi1qR|DB>M4%eSeqyC;ktv=};hi2kF`PQCgfQ1n?=DCSjEl&0d_SLkCpU7qN&f|n z@{j>XS}|Yk7QQjOzP#;z*61#QQ0u?;t7WImU2+8BB+OjmdxC)qSsOiZ!JY9QCC)lw z4JQiy(PPc1P9fviLp@dhJkAuE=Ne&pg~{eOG~fDZq$RKn9%5hlpYcQIa0d27H)cqQ zCLlcT@*!H&_#Ma6rC^QD{c0Xq;2uto8Ezxeahn7FDjKPf_^vaMl3+?SP!dzLF3{sA zHtRrD)A_~l6$B{O!xKJl!2+DvFZ^_kGnTfic=6srLZnA0{H5{zbVNi`u z6xrfRNyN%-60hGZ`W~N|xsT+$Z9+~54D@hvug?zqPi_srB3vf}HB&M+1+mr-R{3By z47cALZ7AWmQHU{Cs~~l|Z!(u@$r*(yA4?L1QogY=jwhT>I$ygA$>)kriF%bI?iM!@ z?FRK};!}8}%2-mGCJL+!wOyHCm^hO60i#L}v?|1dV0Z6y?-s~ayGCL0m-m;jv%3>HV%VSm4bqi_U+?h`$ct>$}FVp zPmQrzS!joWj?PnLH08%LTSm#0bG|#DQZkP+Euhw3)T! zvQeI0W)_ZF@3lh5|1}FwEZUqD@BnergDzWG%B|3A@$R&h%kC0i4#!cs>L+^`o@QfP zdv@V6TuDvH-_TEi2%FVGA^SP^q1v+&FjZDsrY}zp;6}4 z-%0Lif1drdBtJ7=(i}~A5`-jSsIdrznz1UnaQ@6$bcASv_PKoCITR~tXJ}HiI1dPW zz|*V@8H!(-YNz?Gwdt^0jmEHnjP^DnzYFMv<7qi?rE+4YA=3ooK()066*pqA>2M-! zHDismHNtb>`e`-2DQP~;bQII{h&*|?K^4}48mkELT!GsG zV8&1lv?a}eG4f)qXXBk1q+Hz-D_Gt@^9i*~ri5xKs?92ys1GjAL(*RrG95-#_&Asf zRf%UQbW0472-(cJCqfAIMV8K;A0U&4afT8y4wOiIP_-pb#AewcKg#Hm4OcLrl3866 z6Z5@|pis>AZAzY4gVf`_#k}!}=i9bkE*RLU3{o-yMZ_qHmGo(LFSgvuzcNPSaX=mD ztBGtrbggH@OnQQcT3~|hz3!!`Td4og2>)2pAwIA%q>eLXMbuAE#|IaaRj~a`$6L1{ zh4SYrY@k1PG1ZC9DS3=1Kz)UA5gY7%Z(HW`Vw2La+I6QnHnj-3GU$AR;GIHfcbVV6 z5x=@8el&GmAZj+{#~hA!fSep>!n7ijE1-3aiwnqz+G?mkar&KCm6)P z+T_kj`o}WFF%f1Mvs%re&kG!OZUSre*UPYfhRS^thB7c#xOZ(>%H{-<)ZC>D2Oa;av(~w;N z*W<+GgJL+hhQijjb6!@cWBZK&?VUMuJDg*K2vZb?YF(}>?HxG&8^dyz&cT4}Cgm^Q z3`ZO;nrJrn$A$~5znaQc>W~+U24%BUqHLe4#Ty&V2U$4{?N{rC@Mt7Cf)Y(J${(1b zep*tsGxzLA!_5VhxasjwxM@2RGZAkEat-0kk*`{I5SfhHz?{PGal+2UMEbcL5k}A2 zlb5xhi5&}y+Y9_Em!J^hvyp|y*v<&Zy_#!S_$uARkfPLY=khZWZjS0H+@{F}s69pd znoPM*$ZcknzBnhOcD+y}rKhgWVXCVb9U;Tk%Rrdia(xp=QkqH5 z`^xTlCZiRsoQ0`9a@&YgE>lYrCCPj)_(t)ps=OG#JwJ>HB$zG5+dcOxk)8>DzYoQe zRae+JjDzypC~!7w5E@llKCnRIq85O%*Hd2E5W!gpq9n}&FkrkXvC~2PK!#Bi+}Jlj zQ^r!*q=ilsmNnn0#sz0)L|vUnFSJj`zFl}JED8Ua>Nre!iOjdAskkel25mtM%H@>+ zic_e~C&JGW)8GNy7OxPlR48s$1f~)S1a{}!9u***bPO{b>H;>A%adn;GxQ_rT_Wd8 z>K621y)`qam$vpsJQnt++1_}yKOx^+?@wyEhZG$&{18Cjd=x!+yo5Qiz_Endo2pQb^LBk?*A%wm{br8W4Sm3?>cn)aoRCBQy9qs!h4QIx;leJU+>ee~2^@ z3{@Zt1WT{hI|?mXGF5r^41{ej3%n`Zt2H7-D@^NZaf-2Oh4BSm_)yzr^moW8-CwR0GC{g{#aEK+4^$q)MUTe^$u^CLL9Pp=bgmCRN#l7K z1qsU1>J3#-Rp~B#rU^i8PL{@e%PR%bNWrUgxfW-`+h}4=B5RSoZcGUk$m;Il z)Um-bB=+V%T`rKRl~?cWxcMBKEIv|8I`Qq|=jWoxHu|b^ zF0N>O4k8!#WxYXU-)qx63mbY~{E$OJ3}Z>Sr@CWGgQr6UeX1)L?q7h!?k$|k?~u;C zL?(VIB?$AB%*Q@1xW%8-Y%0kA)rhVv}HegVr63*x`ZkXceHKX&@OrN}r1!aGb z;#a7Jw2b0hu1@W+i>qJJ@;FQ6)0t6E2j(}h7s$?`8VkIm_I}Z9pKxGo=8xuE(P)D# zy`9f^bX&gUPMZ+$S?_EviR1uq0J1q`9lfIae>(dLu&B1~eY&Kiks7*$NqT4mrMsnvlI{=? zL=Yqd0TBUd2}J=xMY=&+kVYwKkW`fTpW$A=D|o;E^F6;A7&z@#Pr{qFNF z(QwfzPGT(!PuNa_fK#=chH{MU+?35G`KXx~33jmVAP3eh4O>a#0KQE^5R ztSam^VCfmw+rCk_v0HlWZYf7l6&tp@l%C&}ldX07TBowsJK`mE&5tjsd2O{4tV}fQ zyW}2k%>|vgMMvFWB3a zVwvgj8L_~yC#kyqO%y$CU9I$3i z+?OMK2( zs@Zhem8i~vKGCn^IPO`a=0RvfWEhj9-b$qLElOke6D(PJiS%Tl*)T=I^}8O@{dsc| z(Jh=RoWgwS59c`9v&+VcegswPOid<)uF+I=WbJJ=wqdDtnqC-@lVTvrW-^r|DO`QO zDxfLkyv(EXxaQ7MOCRN)y85T;((G{OwIGed%bYtbdRqjUEe0*Q%2Gv_Y2kw;*){^t zoUzkwe58Eu;7)PWvJ}48d<*nC z-cffMCuz7|41G)1s#$f7a@W%!u}nGIShy}-y9ZylfB79&t)Ki7ZLd7^duBL8JuLm_ z^m_cR&*H|ULqjj&QGWxr&P@JIsq4WSPdd^Ux}QaA#FS4T>b*!Zz>Y2t^ep`Frr>h2 z+*lMiz;Jg-@>Ajyv+>nsZcolniluJJrgbpnxc z6Jn9yi_70jFX{8wd|kUP{wBI-UQp>J(N+*W7l+;y|C5zh>4Uv)%lUVMnJkJ`3@AdE z#PbEcWa`0&UTl}H&tAh}R2KK!*KaErtt`H!0M)GsHyefA>D&31!xEH}$t6qDE1i25^W)~s$>3pI zC;y8#Cm=01rAO$OIGyzw=4DW=s|FTc4eWXtHS^;p7S|5GP91j&N#us+x{cr!$JV+Y zci|g+yYs?X03o0xiX!j2;KM)X};#7*v{1V#O^ZvnWjgD z_o;UikA-Q%doujzM74^jp2Q-8H#1K3x%DKPAgcMG)q|t!;xE!lhHv?D_DJ+v$~}z7 zS$v_y?Aa{nw3^ng!52uECP|2a$aBwIe@95dHup^1$`d=In?54^iSo?U2v(5VjVkqE zlJW=hHSQJ1)HDV{3d#(SJqs7M*F#K|5fh|c5iZVaOr473wpxwg?{5eN2r~1g;3n2V zQ%}h+j`$R)EWoX%J4Prq-o}=$mfF!#WrqoNu{X-(H|NZ?uM$h*w!MqlGuB0R)pn0RH0h%^~txeEbJrbA-flZRC2~ z3{Ku|Z}tKUxWy{$DbDBb<6}Win`2+SpWaY5aLM->U{RX$sVv0%L2c(W8k}j;#-pLE zn+n!0{&K8re5vvA8{PWdqLJ98KCz+|ElK)V>^}c8yW12=_6kzqiX}K_B$NB#e$15> z%07oq7DU&Tc_T99UbMjKC|_M)N8@brl3jve-Ho@zUe4JBG_SS|owx|Pivp=`>2y2F zc(v>c<#9C1YG<+IdKTf&9Z}aFsBpG3r#ra zJYzwP-apeZME?#`v_yRCMCiLL!spFRwYM&=P`Wme$gW!sP%+(|8`mX$fsaGt7;HV- zRp>Wn^>RqBDWpd1L4jGu&3$rLWkHb-r1zd*t%#hqQ7h*n=sUVbg}bL&RDU8Rn}4`5 zYxSM#$hU5+7-K40g6v7DKBKUt%b=6fp$)RC(c&&B%qoL%I0*7iFXV-=<#QZU7H;pp4RxwHN)ar5xDXE&QR&*-Zwmjgmw%< zmDjuk*g5vwm#FE%C>jW3h6(9>gD zw_VL?kw{hsA6NCut>F>)Hj?^;yRH-_^B=}+uZTs zI5szmCd2;|6Gg+8zc8Tx2@^fd$#w=46+V*<4-FXoO^k#1JH7co#5h;fRSndQ08CWQ z@Lw=d=wC!S|6ro0f?wAC!bHz!!vkmw{)360%Z7JO-M?a@K$^SXxN#7`#&5~+;E-S3 zI8b2(NDLwT@3^Qu0BNe7X1)HCgTWV71!O}B%Io;+47 zNt0#=LQj)q2s=g~_GOkhMlq|U+Z!l#)4*M-a>6*gWz4KnK?1r#Nepie498^$`;}~j zrCUSl?E5SVNu)!=MeA1QL}801Y^^9iM*5d614veuDm-Q-EGJ$+HU;ZK%m@w&i;ANr zmY1Q2td1B8nzutiGN4(9TMYBE9L?ktaorsoR5CwR9?5(=n&ZRB`B9;UsWi$(jR|0j zcT}w~a5|VGUgo?Ely%}hA<;3vXT8LcNZo5^63m?+GC6niE=SuYadbR515XQ6g$Oez zvA!Vlc3mnw=l=0PTTBG|#jOY%G720}ebU`yIxCQZs9N5PB&IK8C(C$|yiL;x&1l&= zolJVANM&;>--%RT#`_PVY>#Z)zaHuMJg&XnSPzk4;)9aADHO9NfF5^9g&c|n4HK)i z=@2Nu0$DYUG2)b4p%!aB7VK2yI9LiWOd^~tnJVk>OONENr7=en!Z9|e_?!aM*B*h~ zCi1~oX=Og2D1aykK?EVULAP!l;|*hm|1>AJdC(bhI}IbO8vBGkF5x04|@ zZU|zWzk;_4L3MriRg6hgb4RY&Sn=^j1?h1i?TF}Ak&stkbprGvuY>z8(x!dMOsV^B z)FfRe`CXO87TN?ByW!_4-rz01s9l1yFCWKg-DR+^GnD>yy&!wRpDJ?ibBR*E18M8j zTNO#qJ5S?NM{5_D9*hky(DnDX#(W%Xv+}sQ4AtvLvzkqjNS0Pu^|zFkpL5!>V#dopXzF7wf%KWL{UF zOPuxKh^*3JB+i%qnRvce7sm85>cAxt+tGb5jCPp%FH88hnws3F`}9%kvUPol@LOZn zwQD=yV|_G6cJ%qR%Ok7lSS)*mUG>U=fG5el z)P#~g>wbo063a2|I6vvX(V-t<9_j0>tXKh#oR)d)Ra0q_wpy5 z0IjGsWocl4&epW=>ihm8HvP5M)oT#xx7Cr<0W0$N^;?ubv=dcuyh>>qXIKXK9_m$* zwghasl9!38sCe;AS14%LGUm$`XJ6Fl;ZEJFHsW4+e}haKN`VpdvA1=ZHr@ErolkND z(dI=)CE`Y$TMRp+l7t_SJW$6hw=#Z#hGL2dri%1$@F!bbPu-4J6Rt;Xgy|frevGAX z^pQwi?2RT*u$Po*v^MQfUGE`~6kUE8KmVzv8Y~&IJh@)8nRQrUJKf6mU32uBbJOLD z*ZLgL*`~Dw{x+oHk@pKcCw!lc(C+uY`s{3uaB{9KU zO{b@pfs@kOKktD*-lnI*g|#N;?YC5OWTd7~h6CpAm8Zqd%dNf9%&RD0NP#$GE`{ef2>euy{=&j0fmf83zs3Yg91qsL73TOWyL!N z1>s4J`})bQW2tema^2PIRR&R1aw3%iQ%Y_0dYvhV)Zzj<)5{JgNwFIbUbF}97Pnqs zPyqtV)@~aF`z1dcBo2kRvAy<@*M*3?e9sP?4RhVTDmRc>D=!YpNBAQr^tXmv=5IaB zQLWPpjg)iF5VlS9T^b=3HgAaMr1cYi%lCwv%G_}pzQz;q3ZW+W{Hu~}Bl%Z-m=1lZ z5opww0rb9xbzjHN_rB*lAFjzZ7x_%)6{O_g*Sf(Q{^izAyY8FMv59H|z{ZVj4el zhgKshXu}Sdp)cW-sT!+PSBasV4aycTZ%VK;1tgA;jRct_m}bmV8!4`)ZBhlb>`h&` zK{Lr$@3B1;Htzha)c1JsI_f8z0TS-fp;2+r*fR&vxWZPE)U7LY_^g#_+RFuFLHD#u zCsl+V&{Vq}(Y7~LZ*o`b{ftpG*mdYLy`D@4>27^<^`|KKa`t-Q!=G(~X~o~)9+-%9 zXKeIUX{Znqi1~XzCGGGb(X|%!ioV-2HWsV2&_3Ks>0B!qoHXjhPb~kHW8uqEl9XX= z$|PG0VUdQxP}aC=DREqH^Fa@9Hhx&RVdB-E|&GuxQf$sQ|-&P?aihIv1R0!+!u2-T6KkrEkX%1+RSXk9wjVci68U%`+Mua;rE&a{1?@Tt$~G(23gn zq`q6stRmcys@ejapxLQ`&kltP3ibo(xyvE4^lI zT(;O$i;b1$qKJ4oo~qM(38$U-@o?L?<^Ar>ENx3UM!3LgiAF7RWRPaq&xkBDX8X6H z$uaNRoVL=r_i8How(A<-A^2Muv;tNupG&bw%OZtpzm|u{iJ4FQaM{@$O72PF>wZ_$ zaF7%oN#cqy>_Fw;U`h~&(k#%z6fC^!(^6U&#`LL0%whv`d0PDZUL&-c#cV`;l{VJR zMHdxT4>{Dz1=|V&7Sj&Hf{#ns7VDV}8Ks97z6^?|ST2tjCVE_g4~q-=+b#qcX?>jt z$aKAK`gq-zW0&P)$BJr1%_m=td0W9WZ zo2jonjNJ;)2`&vNlif(J<*`KF{DBe6W!Pb}C772dP?C$6l(EdH1-&rSepC}je>-`} zCWvc1d(%H~%zLhZ@lp2Cyo$%Nu*Rp??|YE%p1UGBUWeSATIRh+*>0&ehsW(0V{=r1 z-7HGtWlein8-IacOXulYGo^W;;b8Jb!k^UnzaQ1J zkDwz@NR>~Y$nn;l(F;R$d%KH)_0uay$CE+5Qa{%=Z{oYw4S&jPlV_6^$5L7A#3|?h z+~~#q00R~p-a03#08+wYeaWqaRgGmsOAC{Eu#Jh2*qpC!8}N>$q#^SI$-O0*-Mo*X z&-~GogHPrj?iKQf*x0IZHu!Y+9NomQ8dzrJvJ})Y?6EK#(n`p&FKZG<&&o1ms&HW= z@A6}^$x7i^M|nojxlv(h(l#NBz6S9zQ$=a%+@f|Iyd)#AO>PLn_p_i%d4nq(7+Uz? z#}yJ#RYC3^fl-WR>H?M4 zEd>}xBT^IZ7HkNTfWc1j3P*-J5l4ZQZEeyzaR8s2&9e-5=`#koZ*Oz_i}{VX4vO^* zMvOpwqVe0|DcZbwc_$p@mOSc2FeD~XltPZUfN3;8b(D-DtX^*E&GZ}(0h1s>myF2|nkMp|)q!ChuBO1$HgB0n``%x9kFNiV)`-IHI^WeLE z;q>XEM=OH$61xvO-5<3}*hbE>M|k*toC$09e6%e)fM|cPJ&>m4;GC$Ipmg07VNE$S#Pne_Lwxy%Ikfpn~tc}gX1_oSd zzD=o(F=Z6^j#VxC&KG-)d6i8Ux!S!3r_EYX5tS{6sz=qye!DOkQG3lhzPM;#Fln`D zg|eBN`-aMm@zj=0_t@L4@y>Qj%;n+LB9=5OEG0b!!fWZ0 zoe#R}v@;$|*(0)Rd2Ix|0k6c6xUtyAG0@E*&HEi_oUNpeRJ z-rL)OylJ=aw3&<3y*}c~8aT-s5tY6FVL-mg`tWnM+I>mTz)s4xW!e~zxI*$py@%l!o1e5Z8{s6tN* zLil1no|r)?50|vWR@HS|Vn1K=KKl?63s~jBo@#yS=M$e;wZ04ZYQ&h^?UnTX?yWCW zjp&n~gP-OIBh6np!DHGlXXeS^zS~U;M4(oUpTyCXShAvF_o0tDlF5>4@@$gtMI`Ytsp|}=BKhWUP|>BUgzmGJ#chBSy%o^tpQ$1VtbBB zFEuWr;J4b#u6W&*in3nayJfmgT0HrFykv;;;~Doz&V;!a(3OM@=AB0(KDUQItnEdQ zJnFQy(;L;2Xgdgd5_M%D?nqoDU8mNGl$M~0Lz6qNGY6?@Zv=QxE565u^p}SW(`?rrELgqixt$SDd!zai|5JK_l}%>V zpGFR*X0uDI(K-+2=2~(Js3tBP{-6?=u-lk(h*#pOcqJenU1|~;p7f=iF)M8G`NMj; zq~O`yr6jXThPzz4AqN}<8N24eqxHDQV4OEt_t_IcWsF+H`(&u;vZ_BFA@r^Gm#guA zoTY{SSN`(TTRSkL`_DA3s+y{fo)X#<`nOry^N(2o?!iCS{U02mv)cZP9|X|R8eT;? z*x7rbS**`Y(gHJ}fFFdO7X@ZG|EnM53Jy5q{hXyzZpe&DqtF?fR zm!*dnFF)gSA9R=e(qY&-D{<8Ql z+fHpbYt`?wxq$ZzRE#+9_#*yv%jGS-ES+5Kh`^_P08AyLZ6gBz)vQxz64*lTQ**UJ zfxvp6C=G8fCkGdx(O^C8Ye?kj;N#&1x(5W-cR=}~JTyH}wkQvji#5s$SmgR2V&Z6&%!-7AKIir!96R+cUiuDydN2>5ZcvDHNxUIys{l+@_*a6u>n zDkLTV6@)^pcz-_&e{;x#kVqo1thblFs|U~N(_SvX83Cc6^g{n53oze1Ias1q^MZ99 zyqr)xr=PrF9d9c~l(iQRFIXN;yA2$zY6)lt`8s&ngY5m?P#!=tKmft`4WRM7U`-EK z8*gir2M=H%3MlutK|oqPe_vM*8&4hq0RdK4R^Zdp3*>|X)Pr1IP@o%s?MAoE1Lf}R z;DNIFPeEW%pQ;9IQvi6sK|BiLFbG5lA`FAVU~mKk@_Tdr0BeZQo;?xd*9!mzgoJ>> zWDEL71`Iv)>x>K-z<F`e^~VFL?M6l0Yv0q z#s)B$&$k26Dtg{#h$s{Ql+NmfLPgLqDf$Ka)%Sqx51U~y2;zJ@fD7o4^9zTG!q3-- zfI!h1D9-3W09}9HW`JY;54}LYi2d1DVvs*{2#KMeXFRJzNbFA?!qDHxiYw z2>t!0;}C#CU;AKfS6ARRdU|If0$+2nbp@fDetJ73@b7gp-A-q E0AiKv6aWAK literal 0 HcmV?d00001 diff --git a/inst/doc/zoo-refcard.tex b/inst/doc/zoo-refcard.tex new file mode 100644 index 0000000..b86e81c --- /dev/null +++ b/inst/doc/zoo-refcard.tex @@ -0,0 +1,8 @@ +\documentclass[notitle]{Z} +\usepackage{a4wide} +\begin{document} +\pagestyle{empty} +\centerline{\Large \bf \pkg{zoo} reference card} +\vspace{0.8cm} +\input{zoo-refcard-raw} +\end{document} diff --git a/inst/doc/zoo.Rnw b/inst/doc/zoo.Rnw new file mode 100644 index 0000000..a7bedec --- /dev/null +++ b/inst/doc/zoo.Rnw @@ -0,0 +1,1088 @@ +\documentclass[article,nojss]{jss} +\DeclareGraphicsExtensions{.pdf,.eps} + +%% need no \usepackage{Sweave} + +\author{Achim Zeileis\\Wirtschaftsuniversit\"at Wien \And + Gabor Grothendieck\\GKX Associates Inc.} +\Plainauthor{Achim Zeileis, Gabor Grothendieck} + +\title{\pkg{zoo}: An \proglang{S3} Class and Methods for + Indexed Totally Ordered Observations} +\Plaintitle{zoo: An S3 Class and Methods for + Indexed Totally Ordered Observations} + +\Keywords{totally ordered observations, irregular time series, + regular time series, \proglang{S3}, \proglang{R}} +\Plainkeywords{totally ordered observations, irregular time series, + regular time series, S3, R} + +\Abstract{ + A previous version to this introduction to the \proglang{R} package \pkg{zoo} + has been published as \cite{zoo:Zeileis+Grothendieck:2005} in the + \emph{Journal of Statistical Software}. + + \pkg{zoo} is an \proglang{R} package providing an \proglang{S3} + class with methods for indexed totally ordered observations, such as + discrete irregular time series. Its key design goals are independence of a + particular index/time/date class and consistency with base + \proglang{R} and the \code{"ts"} class for + regular time series. This paper describes how these are achieved + within \pkg{zoo} and provides several illustrations + of the available methods for \code{"zoo"} objects which include + plotting, merging and binding, several mathematical operations, + extracting and replacing data and index, coercion and \code{NA} + handling. A subclass \code{"zooreg"} embeds regular time series + into the \code{"zoo"} framework and thus bridges the gap between + regular and irregular time series classes in \proglang{R}. +} + +\Address{ + Achim Zeileis\\ + Wirtschaftsuniversit\"at Wien\\ + E-mail: \email{Achim.Zeileis@R-project.org}\\ + + Gabor Grothendieck\\ + GKX Associates Inc.\\ + E-mail: \email{ggrothendieck@gmail.com} +} + + +\begin{document} + +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{zoo: An S3 Class and Methods for Indexed Totally Ordered Observations} +%\VignetteDepends{zoo,tseries,fCalendar,fSeries,strucchange,DAAG} +%\VignetteKeywords{totally ordered observations, irregular time series, S3, R} +%\VignettePackage{zoo} + + +<>= +library("zoo") +library("tseries") +library("strucchange") +library("fCalendar") +library("fSeries") +online <- FALSE ## if set to FALSE the local copy of MSFT.rda + ## is used instead of get.hist.quote() +options(prompt = "R> ") +@ + +\section{Introduction} \label{sec:intro} + +The \proglang{R} system for statistical computing +\citep[\url{http://www.R-project.org/}]{zoo:R:2008} +ships with a class for regularly spaced time series, +\code{"ts"} in package \pkg{stats}, but has no native class for +irregularly spaced time series. With the increased interest in +computational finance with \proglang{R} over the last years +several implementations of classes for irregular time series +emerged which are aimed particularly at finance applications. +These include the \proglang{S4} classes \code{"timeSeries"} +in package \pkg{timeSeries} (previously \pkg{fSeries}) from the +\pkg{Rmetrics} suite \citep{zoo:Rmetrics:2008}, +\code{"its"} in package \pkg{its} \citep{zoo:its:2004} +and the \proglang{S3} class \code{"irts"} in package \pkg{tseries} \citep{zoo:tseries:2007}. +With these packages available, why would anybody want yet another +package providing infrastructure for irregular time series? +The above mentioned implementations have in common that they are restricted to a particular +class for the time scale: the former implementation comes with its own time class +\code{"timeDate"} from package \pkg{timeDate} (previously \pkg{fCalendar}) +built on top of the \code{"POSIXct"} class +available in base \proglang{R} whereas the latter two use \code{"POSIXct"} directly. +And this was the starting point for the \pkg{zoo} project: the first author +of the present paper needed +more general support for ordered observations, independent of a particular +index class, for the package \pkg{strucchange} +\citep{zoo:Zeileis+Leisch+Hornik:2002}. Hence, the package was called +\pkg{zoo} which stands for \underline{Z}'s \underline{o}rdered \underline{o}bservations. +Since the first release, a major part of the additions to \pkg{zoo} +were provided by the second author of this paper, so that the name +of the package does not really reflect the authorship anymore. +Nevertheless, independence of a particular index class remained +the most important design goal. While the package evolved to its current +status, a second key design goal became more and more clear: to provide +methods to standard generic functions for the \code{"zoo"} class that +are similar to those for the \code{"ts"} class (and base \proglang{R} in +general) such that the usage of \pkg{zoo} is very intuitive because +few additional commands have to be learned. +This paper describes how these design goals are implemented in \pkg{zoo}. +The resulting package provides the \code{"zoo"} class which offers an +extensive (and still growing) set of standard and new methods for working +with indexed observations and `talks' to the classes \code{"ts"}, \code{"its"}, +\code{"irts"} and \code{"timeSeries"}. \citep[In addition to these independent +approaches, the class \code{"xts"} built upon \code{"zoo"} was recently +introduced by][.]{zoo:xts:2008}. \pkg{zoo} also bridges the gap +between regular and irregular time series by providing coercion with (virtually) +no loss of information between \code{"ts"} and \code{"zoo"}. +With these tools \pkg{zoo} provides the basic infrastructure for +working with indexed totally ordered observations and the package can be either employed by +users directly or can be a basic ingredient on top of which other more specialized +applications can be built. + +The remainder of the paper is organized as follows: +Section~\ref{sec:zoo-class} explains how \code{"zoo"} objects are created +and illustrates how the corresponding methods for plotting, merging and +binding, several mathematical operations, extracting and replacing data +and index, coercion and \code{NA} handling can be used. Section~\ref{sec:combining} +outlines how other packages can build on this basic infrastructure. +Section~\ref{sec:summary} gives a few summarizing remarks and an outlook +on future developments. Finally, an appendix provides a reference card that +gives an overview of the functionality contained in \pkg{zoo}. + + +\section[The class "zoo" and its methods]{The class \code{"zoo"} and its methods} +\label{sec:zoo-class} + +This section describes how \code{"zoo"} series can be created and subsequently +manipulated, visualized, combined or coerced to other classes. In Section~\ref{sec:zoo}, +the general class \code{"zoo"} for totally ordered series is described. Subsequently, +in Section~\ref{sec:zooreg}, the subclass \code{"zooreg"} for +regular \code{"zoo"} series, i.e., series which have an index with a specified +frequency, is discussed. The methods illustrated in the remainder of the +section are mostly the same for both \code{"zoo"} and \code{"zooreg"} objects +and hence do not have to be discussed separately. The few differences in merging and +binding are briefly highlighted in Section~\ref{sec:merge}. + + +\subsection[Creation of "zoo" objects]{Creation of \code{"zoo"} objects} +\label{sec:zoo} + +The simple idea for the creation of \code{"zoo"} objects is to have +some vector or matrix of observations \code{x} which are totally ordered +by some index vector. In time series applications, this index is a measure of +time but every other numeric, character or even more abstract vector that +provides a total ordering of the observations is also suitable. Objects +of class \code{"zoo"} are created by the function +\begin{Scode} +zoo(x, order.by) +\end{Scode} +where \code{x} is the vector or matrix of observations\footnote{In principle, +more general objects can be indexed, but currently \pkg{zoo} does not support this. +Development plans are that \pkg{zoo} should eventually support indexed factors, +data frames and lists.} and \code{order.by} +is the index by which the observations should be ordered. It has to be +of the same length as \code{NROW(x)}, i.e., either the same length as \code{x} +for vectors or the same number of rows for matrices.\footnote{The only case +where this restriction is not imposed is for zero-length vectors, i.e., vectors +that only have an index but no data.} The \code{"zoo"} object +created is essentially the vector/matrix as before but has an additional +\code{"index"} attribute in which the index is stored.\footnote{There is some +limited support for indexed factors available in which case the \code{"zoo"} +object also has an attribute \code{"oclass"} with the original class +of \code{x}. This feature is still under development and might change in future +versions.} Both the observations in the vector/matrix \code{x} +and the index \code{order.by} can, in principle, be of arbitrary classes. However, most of the +following methods (plotting, aggregating, mathematical operations) for \code{"zoo"} +objects are typically only useful for numeric observations \code{x}. Special +effort in the design was put into independence from a particular class for +the index vector. In \pkg{zoo}, it is assumed that combination \code{c()}, +querying the \code{length()}, value matching \code{MATCH()}, subsetting \code{[}, +and, of course, ordering \code{ORDER()} work when applied to the index. +In addition, an \code{as.character()} method might improve printed output\footnote{If +an \code{as.character()} method is already defined, but gives not the desired +output for printing, then an \code{index2char()} method can be defined. This is a +generic convenience function used for creating character representations of the +index vector and it defaults to using \code{as.character()}.} +and \code{as.numeric()} could be used for computing distances between indexes, e.g., +in interpolation. Both methods are not necessary for working with \code{"zoo"} +objects but could be used if available. +All these methods are available, e.g., for standard numeric and character vectors and for +vectors of classes \code{"Date"}, \code{"POSIXct"} or \code{"times"} +from package \pkg{chron} and \code{"timeDate"} in \pkg{timeDate}. +Because not all required methods used to be available for \code{"timeDate"} in older +versions of \pkg{fCalendar}, Section~\ref{sec:fCalendar} has a somewhat outdated example how +to provide such methods so that \code{"zoo"} objects work with \code{"timeDate"} indexes. +To achieve this independence of the index class, new generic functions for +ordering (\code{ORDER()}) and value matching (\code{MATCH()}) are introduced +as the corresponding base functions \code{order()} and \code{match()} are +non-generic. The default methods simply call the corresponding base functions, i.e., +no new method needs to be introduced for a particular index class if the +non-generic functions \code{order()} and \code{match()} work for this class. + +To illustrate the usage of \code{zoo()}, we first load the package and set the +random seed to make the examples in this paper exactly reproducible. + +<>= +library("zoo") +set.seed(1071) +@ + +Then, we create two vectors \code{z1} and \code{z2} with \code{"POSIXct"} +indexes, one with random observations +<>= +z1.index <- ISOdatetime(2004, rep(1:2,5), sample(28,10), 0, 0, 0) +z1.data <- rnorm(10) +z1 <- zoo(z1.data, z1.index) +@ +and one with a sine wave +<>= +z2.index <- as.POSIXct(paste(2004, rep(1:2, 5), sample(1:28, 10), sep = "-")) +z2.data <- sin(2*1:10/pi) +z2 <- zoo(z2.data, z2.index) +@ +Furthermore, we create a matrix \code{Z} with random observations and a \code{"Date"} +index +<>= +Z.index <- as.Date(sample(12450:12500, 10)) +Z.data <- matrix(rnorm(30), ncol = 3) +colnames(Z.data) <- c("Aa", "Bb", "Cc") +Z <- zoo(Z.data, Z.index) +@ +In the examples above, the generation of indexes looks a bit awkward +due to the fact the indexes need to be randomly generated (and there +are no special functions for random indexes because these are rarely +needed in practice). In ``real world'' applications, the indexes +are typically part of the raw data set read into \proglang{R} so the +code would be even simpler. See Section~\ref{sec:combining} +for such examples.\footnote{Note, that in the code above a new \code{as.Date} +method, provided in \pkg{zoo}, is used to convert days +since 1970-01-01 to class \code{"Date"}. See the respective help page +for more details.} + +Methods to several standard generic functions are available for +\code{"zoo"} objects, such as \code{print}, \code{summary}, \code{str}, \code{head}, +\code{tail} and \code{[} (subsetting), a few of which are illustrated in +the following. + +There are three printing code styles for \code{"zoo"} objects: vectors are by default +printed in \code{"horizontal"} style +<>= +z1 +z1[3:7] +@ +and matrices in \code{"vertical"} style +<>= +Z +Z[1:3, 2:3] +@ +Additionally, there is a \code{"plain"} style which simply first prints the data +and then the index. + +Above, we have illustrated that \code{"zoo"} series can be indexed like vectors +or matrices respectively, i.e., with integers correponding to their observation +number (and column number). But for indexed observations, one would obviously also +like to be able to index with the index class. This is also available in \code{[} +which only uses vector/matrix-type subsetting if its first argument is of class +\code{"numeric"}, \code{"integer"} or \code{"logical"}. + +<>= +z1[ISOdatetime(2004, 1, c(14, 25), 0, 0, 0)] +@ + +If the index class happens to be \code{"numeric"}, the index has to be either insulated in \code{I()} +like \code{z[I(i)]} or the \code{window()} method can be used (see Section~\ref{sec:window}). + +Summaries and most other methods for \code{"zoo"} objects are carried out +column wise, reflecting the rectangular structure. In addition, +a summary of the index is provided. + +<>= +summary(z1) +summary(Z) +@ + + +\subsection[Creation of "zooreg" objects]{Creation of \code{"zooreg"} objects} +\label{sec:zooreg} + +Strictly regular series are such series observations where the distance between +the indexes of every two adjacent observations is the same. Such series can +also be described by their frequency, i.e., the reciprocal value of the distance +between two observations. As \code{"zoo"} can be used to store series with arbitrary +type of index, it can, of course, also be used to store series with regular indexes. +So why should this case be given special attention, in particular as there is already +the \code{"ts"} class devoted entirely to regular series? There are two reasons: First, +to be able to convert back and forth between \code{"ts"} and \code{"zoo"}, the frequency +of a certain series needs to be stored on the \code{"zoo"} side. Second, \code{"ts"} is +limited to strictly regular series and the regularity is lost if some internal observations +are omitted. Series that can be created by omitting some internal observations from strictly +regular series will in the following be refered to as being (weakly) regular. +Therefore, a class that bridges the gap between irregular and strictly regular series +is needed and \code{"zooreg"} fills this gap. Objects of class \code{"zooreg"} inherit +from class \code{"zoo"} but have an additional attribute \code{"frequency"} in which +the frequency of the series is stored. Therefore, they can be employed to represent +both strictly and weakly regular series. + +To create a \code{"zooreg"} object, either the command \code{zoo()} can be used +or the command \code{zooreg()}. + +\begin{Scode} +zoo(x, order.by, frequency) +zooreg(data, start, end, frequency, deltat, ts.eps, order.by) +\end{Scode} + +If \code{zoo()} is called as in the previous section but with an additional +\code{frequency} argument, it is checked whether \code{frequency} complies +with the index \code{order.by}: if it does an object of class \code{"zooreg"} +inheriting from \code{"zoo"} is returned. The command \code{zooreg()} takes mostly +the same arguments as \code{ts()}.\footnote{Only if \code{order.by} +is specified in the \code{zooreg()} call, then \code{zoo(x, order.by, frequency)} +is called.} +In both cases, the index class is more restricted than in the plain \code{"zoo"} +case. The index must be of a class which can be coerced to \code{"numeric"} +(for checking its regularity) and when converted to numeric +the index must be expressable as multiples of 1/frequency. +Furthermore, adding/substracting +a numeric to/from an observation of the index class, should return the correct value +of the index class again, i.e., group generic functions \code{Ops} should be defined.\footnote{An +application of non-numeric indexes for regular series are the classes \code{"yearmon"} +and \code{"yearqtr"} which are designed for monthly and quarterly series respectively +and are discussed in Section~\ref{sec:yearmon}.} + +The following calls yield equivalent series + +<>= +zr1 <- zooreg(sin(1:9), start = 2000, frequency = 4) +zr2 <- zoo(sin(1:9), seq(2000, 2002, by = 1/4), 4) +zr1 +zr2 +@ + +to which methods to standard generic functions for regular series can be +applied, such as \code{frequency}, \code{deltat}, \code{cycle}. + +As stated above, the advantage of \code{"zooreg"} series is that they remain +regular even if an internal observation is dropped: + +<>= +zr1 <- zr1[-c(3, 5)] +zr1 +class(zr1) +frequency(zr1) +@ + +This facilitates \code{NA} handling significantly compared to \code{"ts"} and makes +\code{"zooreg"} a much more attractive data type, e.g., for time series regression. + +\code{zooreg()} can also deal with non-numeric indexes provided that adding \code{"numeric"} +observations to the index class preserves the class and does not coerce to \code{"numeric"}. + +<>= +zooreg(1:5, start = as.Date("2005-01-01")) +@ + + +To check whether a certain series is (strictly) regular, the new generic function +\code{is.regular(x, strict = FALSE)} can be used: + +<>= +is.regular(zr1) +is.regular(zr1, strict = TRUE) +@ + +This function (and also the \code{frequency}, \code{deltat} and \code{cycle}) also +work for \code{"zoo"} objects if the regularity can still be inferred from the data: + +<>= +zr1 <- as.zoo(zr1) +zr1 +class(zr1) +is.regular(zr1) +frequency(zr1) +@ + +Of course, inferring the underlying regularity is not always reliable and it is safer +to store a regular series as a \code{"zooreg"} object if it is intended to be a regular series. + +If a weakly regular series is coerced to \code{"ts"} the missing observations are filled +with \code{NA}s (see also Section~\ref{sec:NA}). +For strictly regular series with numeric index, the class can be switched +between \code{"zoo"} and \code{"ts"} without loss of information. + +<>= +as.ts(zr1) +identical(zr2, as.zoo(as.ts(zr2))) +@ + +This enables direct use of functions such as \code{acf}, \code{arima}, \code{stl} etc. on \code{"zooreg"} +objects as these methods coerce to \code{"ts"} first. +The result only has to be coerced back to \code{"zoo"}, if appropriate. + + +\subsection{Plotting} +\label{sec:plot} + +The \code{plot} method for \code{"zoo"} objects, in particular for +multivariate \code{"zoo"} series, is based on the corresponding +method for (multivariate) regular time series. It relies on \code{plot} +and \code{lines} methods being available for the index class which can +plot the index against the observations. + +By default the \code{plot} method creates a panel for each series +<>= +plot(Z) +@ +but can also display all series in a single panel +<>= +plot(Z, plot.type = "single", col = 2:4) +@ + +\begin{figure}[b!] +\begin{center} +<>= +<> +@ +\caption{\label{fig:plot2} Example of a single panel plot} +\end{center} +\end{figure} + +\begin{figure}[p] +\begin{center} +<>= +<> +@ +<>= +plot(Z, type = "b", lty = 1:3, pch = list(Aa = 1:5, Bb = 2, Cc = 4), col = list(Bb = 2, 4)) +@ +\caption{\label{fig:plot13} Examples of multiple panel plots} +\end{center} +\end{figure} + + +In both cases additional graphical parameters like color \code{col}, +plotting character \code{pch} and line type \code{lty} can be +expanded to the number of series. But the \code{plot} method for +\code{"zoo"} objects offers some more flexibility in specification +of graphical parameters as in +<>= +<> +@ +The argument \code{lty} behaves as before and sets every series in another +line type. The \code{pch} argument is a named list that assigns to each series +a different vector of plotting characters each of which is expanded to the +number of observations. Such a list does not necessarily have to include the names of all +series, but can also specify a subset. For the remaining series the default parameter +is then used which can again be changed: e.g., in the above example the \code{col} argument +is set to display the series \code{"Bb"} in red and all remaining series in blue. +The results of the multiple panel plots are depicted in Figure~\ref{fig:plot13} and the +single panel plot in Figure~\ref{fig:plot2}. + + +\subsection{Merging and binding} +\label{sec:merge} + +As for many rectangular data formats in \proglang{R}, there are +both methods for combining the rows and columns of \code{"zoo"} +objects respectively. For the \code{rbind} method the number of +columns of the combined objects has to be identical and the +indexes may not overlap. +<>= +rbind(z1[5:10], z1[2:3]) +@ +The \code{c} method simply calls \code{rbind} and hence behaves in the same way. + +The \code{cbind} method by default combines the columns by the union of +the indexes and fills the created gaps by \code{NA}s. +<>= +cbind(z1, z2) +@ +In fact, the \code{cbind} method is synonymous with the \code{merge} +method\footnote{Note, that in some situations the column naming in the +resulting object is somewhat problematic in the \code{cbind} method +and the \code{merge} method might provide better formatting of the +column names.} +except that the latter provides additional arguments +which allow for combining the columns by the intersection +of the indexes using the argument \code{all = FALSE} +<>= +merge(z1, z2, all = FALSE) +@ +Additionally, the filling pattern can be changed in \code{merge}, +the naming of the +columns can be modified and the return class of the result can +be specified. In the case of merging of objects with +different index classes, \proglang{R} gives a warning and tries to +coerce the indexes. Merging objects with different index classes is +generally discouraged---if it is used nevertheless, it is the +responsibility of the user to ensure that the result is as intended. +If at least one of the merged/binded objects was a \code{"zooreg"} +object, then \code{merge} tries to return a \code{"zooreg"} +object. This is done by assessing whether there is a common maximal +frequency and by checking whether the resulting index is still +(weakly) regular. + +If non-\code{"zoo"} objects are included in merging, +then \code{merge} gives plain vectors/factors/matrices the index of the +first argument (if it is of the same length). Scalars are always added for +the full index without missing values. + +<>= +merge(z1, pi, 1:10) +@ + +Another function which performs operations along a subset of indexes +is \code{aggregate}, which is discussed in this section although +it does not combine several objects. Using the \code{aggregate} method, \code{"zoo"} objects +are split into subsets along a coarser index grid, +summary statistics are computed for each and then the +reduced object is returned. In the following example, +first a function is set up which returns for a given \code{"Date"} +value the corresponding first of the month. This function is then +used to compute the coarser grid for the \code{aggregate} call: in +the first example, the grouping is computed explicitely by \verb/firstofmonth(index(Z))/ +and the mean of the observations in the month +is returned---in the second example, only the function that computes +the grouping (when applied to \verb/index(Z)/) is supplied and +the first observation is used for aggregation. + +<>= +firstofmonth <- function(x) as.Date(sub("..$", "01", format(x))) +aggregate(Z, firstofmonth(index(Z)), mean) +aggregate(Z, firstofmonth, head, 1) +@ + + +\subsection{Mathematical operations} +\label{sec:Ops} + +To allow for standard mathematical operations among \code{"zoo"} +objects, \pkg{zoo} extends group generic functions \code{Ops}. +These perform the operations only for the intersection of the +indexes of the objects. As an example, the summation and logical +comparison with $<$ of \code{z1} and \code{z2} yield +<>= +z1 + z2 +z1 < z2 +@ + +Additionally, methods for transposing \code{t} of \code{"zoo"} +objects---which coerces to a matrix before---and +computing cumulative quantities such as +\code{cumsum}, \code{cumprod}, \code{cummin}, \code{cummax} +which are all applied column wise. +<>= +cumsum(Z) +@ + + +\subsection{Extracting and replacing the data and the index} +\label{sec:window} + +\pkg{zoo} provides several generic functions and methods +to work on the data contained in a \code{"zoo"} object, the +index (or time) attribute associated to it, and on both data and +index. + +The data stored in \code{"zoo"} objects can be extracted by +\code{coredata} which strips off all \code{"zoo"}-specific attributes and +it can be replaced using \code{coredata<-}. Both are new generic +functions\footnote{The \code{coredata} functionality is similar in spirit to the \code{core} +function in \pkg{its} and \code{value} in \pkg{tseries}. However, the +focus of those functions is somewhat narrower and we try to provide +more general purpose generic functions. See the respective manual +page for more details.} +with methods for \code{"zoo"} objects as illustrated in the following +example. +<>= +coredata(z1) +coredata(z1) <- 1:10 +z1 +@ + +The index associated with a \code{"zoo"} object can be extracted +by \code{index} and modified by \mbox{\code{index<-}.} As the interpretation +of the index as ``time'' in time series applications is natural, +there are also synonymous methods \code{time} and \code{time<-}. +Hence, the commands \code{index(z2)} and \code{time(z2)} +return equivalent results. +<>= +index(z2) +@ +The index scale of \code{z2} can be changed to that of \code{z1} by +<>= +index(z2) <- index(z1) +z2 +@ + +The start and the end of the index/time vector can be queried by +\code{start} and \code{end}: +<>= +start(z1) +end(z1) +@ + + +To work on both data and index/time, \pkg{zoo} provides +\code{window} and \code{window<-} methods for \code{"zoo"} objects. +In both cases the window is specified by +\begin{Scode} +window(x, index, start, end) +\end{Scode} +where \code{x} is the \code{"zoo"} object, \code{index} is a set +of indexes to be selected (by default the full index of \code{x}) +and \code{start} and \code{end} can be used to restrict the +\code{index} set. +<>= +window(Z, start = as.Date("2004-03-01")) +window(Z, index = index(Z)[5:8], end = as.Date("2004-03-01")) +@ + +The first example selects all observations starting from 2004-03-01 +whereas the second selects from the from the 5th to 8th observation +those up to 2004-03-01. + +The same syntax can be used for the corresponding replacement function. +<>= +window(z1, end = as.POSIXct("2004-02-01")) <- 9:5 +z1 +@ + +Two methods that are standard in time series applications +are \code{lag} and \code{diff}. These are available with the same +arguments as the \code{"ts"} methods.\footnote{\code{diff} also +has an additional argument that also allows for geometric and +not only allows arithmetic differences. Furthermore, note the sign +of the lag in \code{lag} which behaves like the \code{"ts"} method, i.e., +by default it is positive and shifts the +observations \emph{forward}, to obtain the more standard \emph{backward} +shift the lag has to be negative.} + +<>= +lag(z1, k = -1) +merge(z1, lag(z1, k = 1)) +diff(z1) +@ + +\subsection[Coercion to and from "zoo"]{Coercion to and from \code{"zoo"}} +\label{sec:as.zoo} + +Coercion to and from \code{"zoo"} objects is available for objects of +various classes, in particular \code{"ts"}, \code{"irts"} and \code{"its"} +objects can be coerced to \code{"zoo"} and back if the index is of the appropriate +class.\footnote{Coercion from \code{"zoo"} to \code{"irts"} is contained in the +\pkg{tseries} package.} + +Coercion between \code{"zooreg"} and \code{"zoo"} is also available and is essentially +dropping the \code{"frequency"} attribute or trying to add one, respectively. + + +Furthermore, \code{"zoo"} objects can be coerced to vectors, matrices, lists and +data frames (the latter dropping the index/time attribute). A simple example is +<>= +as.data.frame(Z) +@ + + +\subsection[NA handling]{\code{NA} handling} +\label{sec:NA} + +Four methods for dealing with \code{NA}s (missing observations) +in the observations are applicable to \code{"zoo"} objects: +\code{na.omit}, \code{na.contiguous}, \code{na.approx} and \code{na.locf}. +\code{na.omit}---or its default method to be more precise---returns a \code{"zoo"} +object with incomplete observations removed. \code{na.contiguous} +extracts the longest consecutive stretch of non-missing values. +Furthermore, new generic functions +\code{na.approx} and \code{na.locf} and corresponding default methods are introduced in \pkg{zoo}. +The former replaces \code{NA}s by linear interpolation (using the +function \code{approx}) and the name of the latter +stands for \underline{l}ast \underline{o}bservation \underline{c}arried +\underline{f}orward. It replaces missing observations by the most recent +non-\code{NA} prior to it. Leading \code{NA}s, which cannot be replaced +by previous observations, are removed in both functions by default. + +<>= +z1[sample(1:10, 3)] <- NA +z1 +na.omit(z1) +na.contiguous(z1) +na.approx(z1) +na.approx(z1, 1:NROW(z1)) +na.locf(z1) +@ + +As the above example illustrates, \code{na.approx} uses by default +the underlying time scale for interpolation. This can be changed, e.g., +to an equidistant spacing, by setting the second argument of +\code{na.approx}. + +\subsection{Rolling functions} +\label{sec:rolling} + +A typical task to be performed on ordered observations is to evaluate some +function, e.g., computing the mean, in a window of observations that is moved +over the full sample period. The resulting statistics are usually synonymously referred to +as rolling/running/moving statistics. In \pkg{zoo}, the generic function +\code{rollapply}\footnote{In previous versions of \pkg{zoo}, this function was called + \code{rapply}. It was renamed because from \proglang{R}~2.4.0 on, base \proglang{R} + provides a different function \code{rapply} for recursive (and not rolling) application + of functions. The function \code{zoo::rapply} is still provided for backward compatibility, + however it dispatches now to \code{rollapply} methods.} +is provided along with a \code{"zoo"} and a \code{"ts"} method. The most important arguments +are + +\begin{Scode} +rollapply(data, width, FUN) +\end{Scode} + +where the function \code{FUN} is applied to a rolling window of size \code{width} +of the observations \code{data}. The function \code{rollapply} currently only evaluates +the function for windows of full size \code{width}, hence the result has \code{width - 1} +fewer observations than the original series. But it can be determined whether the `lost' +observations should be padded with \code{NA}s and whether the result should be left- +or right-aligned or centered (default) with respect to the original index. + +<>= +rollapply(Z, 5, sd) +rollapply(Z, 5, sd, na.pad = TRUE, align = "left") +@ + +To improve the performance of \code{rollapply(x, k, }\textit{foo}\code{)} for some frequently +used functions \textit{foo}, more efficient implementations \code{roll}\textit{foo}\code{(x, k)} +are available (and also called by \code{rollapply}). +Currently, these are the generic functions \code{rollmean}, \code{rollmedian} +and \code{rollmax} which have methods for \code{"zoo"} and \code{"ts"} series and a +default method for plain vectors. + +<>= +rollmean(z2, 5, na.pad = TRUE) +@ + + +\section[Combining zoo with other packages]{Combining \pkg{zoo} with other packages} +\label{sec:combining} + +The main purpose of the package \pkg{zoo} is to provide basic infrastructure for +working with indexed totally ordered observations that can be either employed by +users directly or can be a basic ingredient on top of which other packages can +build. The latter is illustrated with a few brief examples involving the packages +\pkg{strucchange}, \pkg{tseries} and \pkg{fCalendar} in this section. Finally, the +classes \code{"yearmon"} and \code{"yearqtr"} (provided in \pkg{zoo}) +are used for illustrating how \pkg{zoo} can be extended by creating a new index class. + +\subsection[strucchange: Empirical fluctuation processes]{\pkg{strucchange}: Empirical fluctuation processes} +\label{sec:strucchange} + +The package \pkg{strucchange} provides a collection of methods for testing, +monitoring and dating structural changes, in particular in linear regression models. +Tests for structural change assess whether the parameters of a model remain +constant over an ordering with respect to a specified variable, usually time. +To adequately store and visualize empirical fluctuation processes which +capture instabilities over this ordering, a data type for indexed ordered +observations is required. This was the motivation for starting the \pkg{zoo} +project. + +A simple example for the need of \code{"zoo"} objects in \pkg{strucchange} +which can not be (easily) implemented by other irregular time series classes +available in \proglang{R} is described in the following. We assess the constancy of the +electrical resistance over the apparent juice content of kiwi fruits.\footnote{A different +approach would be to test whether the slope of a regression of electrical resistance +on juice content changes with increasing juice content, i.e., to test for +instabilities in \code{ohms \~{} juice} instead of \code{ohms \~{} 1}. Both lead to +similar results.} The data +set \code{fruitohms} is contained in the \pkg{DAAG} package \citep{zoo:DAAG:2004}. +The fitted \code{ocus} object contains the OLS-based CUSUM process for the mean +of the electrical resistance (variable \code{ohms}) indexed by the juice +content (variable \code{juice}). + +<>= +library("strucchange") +library("DAAG") +data("fruitohms") +ocus <- gefp(ohms ~ 1, order.by = ~ juice, data = fruitohms) +@ + +\begin{figure}[h!] +\begin{center} +<>= +plot(ocus) +@ +\caption{\label{fig:strucchange} Empirical M-fluctuation process for \code{fruitohms} data} +\end{center} +\end{figure} + +This OLS-based CUSUM process can be visualized using the \code{plot} method +for \code{"gefp"} objects which builds on the \code{"zoo"} method and yields in +this case the plot in Figure~\ref{fig:strucchange} showing the process which +crosses its 5\% critical value and +thus signals a significant decrease in the mean electrical resistance over the +juice content. For more information on the package \pkg{strucchange} and the +function \code{gefp} see \cite{zoo:Zeileis+Leisch+Hornik:2002} and +\cite{zoo:Zeileis:2005}. + + +\subsection[tseries: Historical financial data]{\pkg{tseries}: Historical financial data} +\label{sec:tseries} + +\emph{This section was written when \pkg{tseries} did not yet support \code{"zoo"} +series directly. For historical reasons and completeness, the example is still +included but for practical purposes it is not relevant anymore because, +from version 0.9-30 on, \code{get.hist.quote} returns a \code{"zoo"} series by default.} + +A typical application for irregular time series which became increasingly +important over the last years in computational statistics and finance is +daily (or higher frequency) financial data. The package \pkg{tseries} provides +the function \code{get.hist.quote} for obtaining historical financial data +by querying Yahoo!\ Finance at \url{http://finance.yahoo.com/}, +an online portal quoting data provided by Reuters. The following code +queries the quotes of Microsoft Corp.\ starting from 2001-01-01 +until 2004-09-30: + +<>= +library("tseries") +MSFT <- get.hist.quote(instrument = "MSFT", start = "2001-01-01", + end = "2004-09-30", origin = "1970-01-01", retclass = "ts") +@ + +<>= +if(online) { + MSFT <- get.hist.quote("MSFT", start = "2001-01-01", + end = "2004-09-30", origin = "1970-01-01", retclass = "ts") + save(MSFT, file = "MSFT.rda", compress = TRUE) +} else { + load("MSFT.rda") +} +@ + +In the returned \code{MSFT} object the irregular data is stored by extending +it in a regular grid and filling the gaps with \code{NA}s. The time is stored +in days starting from an \code{origin}, in this case specified to be 1970-01-01, the +origin used by the \code{"Date"} class. +This series can be transformed easily into a \code{"zoo"} series +using a \code{"Date"} index. + +<>= +MSFT <- as.zoo(MSFT) +index(MSFT) <- as.Date(index(MSFT)) +MSFT <- na.omit(MSFT) +@ + +Because this is daily data, the series has a natural underlying regularity. +Thus, \code{as.zoo()} returns a \code{"zooreg"} object by default. To treat it +as an irregular series \code{as.zoo()} can be applied a second time, yielding +a \code{"zoo"} series. The corresponding log-difference returns are +depicted in Figure~\ref{fig:tseries}. + +<>= +MSFT <- as.zoo(MSFT) +@ + +\begin{figure}[h!] +\begin{center} +<>= +plot(diff(log(MSFT))) +@ +\caption{\label{fig:tseries} Log-difference returns for Microsoft Corp.} +\end{center} +\end{figure} + + +\subsection[fCalendar: Indexes of class "timeDate"]{\pkg{fCalendar}: Indexes of class \code{"timeDate"}} +\label{sec:fCalendar} + +\emph{The original version of this section was written when \pkg{fCalendar} (now: \pkg{timeDate}) +and \pkg{zoo} did not yet include enough methods to attach \code{"timeDate"} indexes to \code{"zoo"} +series. For historical reasons and completeness, we still briefly comment on the communcation +between the packages and their classes.} + +Although the methods in \pkg{zoo} work out of the box for many index classes, +it might be necessary for some index classes to provide \code{c()}, \code{length()}, \code{[}, +\code{ORDER()} and \code{MATCH()} methods such that the methods in \pkg{zoo} +work properly. Previously, this was the case \code{"timeDate"} from the \pkg{fCalendar} package +which is why it was used as an example in this vigntte. +Meanwhile however, both \pkg{zoo} and \pkg{fCalendar}/\pkg{timeDate} +have been enhanced: The latter contains the methods for \code{c()}, \code{length()}, and \code{[}, +while \pkg{zoo} has methods for \code{ORDER()} and \code{MATCH()} for class \code{"timeDate"}. +The last two functions essentially work by coercing to the underlying \code{"POSIXct"} and then +using the associated methods. + +The following example illustrates how \code{z2} can be transformed +to use the \code{"timeDate"} class. +<>= +library("fCalendar") +z2td <- zoo(coredata(z2), timeDate(index(z2), FinCenter = "GMT")) +z2td +@ + +\subsection[The classes "yearmon" and "yearqtr": Roll your own index]{The classes \code{"yearmon"} and \code{"yearqtr"}: Roll your own index} +\label{sec:yearmon} + +One of the strengths of the \pkg{zoo} package is its independence of the +index class, such that the index can be easily customized. The previous section +already explained how an existing class (\code{"timeDate"}) can be used as +the index if the necessary methods are created. This section has a similar +but slightly different focus: it describes how new index classes can be created +addressing a certain type of indexes. These classes are \code{"yearmon"} and +\code{"yearqtr"} (already contained in \pkg{zoo}) which provide indexes for +monthly and quarterly data respectively. +As the code is virtually identical for both classes---except that one has the +frequency 12 and the other 4---we will only discuss \code{"yearmon"} explicitly. + +Of course, monthly data can simply be stored using a numeric index just +as the class \code{"ts"} does. The problem is that this does not have the meta-information +attached that this is really specifying monthly data which is in \code{"yearmon"} +simply added by a class attribute. Hence, the class creator is simply defined as + +\begin{Scode} +yearmon <- function(x) structure(floor(12*x + .0001)/12, class = "yearmon") +\end{Scode} + +which is very similar to the \code{as.yearmon} coercion functions provided. + +As \code{"yearmon"} data is now explicitly declared to describe monthly data, +this can be exploited for coercion to other time classes: either to coarser time scales +such as \code{"yearqtr"} or to finer time scales such as +\code{"Date"}, \code{"POSIXct"} or \code{"POSIXlt"} which by default associate the first day +within a month with a \code{"yearmon"} observation. Adding a \code{format} +and \code{as.character} method produces human readable character representations +of \code{"yearmon"} data and \code{Ops} and \code{MATCH} methods complete the +methods needed for conveniently working with monthly data in \pkg{zoo}. Note, +that all of these methods are very simple and rather obvious (as can be seen in +the \pkg{zoo} sources), but prove very helpful in the following examples. + +First, we create a regular series \code{zr3} with \code{"yearmon"} index which +leads to improved printing compared to the regular series \code{zr1} and \code{zr2} +from Section~\ref{sec:zooreg}. + +<>= +zr3 <- zooreg(rnorm(9), start = as.yearmon(2000), frequency = 12) +zr3 +@ + +This could be aggregated to quarterly data via + +<>= +aggregate(zr3, as.yearqtr, mean) +@ + +The index can easily be transformed to \code{"Date"}, the default being the first day +of the month but which can also be changed to the last day of the month. + +<>= +as.Date(index(zr3)) +as.Date(index(zr3), frac = 1) +@ + +Furthermore, \code{"yearmon"} indexes can easily be coerced to \code{"POSIXct"} such +that the series could be exported as a \code{"its"} or \code{"irts"} series. + +<>= +index(zr3) <- as.POSIXct(index(zr3)) +as.irts(zr3) +@ + +Again, this functionality makes switching between different time scales or index +representations particularly easy and \pkg{zoo} provides the user with the flexibility +to adjust a certain index to his/her problem of interest. + +\section{Summary and outlook} \label{sec:summary} + +The package \pkg{zoo} provides an \proglang{S3} class and methods +for indexed totally ordered observations, such as both regular and irregular time series. +Its key design goals are independence of a particular index class +and compatibility with standard generics similar to the behaviour of +the corresponding \code{"ts"} methods. This paper describes how +these are implemented in \pkg{zoo} and illustrates the usage of +the methods for plotting, merging and +binding, several mathematical operations, extracting and replacing data +and index, coercion and \code{NA} handling. + +An indexed object of class \code{"zoo"} can be thought of as data plus index +where the data are essentially vectors or matrices and the index can be +a vector of (in principle) arbitrary class. For (weakly) regular \code{"zooreg"} +series, a \code{"frequency"} attribute is stored in addition. Therefore, objects of classes +\code{"ts"}, \code{"its"}, \code{"irts"} and \code{"timeSeries"} can easily +be transformed into \code{"zoo"} objects---the reverse transformation is also possible +provided that the index fulfills the restrictions of the respective class. +Hence, the \code{"zoo"} class can also be used as the basis for other +classes of indexed observations and more specific functionality can be built on +top of it. Furthermore, it bridges the gap between irregular and regular series, +facilitating operations such as \code{NA} handling compared to \code{"ts"}. + +Whereas a lot of effort was put into achieving independence of a particular +index class, the types of data that can be indexed with \code{"zoo"} are currently +limited to vectors and matrices, typically containing numeric values. Although, +there is some limited support available for indexed factors, one important +direction for future development of \pkg{zoo} is to add better support for other +objects that can also naturally be indexed including specifically factors, data +frames and lists. + + + +\section*{Computational details} + +The results in this paper were obtained using \proglang{R} +\Sexpr{paste(R.Version()[6:7], collapse = ".")} with the packages +\pkg{zoo} \Sexpr{gsub("-", "--", packageDescription("zoo")$Version)}, +\pkg{strucchange} \Sexpr{gsub("-", "--", packageDescription("strucchange")$Version)}, +\pkg{fCalendar} \Sexpr{gsub("-", "--", packageDescription("fCalendar")$Version)}, +\pkg{tseries} \Sexpr{gsub("-", "--", packageDescription("tseries")$Version)} and +\pkg{DAAG} \Sexpr{gsub("-", "--", packageDescription("DAAG")$Version)}. +\proglang{R} itself and all packages used are available from +CRAN at \url{http://CRAN.R-project.org/}. + + +\bibliography{zoo} + +\newpage + +\begin{appendix} +\section{Reference card} +\input{zoo-refcard-raw} +\end{appendix} + +\end{document} + + +\subsection[stats: (Dynamic) regression modelling]{\pkg{stats}: (Dynamic) regression modelling} +\label{sec:stats} + +\code{zoo} provides a facility for extending regression functions such +as \code{lm} to handle time series. One simply encloses the \code{formula} +argument in \code{I(...)} and ensures that all variables in +the formula are of class \code{"zoo"} or all are of class \code{"ts"}. + +Basic regression functions, like \code{lm} or \code{glm}, in which regression +relationships are specified via a \code{formula} only have limited +support for time series regression. The reason is that \code{lm(formula, ...)} +calls the generic function \code{model.frame(formula, ...)} to create a +a data frame with the variables required. This dispatches to \code{model.frame.formula} +which does not deal specifically with (various types of) time series data. +Therefore, it would be desirable to dispatch to a specialized \code{model.frame} +method depending on the type of the dependent variable. As this is a non-standard +dispatch, \pkg{zoo} provides the following mechanism: In the call to the regression +function, the \code{formula} is insulated by \code{I()}, e.g., as in +\code{lm(I(formula), ...)}, leaving \code{formula} unaltered but returning an object +of class \code{"AsIs"}. Then, \code{model.frame.AsIs} is called which examines the +dependent variable of the \code{formula} and then dispatches to \code{model.frame.foo} +if this is of class \code{"foo"}. In \pkg{zoo}, the methods \code{model.frame.zoo} +and \code{model.frame.ts} are provided which are able to create model frames +from formulas in which \emph{all} variables are of class \code{"zoo"} or \code{"ts"}, +respectively. The advantage of \code{model.frame.zoo} is that it aligns +the variables along a common index, it allows the usage of \code{lag} and +\code{diff} in the model specification and works with the \code{NA} handling methods +described in Section~\ref{sec:NA}. Therefore, dynamic linear regression models +can be fit easily using the standard \code{lm} function by just insulating +\code{I(formula)} in the corresponding call\footnote{In addition to \code{lm} +and \code{glm}, this approach works for many other regression functions including +\code{randomForest} ensembles from \pkg{randomForest}, +\code{svm} support vector machines from \pkg{e1071}, +\code{lqs} resistant regression from \pkg{MASS}, +\code{nnet} neural networks from \pkg{nnet}, +\code{rq} quantile regression from \pkg{quantreg}, +and possibly many others.}. + +A simple example based on artificial data is given below: the lag of a dependent +variable is explained by the first differences of a numeric regressor and an +explanatory factor. Note, that the variables have different indexes. First, a linear +regression model is fitted, then a quantile regression is carried out for the same +equation. + +\begin{verbatim} +yz <- zoo(1:20)^2 +xz <- zoo(1:18)^2 +fz <- zoo(gl(4, 5)) + +lm(I(lag(yz) ~ diff(xz) + fz)) + +library("quantreg") +rq(I(lag(yz) ~ diff(xz) + fz)) +\end{verbatim} + + +See the help page of \code{model.frame.zoo} for more examples +and additional information. Furthermore, note that this feature is under +development and might subject to changes in future versions. + + diff --git a/inst/doc/zoo.bib b/inst/doc/zoo.bib new file mode 100644 index 0000000..c667dc3 --- /dev/null +++ b/inst/doc/zoo.bib @@ -0,0 +1,91 @@ +@Article{zoo:Zeileis+Grothendieck:2005, + author = {Achim Zeileis and Gabor Grothendieck}, + title = {\pkg{zoo}: \proglang{S3} Infrastructure for Regular and Irregular Time Series}, + journal = {Journal of Statistical Software}, + year = 2005, + volume = 14, + number = 6, + pages = {1--27}, + url = {http://www.jstatsoft.org/v14/i06/} +} + +@Manual{zoo:R:2008, + title = {\proglang{R}: {A} Language and Environment for Statistical Computing}, + author = {{\proglang{R} Development Core Team}}, + organization = {\proglang{R} Foundation for Statistical Computing}, + address = {Vienna, Austria}, + year = {2008}, + note = {{ISBN} 3-900051-07-0}, + url = {http://www.R-project.org/} +} + +@Article{zoo:Zeileis+Leisch+Hornik:2002, + author = {Achim Zeileis and Friedrich Leisch and Kurt Hornik and + Christian Kleiber}, + title = {\pkg{strucchange}: {A}n \proglang{R} Package for Testing + for Structural Change in Linear Regression Models}, + journal = {Journal of Statistical Software}, + year = 2002, + volume = 7, + number = 2, + pages = {1--38}, + url = {http://www.jstatsoft.org/v07/i02/} +} + +@Article{AER:Zeileis:2005, + author = {Achim Zeileis}, + title = {Implementing a Class of Structural Change Tests: An Econometric Computing Approach}, + journal = {Computational Statistics \& Data Analysis}, + volume = {50}, + issue = {11}, + pages = {2987--3008}, + year = {2006}, + doi = {10.1016/j.csda.2005.07.001}, +} + +@Manual{zoo:Rmetrics:2008, + title = {\pkg{Rmetrics}: {A}n Environment and Software Collection for + Teaching Financial Engineering and Computational Finance}, + author = {Diethelm Wuertz}, + year = {2008}, + note = {\proglang{R}~packages \pkg{fArma}, \pkg{fAsianOptions}, + \pkg{fAssets}, \pkg{fBasics}, \pkg{fCalendar}, \pkg{fCopulae}, + \pkg{fEcofin}, \pkg{fExoticOptions}, \pkg{fExtremes}, \pkg{fGarch}, + \pkg{fImport}, \pkg{fMultivar}, \pkg{fNonlinear}, \pkg{fOptions}, + \pkg{fPortfolio}, \pkg{fRegression}, \pkg{fSeries}, \pkg{fTrading}, + \pkg{fUnitRoots}, \pkg{fUtilities}}, + url = {http://CRAN.R-project.org/package=Rmetrics}, +} + +@Manual{zoo:tseries:2007, + title = {\pkg{tseries}: Time Series Analysis and Computational Finance}, + author = {Adrian Trapletti}, + year = {2007}, + note = {\proglang{R}~package version~0.10-13}, + url = {http://CRAN.R-project.org/package=tseries} +} + +@Manual{zoo:its:2004, + title = {\pkg{its}: Irregular Time Series}, + author = {Giles Heywood}, + organization = {Portfolio \& Risk Advisory Group and Commerzbank Securities}, + year = {2006}, + note = {\proglang{R} package version 1.1.5}, + url = {http://CRAN.R-project.org/package=its}, +} + +@Manual{zoo:DAAG:2004, + title = {\pkg{DAAG}: Data Analysis and Graphics}, + author = {John Maindonald and W. John Braun}, + year = {2008}, + note = {\proglang{R} package version 0.97}, + url = {http://CRAN.R-project.org/package=DAAG}, +} + +@Manual{zoo:xts:2008, + title = {\pkg{xts}: Extensible Time Series}, + author = {Jeffrey A. Ryan and Josh M. Ulrich}, + year = {2008}, + note = {\proglang{R} package version 0.0-5}, + url = {http://CRAN.R-project.org/package=xts}, +} diff --git a/man/MATCH.Rd b/man/MATCH.Rd new file mode 100644 index 0000000..e2c93bc --- /dev/null +++ b/man/MATCH.Rd @@ -0,0 +1,33 @@ +\name{MATCH} +\alias{MATCH} +\alias{MATCH.default} +\title{Value Matching} +\description{ +\code{MATCH} is a generic function for value matching. +} + +\usage{ +MATCH(x, table, nomatch = NA, \dots) +} +\arguments{ + \item{x}{an object.} + \item{table}{the values to be matched against.} + \item{nomatch}{the value to be returned in the case when no match is + found. Note that it is coerced to \code{integer}.} + \item{\dots}{further arguments to be passed to methods.} +} + +\details{ +\code{MATCH} is a new generic function which aims at providing +the functionality of the non-generic base function \code{\link[base]{match}} +for arbitrary objects. Currently, there is only a default method which +simply calls \code{\link[base]{match}}. +} + + +\seealso{\code{\link[base]{match}}} + +\examples{ +MATCH(1:5, 2:3) +} +\keyword{manip} diff --git a/man/ORDER.Rd b/man/ORDER.Rd new file mode 100644 index 0000000..0e6c9c6 --- /dev/null +++ b/man/ORDER.Rd @@ -0,0 +1,38 @@ +\name{ORDER} +\alias{ORDER} +\alias{ORDER.default} +\title{Ordering Permutation} +\description{ +\code{ORDER} is a generic function for computing ordering +permutations. +} + +\usage{ +ORDER(x, \dots) +\method{ORDER}{default}(x, \dots, na.last = TRUE, decreasing = FALSE) +} +\arguments{ + \item{x}{an object.} + \item{\dots}{further arguments to be passed to methods.} + \item{na.last}{for controlling the treatment of \code{NA}s. + If \code{TRUE}, missing values in the data are put last; if + \code{FALSE}, they are put first; if \code{NA}, they are removed. + } + \item{decreasing}{logical. Should the sort order be increasing or + decreasing?} +} + +\details{ +\code{ORDER} is a new generic function which aims at providing +the functionality of the non-generic base function \code{\link[base]{order}} +for arbitrary objects. Currently, there is only a default method which +simply calls \code{\link[base]{order}}. +} + + +\seealso{\code{\link[base]{order}}} + +\examples{ +ORDER(rnorm(5)) +} +\keyword{manip} diff --git a/man/aggregate.zoo.Rd b/man/aggregate.zoo.Rd new file mode 100644 index 0000000..fa1c898 --- /dev/null +++ b/man/aggregate.zoo.Rd @@ -0,0 +1,149 @@ + +\name{aggregate.zoo} +\alias{aggregate.zoo} +\alias{split.zoo} +\title{Compute Summary Statistics of zoo Objects} +\description{ +Splits a \code{"zoo"} object into subsets along a coarser index grid, +computes summary statistics for each, and returns the +reduced \code{"zoo"} object. +} + +\usage{ +\method{aggregate}{zoo}(x, by, FUN, \dots, regular = NULL, frequency = NULL) +} + +\arguments{ + \item{x}{an object of class \code{"zoo"}.} + \item{by}{index vector of the same length as \code{index(x)} which defines + aggregation groups and the new index to be associated with each group. + If \code{by} is a function, then it is applied to \code{index(x)} to + obtain the aggregation groups.} + \item{FUN}{a scalar function to compute the summary statistics + which can be applied to all subsets.} + \item{\dots}{further arguments passed to \code{FUN}.} + \item{regular}{logical. Should the aggregated series be coerced to class \code{"zooreg"} + (if the series is regular)? The default is \code{FALSE} for \code{"zoo"} series and + \code{TRUE} for \code{"zooreg"} series.} + \item{frequency}{numeric indicating the frequency of the aggregated series + (if a \code{"zooreg"} series should be returned. The default is to + determine the frequency from the data if \code{regular} is \code{TRUE}. + If \code{frequency} is specified, it sets \code{regular} to \code{TRUE}. + See examples for illustration.} +} + +\value{ +An object of class \code{"zoo"} or \code{"zooreg"}. +} + +\note{The \code{xts} package functions \code{endpoints}, \code{period.apply} +\code{to.period}, \code{to.weekly}, \code{to.monthly}, etc., +can also directly input and output certain \code{zoo} objects and +so can be used for aggregation tasks in some cases as well.} + +\seealso{\code{\link{zoo}}} + +\examples{ +## averaging over values in a month: +# long series +x.date <- as.Date(paste(2004, rep(1:4, 4:1), seq(1,20,2), sep = "-")) +x <- zoo(rnorm(12), x.date) +# coarser dates +x.date2 <- as.Date(paste(2004, rep(1:4, 4:1), 1, sep = "-")) +x2 <- aggregate(x, x.date2, mean) +# 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)))] + +# This is the same except it uses the last day of the quarter. +# It requires R 2.6.0 which introduced the fromLast= argument. +\dontrun{ +z.day[!duplicated(as.yearqtr(time(z.day)), fromLast = TRUE)] +} + +# 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) +} + +# 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)))] + +# same except times are of "yearmon" class +aggregate(zz, as.yearmon, head, 1) + +# aggregate POSIXct seconds data every 10 minutes +tt <- seq(10, 2000, 10) +x <- zoo(tt, structure(tt, class = c("POSIXt", "POSIXct"))) +aggregate(x, time(x) - as.numeric(time(x)) \%\% 600, mean) + +# aggregate weekly series to a series with frequency of 52 per year +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) + +# or, take mean of all points in each +aggregate(z, new.freq, mean) + +# 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) +} +\keyword{ts} diff --git a/man/as.zoo.Rd b/man/as.zoo.Rd new file mode 100644 index 0000000..5f9e2bc --- /dev/null +++ b/man/as.zoo.Rd @@ -0,0 +1,73 @@ +\name{as.zoo} +\alias{as.zoo} +\alias{as.zoo.default} +\alias{as.zoo.fts} +\alias{as.zoo.its} +\alias{as.zoo.irts} +\alias{as.zoo.mcmc} +\alias{as.zoo.tis} +\alias{as.zoo.xts} +\alias{as.zoo.zoo} +\alias{as.matrix.zoo} +\alias{as.vector.zoo} +\alias{as.data.frame.zoo} +\alias{as.list.zoo} +\alias{as.list.ts} +\alias{as.zoo.ts} +\alias{as.ts.zoo} + +\title{Coercion from and to zoo} +\description{ +Methods for coercing \code{"zoo"} objects to other classes and +a generic function \code{as.zoo} for coercing objects to class \code{"zoo"}. +} +\usage{ +as.zoo(x, \dots) +} +\arguments{ + \item{x}{an object,} + \item{\dots}{further arguments passed to \code{\link{zoo}} when the return + object is created.} +} + +\details{ +\code{as.zoo} currently has a default method and methods for \code{\link{ts}}, +\code{\link[its]{its}}, \code{\link[fts]{fts}}, \code{\link[tseries]{irts}}, +\code{\link[coda]{mcmc}}, \code{\link[fame]{tis}}, \code{\link[xts]{xts}} +objects (and \code{\link{zoo}} objects themselves). + +Methods for coercing objects of class \code{"zoo"} to other classes +currently include: \code{\link{as.ts}}, \code{\link{as.matrix}}, \code{\link{as.vector}}, +\code{\link{as.data.frame}}, \code{\link{as.list}} (the latter also being available +for \code{"ts"} objects). + +In the conversion between \code{zoo} and \code{ts}, the \code{\link{zooreg}} class is +always used. +} + +\value{ +\code{as.zoo} returns a \code{\link{zoo}} object. +} + +\seealso{\code{\link{zoo}}, \code{\link{zooreg}}, \code{\link{ts}}, + \code{\link[its]{its}}, \code{\link[tseries]{irts}}, + \code{\link[fame]{tis}}, \code{\link[fts]{fts}}, \code{\link[coda]{mcmc}}, + \code{\link[xts]{xts}}. +} + +\examples{ +## coercion to zoo: +## default method +as.zoo(rnorm(5)) +## method for "ts" objects +as.zoo(ts(rnorm(5), start = 1981, freq = 12)) + +## 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) +as.vector(x) +as.data.frame(x) +as.list(x) +} +\keyword{ts} diff --git a/man/coredata.Rd b/man/coredata.Rd new file mode 100755 index 0000000..e2ad678 --- /dev/null +++ b/man/coredata.Rd @@ -0,0 +1,52 @@ +\name{coredata} +\alias{coredata} +\alias{coredata.default} +\alias{coredata.zoo} +\alias{coredata.ts} +\alias{coredata.its} +\alias{coredata.irts} +\alias{coredata<-} +\alias{coredata<-.zoo} +\alias{coredata<-.ts} +\alias{coredata<-.irts} +\alias{coredata<-.its} +\title{Extracting/Replacing the Core Data of Objects} +\description{ +Generic functions for extracting the core data contained in +a (more complex) object and replacing it. +} + +\usage{ +coredata(x, \dots) +coredata(x) <- value +} + +\arguments{ + \item{x}{an object.} + \item{\dots}{further arguments passed to methods.} + \item{value}{a suitable value object for use with \code{x}.} +} + +\value{ +In \code{zoo}, there are currently \code{coredata} methods for time series +objects of class \code{"zoo"}, \code{"ts"}, \code{"its"}, \code{"irts"}, all of +which strip off the index/time attributes and return only the observations. +The are also corresponding replacement methods for these classes. +} + +\seealso{\code{\link{zoo}}} + +\examples{ +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 +## and only matrix of observations +coredata(x) + +## change the observations +coredata(x) <- matrix(1:20, ncol = 2) +x +} +\keyword{ts} diff --git a/man/frequency.Rd b/man/frequency.Rd new file mode 100644 index 0000000..d6f0412 --- /dev/null +++ b/man/frequency.Rd @@ -0,0 +1,35 @@ +\name{frequency<-} +\alias{frequency<-} +\alias{frequency<-.zoo} +\alias{frequency<-.zooreg} +\title{Replacing the Index of Objects} +\description{ +Generic function for replacing the frequency of an object. +} +\usage{ +frequency(x) <- value +} +\arguments{ + \item{x}{an object.} + \item{value}{a frequency.} +} + +\details{ +\code{frequency<-} is a generic function for replacing (or assigning) +the frequency of an object. Currently, there is a \code{"zooreg"} and +a \code{"zoo"} method. In both cases, the \code{value} is assigned +to the \code{"frequency"} of the object if it complies with the +\code{index(x)}. +} + +\seealso{\code{\link{zooreg}}, \code{\link{index}}} + +\examples{ +z <- zooreg(1:5) +z +as.ts(z) +frequency(z) <- 3 +z +as.ts(z) +} +\keyword{ts} diff --git a/man/index.Rd b/man/index.Rd new file mode 100644 index 0000000..02dea47 --- /dev/null +++ b/man/index.Rd @@ -0,0 +1,72 @@ +\name{index} +\alias{index} +\alias{index.default} +\alias{index.zoo} +\alias{index.ts} +\alias{time.zoo} +\alias{index<-} +\alias{index<-.zoo} +\alias{time<-} +\alias{time<-.zoo} +\alias{start.zoo} +\alias{end.zoo} +\title{Extracting/Replacing the Index of Objects} +\description{ +Generic functions for extracting the index of an object +and replacing it. +} +\usage{ +index(x, \dots) +index(x) <- value +} +\arguments{ + \item{x}{an object.} + \item{\dots}{further arguments passed to methods.} + \item{value}{an ordered vector of the same length + as the \code{"index"} attribute of \code{x}.} +} + +\details{ +\code{index} is a generic function for extracting the index +of objects, currently it has a default method and a method +for \code{\link{zoo}} objects which is the same as the +\code{\link{time}} method for \code{\link{zoo}} objects. +Another pair of generic functions provides replacing +the \code{index} or \code{time} attribute. +Methods are available for \code{"zoo"} objects only, see examples below. + +The start and end of the index/time can be queried by using +the methods of \code{start} and \code{end}. +} + +\seealso{\code{\link{time}}, \code{\link{zoo}}} + +\examples{ +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) +time(x) + +## change class of index from Date to POSIXct +## relative to current time zone +x +index(x) <- as.POSIXct(format(time(x)),tz="") +x + +## replace index/time of a zoo object +index(x) <- 1:5 +x +time(x) <- 6:10 +x + +## query start and end of a zoo object +start(x) +end(x) + +## query index of a usual matrix +xm <- matrix(rnorm(10), ncol = 2) +index(xm) +} +\keyword{ts} diff --git a/man/is.regular.Rd b/man/is.regular.Rd new file mode 100644 index 0000000..b283bf3 --- /dev/null +++ b/man/is.regular.Rd @@ -0,0 +1,76 @@ +\name{is.regular} +\alias{is.regular} +\alias{is.regular.zoo} +\alias{is.regular.ts} +\alias{is.regular.zooreg} +\alias{is.regular.default} + +\title{Check Regularity of a Series} + +\description{ +\code{is.regular} is a regular function for checking whether a series of ordered observations +has an underlying regularity or is even strictly regular. +} + +\usage{ +is.regular(x, strict = FALSE) +} + +\arguments{ + \item{x}{an object (representing a series of ordered observations).} + \item{strict}{logical. Should strict regularity be checked? See details.} +} + +\details{ +A time series can either be irregular (unequally spaced), strictly regular (equally spaced) +or have an underlying regularity, i.e., be created from a regular series by +omitting some observations. Here, the latter property is called \emph{regular}. +Consequently, regularity follows from strict regularity but not vice versa. + +\code{is.regular} is a generic function for checking regularity (default) or +strict regularity. Currently, it has methods for \code{"ts"} objects (which are +always strictly regular), \code{"zooreg"} objects (which are at least regular), +\code{"zoo"} objects (which can be either irregular, regular or even strictly regular) +and a default method. The latter coerces \code{x} to \code{"zoo"} before checking +its regularity. +} + +\value{ +A logical is returned indicating whether \code{x} is (strictly) regular. +} + +\seealso{\code{\link{zooreg}}, \code{\link{zoo}}} + +\examples{ +## checking of a strictly regular zoo series +z <- zoo(1:10, seq(2000, 2002.25, by = 0.25), frequency = 4) +z +class(z) +frequency(z) ## extraction of frequency attribute +is.regular(z) +is.regular(z, strict = TRUE) +## by omitting observations, the series is not strictly regular +is.regular(z[-3]) +is.regular(z[-3], strict = TRUE) + +## 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 +class(z) +frequency(z) ## data driven computation of frequency +is.regular(z) +is.regular(z, strict = TRUE) +## by omitting observations, the series is not strictly regular +is.regular(z[-3]) +is.regular(z[-3], strict = TRUE) + +## checking of an irregular zoo series +z <- zoo(1:10, rnorm(10)) +z +class(z) +frequency(z) ## attempt of data-driven frequency computation +is.regular(z) +is.regular(z, strict = TRUE) +} +\keyword{ts} diff --git a/man/lag.zoo.Rd b/man/lag.zoo.Rd new file mode 100644 index 0000000..2a3bdd9 --- /dev/null +++ b/man/lag.zoo.Rd @@ -0,0 +1,66 @@ +\name{lag.zoo} +\alias{lag.zoo} +\alias{diff.zoo} +\title{Lags and Differences of zoo Objects} +\description{ +Methods for computing lags and differences of \code{"zoo"} objects. +} + +\usage{ +\method{lag}{zoo}(x, k = 1, na.pad = FALSE, \dots) +\method{diff}{zoo}(x, lag = 1, differences = 1, arithmetic = TRUE, na.pad = FALSE, \dots) +} + +\arguments{ + \item{x}{a \code{"zoo"} object.} + \item{k, lag}{the number of lags (in units of observations). + Note the sign of \code{k} behaves as in \code{\link[stats]{lag}}.} + \item{differences}{an integer indicating the order of the difference.} + \item{arithmetic}{logical. Should arithmetic (or geometric) differences be computed?} + \item{na.pad}{logical. If \code{TRUE} it adds any times that would not otherwise have been in + the result with a value of \code{NA}. If \code{FALSE} those times are dropped.} + \item{\dots}{currently not used.} +} + +\details{ +These methods for \code{"zoo"} objects behave analogously to the default +methods. The only additional arguments are \code{arithmetic} in \code{diff} +\code{na.pad} in \code{lag.zoo} which can also be specified in \code{diff.zoo} +as part of the dots. +Also, \code{"k"} can be a vector of lags in which case the names of +\code{"k"}, if any, are used in naming the result. + + +} + +\value{ +The lagged or differenced \code{"zoo"} object. +} + + +\note{ + Note the sign of \code{k}: a series lagged by a positive \code{k} + is shifted \emph{earlier} in time. + + \code{lag.zoo} and \code{lag.zooreg} can give different results. + For a lag of 1 \code{lag.zoo} moves points to the adjacent time point + whereas \code{lag.zooreg} moves the time by \code{deltat}. This + implies that a point in a \code{zoo} series cannot be lagged to a time + point that is not already in the series whereas this is possible for + a \code{zooreg} series. +} + + +\seealso{\code{\link{zoo}}, \code{\link[stats]{lag}}, \code{\link[stats]{diff}}} + +\examples{ +x <- zoo(11:21) + +lag(x, k = 1) +lag(x, k = -1) +# this pairs each value of x with the next or future value +merge(x, lag1 = lag(x, k=1)) +diff(x^2) +diff(x^2, na.pad = TRUE) +} +\keyword{ts} diff --git a/man/make.par.list.Rd b/man/make.par.list.Rd new file mode 100644 index 0000000..52fbcdf --- /dev/null +++ b/man/make.par.list.Rd @@ -0,0 +1,54 @@ +\name{make.par.list} +\alias{make.par.list} + +\title{Make a List from a Parameter Specification} + +\description{ + Process parameters so that a list of parameter + specifications is returned (used by \code{plot.zoo} and + \code{xyplot.zoo}). +} + +\usage{ +make.par.list(nams, x, n, m, def, recycle = sum(unnamed) > 0) +} + +\arguments{ + \item{nams}{character vector with names of variables.} + \item{x}{list or vector of parameter specifications, see details.} + \item{n}{numeric, number of rows.} + \item{m}{numeric, number of columns. (Only determines whether \code{m} + is 1 or greater than 1.} + \item{def}{default parameter value.} + \item{recycle}{logical. If \code{TRUE} recycle columns to provide + unspecified ones. If \code{FALSE} use \code{def} to provide unspecified + ones. This only applies to entire columns. Within columns recycling is + always done regardless of how \code{recycle} is set. Defaults to + \code{TRUE} if there is at least one unnamed variable and defaults to + \code{FALSE} if there are only named variables in \code{x}.} +} + +\details{ + This function is currently intended for internal use. It is currently + used by + \code{plot.zoo} and \code{xyplot.zoo} but might also be used in the future + to create additional new plotting routines. + It creates a new list which uses the named variables from \code{x} + and then assigns the unnamed in order. For the remaining variables + assign them the default value if \code{!recycle} or recycle the + unnamed variables if \code{recycle}. +} + +\value{ + A list of parameters, see details. +} + +\examples{ +make.par.list(letters[1:5], 1:5, 3, 5) +suppressWarnings( make.par.list(letters[1:5], 1:4, 3, 5, 99) ) +make.par.list(letters[1:5], c(d=3), 3, 5, 99) +make.par.list(letters[1:5], list(d=1:2, 99), 3, 5) +make.par.list(letters[1:5], list(d=1:2, 99, 100), 3, 5) +} + +\keyword{ts} diff --git a/man/make.unique.approx.Rd b/man/make.unique.approx.Rd new file mode 100644 index 0000000..1e24006 --- /dev/null +++ b/man/make.unique.approx.Rd @@ -0,0 +1,35 @@ +\name{make.unique.approx} +\alias{make.unique.approx} +\alias{make.unique.approx.default} +\title{ Make a vector unique } +\description{ + Make a vector unique +} +\usage{ +make.unique.approx(x, ...) +\method{make.unique.approx}{default}(x, quantile = 1, ...) +} +\arguments{ + \item{x}{Vector. Vector of a class which has differences that can be coerced to numeric for which the difference, when added to the first value, returns the +second value. } + \item{quantile}{A number between 0 and 1 such that if it is 0 then +the first time value among duplicates is kept as is and the others +calculated via linear interpolation or if 1 then the last time value is +kept as is and the others calculated via linear interpolation. If +an intermediate fraction is used then that quantile is kept as is.} + \item{\dots}{Further arguments.} +} + +\value{ +The function returns \code{x} except among any set of repeated elements +the one at the position whose quantile is indicated is left as is and +all others are linearly interpolated. + +} +\seealso{ \code{\link{read.zoo}} } +\examples{ +xx <- c(10, rep(20, 10), 30) +make.unique.approx(xx) + +} +\keyword{ ts } diff --git a/man/merge.zoo.Rd b/man/merge.zoo.Rd new file mode 100644 index 0000000..6d48add --- /dev/null +++ b/man/merge.zoo.Rd @@ -0,0 +1,130 @@ +\name{merge.zoo} +\alias{merge.zoo} +\alias{rbind.zoo} +\alias{c.zoo} +\alias{cbind.zoo} +\title{Merge Two or More zoo Objects} +\description{ +Merge two zoo objects by common indexes (times), or do other +versions of database \emph{join} operations. +} + +\usage{ +\method{merge}{zoo}(\dots, all = TRUE, fill = NA, suffixes = NULL, + retclass = c("zoo", "list", "data.frame")) +} + +\arguments{ + \item{\dots}{two or more objects, usually of class \code{"zoo"}.} + \item{all}{logical vector having the same length as the number of \code{"zoo"} + objects to be merged (otherwise expanded).} + \item{fill}{an element for filling gaps in merged \code{"zoo"} + objects (if any).} + \item{suffixes}{character vector of the same length as the number of + \code{"zoo"} objects specifying the suffixes to be used for making + the merged column names unique.} + \item{retclass}{character that specifies the class of the returned result. + It can be \code{"zoo"} (the default), \code{"list"} or \code{NULL}. For + details see below.} +} + +\details{ +The \code{merge} method for \code{"zoo"} objects combines the columns +of several objects along the union of the dates +for \code{all = TRUE}, the default, +or the intersection of their dates for \code{all = FALSE} +filling up the created gaps (if any) with the \code{fill} pattern. + +The first argument must be a \code{zoo} object. If any of the remaining +arguments are plain vectors or matrices with the same length or number +of rows as the first argument then such arguments are coerced to \code{"zoo"} +using \code{as.zoo}. If they are plain but have length 1 then they are +merged after all non-scalars such that their column is filled with the +value of the scalar. + +\code{all} can be a vector of the same length as the number of \code{"zoo"} +objects to merged (if not, it is expanded): All indexes +(times) of the objects corresponding to \code{TRUE} are included, for those +corresponding to \code{FALSE} only the indexes present in all objects are +included. This allows intersection, union and left and right joins +to be expressed. + +If \code{retclass} is \code{"zoo"} (the default) a single merged \code{"zoo"} +object is returned. If it is set to \code{"list"} a list of \code{"zoo"} +objects is returned. If \code{retclass = NULL} then instead of returning a value it updates each +argument (if it is a variable rather than an expression) in +place so as to extend or reduce it to use the common index vector. + +The indexes of different +\code{"zoo"} objects can be of different classes and are coerced to +one class in the resulting object (with a warning). + +The default \code{cbind} method is essentially the default \code{merge} +method, but does not support the \code{retclass} argument. +The \code{rbind} +method combines the dates of the \code{"zoo"} objects (duplicate dates are +not allowed) and combines the rows of the objects. Furthermore, the +\code{c} method is identical to the \code{rbind} method. +} + +\value{ +An object of class \code{"zoo"} if \code{retclass="zoo"}, an object of +class \code{"list"} if \code{retclass="list"} or modified arguments as +explained above if \code{retclass=NULL}. If the result is an object +of class \code{"zoo"} then its frequency is the common frequency of its +zoo arguments, if they have a common frequency. +} + +\seealso{\code{\link{zoo}}} + +\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) +merge(y1, y2, all = FALSE, suffixes = c("a", "b")) +merge(y1, y2, all = TRUE) +merge(y1, y2, all = TRUE, fill = 0) + +## 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) + +## 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) +# same but with zero fill +merge(z, z0, fill = 0) + +merge(z, coredata(z), 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] +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) + +} +\keyword{ts} diff --git a/man/multitime.Rd b/man/multitime.Rd new file mode 100644 index 0000000..94a97ac --- /dev/null +++ b/man/multitime.Rd @@ -0,0 +1,70 @@ +\name{as.multitime} +\alias{multitime} +\alias{as.multitime} +\alias{as.multitime.default} +\alias{coredata.multitime} +\alias{index.multitime} +\alias{as.character.multitime} +\alias{MATCH.multitime} +\alias{ORDER.multitime} +\alias{xtfrm.multitime} +\alias{Ops.multitime} +\alias{"[.multitime"} +\alias{c.multitime} +\alias{as.numeric.multitime} +\alias{as.Date.multitime} +\alias{as.yearmon.multitime} +\alias{as.yearqtr.multitime} +\alias{make.unique.multitime} +\title{ A time object with multiple time scales. } +\description{ + Multitime objects have a primary time scale and a secondary time scale. + The latter can be used to distinguish between duplicates in the primary + time scale or provide an alternate representation such as specific dates + that correspond to year/months. +} +\usage{ +multitime(x, ...) + +as.multitime(x, ...) +\method{as.multitime}{default}(x, index, ...) +} +\arguments{ + \item{x}{ Primary time scale. } + \item{index}{ Optional secondary time scale. } + \item{\dots}{ Other arguments passed to individual methods. } +} +\details{ +Creates an object of class \code{multitime} which has a primary and +possibly secondary time scale. Methods provided are: \code{as.multitime}, +\code{as.multitime.default}, \code{coredata.multitime}, \code{index.multitime}, +\code{as.character.multitime}, \code{MATCH.multitime}, \code{ORDER.multitime}, +\code{xtfrm.multitime}, \code{Ops.multitime}, \code{[.multitime} +\code{c.multitime}, \code{as.numeric.multitime}, +\code{as.Date.multitime}, \code{as.yearmon.multitime}, +\code{as.yearqtr.multitime} and \code{make.unique.multitime}. +The primary and secondary time scales when considered in conjunction with +each other must be unique if they are to be used as the times of a zoo +object yet individually need not be. + +\code{as.Date}, \code{as.yearmon} and \code{as.yearqtr} methods search +through the time scales and return the first one found of the indicated +class or if none found convert the first time scale to the indicated class. +} +\value{ + An object of class \code{"multitime"}. +} +\examples{ +# use secondary time scale to uniquify times +z <- zoo(1:3, as.multitime(c(1, 1, 2), c(1, 2, 1))) +z + +# an object with both yearmon and Date scales +ym <- as.yearmon(2001:2003) +z2 <- zoo(1:3, as.multitime(ym, as.Date(ym, frac = 1))) +z2 +as.yearmon(time(z2)) +as.Date(time(z2)) + +} +\keyword{ts} diff --git a/man/na.approx.Rd b/man/na.approx.Rd new file mode 100644 index 0000000..b497d13 --- /dev/null +++ b/man/na.approx.Rd @@ -0,0 +1,61 @@ +\name{na.approx} +\alias{na.approx} +\alias{na.approx.default} +\alias{na.spline} +\alias{na.spline.default} +\title{Replace NA by Interpolation} +\description{ +Generic functions for replacing each \code{NA} with interpolated +values. +} +\usage{ +na.approx(object, \dots) +\method{na.approx}{default}(object, along = index(object), na.rm = TRUE, \dots) + +na.spline(object, \dots) +\method{na.spline}{default}(object, along = index(object), na.rm = TRUE, \dots) +} +\arguments{ + \item{object}{object in which \code{NA}s are to be replaced} + \item{along}{variable to use for interpolation. Has to be numeric, is + otherwise coerced to numeric.} + \item{na.rm}{logical. Should leading \code{NA}s be removed?} + \item{\dots}{further arguments passed to methods.} +} + +\details{ + Missing values (\code{NA}s) are replaced by linear interpolation via + \code{\link{approx}} or cubic spline interpolation via \code{\link{spline}}, + respectively. + + By default the index associated with \code{object} is used + for interpolation. Note, that if this calls \code{index.default} + this gives an equidistant spacing \code{1:NROW(object)}. If \code{object} + is a matrix or data.frame, the interpolation is done separately for + each column. +} + +\value{ +An object in which each \code{NA} in the input object is replaced +by interpolating the non-\code{NA} values before and after it. +Leading \code{NA}s are omitted (if \code{na.rm = TRUE}) or not replaced (if \code{na.rm = FALSE}). +} + +\seealso{\code{\link{zoo}}, \code{\link{approx}}, \code{\link{na.contiguous}}, \code{link{na.locf}}, \code{\link{na.omit}}, \code{\link{na.trim}}, \code{\link{spline}}, \code{\link[stinepack]{stinterp}}} + +\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) +## use equidistant spacing +na.approx(z, 1:6) + +# with and without na.rm = FALSE +zz <- c(NA,9,3,NA,3,2) +na.approx(zz, na.rm = FALSE) +na.approx(zz) + +} +\keyword{ts} diff --git a/man/na.locf.Rd b/man/na.locf.Rd new file mode 100644 index 0000000..a91190e --- /dev/null +++ b/man/na.locf.Rd @@ -0,0 +1,60 @@ +\name{na.locf} +\alias{na.locf} +\alias{na.locf.data.frame} +\alias{na.locf.list} +\alias{na.locf.default} +\title{Last Observation Carried Forward} +\description{ +Generic function for replacing each \code{NA} with the most recent +non-\code{NA} prior to it. +} +\usage{ +na.locf(object, na.rm = TRUE, \dots) +\method{na.locf}{default}(object, na.rm = TRUE, fromLast, rev, \dots) +} +\arguments{ + \item{object}{an object.} + \item{na.rm}{logical. Should leading \code{NA}s be removed?} + \item{fromLast}{logical. Causes observations to be carried backward rather + than forward. Default is \code{FALSE}. + This corresponds to NOCB (next observation carried backward).} + \item{rev}{Use \code{fromLast} instead. This argument will + be eliminated in the future in favor of \code{fromLast}.} + \item{\dots}{further arguments passed to methods.} +} + +\value{ +An object in which each \code{NA} in the input object is replaced +by the most recent non-\code{NA} prior to it. If there are no earlier non-\code{NA}s then +the \code{NA} is omitted (if \code{na.rm = TRUE}) or it is not replaced (if \code{na.rm = FALSE}). + +Note that if a multi-column zoo object has a column entirely composed of +\code{NA} then with \code{na.rm=TRUE}, the default, +the above implies that the resulting object will have +zero rows. Use \code{na.rm=FALSE} to preserve the \code{NA} values instead. +} + +\seealso{\code{\link{zoo}}} + +\examples{ +az <- zoo(1:6) + +bz <- zoo(c(2,NA,1,4,5,2)) +na.locf(bz) +na.locf(bz, fromLast = TRUE) + +cz <- zoo(c(NA,9,3,2,3,2)) +na.locf(cz) + +# generate and fill in missing dates +# by merging with a zero width series having those dates +# and then applying na.locf +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"))) +dd <- seq(start(z), end(z), "day") +na.locf(merge(z, zoo(, dd))) + +} +\keyword{ts} diff --git a/man/na.trim.Rd b/man/na.trim.Rd new file mode 100644 index 0000000..79f104c --- /dev/null +++ b/man/na.trim.Rd @@ -0,0 +1,45 @@ +\name{na.trim} +\alias{na.trim} +\alias{na.trim.default} +\title{Trim Leading/Trailing Missing Observations} +\description{ +Generic function for removing leading and trailing \code{NA}s. +} +\usage{ +na.trim(object, \dots) +\method{na.trim}{default}(object, sides = c("both", "left", "right"), + is.na = c("any", "all"), \dots) +} +\arguments{ + \item{object}{an object.} + \item{sides}{character specifying whether \code{NA}s are to be removed from +both sides, just from the left side or just from the right side.} + \item{is.na}{If "any" then a row will be regarded as \code{NA} if it has + any \code{NA}s. If "all" then a row will be regarded as \code{NA} + only if all elements in the row are \code{NA}. For one dimensional + zoo objects this argument has no effect.} + \item{\dots}{further arguments passed to methods.} +} + +\value{ +An object in which leading and/or trailing +\code{NA}s have been removed. +} + +\seealso{\code{\link{na.approx}}, \code{\link{na.contiguous}}, \code{\link{na.locf}}, \code{\link{na.omit}}, \code{\link{na.spline}}, \code{\link[stinepack]{stinterp}}, \code{\link{zoo}}} +\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) +na.trim(xx) + +# 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)) + +} +\keyword{ts} diff --git a/man/plot.zoo.Rd b/man/plot.zoo.Rd new file mode 100644 index 0000000..9a8393c --- /dev/null +++ b/man/plot.zoo.Rd @@ -0,0 +1,272 @@ +\name{plot.zoo} +\alias{plot.zoo} +\alias{barplot.zoo} +\alias{lines.zoo} +\alias{points.zoo} +\title{Plotting zoo Objects} +\description{ +Plotting method for objects of class \code{"zoo"}. +} +\usage{ +\method{plot}{zoo}(x, y = NULL, screens, plot.type, + panel = lines, xlab = "Index", ylab = NULL, main = NULL, + xlim = NULL, ylim = NULL, xy.labels = FALSE, xy.lines = NULL, + oma = c(6, 0, 5, 0), mar = c(0, 5.1, 0, 2.1), + col = 1, lty = 1, lwd = 1, pch = 1, type = "l", nc, widths = 1, heights = 1, \dots) +\method{lines}{zoo}(x, y = NULL, type = "l", \dots) +\method{points}{zoo}(x, y = NULL, type = "p", \dots) +} +\arguments{ + \item{x}{an object of class \code{"zoo"}.} + \item{y}{an object of class \code{"zoo"}. If \code{y} is \code{NULL} + (the default) a time series plot of \code{x} is produced, otherwise + if both \code{x} and \code{y} are univariate \code{"zoo"} series, a + scatter plot of \code{y} versus \code{x} is produced.} + \item{screens}{factor (or coerced to factor) whose levels specify which + graph each series is to be plotted in. \code{screens=c(1,2,1)} + would plot series 1, 2 and 3 in graphs 1, 2 and 1. If not specified + then 1 is used if \code{plot.type="single"} and \code{seq_len(ncol(x))} + otherwise.} + \item{plot.type}{for multivariate zoo objects, "multiple" plots the + series on multiple plots and "single" superimposes them on a single + plot. Default is "single" if \code{screens} has only one level and + \code{"multiple"} otherwise. If neither \code{screens} nor + \code{plot.type} is specified then \code{"single"} + is used if there is one series and \code{"mulitple"} otherwise. This + option is provided for back compatibility. Usually \code{screens} is + used instead.} + \item{panel}{a \code{function(x, y, col, lty, \dots)} which gives the + action to be carried out in each panel of the display for + \code{plot.type = "multiple"}.} + \item{ylim}{if \code{plot.type = "multiple"} then it can be a list of + y axis limits. If not a list each graph has the same limits. + If any list element is not a pair then its range is used instead. If + \code{plot.type = "single"} then it is as in \code{plot}.} + \item{xy.labels}{logical, indicating if \code{\link{text}} labels should be + used in the scatter plot, or character, supplying a vector of labels to be used.} + \item{xy.lines}{logical, indicating if \code{\link{lines}} should be drawn in + the scatter plot. Defaults to the value of \code{xy.labels} if that is + logical, otherwise to \code{FALSE}.} + \item{xlab, ylab, main, xlim, oma, mar}{graphical arguments, see \code{\link{par}}.} + \item{col, lty, lwd, pch, type}{graphical arguments that can be vectors or + (named) lists. See the details for more information.} + \item{nc}{the number of columns to use when \code{plot.type = "multiple"}. + Defaults to \code{1} for up to \code{4} series, otherwise to \code{2}.} + \item{widths, heights}{widths and heights for individual graphs, see + \code{\link{layout}}.} + \item{\dots}{additional graphical arguments.} +} + +\details{ +The methods for \code{plot} and \code{lines} are very similar +to the corresponding \code{ts} methods. However, the handling of +several graphical parameters is more flexible for multivariate series. +These parameters can be vectors of the same length as the number of +series plotted or are recycled if shorter. They can also be (partially) +named list, e.g., \code{list(A = c(1,2), c(3,4))} in which \code{c(3, 4)} +is the default value and \code{c(1, 2)} the value only for series \code{A}. +The \code{screens} argument can be specified in a similar way. +If \code{plot.type} and \code{screens} conflict then multiple plots +will be assumed. Also see the examples. + +In the case of a custom panel the panel can reference +\code{parent.frame$panel.number} in order to determine which +frame the panel is being called from. See examples. + +\code{par(mfrow=...)} and \code{Axis} can be used in conjunction with +single panel plots in the same way as with other classic graphics. + +For multi-panel graphics, \code{plot.zoo} takes over the layout so +\code{par(mfrow=...)} cannot be used. \code{Axis} can be used within +the panels themselves but not outside the panel. See examples. + +In addition to classical time series line plots, there is also a +simple \code{\link{barplot}} method for \code{"zoo"} series. +} + +\seealso{\code{\link{zoo}}, \code{\link{plot.ts}}, \code{\link{barplot}}, +\code{\link{xyplot.zoo}}} + +\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 +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) + +# automatically placed point labels +\dontrun{ +library("maptools") +pointLabel(time(z), coredata(z[,2]), labels = format(time(z)), cex = 0.5) +} + +## 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) + +## barplot +x <- zoo(cbind(rpois(5, 2), rpois(5, 3)), x.Date) +barplot(x, beside = TRUE) + +## 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 +\dontrun{ +library("TeachingDemos") +tke.test1 <- list(Parameters = list( + pch = list("spinbox", init = 1, from = 0, to = 255, width = 5), + cex = list("slider", init = 1.5, from = 0.1, to = 5, resolution = 0.1), + type = list("combobox", init = "b", + values = c("p", "l", "b", "o", "c", "h", "s", "S", "n"), width = 5), + lwd = list("spinbox", init = 1, from = 0, to = 5, increment = 1, width = 5), + lty = list("spinbox", init = 1, from = 0, to = 6, increment = 1, width = 5) +)) +z <- zoo(rnorm(25)) +tkexamp(plot(z), tke.test1, plotloc = "top") +} + +} +\keyword{ts} diff --git a/man/read.zoo.Rd b/man/read.zoo.Rd new file mode 100644 index 0000000..6c7a57c --- /dev/null +++ b/man/read.zoo.Rd @@ -0,0 +1,174 @@ +\name{read.zoo} +\alias{read.zoo} +\alias{write.zoo} + +\title{Reading and Writing zoo Series} +\description{ +\code{read.zoo} and \code{write.zoo} are convenience functions for reading +and writing \code{"zoo"} series from/to text files. They are convenience +interfaces to \code{read.table} and \code{write.table}, respectively. +} +\usage{ +read.zoo(file, format = "", tz = "", FUN = NULL, + regular = FALSE, index.column = 1, drop = TRUE, make.unique = NULL, + split = NULL, aggregate = FALSE, \dots) +write.zoo(x, file = "", index.name = "Index", row.names = FALSE, col.names = NULL, \dots) +} +\arguments{ + \item{file}{character giving the name of the file which the data + are to be read from/written to. See \code{\link{read.table}} and + \code{\link{write.table}} for more information. Alternatively, + in \code{read.zoo}, \code{file} can be a \code{data.frame} (e.g., + resulting from a previous \code{read.table} call) that + is subsequently processed to a \code{"zoo"} series.} + \item{format}{date format argument passed to \code{FUN}.} + \item{tz}{time zone argument passed to \code{\link{as.POSIXct}}.} + \item{FUN}{a function for computing the index from the first column + of the data. See details.} + \item{regular}{logical. Should the series be coerced to class \code{"zooreg"} + (if the series is regular)?} + \item{index.column}{integer. The column of the data frame in which the index/time + is stored.} + \item{drop}{logical. If the data frame contains just a single data column, should + the second dimension be dropped?} + \item{x}{a \code{"zoo"} object.} + \item{index.name}{character with name of the index column in the written + data file.} + \item{row.names}{logical. Should row names be written? Default is \code{FALSE} + because the row names are just character representations of the index.} + \item{col.names}{logical. Should column names be written? Default is to + write column names only if \code{x} has column names.} + \item{make.unique}{function. It is applied to the time index after + \code{FUN} and before \code{aggregate} normally intended to make + duplicate index values unique.} + \item{split}{NULL or column number or name or vector of numbers or + names. If not NULL then the data is assumed to be in long format and is + split according to the indicated columns. See the R + \code{\link[stats]{reshape}} command for description of long data. + If \code{split=Inf} then the first of each run are made into a separate + series, the second of each run and so on. If \code{split= -Inf} then + the last of each run is made into a separate series, the second last + and so on. +} + \item{aggregate}{logical or function. If set to \code{TRUE}, then \code{\link{aggregate.zoo}} + is applied to the zoo object created to compute the \code{\link{mean}} of all values with + the same time index. Alternatively, \code{aggregate} can be set to any other + function that should be used for aggregation. + If \code{FALSE} (the default), no aggregation is performed and a warning + is given if there are any duplicated time indexes. Note that most + \code{zoo} functions do not accept objects with duplicate time indexes. + See \code{\link{aggregate.zoo}}.} + \item{\dots}{further arguments passed to \code{\link{read.table}} or + \code{\link{write.table}}, respectively.} +} + +\details{ +\code{read.zoo} is a convenience function which should make it easier +to read data from a text file and turn it into a \code{"zoo"} series +immediately. \code{read.zoo} reads the data file via \code{read.table(file, \dots)}. +The column \code{index.column} (by default the first) of the resulting data is +interpreted to be the index/time, the remaining columns the corresponding data. +(If the file only has only column then that is assumed to be the data column and +\code{1, 2, ...} are used for the index.) To assign the appropriate class +to the index, \code{FUN} can be specified and is applied to the first column. + +To process the index, \code{read.zoo} uses the first of the following that is +true: 1. If \code{FUN} is specified then \code{read.zoo} calls \code{FUN} with +the index as the first argument. 2. If \code{tz} is specified then the index +column is converted to \code{POSIXct}. 3. If \code{format} is specified +then the index column is converted to \code{Date}. 4. A heuristic +attempts to decide among \code{"numeric"}, \code{"Date"} and \code{"POSIXct"}. +If \code{format} and/or \code{tz} is specified +then it is passed to the conversion function as well. + + +If \code{regular} is set to \code{TRUE} and the resulting series has an +underlying regularity, it is coerced to a \code{"zooreg"} series. + +\code{write.zoo} is a convenience function for writing \code{"zoo"} series +to text files. It first coerces its argument to a \code{"data.frame"}, adds +a column with the index and then calls \code{\link{write.table}}. +} + +\value{ +\code{read.zoo} returns an object of class \code{"zoo"} (or \code{"zooreg"}). +} +\note{\code{read.zoo} works by first reading the data in using \code{read.table} +and then processing it. This implies that +if the index field is entirely numeric the default is to pass it to \code{FUN} +or the built-in date conversion routine +a number, rather than a character string. +Thus, a date field such as \code{09122007} intended +to represent December 12, 2007 would be seen as \code{9122007} +and interpreted as the 91st day +thereby generating an error. + +This comment also applies to trailing decimals so that if +\code{2000.10} were intended to represent the 10th month of 2000 in fact +it would receive +\code{2000.1} and regard it as the first month of 2000 +unless similar precautions were taken. + +In the above cases the index field should be specified to be +\code{"character"} so that leading or trailing zeros +are not dropped. This can be done by specifying a \code{"character"} +index column in the +\code{"colClasses"} argument, which is passed to \code{read.table}, +as shown in the examples below. +} + +\seealso{\code{\link{zoo}}, \code{\link{make.unique}}} + +\examples{ +\dontrun{ +## turn *numeric* first column into yearmon index +## where number is year + fraction of year represented by month +z <- read.zoo("foo.csv", sep = ",", FUN = as.yearmon) + +## first column is of form yyyy.mm +## (Here we use format in place of as.character so that final zero +## is not dropped in dates like 2001.10 which as.character would do.) +f <- function(x) as.yearmon(format(x, nsmall = 2), "\%Y.\%m") +z <- read.zoo("foo.csv", header = TRUE, FUN = f) + +## turn *character* first column into "Date" index +## Assume lines look like: 12/22/2007 1 2 +z <- read.zoo("foo.tab", format = "\%m/\%d/\%Y") + +# Suppose lines look like: 09112007 1 2 and there is no header +z <- read.zoo("foo.txt", format = "\%d\%m\%Y") + +## csv file with first column of form YYYY-mm-dd HH:MM:SS +## Read in times as "chron" class. Requires chron 2.3-22 or later. +z <- read.zoo("foo.csv", header = TRUE, sep = ",", FUN = as.chron) + +## same but with custom format. Note as.chron uses POSIXt-style % formats +## Read in times as "chron" class. Requires chron 2.3-24 or later. +z <- read.zoo("foo.csv", header = TRUE, sep = ",", FUN = as.chron, + format = "%Y%m%d") + +## same file format but read it in times as "POSIXct" class. +z <- read.zoo("foo.csv", header = TRUE, sep = ",", tz = "") + +## csv file with first column mm-dd-yyyy. Read times as "Date" class. +z <- read.zoo("foo.csv", header = TRUE, sep = ",", format = "\%m-\%d-\%Y") + +## whitespace separated file with first column of form YYYY-mm-ddTHH:MM:SS +## and no headers. T appears literally. Requires chron 2.3-22 or later. +z <- read.zoo("foo.csv", FUN = as.chron) +} + +## omit the read.table() phase and directly supply a data.frame +dat <- data.frame(date = paste("2000-01-", 10:15, sep = ""), a = rnorm(6), b = 1:6) +z <- read.zoo(dat) + +## using built-in data frame BOD +read.zoo(BOD) + +read.zoo(BOD, FUN = as.Date) + +read.zoo(BOD[c(1:6, 1), ], aggregate = mean) + +} +\keyword{ts} + diff --git a/man/rollapply.Rd b/man/rollapply.Rd new file mode 100644 index 0000000..c91ddcc --- /dev/null +++ b/man/rollapply.Rd @@ -0,0 +1,88 @@ +\name{rollapply} +\alias{rollapply} +\alias{rollapply.zoo} +\alias{rollapply.ts} +\title{Apply Rolling Functions} +\description{ + A generic function for applying a function to rolling margins of an array. +} +\usage{ +rollapply(data, width, FUN, \dots, by = 1, ascending = TRUE, by.column = TRUE, + na.pad = FALSE, align = c("center", "left", "right")) +} +\arguments{ + \item{data}{the data to be used (representing a series of observations).} + \item{width}{number of points per group.} + \item{FUN}{the function to be applied. + In the case of functions like \code{+}, \code{\%*\%}, etc., the + function name must be quoted.} + \item{\dots}{optional arguments to \code{FUN}.} + \item{by}{calculate FUN for trailing width points at every by-th time + point.} + \item{ascending}{logical. If TRUE then points are passed to \code{FUN} in + ascending order of time; otherwise, they are passed in descending order.} + \item{by.column}{logical. If \code{TRUE}, \code{FUN} is applied to each column separately.} + \item{na.pad}{logical. If \code{TRUE} + then additional elements or rows of \code{NA}s are added so that + result has same number of elements or rows as \code{data}.} + \item{align}{character specifying whether result should be left- or + right-aligned or centered (default).} +} +\details{ + Groups time points in successive sets of \code{width} time points and + applies \code{FUN} to the corresponding values. If \code{FUN} is + \code{mean}, \code{max} or \code{median} and \code{by.column} is + \code{TRUE} and there are no extra arguments + then special purpose code is used to enhance performance. + See \code{\link{rollmean}}, \code{\link{rollmax}} and \code{\link{rollmedian}} + for more details. + + Currently, there are methods for \code{"zoo"} and \code{"ts"} series. + + In previous versions, this function was called \code{rapply}. It was renamed + because from R 2.4.0 on, base R provides a different function \code{rapply} + for recursive (and not rolling) application of functions. +} +\value{ + A object of the same class as \code{data} with the results of the rolling function. +} + +\seealso{\code{\link{rollmean}}} + +\examples{ +## rolling mean +z <- zoo(11:15, as.Date(31:35)) +rollapply(z, 2, mean) + +## non-overlapping means +z2 <- zoo(rnorm(6)) +rollapply(z2, 3, mean, by = 3) # means of nonoverlapping groups of 3 +aggregate(z2, c(3,3,3,6,6,6), mean) # same + +## optimized vs. customized versions +rollapply(z2, 3, mean) # uses rollmean which is optimized for mean +rollmean(z2, 3) # same +rollapply(z2, 3, (mean)) # does not use rollmean + +## 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) +fm <- 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 +plot(fm) +## showing the shifts after the oil crisis in Oct 1973 +## and after the seatbelt legislation change in Jan 1983 +} +\keyword{iteration} +\keyword{array} +\keyword{ts} diff --git a/man/rollmean.Rd b/man/rollmean.Rd new file mode 100644 index 0000000..9708ebd --- /dev/null +++ b/man/rollmean.Rd @@ -0,0 +1,67 @@ +\name{rollmean} +\alias{rollmean} +\alias{rollmax} +\alias{rollmedian} +\alias{rollmean.zoo} +\alias{rollmedian.zoo} +\alias{rollmax.zoo} +\alias{rollmean.ts} +\alias{rollmedian.ts} +\alias{rollmax.ts} +\alias{rollmean.default} +\alias{rollmedian.default} +\alias{rollmax.default} +\title{Rolling Means/Maximums/Medians} +\description{ +Generic functions for computing rolling means, maximums and medians of ordered observations. +} +\usage{ +rollmean(x, k, na.pad = FALSE, align = c("center", "left", "right"), \dots) +rollmax(x, k, na.pad = FALSE, align = c("center", "left", "right"), \dots) +rollmedian(x, k, na.pad = FALSE, align = c("center", "left", "right"), \dots) +} +\arguments{ + \item{x}{an object (representing a series of observations).} + \item{k}{integer width of the rolling window. Must be odd for \code{rollmedian}.} + \item{na.pad}{logical. Should \code{NA} padding be added at beginning?} + \item{align}{character specifying whether result should be left- or + right-aligned or centered (default).} + \item{\dots}{Further arguments passed to methods.} +} + +\details{ +These functions compute rolling means, maximums and medians respectively +and are thus similar to \code{\link{rollapply}} but are +optimized for speed. + +Currently, there are methods for \code{"zoo"} and \code{"ts"} series and +default methods (intended for vectors). The default method of \code{rollmedian} +is an interface to \code{\link{runmed}}. +The default method of \code{rollmean} does not handle inputs that contain +\code{NA}s. In such cases, use \code{\link{rollapply}} instead. +} + +\value{ +An object of the same class as \code{x} with the rolling mean/max/median. +} + +\seealso{\code{\link{rollapply}}, \code{\link{zoo}}} + +\examples{ +x.Date <- as.Date(paste(2004, rep(1:4, 4:1), sample(1:28, 10), sep = "-")) +x <- zoo(rnorm(12), x.Date) + +rollmean(x, 3) +rollmax(x, 3) +rollmedian(x, 3) + +xm <- zoo(matrix(1:12, 4, 3), x.Date[1:4]) +rollmean(xm, 3) +rollmax(xm, 3) +rollmedian(xm, 3) + +rollapply(xm, 3, mean) # uses rollmean +rollapply(xm, 3, function(x) mean(x)) # does not use rollmean + +} +\keyword{ts} diff --git a/man/window.zoo.Rd b/man/window.zoo.Rd new file mode 100644 index 0000000..c797136 --- /dev/null +++ b/man/window.zoo.Rd @@ -0,0 +1,67 @@ +\name{window.zoo} +\alias{window.zoo} +\alias{window<-.zoo} +\title{Extract/Replacing the Time Windows of Objects} +\description{ +Methods for extracting time windows +of \code{"zoo"} objects and replacing it. +} + +\usage{ +\method{window}{zoo}(x, index. = index(x), start = NULL, end = NULL, \dots) +\method{window}{zoo}(x, index. = index(x), start = NULL, end = NULL, \dots) <- value +} + +\arguments{ + \item{x}{an object.} + \item{index.}{the index/time window which should be extracted.} + \item{start}{an index/time value. Only the indexes in \code{index} + which are greater or equal to \code{start} are used. If the index + class supports comparisons to character variables, as does \code{"Date"} + class, \code{"yearmon"} class, \code{"yearqtr"} class and + the \code{chron} package classes \code{"dates"} and \code{"times"} + then \code{start} may alternately be a character variable.} + \item{end}{an index/time value. Only the indexes in \code{index} + which are lower or equal to \code{end} are used. Similar comments + about character variables mentioned under \code{start} apply + here too.} + \item{value}{a suitable value object for use with \code{window(x)}.} + \item{\dots}{currently not used.} +} + +\value{ +Either the time window of the object is extracted (and hence return a \code{"zoo"} +object) or it is replaced. +} + +\seealso{\code{\link{zoo}}} + +\examples{ +## 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 + +window(x, start = as.Date("2003-02-01"), end = as.Date("2003-03-01")) +window(x, index = x.date[1:6], start = as.Date("2003-02-01")) +window(x, index = x.date[c(4, 8, 10)]) +window(x, index = x.date[c(4, 8, 10)]) <- matrix(1:6, ncol = 2) +x + +## for classes that support comparisons with "character" variables +## start and end may be "character". +window(x, start = "2003-02-01") + +## zooreg example (with plain numeric index) +z <- zooreg(rnorm(10), start = 2000, freq = 4) +window(z, start = 2001.75) +window(z, start = c(2001, 4)) + +## 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) + +} +\keyword{ts} diff --git a/man/xyplot.zoo.Rd b/man/xyplot.zoo.Rd new file mode 100644 index 0000000..36c35d1 --- /dev/null +++ b/man/xyplot.zoo.Rd @@ -0,0 +1,259 @@ +\name{xyplot.zoo} +\alias{xyplot.zoo} +\alias{xyplot.ts} +\alias{xyplot.its} +\alias{xyplot.tis} +\alias{panel.lines.zoo} +\alias{panel.lines.ts} +\alias{panel.lines.its} +\alias{panel.lines.tis} +\alias{panel.points.zoo} +\alias{panel.points.ts} +\alias{panel.points.its} +\alias{panel.points.tis} +\alias{panel.segments.zoo} +\alias{panel.segments.ts} +\alias{panel.segments.its} +\alias{panel.segments.tis} +\alias{panel.text.zoo} +\alias{panel.text.ts} +\alias{panel.text.its} +\alias{panel.text.tis} +\alias{panel.rect.zoo} +\alias{panel.rect.ts} +\alias{panel.rect.its} +\alias{panel.rect.tis} +\alias{panel.arrows.zoo} +\alias{panel.arrows.ts} +\alias{panel.arrows.its} +\alias{panel.arrows.tis} +\alias{panel.polygon.zoo} +\alias{panel.polygon.ts} +\alias{panel.polygon.its} +\alias{panel.polygon.tis} +\alias{panel.plot.default} +\alias{panel.plot.custom} + +\title{Plot zoo Series with Lattice} + +\description{ +\code{xyplot} methods for time series objects (of class \code{"zoo"}, +\code{"ts"}, \code{"its"}, or \code{"tis"}). These functions are still under development +and the interface and functionality might be modified/extended in future +releases. +} + +\usage{ + +\method{xyplot}{zoo}(x, data, screens = seq_len(NCOL(x)), + default.scales = list(y = list(relation = "free")), + layout = NULL, xlab = "Index", ylab = NULL, + lty = trellis.par.get("plot.line")$lty, + lwd = trellis.par.get("plot.line")$lwd, + pch = trellis.par.get("plot.symbol")$pch, + type = "l", + col = trellis.par.get("plot.line")$col, + strip = TRUE, panel = panel.plot.default, ...) + +panel.plot.default(x, y, subscripts, groups, + panel = panel.xyplot, + col = 1, type = "p", pch = 20, lty = 1, lwd = 1, ...) + +panel.plot.custom(...) + +panel.lines.zoo(x, ...) +panel.points.zoo(x, ...) +panel.segments.zoo(x0, x1, ...) +panel.text.zoo(x, ...) +panel.rect.zoo(x0, x1, ...) +panel.arrows.zoo(x0, x1, ...) +panel.polygon.zoo(x, ...) + +} +\arguments{ + \item{x, x0, x1}{time series object of class \code{"zoo"}, \code{"ts"} or + \code{"its"}. For \code{panel.plot.default} it should be a numeric + vector.} + \item{y}{numeric vector or matrix.} + \item{subscripts, groups, panel}{arguments for panel functions, see + description of \code{panel} argument in \code{\link[lattice]{xyplot}}.} + \item{data}{currently not used.} + \item{screens}{factor (or coerced to factor) whose levels specify which + graph each series is to be plotted in. \code{screens = c(1, 2, 1)} + would plot series 1, 2 and 3 in graphs 1, 2 and 1.} + \item{default.scales}{\code{scales} specification. The default is set so that all + series have the \code{"same"} X axis but \code{"free"} Y axis. + See \code{\link[lattice]{xyplot}} in the \pkg{lattice} package for more + information on \code{scales}. For users, it is recommended to set the \code{scales} + argument instead of \code{default.scales}.} + \item{layout}{numeric vector of length 2 specifying number of columns + and rows in the plot, see \code{\link[lattice]{xyplot}} for more details. + The default is to fill columns with up to 5 rows.} + \item{xlab}{character string used as the X axis label.} + \item{ylab}{character string used as the Y axis label. If there + are multiple panels it may be a character vector the same length + as the number of panels.} + \item{lty, lwd, pch, type, col}{graphical arguments passed to \code{\link[lattice]{xyplot}}. + These arguments can also be vectors or (named) lists, see details + for more information.} + \item{strip}{logical, character or function specifying headings used for + panels. If character, should be a vector the same length as the + number of panels. If \code{TRUE} column names are used for headers. + If \code{FALSE}, no headings are produced. See + \code{\link[lattice]{xyplot}} for the case in + which \code{strip} is a function.} + \item{\dots}{additional arguments passed to \code{\link[lattice]{xyplot}}. } +} +\details{ + \code{xyplot.zoo} plots + a \code{"zoo"}, \code{"ts"} or \code{"its"} object using + \code{\link[lattice]{xyplot}} from \pkg{lattice}. Series of other classes + are coerced to \code{"zoo"} first. + + The handling of several graphical parameters is more + flexible for multivariate series. These parameters can be + vectors of the same length as the number of series plotted or + are recycled if shorter. They can also be (partially) named list, e.g., + \code{list(A = c(1,2), c(3,4))} in which \code{c(3, 4)} is the + default value and \code{c(1, 2)} the value only for series \code{A}. + The \code{screens} argument can be specified in a similar way. + + \code{plot.panel.default} is the default panel function. + \code{plot.panel.custom} facilitates the development of + custom panels. Usually it has one argument \code{"panel"} + which specifies the custom panel. That panel typically calls + \code{plot.panel.default}. The panel function may use the panel.number() + function to find out which panel is currently being executed. + See the examples. +} +\value{ + Invisibly returns a \code{"trellis"} class object. Printing this + object using \code{print} will display it. +} +\seealso{\code{\link{zoo}}, \code{\link{plot.ts}}, \code{\link{barplot}}, +\code{\link{plot.zoo}}} +\examples{ +library("lattice") +library("grid") + +# 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))) + +set.seed(1) +z <- zoo(cbind(a = 1:5, b = 11:15, c = 21:25) + rnorm(5)) + +# plot a blue running mean on the panel of b. +# Also add a grid. +# We show two ways to do it. + +# Number 1. Using trellis.focus. +print(xyplot(z)) +trellis.focus("panel", 1, 2, highlight = FALSE) +z.mean <- rollmean(z, 3) +# uncomment next line and remove line after that when +# lattice makes panel.lines generic +# print(panel.lines(time(z.mean), z.mean[,2], col = "blue")) +print(panel.lines.zoo(z.mean[,2], col = "blue")) +print(panel.grid(h = 10, v = 10, col = "grey", lty = 3)) +trellis.unfocus() + +# Number 2. Using a custom panel routine. +# This example relies on R version 2.40 or higher. +p <- function(x, y, groups = NULL, ...) { + panel.xyplot(x, y, groups = groups, ...) + if (panel.number() == 2) { + panel.lines.zoo(rollmean(zoo(y, x), 3), col = "blue") + panel.grid(h = 10, v = 10, col = "grey", lty = 3) + } +} +print(xyplot(z, panel = panel.plot.custom(panel = p))) + +# 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.plot.default", trellis.panelArgs()) +trellis.unfocus() + +# same but make first (i.e. bottom) panel twice as large as others +print(xyplot(z), heights = list(c(2,1,1), units = "null")) +# add a grid - this method does not confine grid to frames +# To do that see prior example. +panel.grid() + +# Plot all in one panel. +print(xyplot(z, screens = 1)) + +# 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 (upper) panel 3x the height of the 1st (lower) panel +# Also make the strip background orange. +p <- xyplot(z, screens = c(1,1,2), type = c("p", "l", "o"), col = 1:3, + par.setting = 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") +z <- zoo(seq(length(Days))^2, Days) +Months <- Days[format(Days, "\%d") == "01"] +Weeks <- Days[format(Days, "\%w") == "0"] +xyplot(z, 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 +my.axis <- function(side, ...) if (side != "top") axis.default(side, ...) +my.panel <- function(...) { + panel.axis(outside = TRUE, lab = FALSE) + panel.plot.default(...) +} +set.seed(1) +z <- zoo(cbind(a = 1:5, b = 11:15, c = 21:25) + rnorm(5)) +xyplot(z, between = list(x = 1.2, y = 1), par.settings = list(panel = "off"), + axis = my.axis, panel = my.panel) + +# left strips but no top strips +xyplot(z, screens = colnames(z), strip = FALSE , strip.left = TRUE) + +# same but more complex +xyplot(z, strip = FALSE , strip.left = strip.custom(factor.levels = colnames(z))) + +# 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")) + +\dontrun{ +# playwith (>= 0.8-55) +library("playwith") +z3 <- zoo(cbind(a = rnorm(100), b = rnorm(100) + 1), as.Date(1:100)) +playwith(xyplot(z3), time.mode = TRUE) + +# after running this click on Identify Points and then click on +# points to identify in graph; right click to finish +labs <- paste(z3, index(z3), sep = "@") +playwith(xyplot(z3, type = "o"), labels = labs, label.args = list(cex = 0.7)) + +# for playwith identify tool this returns indexes into times of clicked points +ids <- do.call(rbind, playDevCur()$ids)$which +z3[ids,] +} + +} +\keyword{ts} diff --git a/man/yearmon.Rd b/man/yearmon.Rd new file mode 100644 index 0000000..9235545 --- /dev/null +++ b/man/yearmon.Rd @@ -0,0 +1,140 @@ +\name{yearmon} +\alias{yearmon} +\alias{as.yearmon} +\alias{as.yearmon.default} +\alias{as.yearmon.numeric} +\alias{as.yearmon.integer} +\alias{as.yearmon.dates} +\alias{as.yearmon.Date} +\alias{as.yearmon.timeDate} +\alias{as.yearmon.jul} +\alias{as.yearmon.POSIXt} +\alias{as.yearmon.character} +\alias{as.yearmon.date} +\alias{as.yearmon.factor} +\alias{as.Date.yearmon} +\alias{as.POSIXct.yearmon} +\alias{as.POSIXlt.yearmon} +\alias{as.numeric.yearmon} +\alias{as.character.yearmon} +\alias{as.data.frame.yearmon} +\alias{c.yearmon} +\alias{cycle.yearmon} +\alias{format.yearmon} +\alias{is.yearmon} +\alias{mean.yearmon} +\alias{print.yearmon} +\alias{range.yearmon} +\alias{summary.yearmon} +\alias{unique.yearmon} +\alias{[.yearmon} +\alias{MATCH.yearmon} +\alias{Ops.yearmon} +\alias{Sys.yearmon} +\alias{-.yearmon} + +\title{An Index Class for Monthly Data} +\description{ + \code{"yearmon"} is a class for representing monthly data. +} +\usage{ +yearmon(x) +} +\arguments{ + \item{x}{numeric (interpreted as being \dQuote{in years}).} +} +\details{ + The \code{"yearmon"} class is used to represent monthly data. Internally it holds + the data as year plus 0 for January, 1/12 for February, 2/12 for March + and so on in order that its internal representation is the same as + \code{ts} class with \code{frequency = 12}. If \code{x} is not in this + format it is rounded via \code{floor(12*x + .0001)/12}. + + There are coercion methods available for various classes including: + default coercion to \code{"yearmon"} (which coerces to \code{"numeric"} first) + and coercions to and from \code{"yearmon"} to \code{"Date"} (see below), + \code{"POSIXct"}, + \code{"POSIXlt"}, \code{"numeric"}, \code{"character"} and \code{"jul"}. + The last one is from the \code{"fame"} package available on CRAN. + In the case of + \code{as.yearmon.character} the \code{format} argument uses the same + percent code as + \code{"Date"}. These are described in \code{\link{strptime}}. Unlike + \code{"Date"} one can specify a year and month with no day. + Default formats of \code{"\%Y-\%m"}, \code{"\%Y-\%m-\%d"} and \code{"\%b \%Y"}. + + There is an \code{is.numeric} method which returns \code{FALSE}. + + \code{as.Date.yearmon} and \code{as.yearmon.yearqtr} + each has an optional + second argument of \code{"frac"} which is a number between 0 and 1 inclusive + that indicates the fraction of the way through the period that the result + represents. The default is 0 which means the beginning of the period. + + There is also a \code{date} method for \code{as.yearmon} usable with objects + created with package \code{date}. + + \code{Sys.yearmon()} returns the current year/month and methods for + \code{min}, \code{max} and \code{range} are defined (by defining + a method for \code{Summary}). + + A \code{yearmon} \code{mean} method is also defined. +} + +\value{ + Returns its argument converted to class \code{yearmon}. +} + +\seealso{\code{\link{yearqtr}}, \code{\link{zoo}}, \code{\link{zooreg}}, \code{\link{ts}}} + +\examples{ +x <- as.yearmon(2000 + seq(0, 23)/12) +x + +as.yearmon("mar07", "\%b\%y") +as.yearmon("2007-03-01") +as.yearmon("2007-12") + +# returned Date is the fraction of the way through +# the period given by frac (= 0 by default) +as.Date(x) +as.Date(x, frac = 1) +as.POSIXct(x) + +# given a Date, x, return the Date of the next Friday +nextfri <- function(x) 7 * ceiling(as.numeric(x - 1)/7) + as.Date(1) + +# 3rd Friday in last month of the quarter of Date x +as.Date(as.yearmon(as.yearqtr(x)) + 2/12) + 14 + +z <- zoo(rnorm(24), x, frequency = 12) +z +as.ts(z) + +## 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(textConnection(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) + +xx <- zoo(seq_along(x), x) + +## aggregating over year +as.year <- function(x) as.numeric(floor(as.yearmon(x))) +aggregate(xx, as.year, mean) + +} +\keyword{ts} diff --git a/man/yearqtr.Rd b/man/yearqtr.Rd new file mode 100644 index 0000000..5ec985a --- /dev/null +++ b/man/yearqtr.Rd @@ -0,0 +1,125 @@ +\name{yearqtr} +\alias{yearqtr} +\alias{as.yearqtr} +\alias{as.yearqtr.default} +\alias{as.yearqtr.numeric} +\alias{as.yearqtr.integer} +\alias{as.yearqtr.date} +\alias{as.yearqtr.dates} +\alias{as.yearqtr.Date} +\alias{as.yearqtr.timeDate} +\alias{as.yearqtr.jul} +\alias{as.yearqtr.POSIXt} +\alias{as.yearqtr.character} +\alias{as.yearqtr.factor} +\alias{as.yearqtr.yearqtr} +\alias{as.Date.yearqtr} +\alias{as.POSIXct.yearqtr} +\alias{as.POSIXlt.yearqtr} +\alias{as.numeric.yearqtr} +\alias{as.character.yearqtr} +\alias{as.data.frame.yearqtr} +\alias{c.yearqtr} +\alias{cycle.yearqtr} +\alias{format.yearqtr} +\alias{is.numeric.yearqtr} +\alias{mean.yearqtr} +\alias{print.yearqtr} +\alias{range.yearqtr} +\alias{summary.yearqtr} +\alias{unique.yearqtr} +\alias{[.yearqtr} +\alias{MATCH.yearqtr} +\alias{Ops.yearqtr} +\alias{Summary.yearqtr} +\alias{Sys.yearqtr} +\alias{-.yearqtr} + +\title{An Index Class for Quarterly Data} +\description{ + \code{"yearqtr"} is a class for representing quarterly data. +} + +\usage{ +yearqtr(x) +as.yearqtr(x, \dots) +\method{format}{yearqtr}(x, format = "\%Y Q\%q", \dots) +} + +\arguments{ + \item{x}{for \code{yearqtr} a numeric (interpreted as being + \dQuote{in years}). For \code{as.yearqtr} another date class + object. For the \code{"yearqtr"} method of \code{format} an + object of class \code{"yearqtr"} or if called as \code{format.yearqtr} + then an object with an \code{as.yearqtr} method that can be coerced + to \code{"yearqtr"}.} + \item{format}{character string specifying format. + \code{"\%C"}, \code{"\%Y"}, \code{"\%y"} and \code{"\%q"}, if present, + are replaced with the century, year, last two digits of the year, + and quarter (i.e. a number between 1 and 4), respectively.} + \item{\dots}{other arguments. Currently not used.} +} + +\details{ + The \code{"yearqtr"} class is used to represent quarterly data. Internally it holds + the data as year plus 0 for Quarter 1, 1/4 for Quarter 2 + and so on in order that its internal representation is the same as + \code{ts} class with \code{frequency = 4}. If \code{x} is not in this + format it is rounded via \code{floor(4*x + .0001)/4}. + + \code{as.yearqtr.character} uses a default format of \code{"\%Y Q\%q"}, + \code{"\%Y q\%q"} or \code{"\%Y-\%q"} according to whichever matches. + \code{\%q} accepts the numbers 1-4 (possibly with leading zeros). + + There are coercion methods available for various classes including: + default coercion to \code{"yearqtr"} (which coerces to \code{"numeric"} first) + and coercion from \code{"yearqtr"} to \code{"Date"} (see below), \code{"POSIXct"}, + \code{"POSIXlt"}, \code{"numeric"}, \code{"character"} and \code{"jul"}. + The last one is from the \code{frame} package on CRAN. + + There is an \code{is.numeric} method which returns \code{FALSE}. + + There is also a \code{date} method for \code{as.yearqtr} usable with objects + created with package \code{date}. + + \code{Sys.yearqtr()} returns the current year/month and methods for + \code{min}, \code{max} and \code{range} are defined (by defining + a method for \code{Summary}. + + A \code{yearqtr} \code{mean} method is also defined. + + Certain methods support a \code{frac} argument. See \code{\link{yearmon}}. + +} +\value{ + \code{yearqtr} and \code{as.yearqtr} return the first argument converted to + class \code{yearqtr}. + The \code{format} method returns a character string representation of + its argument first argument. +} + +\seealso{\code{\link{yearmon}}, \code{\link{zoo}}, \code{\link{zooreg}}, \code{\link{ts}}, + \code{\link{strptime}}.} + +\examples{ +x <- as.yearqtr(2000 + seq(0, 7)/4) +x + +format(x, "\%Y Quarter \%q") +as.yearqtr("2001 Q2") +as.yearqtr("2001 q2") # same +as.yearqtr("2001-2") # same + +# returned Date is the fraction of the way through +# the period given by frac (= 0 by default) +dd <- as.Date(x) +format.yearqtr(dd) +as.Date(x, frac = 1) +as.POSIXct(x) + +zz <- zoo(rnorm(8), x, frequency = 4) +zz +as.ts(zz) + +} +\keyword{ts} diff --git a/man/zoo.Rd b/man/zoo.Rd new file mode 100644 index 0000000..3787ca6 --- /dev/null +++ b/man/zoo.Rd @@ -0,0 +1,381 @@ +\name{zoo} +\alias{zoo} +\alias{with.zoo} +\alias{range.zoo} +\alias{print.zoo} +\alias{as.zoo.factor} +\alias{summary.zoo} +\alias{str.zoo} +\alias{is.zoo} +\alias{[.zoo} +\alias{$.zoo} +\alias{$<-.zoo} +\alias{subset.zoo} +\alias{head.zoo} +\alias{tail.zoo} +\alias{Ops.zoo} +\alias{t.zoo} +\alias{cumsum.zoo} +\alias{cumprod.zoo} +\alias{cummin.zoo} +\alias{cummax.zoo} +\alias{na.contiguous} +\alias{na.contiguous.data.frame} +\alias{na.contiguous.list} +\alias{na.contiguous.default} +\alias{na.contiguous.zoo} +\alias{scale.zoo} +\alias{xtfrm.zoo} +\alias{names.zoo} +\alias{names<-.zoo} +\alias{rev.zoo} + +\alias{index2char} +\alias{index2char.default} +\alias{index2char.numeric} + +\alias{head.ts} +\alias{tail.ts} + +\title{Z's Ordered Observations} +\description{ +\code{zoo} is the creator for an S3 class of indexed +totally ordered observations which includes irregular +time series. +} +\usage{ +zoo(x = NULL, order.by = index(x), frequency = NULL) +\method{print}{zoo}(x, style = , quote = FALSE, \dots) +} +\arguments{ + \item{x}{a numeric vector, matrix or a factor.} + \item{order.by}{an index vector with unique entries by which the + observations in \code{x} are ordered. See the details for support + of non-unique indexes.} + \item{frequency}{numeric indicating frequency of \code{order.by}. + If specified, it is checked whether \code{order.by} and \code{frequency} + comply. If so, a regular \code{"zoo"} series is returned, i.e., + an object of class \code{c("zooreg", "zoo")}. See below and + \code{\link{zooreg}} for more details.} + \item{style}{a string specifying the printing style which can be + \code{"horizontal"} (the default for vectors), \code{"vertical"} + (the default for matrices) or \code{"plain"} (which first prints + the data and then the index).} + \item{quote}{logical. Should characters be quoted?} + \item{\dots}{further arguments passed to the print methods of + the data and the index.} +} + +\details{ +\code{zoo} provides infrastructure for ordered observations +which are stored internally in a vector or matrix with an +index attribute (of arbitrary class, see below). The index +must have the same length as \code{NROW(x)} except in the +case of a zero length numeric vector in which case the index +length can be any length. Emphasis has +been given to make all methods independent of the index/time class +(given in \code{order.by}). In principle, the data \code{x} could also +be arbitrary, but currently there is only support for vectors and matrices +and partial support for factors. + +\code{zoo} is particularly aimed at irregular time series of numeric +vectors/matrices, but it also supports regular time series (i.e., +series with a certain \code{frequency}). +\code{zoo}'s key design goals are independence of a particular +index/date/time class and consistency +with \code{ts} and base R by providing methods to standard generics. Therefore, +standard functions can be used to work with \code{"zoo"} objects and +memorization of new commands is reduced. + +When creating a \code{"zoo"} object with the function \code{zoo}, +the vector of indexes \code{order.by} can be of (a single) arbitrary class +(if \code{x} is shorter or longer than \code{order.by} it is +expanded accordingly), +but it is essential that \code{ORDER(order.by)} works. For other +functions it is assumed that \code{c()}, \code{length()}, +\code{MATCH()} and subsetting \code{[,} work. If this is not the case +for a particular index/date/time class, then methods for these +generic functions should be created by the user. Note, that to achieve this, +new generic functions \code{\link{ORDER}} and \code{\link{MATCH}} are created in +the \code{zoo} package with default methods corresponding to +the non-generic base functions \code{\link[base]{order}} +and \code{\link[base]{match}}. Furthermore, for certain (but not for all) +operations the index class should have an \code{as.numeric} method (in +particular for regular series) and an \code{as.character} method might improve +printed output (see also below). + +The index observations \code{order.by} should typically be unique, such that +the observations can be totally ordered. Nevertheless, \code{zoo()} is able to create +\code{"zoo"} objects with duplicated indexes (with a warning) and simple methods such as \code{plot()} +or \code{summary()} will typically work for such objects. However, this is +not formally supported as the bulk of functionality provided in \pkg{zoo} requires +unique index observations/time stamps. See below for an example how to remove +duplicated indexes. + +If a \code{frequency} is specified when creating a series via \code{zoo}, the +object returned is actually of class \code{"zooreg"} which inherits from \code{"zoo"}. +This is a subclass of \code{"zoo"} which relies on having a \code{"zoo"} series +with an additional \code{"frequency"} attribute (which has to comply with the +index of that series). Regular \code{"zooreg"} series can also be created by +\code{\link{zooreg}}, the \code{zoo} analogue of \code{\link{ts}}. See the +respective help page and \code{\link{is.regular}} for further details. + +Methods to standard generics for \code{"zoo"} objects currently +include: \code{print} (see above), \code{summary}, \code{str}, \code{head}, +\code{tail}, \code{[} (subsetting), \code{rbind}, \code{cbind}, \code{merge} +(see \code{\link{merge.zoo}}), \code{aggregate} (see \code{\link{aggregate.zoo}}), \code{rev}, \code{split} (see \code{\link{aggregate.zoo}}), \code{barplot}, +\code{plot} and \code{lines} (see \code{\link{plot.zoo}}). For multivariate +\code{"zoo"} series with column names the \code{$} extractor is available, +behaving similar as for \code{"data.frame"} objects. + +To \dQuote{prettify} printed output of \code{"zoo"} series the generic +function \code{index2char} is used for turning index values into character +values. It defaults to using \code{as.character} but can be customized +if a different printed display should be used (although this should not +be necessary, usually). + +The subsetting method \code{[} work essentially like the +corresponding functions for vectors or matrices respectively, i.e., takes +indexes of type \code{"numeric"}, \code{"integer"} or \code{"logical"}. But +additionally, it can be used to index with observations from the index class of +the series. If the index class of the series is one of the three classes above, +the corresponding index has to be encapsulated in \code{I()} to enforce usage of +the index class (see examples). Subscripting by a zoo object whose +data contains logical values is undefined. + +Additionally, \code{zoo} provides several generic functions and methods +to work (a) on the data contained in a \code{"zoo"} object, (b) the +index (or time) attribute associated to it, and (c) on both data and +index: + +(a) The data contained in \code{"zoo"} objects can be extracted by +\code{coredata} (strips off all \code{"zoo"}-specific attributes) and modified +using \code{coredata<-}. Both are new generic functions with methods for +\code{"zoo"} objects, see \code{\link{coredata}}. + +(b) The index associated with a \code{"zoo"} object can be extracted +by \code{index} and modified by \code{index<-}. As the interpretation +of the index as \dQuote{time} in time series applications is more natural, +there are also synonymous methods \code{time} and \code{time<-}. The +start and the end of the index/time vector can be queried by +\code{start} and \code{end}. See \code{\link{index}}. + +(c) To work on both data and index/time, \code{zoo} provides methods +\code{lag}, \code{diff} (see \code{\link{lag.zoo}}) and \code{window}, +\code{window<-} (see \code{\link{window.zoo}}). + +In addition to standard group generic function (see \code{\link{Ops}}), +the following mathematical operations are available as methods for +\code{"zoo"} objects: transpose \code{t} which coerces to a matrix +first, and \code{cumsum}, \code{cumprod}, \code{cummin}, \code{cummax} +which are applied column wise. + +Coercion to and from \code{"zoo"} objects is available for objects of +various classes, in particular \code{"ts"}, \code{"irts"} and \code{"its"} +objects can be coerced to \code{"zoo"}, the reverse is available for +\code{"its"} and for \code{"irts"} (the latter in package \code{tseries}). +Furthermore, \code{"zoo"} objects can be coerced to vectors, matrices and +lists and data frames (dropping the index/time attribute). See \code{\link{as.zoo}}. + +Six methods are available for \code{NA} handling in the data of +\code{"zoo"} objects: +\code{\link{na.approx}} which uses linear interpolation to fill +in \code{NA} values. +\code{\link{na.contiguous}} which extracts the longest consecutive +stretch of non-missing values in a \code{"zoo"} object, +\code{\link{na.locf}} which +replaces \code{NA}s by the last previous non-\code{NA}, +\code{\link{na.omit}} which returns a \code{"zoo"} +object with incomplete observations removed, +\code{\link{na.spline}} which uses linear interpolation to fill +in \code{NA} values and +\code{\link{na.trim}} which trims runs of \code{NA}s off the beginning and +end but not in the interior. A 7th \code{NA} routine can be found in +the \code{stinepack} package where \code{\link[stinepack]{na.stinterp}} which +performs Stineman interpolation. + +A typical task to be performed on ordered observations is to evaluate some +function, e.g., computing the mean, in a window of observations that is moved +over the full sample period. The generic function \code{\link{rollapply}} +provides this functionality for arbitrary functions and more efficient versions +\code{\link{rollmean}}, \code{\link{rollmax}}, \code{\link{rollmedian}} are +available for the mean, maximum and median respectively. + +The \code{zoo} package has an \code{as.Date} \code{numeric} method +which is similar to the one in the core of \code{R} except that the +\code{origin} argument defaults to January 1, 1970 (whereas the one +in the core of \code{R} has no default). +} + +\references{ + Achim Zeileis and Gabor Grothendieck (2005). + \pkg{zoo}: S3 Infrastructure for Regular and Irregular Time Series. + \emph{Journal of Statistical Software}, \bold{14(6)}, 1-27. + URL http://www.jstatsoft.org/v14/i06/ and available as + \code{vignette("zoo")}. + + Ajay Shah, Achim Zeileis and Gabor Grothendieck (2005). + \pkg{zoo} Quick Reference. + Package vignette available as \code{vignette("zoo-quickref")}. +} + +\value{ +A vector or matrix with an \code{"index"} attribute of the same +dimension (\code{NROW(x)}) by which \code{x} is ordered. +} + +\seealso{\code{\link{zooreg}}, \code{\link{plot.zoo}}, \code{\link{index}}, \code{\link{merge.zoo}}} + +\examples{ +## 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) + +## subsetting with numeric indexes +x[c(2, 4)] +## subsetting with index class +x[as.Date("2003-02-01") + c(2, 8)] + +## 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)] +## subsetting with index class can be enforced by I() +x[I(c(3, 9))] + +## 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 + +## $ extractor for multivariate zoo series with column names +z <- zoo(cbind(foo = rnorm(5), bar = rnorm(5))) +z$foo +z$xyz <- zoo(rnorm(3), 2:4) +z + +## 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 +comment(x1) + +# 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 + +## zoo series with duplicated indexes +z3 <- zoo(1:8, c(1, 2, 2, 2, 3, 4, 5, 5)) +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)] +x1[coredata(x1 > 3)] +x1[as.logical(x1 > 3)] +subset(x1, x1 > 3) + +## 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)) + +z5 <- zoo(11:15, letters[1:5]) +merge(z5, lag(z5)) + +## 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. +\dontrun{ +# this gives a warning +# and then creates an illegal zoo object +z6 <- zoo(11:15, c(1, 1, 2, 2, 5)) +z6 + +# fix it up by averaging duplicates +aggregate(z6, force, mean) + +# or, fix it up by taking last in each set of duplicates +aggregate(z6, force, tail, 1) + +# fix it up via interpolation of duplicate times +time(z6) <- na.approx(ifelse(duplicated(time(z6)), NA, time(z6)), na.rm = FALSE) +# if there is a run of equal times at end they +# wind up as NAs and we cannot have NA times +z6 <- z6[!is.na(time(z6))] +z6 + +x1. <- x1 <- zoo (matrix (1:12, nrow = 3), as.Date("2008-08-01") + 0:2) +colnames (x1) <- c ("A", "B", "C", "D") +x2 <- zoo (matrix (1:12, nrow = 3), as.Date("2008-08-01") + 1:3) +colnames (x2) <- c ("B", "C", "D", "E") + +both.dates = as.Date (intersect (index (t1), index (t2))) +both.cols = intersect (colnames (t1), colnames (t2)) + +x1 [both.dates, both.cols] + +## +## there is "[.zoo" but no "[<-.zoo" however these 4 work +## + +## wrong +## x1[both.dates, both.cols] <- x2[both.dates, both.cols] + +# 4 correct alternates +# #1 +window(x1, both.dates)[, both.cols] <- x2[both.dates, both.cols] + +# #2. restore x1 and show a different way +x1 <- x1. +window(x1, both.dates)[, both.cols] <- window(x2, both.dates)[, both.cols] + +# #3. restore x1 and show a different way +x1 <- x1. +x1[time(x1) %in% both.dates, both.cols] <- x2[both.dates, both.cols] + +# #4. restore x1 and show a different way +x1 <- x1. +x1[time(x1) %in% both.dates, both.cols] <- x2[time(t2) %in% both.dates, both.cols] + + + +} + +} +\keyword{ts} + diff --git a/man/zooreg.Rd b/man/zooreg.Rd new file mode 100644 index 0000000..af5f91f --- /dev/null +++ b/man/zooreg.Rd @@ -0,0 +1,171 @@ +\name{zooreg} +\alias{zooreg} +\alias{frequency.zooreg} +\alias{frequency.zoo} +\alias{deltat.zooreg} +\alias{deltat.zoo} +\alias{cycle.zooreg} +\alias{cycle.zoo} +\alias{as.zooreg} +\alias{as.zooreg.default} +\alias{as.zooreg.ts} +\alias{as.zooreg.its} +\alias{as.zooreg.xts} +\alias{as.ts.zooreg} +\alias{as.zoo.zooreg} +\alias{as.zooreg.zoo} +\alias{index<-.zooreg} +\alias{time<-.zooreg} +\alias{lag.zooreg} + +\title{Regular zoo Series} + +\description{ +\code{zooreg} is the creator for the S3 class \code{"zooreg"} +for regular \code{"zoo"} series. It inherits from \code{"zoo"} +and is the analogue to \code{\link{ts}}. +} + +\usage{ +zooreg(data, start = 1, end = numeric(), frequency = 1, + deltat = 1, ts.eps = getOption("ts.eps"), order.by = NULL) +} + +\arguments{ + \item{data}{a numeric vector, matrix or a factor.} + \item{start}{the time of the first observation. Either a single number or + a vector of two integers, which specify a natural time unit + and a (1-based) number of samples into the time unit.} + \item{end}{the time of the last observation, specified in the same way + as \code{start}.} + \item{frequency}{the number of observations per unit of time.} + \item{deltat}{the fraction of the sampling period between successive + observations; e.g., 1/12 for monthly data. Only one of + \code{frequency} or \code{deltat} should be provided.} + \item{ts.eps}{time series comparison tolerance. Frequencies are considered + equal if their absolute difference is less than \code{ts.eps}.} + \item{order.by}{a vector by which the observations in \code{x} + are ordered. If this is specified the arguments \code{start} and + \code{end} are ignored and \code{zoo(data, order.by, frequency)} is + called. See \code{\link{zoo}} for more information.} +} + +\details{ +Strictly regular series are those whose time points are equally spaced. +Weakly regular series are strictly regular time series in which some +of the points may have been removed but still have the original +underlying frequency associated with them. +\code{"zooreg"} is a subclass of \code{"zoo"} that is used to represent both weakly +and strictly regular series. Internally, it is the same as \code{"zoo"} except +it also has a \code{"frequency"} attribute. Its index class is more restricted +than \code{"zoo"}. The index: 1. must be numeric or a class which can be coerced +via \code{as.numeric} (such as \code{\link{yearmon}}, \code{\link{yearqtr}}, +\code{\link{Date}}, \code{\link{POSIXct}}, \code{\link[fame]{tis}}, +\code{\link[xts]{xts}}, etc.). +2. when converted to numeric +must be expressible as multiples of 1/frequency. 3. +group generic functions \code{\link{Ops}} should be defined, i.e., +adding/subtracting a numeric to/from the index class should produce the correct +value of the index class again. + +\code{zooreg} is the \code{zoo} analogue to \code{\link{ts}}. The arguments +are almost identical, only in the case where \code{order.by} is specified, +\code{\link{zoo}} is called with \code{zoo(data, order.by, frequency)}. It +creates a regular series of class \code{"zooreg"} which inherits from \code{"zoo"}. +It is essentially a \code{"zoo"} series with an additional \code{"frequency"} +attribute. In the creation of \code{"zooreg"} objects (via \code{\link{zoo}}, +\code{\link{zooreg}}, or coercion functions) it is always check whether the +index specified complies with the frequency specified. + +The class \code{"zooreg"} offers two advantages over code \code{"ts"}: 1. The +index does not have to be plain numeric (although that is the default), it just +must be coercible to numeric, thus printing and plotting can be customized. +2. This class can not only represent strictly regular series, but also series +with an underlying regularity, i.e., where some observations from a regular grid +are omitted. + +Hence, \code{"zooreg"} is a bridge between \code{"ts"} and \code{"zoo"} and +can be employed to coerce back and forth between the two classes. The coercion +function \code{as.zoo.ts} returns therefore an object of class \code{"zooreg"} +inheriting from \code{"zoo"}. Coercion between \code{"zooreg"} and \code{"zoo"} +is also available and drops or tries to add a frequency respectively. + +For checking whether a series is strictly regular or does have an underlying +regularity the generic function \code{\link{is.regular}} can be used. + +Methods to standard generics for regular series such as \code{\link{frequency}}, +\code{\link{deltat}} and \code{\link{cycle}} are available for both \code{"zooreg"} +and \code{"zoo"} objects. In the latter case, it is checked first (in a data-driven way) +whether the series is in fact regular or not. + +\code{as.zooreg.tis} has a \code{class} argument whose value represents the +class of the index of the \code{zooreg} object into which the \code{tis} +object is converted. The default value is \code{"ti"}. Note that the +frequency of the \code{zooreg} object will not necessarily be the same +as the frequency of the \code{tis} object that it is converted from. +} + +\value{ +An object of class \code{"zooreg"} which inherits from \code{"zoo"}. +It is essentially a \code{"zoo"} series with a \code{"frequency"} +attribute. +} + +\seealso{\code{\link{zoo}}, \code{\link{is.regular}}} + +\examples{ +## equivalent specifications of a quarterly series +## starting in the second quarter of 1959. +zooreg(1:10, frequency = 4, start = c(1959, 2)) +as.zoo(ts(1:10, frequency = 4, start = c(1959, 2))) +zoo(1:10, seq(1959.25, 1961.5, by = 0.25), frequency = 4) + +## use yearqtr class for indexing the same series +z <- zoo(1:10, yearqtr(seq(1959.25, 1961.5, by = 0.25)), frequency = 4) +z +z[-(3:4)] + +## create a regular series with a "Date" index +zooreg(1:5, start = Sys.Date()) +## or with "yearmon" index +zooreg(1:5, end = yearmon(2000)) + +## 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) +lag(zr, k = -1) +diff(zz) +diff(zr) + +## lag.zooreg wihtout and with na.pad +lag(zr, k = -1) +lag(zr, k = -1, na.pad = TRUE) + +## standard methods available for regular series +frequency(z) +deltat(z) +cycle(z) +cycle(z[-(3:4)]) + +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. +\dontrun{ +length(as.ts(zz)) # 154 +} +# 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 + +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)) + +} +\keyword{ts}