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 0000000..ed7194a Binary files /dev/null and b/inst/doc/MSFT.rda differ 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 0000000..65057bb Binary files /dev/null and b/inst/doc/sunw.rda differ diff --git a/inst/doc/zoo-faq.Rnw b/inst/doc/zoo-faq.Rnw new file mode 100644 index 0000000..a1eb85f --- /dev/null +++ b/inst/doc/zoo-faq.Rnw @@ -0,0 +1,494 @@ +\documentclass[article,nojss]{jss} +\DeclareGraphicsExtensions{.pdf,.eps} +%%\newcommand{\mysection}[2]{\subsubsection[#2]{\textbf{#1}}} +\let\mysection=\subsubsection +\renewcommand{\jsssubsubsec}[2][default]{\vskip \preSskip% + \pdfbookmark[3]{#1}{Subsubsection.\thesubsubsection.#1}% + \refstepcounter{subsubsection}% + {\large \textbf{\textit{#2}}} \nopagebreak + \vskip \postSskip \nopagebreak} + +%% need no \usepackage{Sweave} + +\author{Gabor Grothendieck\\GKX Associates Inc. \And + Achim Zeileis\\Wirtschaftsuniversit\"at Wien} +\Plainauthor{Achim Zeileis, Gabor Grothendieck} + +\title{\pkg{zoo} FAQ} +\Plaintitle{zoo FAQ} + +\Keywords{irregular time series, daily data, weekly data, returns} + +\Abstract{ + This is a collection of frequently asked questions (FAQ) about the + \pkg{zoo} package together with their answers. +} + +\Address{ + Gabor Grothendieck\\ + GKX Associates Inc.\\ + E-mail: \email{ggrothendieck@gmail.com}\\ + + Achim Zeileis\\ + Wirtschaftsuniversit\"at Wien\\ + E-mail: \email{Achim.Zeileis@R-project.org}\\ +} + +\begin{document} + +\SweaveOpts{engine=R,eps=FALSE} +%\VignetteIndexEntry{zoo FAQ} +%\VignetteDepends{zoo,tseries} +%\VignetteKeywords{irregular time series, daily data, weekly data, returns} +%\VignettePackage{zoo} + + +<>= +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 0000000..77c9bca Binary files /dev/null and b/inst/doc/zoo-refcard.pdf differ 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}